Permalink
Browse files

Merge pull request #1276 from TomasMikula/FreeTMonadPlus-fix

Fix the `plus` operation for `FreeT`
  • Loading branch information...
2 parents 2f43966 + ec93e26 commit 82120da91df57184b35780e850528ccad446f48b @TomasMikula TomasMikula committed on GitHub Feb 14, 2017
Showing with 28 additions and 12 deletions.
  1. +9 −12 core/src/main/scala/scalaz/FreeT.scala
  2. +19 −0 tests/src/test/scala/scalaz/FreeTTest.scala
@@ -156,25 +156,22 @@ sealed abstract class FreeT[S[_], M[_], A] {
})
/**
- * Finds the first `M` instance, `m`, and maps it to contain the rest
- * of the computation. Since only `map` is used on `m`, its structure
- * is preserved.
+ * Perform recursive binds on `M` until first suspension is reached.
*/
- @tailrec
- private[scalaz] final def toM(implicit M: Applicative[M]): M[FreeT[S, M, A]] =
- this match {
+ private[scalaz] final def toM(implicit M0: BindRec[M], M: Applicative[M]): M[FreeT[S, M, A]] =
+ M0.tailrecM(this)(_.step match {
case Suspend(m) => M.map(m) {
- case -\/(a) => point(a)
- case \/-(s) => liftF(s)
+ case -\/(a) => \/-(point(a))
+ case \/-(s) => \/-(liftF(s))
}
case g1 @ Gosub(_, _) => g1.a match {
case Suspend(m) => M.map(m) {
- case -\/(a) => g1.f(a)
- case \/-(s) => liftF[S, M, g1.A](s).flatMap(g1.f)
+ case -\/(a) => -\/(g1.f(a))
+ case \/-(s) => \/-(liftF[S, M, g1.A](s).flatMap(g1.f))
}
- case g0 @ Gosub(_, _) => g0.a.flatMap(g0.f(_).flatMap(g1.f)).toM
+ case g0 @ Gosub(_, _) => sys.error("Unreachable code: `Gosub` returned from `step` has `Suspend` on the left")
}
- }
+ })
@tailrec
private def step: FreeT[S, M, A] =
@@ -36,6 +36,25 @@ object FreeTTest extends SpecLite {
checkAll(traverse.laws[FreeTListOption])
checkAll(monadTrans.laws[FreeTList, Option])
+ "lawful MonadPlus" in {
+ // give names to some expressions
+ val f: Unit => FreeTListOption[Unit] = _ => FreeT.liftM(MonadPlus[Option].empty)
+ val a = ()
+ val g = ().point[FreeTListOption]
+
+ // by the monad laws, f1 = f2
+ val f1 = a.point[FreeTListOption] flatMap f
+ val f2 = f(a)
+
+ // by the substitution property of equality,
+ // when f1 = f2, then also fg1 = fg2
+ val fg1 = MonadPlus[FreeTListOption].plus(f1, g)
+ val fg2 = MonadPlus[FreeTListOption].plus(f2, g)
+
+ // so let's check that
+ Equal[FreeTListOption[Unit]].equal(fg1, fg2)
+ }
+
"not stack overflow with 50k binds" in {
val expected = Applicative[FreeTListOption].point(())
val result =

0 comments on commit 82120da

Please sign in to comment.