From dd3419a0811e17d19584ac240831c99bc216f734 Mon Sep 17 00:00:00 2001 From: raulraja Date: Wed, 20 Jul 2016 01:12:37 +0200 Subject: [PATCH 01/22] A mens to derive folds from foldMap and FreeT + instances --- core/src/main/scala/cats/Foldable.scala | 21 +- free/src/main/scala/cats/free/FreeT.scala | 348 ++++++++++++++++++++++ 2 files changed, 368 insertions(+), 1 deletion(-) create mode 100644 free/src/main/scala/cats/free/FreeT.scala diff --git a/core/src/main/scala/cats/Foldable.scala b/core/src/main/scala/cats/Foldable.scala index fa0a9df71a..13859dd4e2 100644 --- a/core/src/main/scala/cats/Foldable.scala +++ b/core/src/main/scala/cats/Foldable.scala @@ -206,7 +206,6 @@ import simulacrum.typeclass def foldK[G[_], A](fga: F[G[A]])(implicit G: MonoidK[G]): G[A] = fold(fga)(G.algebra) - /** * Find the first element matching the predicate, if one exists. */ @@ -291,4 +290,24 @@ object Foldable { Eval.defer(if (it.hasNext) f(it.next, loop()) else lb) loop() } + + /** Do we want syntax for FunctionN on cats.syntax ? + */ + private[cats] def flip[A, B, R](f: (A, B) => R) : (B, A) => R = + (b: B, a: A) => f(a, b) + + trait FromFoldMap[F[_]] extends Foldable[F] { + + implicit def endoMonoidFunction1[A] : Monoid[A => A] = implicitly + + implicit def endoMonoidFunction2[A, B] : Monoid[(A, B) => A] = implicitly + + override def foldLeft[A, B](fa: F[A], b: B)(f: (B, A) => B): B = + foldMap(fa)((a: A) => flip(f).curried(a)) apply (b) + + override def foldRight[A, B](fa: F[A], lb: Eval[B])(f: (A, Eval[B]) => Eval[B]) : Eval[B] = + foldMap(fa)((a: A) => f(a, _: Eval[B])) apply lb + + } + } diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala new file mode 100644 index 0000000000..f062239a62 --- /dev/null +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -0,0 +1,348 @@ +package cats +package free + +import scala.annotation.tailrec + +import cats.data.Xor + + +sealed abstract class FreeT[S[_], M[_], A] { + + import FreeT._ + + final def map[B](f: A => B)(implicit M: Applicative[M]): FreeT[S, M, B] = + flatMap(a => pure(f(a))) + + /** Binds the given continuation to the result of this computation. */ + final def flatMap[B](f: A => FreeT[S, M, B]): FreeT[S, M, B] = + Gosub(this, f) + + /** + * Changes the underlying `Monad` for this `FreeT`, ie. + * turning this `FreeT[S, M, A]` into a `FreeT[S, N, A]`. + */ + def hoist[N[_]](mn: M ~> N): FreeT[S, N, A] = + step match { + case e @ Gosub(_, _) => + Gosub(e.a.hoist(mn), e.f.andThen(_.hoist(mn))) + case Suspend(m) => + Suspend(mn(m)) + } + + /** Change the base functor `S` for a `FreeT` action. */ + def interpret[T[_]](st: S ~> T)(implicit M: Functor[M]): FreeT[T, M, A] = + step match { + case e @ Gosub(_, _) => + Gosub(e.a.interpret(st), e.f.andThen(_.interpret(st))) + case Suspend(m) => + Suspend(M.map(m)(_.map(s => st(s)))) + } + + /** + * Runs to completion, mapping the suspension with the given transformation + * at each step and accumulating into the monad `M`. + */ + def foldMap(f: S ~> M)(implicit M0: FlatMapRec[M], M1: Applicative[M]): M[A] = { + def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = + ft match { + case Suspend(ma) => M0.flatMap(ma) { + case Xor.Left(a) => M1.pure(Xor.Right(a)) + case Xor.Right(sa) => M0.map(f(sa))(Xor.right) + } + case g @ Gosub(_, _) => g.a match { + case Suspend(mx) => M0.flatMap(mx) { + case Xor.Left(x) => M1.pure(Xor.left(g.f(x))) + case Xor.Right(sx) => M0.map(f(sx))(g.f andThen Xor.left) + } + case g0 @ Gosub(_, _) => M1.pure(Xor.left(g0.a.flatMap(g0.f(_).flatMap(g.f)))) + } + } + + M0.tailRecM(this)(go) + } + + /** Evaluates a single layer of the free monad **/ + def resume(implicit S: Functor[S], M0: FlatMapRec[M], M1: Applicative[M]): M[A Xor S[FreeT[S, M, A]]] = { + def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor (A Xor S[FreeT[S, M, A]])] = + ft match { + case Suspend(f) => M0.map(f)(as => Xor.right(as.map(S.map(_)(pure(_))))) + case g1 @ Gosub(_, _) => g1.a match { + case Suspend(m1) => M0.map(m1) { + case Xor.Left(a) => Xor.left(g1.f(a)) + case Xor.Right(fc) => Xor.right(Xor.right(S.map(fc)(g1.f(_)))) + } + case g2 @ Gosub(_, _) => M1.pure(Xor.left(g2.a.flatMap(g2.f(_).flatMap(g1.f)))) + } + } + + M0.tailRecM(this)(go) + } + + /** + * Runs to completion, using a function that maps the resumption from `S` to a monad `M`. + */ + def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], M0: FlatMapRec[M], M1: Applicative[M]): M[A] = { + def runM2(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = + M0.flatMap(ft.resume) { + case Xor.Left(a) => M1.pure(Xor.right(a)) + case Xor.Right(fc) => M0.map(interp(fc))(Xor.left) + } + + M0.tailRecM(this)(runM2) + } + + /** + * 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. + */ + @tailrec + private[cats] final def toM(implicit M: Applicative[M]): M[FreeT[S, M, A]] = + this match { + case Suspend(m) => M.map(m) { + case Xor.Left(a) => pure(a) + case Xor.Right(s) => liftF(s) + } + case g1 @ Gosub(_, _) => g1.a match { + case Suspend(m) => M.map(m) { + case Xor.Left(a) => g1.f(a) + case Xor.Right(s) => liftF[S, M, g1.A](s).flatMap(g1.f) + } + case g0 @ Gosub(_, _) => g0.a.flatMap(g0.f(_).flatMap(g1.f)).toM + } + } + + @tailrec + private def step: FreeT[S, M, A] = + this match { + case g @ Gosub(_, _) => g.a match { + case g0 @ Gosub(_, _) => g0.a.flatMap(a => g0.f(a).flatMap(g.f)).step + case _ => g + } + case x => x + } +} + + +object FreeT /* extends FreeTInstances */ { + /** Suspend the computation with the given suspension. */ + private case class Suspend[S[_], M[_], A](a: M[A Xor S[A]]) extends FreeT[S, M, A] + + /** Call a subroutine and continue with the given function. */ + private case class Gosub[S[_], M[_], A0, B](a0: FreeT[S, M, A0], f0: A0 => FreeT[S, M, B]) extends FreeT[S, M, B] { + type A = A0 + def a: FreeT[S, M, A] = a0 + def f: A => FreeT[S, M, B] = f0 + } + + /** Return the given value in the free monad. */ + def pure[S[_], M[_], A](value: A)(implicit M: Applicative[M]): FreeT[S, M, A] = Suspend(M.pure(Xor.left(value))) + + def suspend[S[_], M[_], A](a: M[A Xor S[FreeT[S, M, A]]])(implicit M: Applicative[M]): FreeT[S, M, A] = + liftT(a).flatMap({ + case Xor.Left(a) => pure(a) + case Xor.Right(s) => roll(s) + }) + + def tailRecM[S[_], M[_]: Applicative, A, B](a: A)(f: A => FreeT[S, M, A Xor B]): FreeT[S, M, B] = + f(a).flatMap { + case Xor.Left(a0) => tailRecM(a0)(f) + case Xor.Right(b) => pure[S, M, B](b) + } + + def liftT[S[_], M[_], A](value: M[A])(implicit M: Functor[M]): FreeT[S, M, A] = + Suspend(M.map(value)(Xor.left)) + + /** A version of `liftT` that infers the nested type constructor. */ + def liftTU[S[_], MA](value: MA)(implicit M: Unapply[Functor, MA]): FreeT[S, M.M, M.A] = + liftT[S, M.M, M.A](M.subst(value))(M.TC) + + /** Suspends a value within a functor in a single step. Monadic unit for a higher-order monad. */ + def liftF[S[_], M[_], A](value: S[A])(implicit M: Applicative[M]): FreeT[S, M, A] = + Suspend(M.pure(Xor.right(value))) + + def roll[S[_], M[_], A](value: S[FreeT[S, M, A]])(implicit M: Applicative[M]): FreeT[S, M, A] = + liftF[S, M, FreeT[S, M, A]](value).flatMap(identity) + +} + +sealed abstract class FreeTInstances6 { + /* + implicit def freeTMonadWriter[S[_], M[_], E](implicit M1: MonadWriter[M, E]): MonadWriter[FreeT[S, M, ?], E] = + new MonadWriter[FreeT[S, M, ?], E] with FreeTMonad[S, M] { + + override def M = implicitly + + override def writer[A](aw: (E, A)) = + FreeT.liftT(M1.writer(aw)) + + override def listen[A](fa: FreeT[S,M,A]) : FreeT[S,M,(E, A)] = { + val tmp = M1.flatMap[(A Xor A, W), A Xor (B, W)](M1.listen(ma.)){ + case (Xor.Left(a), _) => M1.pure(Xor.left(a)) + case (Xor.Right(b), w) => M1.pure(Xor.right((b, w))) + } + + } + FreeT.liftT(flatMap(fa.value)(a => map(fa.written)(l => (l, (l, a))))) + } + */ +} + + // def writer[A](aw: (W, A)): F[A] + + + +sealed abstract class FreeTInstances5 extends FreeTInstances6 { + implicit def freeTMonadReader[S[_], M[_], E](implicit M1: MonadReader[M, E]): MonadReader[FreeT[S, M, ?], E] = + new MonadReader[FreeT[S, M, ?], E] with FreeTMonad[S, M] { + override def M = implicitly + override def ask = + FreeT.liftT(M1.ask) + override def local[B](f: E => E)(fa: FreeT[S, M, B]) = + fa.hoist(new (M ~> M){ + def apply[A](a: M[A]) = M1.local(f)(a) + }) + } +} + +sealed abstract class FreeTInstances4 extends FreeTInstances5 { + implicit def freeTMonadState[S[_], M[_], E](implicit M1: MonadState[M, E]): MonadState[FreeT[S, M, ?], E] = + new MonadState[FreeT[S, M, ?], E] with FreeTMonad[S, M] { + override def M = implicitly + override def get = + FreeT.liftT(M1.get) + override def set(s: E) = + FreeT.liftT(M1.set(s)) + } +} + +sealed abstract class FreeTInstances3 extends FreeTInstances4 { + implicit def freeTMonadError[S[_], M[_]: FlatMapRec, E](implicit E: MonadError[M, E]): MonadError[FreeT[S, M, ?], E] = + new MonadError[FreeT[S, M, ?], E] with FreeTMonad[S, M] { + override def M = implicitly + override def handleErrorWith[A](fa: FreeT[S, M, A])(f: E => FreeT[S, M, A]) = + FreeT.liftT[S, M, FreeT[S, M, A]](E.handleErrorWith(fa.toM)(f.andThen(_.toM)))(M).flatMap(identity) + override def raiseError[A](e: E) = + FreeT.liftT(E.raiseError[A](e))(M) + } +} + +sealed abstract class FreeTInstances2 extends FreeTInstances3 { + implicit def freeTFlatMap[S[_], M[_]](implicit M0: Applicative[M]): FlatMap[FreeT[S, M, ?]] = + new FreeTFlatMap[S, M] { + implicit def M: Applicative[M] = M0 + } + + implicit def freeTTransLift[S[_]]: TransLift[FreeT[S, ?[_], ?]] = + new TransLift[FreeT[S, ?[_], ?]] { + + type TC[M[_]] = Functor[M] + + override def liftT[M[_]: Functor, A](ma: M[A]): FreeT[S, M, A] = + FreeT.liftT(ma) + } + + implicit def freeTFoldable[S[_]: Foldable: Functor, M[_]: Foldable: Applicative: FlatMapRec]: Foldable[FreeT[S, M, ?]] = + new FreeTFoldable[S, M] { + override def S = implicitly + override def F = implicitly + override def M = implicitly + override def M1 = implicitly + override def M2 = implicitly + } +} + +sealed abstract class FreeTInstances1 extends FreeTInstances2 { + implicit def freeTTraverse[S[_]: Traverse, M[_]: Traverse: Applicative: FlatMapRec]: Traverse[FreeT[S, M, ?]] = + new FreeTTraverse[S, M] { + override def F = implicitly + override def M = implicitly + override def M1 = implicitly + override def M2 = implicitly + } +} + +sealed abstract class FreeTInstances0 extends FreeTInstances1 { + implicit def freeTMonad[S[_], M[_]](implicit M0: Applicative[M]): Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] = + new FreeTMonad[S, M] { + def M = M0 + } + + implicit def freeTCombine[S[_], M[_]: Applicative: FlatMapRec: SemigroupK]: SemigroupK[FreeT[S, M, ?]] = + new FreeTCombine[S, M] { + override def M = implicitly + override def M1 = implicitly + override def M2 = implicitly + } +} + +sealed abstract class FreeTInstances extends FreeTInstances0 { + implicit def freeTMonadCombine[S[_], M[_]: Alternative: FlatMapRec]: MonadCombine[FreeT[S, M, ?]] = + new MonadCombine[FreeT[S, M, ?]] with FreeTCombine[S, M] with FreeTMonad[S, M] { + override def M = implicitly + override def M1 = implicitly + override def M2 = implicitly + + override def empty[A] = FreeT.liftT[S, M, A](MonoidK[M].empty[A])(M) + } +} + +private trait FreeTFlatMap[S[_], M[_]] extends FlatMap[FreeT[S, M, ?]] { + implicit def M: Applicative[M] + + override final def map[A, B](fa: FreeT[S, M, A])(f: A => B): FreeT[S, M, B] = fa.map(f) + def flatMap[A, B](fa: FreeT[S, M, A])(f: A => FreeT[S, M, B]): FreeT[S, M, B] = fa.flatMap(f) +} + +private trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] with FreeTFlatMap[S, M] { + implicit def M: Applicative[M] + + override final def pure[A](a: A) = + FreeT.pure[S, M, A](a) + override final def tailRecM[A, B](a: A)(f: A => FreeT[S, M, A Xor B]) = + FreeT.tailRecM(a)(f) +} + +private trait FreeTCombine[S[_], M[_]] extends SemigroupK[FreeT[S, M, ?]] { + implicit def M: Applicative[M] + implicit def M1: FlatMapRec[M] + def M2: SemigroupK[M] + override final def combineK[A](a: FreeT[S, M, A], b: FreeT[S, M, A]) = + FreeT.liftT(M2.combineK(a.toM, b.toM))(M).flatMap(identity) +} + +private trait FreeTFoldable[S[_], M[_]] extends Foldable[FreeT[S, M, ?]] with Foldable.FromFoldMap[FreeT[S, M, ?]] { + implicit def S: Functor[S] + implicit def M: Applicative[M] + implicit def M1: FlatMapRec[M] + def F: Foldable[S] + def M2: Foldable[M] + + override final def foldMap[A, B: Monoid](fa: FreeT[S, M, A])(f: A => B): B = + M2.foldMap(fa.resume){ + case Xor.Right(a) => + F.foldMap(a)(foldMap(_)(f)) + case Xor.Left(a) => + f(a) + } +} + +private trait FreeTTraverse[S[_], M[_]] extends Traverse[FreeT[S, M, ?]] with FreeTFoldable[S, M] with FreeTFlatMap[S, M] { + override final def S: Functor[S] = F + override implicit def F: Traverse[S] + override def M2: Traverse[M] + override implicit def M: Applicative[M] + override implicit def M1: FlatMapRec[M] + + override final def traverse[G[_], A, B](fa: FreeT[S, M, A])(f: A => G[B])(implicit G: Applicative[G]) = + G.map( + M2.traverse(fa.resume){ + case Xor.Right(a) => + G.map(F.traverse(a)(traverse(_)(f)))(FreeT.roll(_)(M)) + case Xor.Left(a) => + G.map(f(a))(FreeT.pure[S, M, B]) + } + )(FreeT.liftT(_)(M).flatMap(identity)) +} + + From 43d08cb470e15c3b0a853cd59a6865cd0e568261 Mon Sep 17 00:00:00 2001 From: raulraja Date: Mon, 1 Aug 2016 23:52:55 +0200 Subject: [PATCH 02/22] FreeT Instances + Law Tests --- core/src/main/scala/cats/Foldable.scala | 21 +-- free/src/main/scala/cats/free/FreeT.scala | 131 +++------------- .../src/test/scala/cats/free/FreeTTests.scala | 144 ++++++++++++++++++ 3 files changed, 164 insertions(+), 132 deletions(-) create mode 100644 free/src/test/scala/cats/free/FreeTTests.scala diff --git a/core/src/main/scala/cats/Foldable.scala b/core/src/main/scala/cats/Foldable.scala index 13859dd4e2..fa0a9df71a 100644 --- a/core/src/main/scala/cats/Foldable.scala +++ b/core/src/main/scala/cats/Foldable.scala @@ -206,6 +206,7 @@ import simulacrum.typeclass def foldK[G[_], A](fga: F[G[A]])(implicit G: MonoidK[G]): G[A] = fold(fga)(G.algebra) + /** * Find the first element matching the predicate, if one exists. */ @@ -290,24 +291,4 @@ object Foldable { Eval.defer(if (it.hasNext) f(it.next, loop()) else lb) loop() } - - /** Do we want syntax for FunctionN on cats.syntax ? - */ - private[cats] def flip[A, B, R](f: (A, B) => R) : (B, A) => R = - (b: B, a: A) => f(a, b) - - trait FromFoldMap[F[_]] extends Foldable[F] { - - implicit def endoMonoidFunction1[A] : Monoid[A => A] = implicitly - - implicit def endoMonoidFunction2[A, B] : Monoid[(A, B) => A] = implicitly - - override def foldLeft[A, B](fa: F[A], b: B)(f: (B, A) => B): B = - foldMap(fa)((a: A) => flip(f).curried(a)) apply (b) - - override def foldRight[A, B](fa: F[A], lb: Eval[B])(f: (A, Eval[B]) => Eval[B]) : Eval[B] = - foldMap(fa)((a: A) => f(a, _: Eval[B])) apply lb - - } - } diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index f062239a62..53fcd56787 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -5,8 +5,7 @@ import scala.annotation.tailrec import cats.data.Xor - -sealed abstract class FreeT[S[_], M[_], A] { +sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { import FreeT._ @@ -87,7 +86,6 @@ sealed abstract class FreeT[S[_], M[_], A] { case Xor.Left(a) => M1.pure(Xor.right(a)) case Xor.Right(fc) => M0.map(interp(fc))(Xor.left) } - M0.tailRecM(this)(runM2) } @@ -124,12 +122,12 @@ sealed abstract class FreeT[S[_], M[_], A] { } -object FreeT /* extends FreeTInstances */ { +object FreeT extends FreeTInstances { /** Suspend the computation with the given suspension. */ - private case class Suspend[S[_], M[_], A](a: M[A Xor S[A]]) extends FreeT[S, M, A] + private[free] case class Suspend[S[_], M[_], A](a: M[A Xor S[A]]) extends FreeT[S, M, A] /** Call a subroutine and continue with the given function. */ - private case class Gosub[S[_], M[_], A0, B](a0: FreeT[S, M, A0], f0: A0 => FreeT[S, M, B]) extends FreeT[S, M, B] { + private[free] case class Gosub[S[_], M[_], A0, B](a0: FreeT[S, M, A0], f0: A0 => FreeT[S, M, B]) extends FreeT[S, M, B] { type A = A0 def a: FreeT[S, M, A] = a0 def f: A => FreeT[S, M, B] = f0 @@ -166,47 +164,8 @@ object FreeT /* extends FreeTInstances */ { } -sealed abstract class FreeTInstances6 { - /* - implicit def freeTMonadWriter[S[_], M[_], E](implicit M1: MonadWriter[M, E]): MonadWriter[FreeT[S, M, ?], E] = - new MonadWriter[FreeT[S, M, ?], E] with FreeTMonad[S, M] { - - override def M = implicitly - - override def writer[A](aw: (E, A)) = - FreeT.liftT(M1.writer(aw)) - - override def listen[A](fa: FreeT[S,M,A]) : FreeT[S,M,(E, A)] = { - val tmp = M1.flatMap[(A Xor A, W), A Xor (B, W)](M1.listen(ma.)){ - case (Xor.Left(a), _) => M1.pure(Xor.left(a)) - case (Xor.Right(b), w) => M1.pure(Xor.right((b, w))) - } - - } - FreeT.liftT(flatMap(fa.value)(a => map(fa.written)(l => (l, (l, a))))) - } - */ -} - - // def writer[A](aw: (W, A)): F[A] - - - -sealed abstract class FreeTInstances5 extends FreeTInstances6 { - implicit def freeTMonadReader[S[_], M[_], E](implicit M1: MonadReader[M, E]): MonadReader[FreeT[S, M, ?], E] = - new MonadReader[FreeT[S, M, ?], E] with FreeTMonad[S, M] { - override def M = implicitly - override def ask = - FreeT.liftT(M1.ask) - override def local[B](f: E => E)(fa: FreeT[S, M, B]) = - fa.hoist(new (M ~> M){ - def apply[A](a: M[A]) = M1.local(f)(a) - }) - } -} - -sealed abstract class FreeTInstances4 extends FreeTInstances5 { - implicit def freeTMonadState[S[_], M[_], E](implicit M1: MonadState[M, E]): MonadState[FreeT[S, M, ?], E] = +private[free] sealed trait FreeTInstances3 { + implicit def catsFreeMonadStateForFreeT[S[_], M[_], E](implicit M1: MonadState[M, E]): MonadState[FreeT[S, M, ?], E] = new MonadState[FreeT[S, M, ?], E] with FreeTMonad[S, M] { override def M = implicitly override def get = @@ -216,8 +175,8 @@ sealed abstract class FreeTInstances4 extends FreeTInstances5 { } } -sealed abstract class FreeTInstances3 extends FreeTInstances4 { - implicit def freeTMonadError[S[_], M[_]: FlatMapRec, E](implicit E: MonadError[M, E]): MonadError[FreeT[S, M, ?], E] = +private[free] sealed trait FreeTInstances2 extends FreeTInstances3 { + implicit def catsFreeMonadErrorForFreeT[S[_], M[_]: FlatMapRec, E](implicit E: MonadError[M, E]): MonadError[FreeT[S, M, ?], E] = new MonadError[FreeT[S, M, ?], E] with FreeTMonad[S, M] { override def M = implicitly override def handleErrorWith[A](fa: FreeT[S, M, A])(f: E => FreeT[S, M, A]) = @@ -227,13 +186,13 @@ sealed abstract class FreeTInstances3 extends FreeTInstances4 { } } -sealed abstract class FreeTInstances2 extends FreeTInstances3 { - implicit def freeTFlatMap[S[_], M[_]](implicit M0: Applicative[M]): FlatMap[FreeT[S, M, ?]] = +private[free] sealed trait FreeTInstances1 extends FreeTInstances2 { + implicit def catsFreeFlatMapForFreeT[S[_], M[_]](implicit M0: Applicative[M]): FlatMap[FreeT[S, M, ?]] = new FreeTFlatMap[S, M] { implicit def M: Applicative[M] = M0 } - implicit def freeTTransLift[S[_]]: TransLift[FreeT[S, ?[_], ?]] = + implicit def catsFreeTransLiftForFreeT[S[_]]: TransLift[FreeT[S, ?[_], ?]] = new TransLift[FreeT[S, ?[_], ?]] { type TC[M[_]] = Functor[M] @@ -241,34 +200,15 @@ sealed abstract class FreeTInstances2 extends FreeTInstances3 { override def liftT[M[_]: Functor, A](ma: M[A]): FreeT[S, M, A] = FreeT.liftT(ma) } - - implicit def freeTFoldable[S[_]: Foldable: Functor, M[_]: Foldable: Applicative: FlatMapRec]: Foldable[FreeT[S, M, ?]] = - new FreeTFoldable[S, M] { - override def S = implicitly - override def F = implicitly - override def M = implicitly - override def M1 = implicitly - override def M2 = implicitly - } } -sealed abstract class FreeTInstances1 extends FreeTInstances2 { - implicit def freeTTraverse[S[_]: Traverse, M[_]: Traverse: Applicative: FlatMapRec]: Traverse[FreeT[S, M, ?]] = - new FreeTTraverse[S, M] { - override def F = implicitly - override def M = implicitly - override def M1 = implicitly - override def M2 = implicitly - } -} - -sealed abstract class FreeTInstances0 extends FreeTInstances1 { - implicit def freeTMonad[S[_], M[_]](implicit M0: Applicative[M]): Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] = +private[free] sealed trait FreeTInstances0 extends FreeTInstances1 { + implicit def catsFreeMonadForFreeT[S[_], M[_]](implicit M0: Applicative[M]): Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] = new FreeTMonad[S, M] { def M = M0 } - implicit def freeTCombine[S[_], M[_]: Applicative: FlatMapRec: SemigroupK]: SemigroupK[FreeT[S, M, ?]] = + implicit def catsFreeCombineForFreeT[S[_], M[_]: Applicative: FlatMapRec: SemigroupK]: SemigroupK[FreeT[S, M, ?]] = new FreeTCombine[S, M] { override def M = implicitly override def M1 = implicitly @@ -276,8 +216,8 @@ sealed abstract class FreeTInstances0 extends FreeTInstances1 { } } -sealed abstract class FreeTInstances extends FreeTInstances0 { - implicit def freeTMonadCombine[S[_], M[_]: Alternative: FlatMapRec]: MonadCombine[FreeT[S, M, ?]] = +private[free] sealed trait FreeTInstances extends FreeTInstances0 { + implicit def catsFreeMonadCombineForFreeT[S[_], M[_]: Alternative: FlatMapRec]: MonadCombine[FreeT[S, M, ?]] = new MonadCombine[FreeT[S, M, ?]] with FreeTCombine[S, M] with FreeTMonad[S, M] { override def M = implicitly override def M1 = implicitly @@ -287,14 +227,14 @@ sealed abstract class FreeTInstances extends FreeTInstances0 { } } -private trait FreeTFlatMap[S[_], M[_]] extends FlatMap[FreeT[S, M, ?]] { +private[free] sealed trait FreeTFlatMap[S[_], M[_]] extends FlatMap[FreeT[S, M, ?]] { implicit def M: Applicative[M] override final def map[A, B](fa: FreeT[S, M, A])(f: A => B): FreeT[S, M, B] = fa.map(f) def flatMap[A, B](fa: FreeT[S, M, A])(f: A => FreeT[S, M, B]): FreeT[S, M, B] = fa.flatMap(f) } -private trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] with FreeTFlatMap[S, M] { +private[free] sealed trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] with FreeTFlatMap[S, M] { implicit def M: Applicative[M] override final def pure[A](a: A) = @@ -303,7 +243,7 @@ private trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with FlatMapR FreeT.tailRecM(a)(f) } -private trait FreeTCombine[S[_], M[_]] extends SemigroupK[FreeT[S, M, ?]] { +private[free] sealed trait FreeTCombine[S[_], M[_]] extends SemigroupK[FreeT[S, M, ?]] { implicit def M: Applicative[M] implicit def M1: FlatMapRec[M] def M2: SemigroupK[M] @@ -311,38 +251,5 @@ private trait FreeTCombine[S[_], M[_]] extends SemigroupK[FreeT[S, M, ?]] { FreeT.liftT(M2.combineK(a.toM, b.toM))(M).flatMap(identity) } -private trait FreeTFoldable[S[_], M[_]] extends Foldable[FreeT[S, M, ?]] with Foldable.FromFoldMap[FreeT[S, M, ?]] { - implicit def S: Functor[S] - implicit def M: Applicative[M] - implicit def M1: FlatMapRec[M] - def F: Foldable[S] - def M2: Foldable[M] - - override final def foldMap[A, B: Monoid](fa: FreeT[S, M, A])(f: A => B): B = - M2.foldMap(fa.resume){ - case Xor.Right(a) => - F.foldMap(a)(foldMap(_)(f)) - case Xor.Left(a) => - f(a) - } -} - -private trait FreeTTraverse[S[_], M[_]] extends Traverse[FreeT[S, M, ?]] with FreeTFoldable[S, M] with FreeTFlatMap[S, M] { - override final def S: Functor[S] = F - override implicit def F: Traverse[S] - override def M2: Traverse[M] - override implicit def M: Applicative[M] - override implicit def M1: FlatMapRec[M] - - override final def traverse[G[_], A, B](fa: FreeT[S, M, A])(f: A => G[B])(implicit G: Applicative[G]) = - G.map( - M2.traverse(fa.resume){ - case Xor.Right(a) => - G.map(F.traverse(a)(traverse(_)(f)))(FreeT.roll(_)(M)) - case Xor.Left(a) => - G.map(f(a))(FreeT.pure[S, M, B]) - } - )(FreeT.liftT(_)(M).flatMap(identity)) -} diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala new file mode 100644 index 0000000000..f6c96a7333 --- /dev/null +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -0,0 +1,144 @@ +package cats +package free + +import cats._ +import cats.data._ +import cats.laws.discipline._ +import cats.tests.{CatsSuite, ListWrapper} + +import org.scalacheck.{Arbitrary, Gen} + +class FreeTTests extends CatsSuite { + + import ListWrapper._ + import FreeTTests._ + + { + implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative + implicit val listWrapperFlatMap: FlatMap[ListWrapper] = ListWrapper.monadCombine + implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + implicit val catsFlatMapForFreeT = FreeT.catsFreeFlatMapForFreeT[ListWrapper, ListWrapper] + checkAll("FreeT[ListWrapper, ListWrapper, Int]", FlatMapTests[FreeTListWrapper].flatMap[Int, Int, Int]) + checkAll("FlatMap[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(FlatMap[FreeTListWrapper])) + } + + { + implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative + implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec + implicit val catsFlatMapRecForFreeT = FreeT.catsFreeMonadForFreeT[ListWrapper, ListWrapper] + implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + checkAll("FreeT[ListWrapper, ListWrapper, Int]", FlatMapRecTests[FreeTListWrapper].flatMapRec[Int, Int, Int]) + checkAll("FlatMapRec[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(FlatMapRec[FreeTListWrapper])) + } + + { + implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative + implicit val catsMonadForFreeT = FreeT.catsFreeMonadForFreeT[ListWrapper, ListWrapper] + implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadTests[FreeTListWrapper].monad[Int, Int, Int]) + checkAll("Monad[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(Monad[FreeTListWrapper])) + } + + { + implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative + implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec + implicit val listSemigroupK: SemigroupK[ListWrapper] = ListWrapper.semigroupK + implicit val catsMonadCombineForFreeT = FreeT.catsFreeCombineForFreeT[ListWrapper, ListWrapper] + implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + checkAll("FreeT[ListWrapper, ListWrapper, Int]", SemigroupKTests[FreeTListWrapper].semigroupK[Int]) + checkAll("SemigroupK[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(SemigroupK[FreeTListWrapper])) + } + + { + implicit val listWrapperApplicative: Alternative[ListWrapper] = ListWrapper.alternative + implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec + implicit val catsMonadCombineForFreeT = FreeT.catsFreeMonadCombineForFreeT[ListWrapper, ListWrapper] + implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadCombineTests[FreeTListWrapper].monadCombine[Int, Int, Int]) + checkAll("MonadCombine[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(MonadCombine[FreeTListWrapper])) + } + + { + import cats.data.XorT + implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec + implicit val catsMonadErrorForFreeT = FreeT.catsFreeMonadErrorForFreeT[ListWrapper, Option, Unit] + implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListOption] + implicit val eqXortTFA: Eq[XorT[FreeTListOption, Unit, Int]] = XorT.catsDataEqForXorT[FreeTListOption, Unit, Int] + checkAll("FreeT[ListWrapper, Option, Int]", MonadErrorTests[FreeTListOption, Unit].monadError[Int, Int, Int]) + checkAll("MonadError[FreeT[ListWrapper, Option, ?]]", SerializableTests.serializable(MonadError[FreeTListOption, Unit])) + } + + { + implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListState] + implicit val catsMonadStateForFreeT = FreeT.catsFreeMonadStateForFreeT[IntState, IntState, Int] + checkAll("FreeT[ListWrapper, State[Int, ?], Int]", MonadStateTests[FreeTListState, Int].monadState[Int, Int, Int]) + checkAll("MonadState[FreeT[ListWrapper,State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTListState, Int])) + } + +} + +object FreeTTests extends FreeTTestsInstances + +sealed trait FreeTTestsInstances { + + import Arbitrary._ + import org.scalacheck.Arbitrary + import cats.kernel.instances.option._ + import cats.tests.StateTTests._ + + type IntState[A] = State[Int, A] + type FreeTListW[M[_], A] = FreeT[ListWrapper, M, A] + type FreeTListWrapper[A] = FreeTListW[ListWrapper, A] + type FreeTListOption[A] = FreeTListW[Option, A] + type FreeTListState[A] = FreeT[IntState, IntState, A] + + implicit val intEq : Eq[Int] = new Eq[Int] { + def eqv(a : Int, b : Int) = a == b + } + + implicit def intStateEq[A : Eq] : Eq[IntState[A]] = stateEq[Int, A] + + implicit def evalEq[A : Eq] : Eq[Eval[A]] = Eval.catsEqForEval[A] + + implicit def listWrapperArbitrary[A: Arbitrary]: Arbitrary[ListWrapper[A]] = ListWrapper.listWrapperArbitrary[A] + + implicit def freeTStateArb[A : Arbitrary](implicit LA : Arbitrary[ListWrapper[A]]) : Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] + + implicit def freeTArb[F[_], G[_]: Applicative, A](implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Arbitrary[FreeT[F, G, A]] = + Arbitrary(freeTGen[F, G, A](4)) + + + implicit def freeTListWrapperEq[A](implicit A: Eq[A]): Eq[FreeTListWrapper[A]] = new Eq[FreeTListWrapper[A]] { + implicit val listWrapperMonad: MonadRec[ListWrapper] = ListWrapper.monadRec + def eqv(a: FreeTListWrapper[A], b: FreeTListWrapper[A]) = Eq[ListWrapper[A]].eqv(a.runM(identity), b.runM(identity)) + } + + implicit def freeTListOptionEq[A](implicit A: Eq[A], OF: MonadRec[Option]): Eq[FreeTListOption[A]] = new Eq[FreeTListOption[A]] { + implicit val listWrapperMonad: MonadRec[ListWrapper] = ListWrapper.monadRec + def eqv(a: FreeTListOption[A], b: FreeTListOption[A]) = Eq[Option[A]].eqv(a.runM(_.list.headOption), b.runM(_.list.headOption)) + } + + implicit def freeTListStateEq[A](implicit A : Eq[A], SM: MonadRec[IntState]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { + def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[State[Int, A]].eqv(a.runM(identity), b.runM(identity)) + } + + private def freeTGen[F[_], G[_]: Applicative, A](maxDepth: Int)(implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Gen[FreeT[F, G, A]] = { + val noFlatMapped = Gen.oneOf( + A.arbitrary.map(FreeT.pure[F, G, A]), + F.arbitrary.map(FreeT.liftF[F, G, A]) + ) + + val nextDepth = Gen.chooseNum(1, maxDepth - 1) + + def withFlatMapped = for { + fDepth <- nextDepth + freeDepth <- nextDepth + f <- arbFunction1[A, FreeT[F, G, A]](Arbitrary(freeTGen[F, G, A](fDepth))).arbitrary + freeFGA <- freeTGen[F, G, A](freeDepth) + } yield freeFGA.flatMap(f) + + if (maxDepth <= 1) noFlatMapped + else Gen.oneOf(noFlatMapped, withFlatMapped) + } + +} From 80ac0d5199d639eb78666c5912384ab4a7d6eff4 Mon Sep 17 00:00:00 2001 From: raulraja Date: Mon, 1 Aug 2016 23:53:23 +0200 Subject: [PATCH 03/22] Fixed typo on Kleisli Tests --- tests/src/test/scala/cats/tests/KleisliTests.scala | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/src/test/scala/cats/tests/KleisliTests.scala b/tests/src/test/scala/cats/tests/KleisliTests.scala index 451a80685c..05978c3aad 100644 --- a/tests/src/test/scala/cats/tests/KleisliTests.scala +++ b/tests/src/test/scala/cats/tests/KleisliTests.scala @@ -19,8 +19,8 @@ class KleisliTests extends CatsSuite { implicit val iso = CartesianTests.Isomorphisms.invariant[Kleisli[Option, Int, ?]] - checkAll("Klesili[Option, Int, Int] with Unit", ApplicativeErrorTests[Kleisli[Option, Int, ?], Unit].applicativeError[Int, Int, Int]) - checkAll("ApplicativeError[Klesili[Option, Int, Int], Unit]", SerializableTests.serializable(ApplicativeError[Kleisli[Option, Int, ?], Unit])) + checkAll("Kleisli[Option, Int, Int] with Unit", ApplicativeErrorTests[Kleisli[Option, Int, ?], Unit].applicativeError[Int, Int, Int]) + checkAll("ApplicativeError[Kleisli[Option, Int, Int], Unit]", SerializableTests.serializable(ApplicativeError[Kleisli[Option, Int, ?], Unit])) checkAll("Kleisli[Option, Int, Int]", CartesianTests[Kleisli[Option, Int, ?]].cartesian[Int, Int, Int]) checkAll("Cartesian[Kleisli[Option, Int, ?]]", SerializableTests.serializable(Cartesian[Kleisli[Option, Int, ?]])) @@ -207,4 +207,4 @@ class KleisliTests extends CatsSuite { FlatMap[IntReader] Semigroup[IntReader[String]] } -} \ No newline at end of file +} From 5a616e8030d44bfd693aea12804f512080827c9f Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 4 Aug 2016 07:41:34 +0200 Subject: [PATCH 04/22] Basic docs for FreeT --- docs/src/main/tut/freemonad.md | 68 ++++++++++++ free/src/main/scala/cats/free/FreeT.scala | 2 + .../src/test/scala/cats/free/FreeTTests.scala | 103 ++++++++++++++++-- 3 files changed, 163 insertions(+), 10 deletions(-) diff --git a/docs/src/main/tut/freemonad.md b/docs/src/main/tut/freemonad.md index b9a93c8b8c..50ae248b79 100644 --- a/docs/src/main/tut/freemonad.md +++ b/docs/src/main/tut/freemonad.md @@ -493,6 +493,74 @@ As the sequence of operations becomes longer, the slower a `flatMap` "through" the structure will be. With `FlatMapped`, `Free` becomes a right-associated structure not subject to quadratic complexity. +## FreeT + +Often times we want to interleave the syntax tree when building a Free monad +with some other effect not declared as part of the ADT. +FreeT solves this problem by allowing us to mix building steps of the AST +with calling action in other base monad. + +In the following example a basic console application is shown. +When the user inputs some text we use a separate `State` monad to track what the user +typed. + +As we can observe in this case `FreeT` offers us a the alternative to delegate denotations to `State` +monad with stronger equational guarantees than if we were emulating the `State` ops in our own ADT. + +```tut:book +/* A base ADT for the user interaction without state semantics */ +sealed abstract class Teletype[A] extends Product with Serializable +final case class WriteLine(line : String) extends Teletype[Unit] +final case class ReadLine(prompt : String) extends Teletype[String] + +type TeletypeT[M[_], A] = FreeT[Teletype, M, A] +type Log = List[String] + +/** Smart constructors, notice we are abstracting over any MonadState instance + * to potentially support other types beside State + */ +class TeletypeOps[M[_]](implicit MS : MonadState[M, Log]) { + def writeLine(line : String) : TeletypeT[M, Unit] = + FreeT.liftF[Teletype, M, Unit](WriteLine(line)) + def readLine(prompt : String) : TeletypeT[M, String] = + FreeT.liftF[Teletype, M, String](ReadLine(prompt)) + def log(s : String) : TeletypeT[M, Unit] = + FreeT.liftT[Teletype, M, Unit](MS.modify(s :: _)) +} + +object TeletypeOps { + implicit def teleTypeOpsInstance[M[_]](implicit MS : MonadState[M, Log]) : TeletypeOps[M] = new TeletypeOps +} + +type TeletypeState[A] = State[List[String], A] + +def program(implicit TO : TeletypeOps[TeletypeState]) : TeletypeT[TeletypeState, Unit] = { + import TO._ + for { + userSaid <- readLine("say something") + _ <- log(s"user said : $userSaid") + _ <- writeLine("thanks!") + } yield () +} + +def interpreter = new (Teletype ~> TeletypeState) { + def apply[A](fa : Teletype[A]) : TeletypeState[A] = { + fa match { + case ReadLine(prompt) => + println(prompt) + val userInput = scala.io.StdIn.readLine() + StateT.pure[Eval, List[String], A](userInput) + case WriteLine(line) => + StateT.pure[Eval, List[String], A](println(line)) + } + } +} + +val state = program.foldMap(interpreter) +val initialState = Nil +val (stored, _) = state.run(initialState).value +``` + ## Future Work (TODO) There are many remarkable uses of `Free[_]`. In the future, we will diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 53fcd56787..e61c83784f 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -5,6 +5,8 @@ import scala.annotation.tailrec import cats.data.Xor +/** FreeT is a monad transformer for Free monads over a Functor S + */ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { import FreeT._ diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index f6c96a7333..da744773bb 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -2,6 +2,7 @@ package cats package free import cats._ +import cats.arrow.FunctionK import cats.data._ import cats.laws.discipline._ import cats.tests.{CatsSuite, ListWrapper} @@ -67,7 +68,7 @@ class FreeTTests extends CatsSuite { checkAll("FreeT[ListWrapper, Option, Int]", MonadErrorTests[FreeTListOption, Unit].monadError[Int, Int, Int]) checkAll("MonadError[FreeT[ListWrapper, Option, ?]]", SerializableTests.serializable(MonadError[FreeTListOption, Unit])) } - + { implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListState] implicit val catsMonadStateForFreeT = FreeT.catsFreeMonadStateForFreeT[IntState, IntState, Int] @@ -75,6 +76,85 @@ class FreeTTests extends CatsSuite { checkAll("MonadState[FreeT[ListWrapper,State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTListState, Int])) } + test("FlatMap stack safety tested with 50k flatMaps") { + val expected = Applicative[FreeTListOption].pure(()) + val result = + FlatMapRec[FreeTListOption].tailRecM(0)((i: Int) => + if (i < 50000) + Applicative[FreeTListOption].pure(Xor.left[Int, Unit](i + 1)) + else + Applicative[FreeTListOption].pure(Xor.right[Int, Unit](()))) + + Eq[FreeTListOption[Unit]].eqv(expected, result) should ===(true) + } + + test("Stack safe with 50k left-associated flatMaps") { + val expected = Applicative[FreeTListOption].pure(()) + val result = + (0 until 50000).foldLeft(Applicative[FreeTListOption].pure(()))( + (fu, i) => fu.flatMap(u => Applicative[FreeTListOption].pure(u)) + ) + + Eq[FreeTListOption[Unit]].eqv(expected, result) should ===(true) + } + + test("Stack safe with flatMap followed by 50k maps") { + val expected = Applicative[FreeTListOption].pure(()) + val result = + (0 until 50000).foldLeft(().pure[FreeTListOption].flatMap(_.pure[FreeTListOption]))( + (fu, i) => fu.map(identity) + ) + + Eq[FreeTListOption[Unit]].eqv(expected, result) should ===(true) + } + + test("hoist to universal id equivalent to original instance") { + forAll { a: FreeTListOption[Int] => + val b = a.hoist(FunctionK.id) + Eq[FreeTListOption[Int]].eqv(a, b) should ===(true) + } + } + + test("hoist stack-safety") { + val a = (0 until 50000).foldLeft(Applicative[FreeTListOption].pure(()))( + (fu, i) => fu.flatMap(u => Applicative[FreeTListOption].pure(u)) + ) + val b = a.hoist(FunctionK.id) + } + + test("interpret to universal id equivalent to original instance") { + forAll { a: FreeTListOption[Int] => + val b = a.interpret(FunctionK.id) + Eq[FreeTListOption[Int]].eqv(a, b) should ===(true) + } + } + + test("interpret stack-safety") { + val a = (0 until 50000).foldLeft(Applicative[FreeTListOption].pure(()))( + (fu, i) => fu.flatMap(u => Applicative[FreeTListOption].pure(u)) + ) + val b = a.interpret(FunctionK.id) // used to overflow + } + + test("foldMap consistent with runM") { + implicit val listWrapperFunctor = ListWrapper.monad + forAll { a: FreeTListOption[Int] => + val x = a.runM(_.list.headOption) + val y = a.foldMap(headOption) + Eq[Option[Int]].eqv(x, y) should ===(true) + } + } + + test("== should not return true for unequal instances") { + val a = FreeT.pure[List, Option, Int](1).flatMap(x => FreeT.pure(2)) + val b = FreeT.pure[List, Option, Int](3).flatMap(x => FreeT.pure(4)) + a == b should be(false) + } + + private[free] def liftTUCompilationTests() = { + val a: String Xor Int = Xor.right(42) + val b: FreeT[Option, String Xor ?, Int] = FreeT.liftTU(a) + } } object FreeTTests extends FreeTTestsInstances @@ -92,22 +172,25 @@ sealed trait FreeTTestsInstances { type FreeTListOption[A] = FreeTListW[Option, A] type FreeTListState[A] = FreeT[IntState, IntState, A] - implicit val intEq : Eq[Int] = new Eq[Int] { - def eqv(a : Int, b : Int) = a == b + object headOption extends (ListWrapper ~> Option) { + def apply[A](l: ListWrapper[A]): Option[A] = l.list.headOption + } + + implicit val intEq: Eq[Int] = new Eq[Int] { + def eqv(a: Int, b: Int) = a == b } - implicit def intStateEq[A : Eq] : Eq[IntState[A]] = stateEq[Int, A] + implicit def intStateEq[A: Eq]: Eq[IntState[A]] = stateEq[Int, A] - implicit def evalEq[A : Eq] : Eq[Eval[A]] = Eval.catsEqForEval[A] + implicit def evalEq[A: Eq]: Eq[Eval[A]] = Eval.catsEqForEval[A] implicit def listWrapperArbitrary[A: Arbitrary]: Arbitrary[ListWrapper[A]] = ListWrapper.listWrapperArbitrary[A] - - implicit def freeTStateArb[A : Arbitrary](implicit LA : Arbitrary[ListWrapper[A]]) : Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] - + + implicit def freeTStateArb[A: Arbitrary](implicit LA: Arbitrary[ListWrapper[A]]): Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] + implicit def freeTArb[F[_], G[_]: Applicative, A](implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Arbitrary[FreeT[F, G, A]] = Arbitrary(freeTGen[F, G, A](4)) - implicit def freeTListWrapperEq[A](implicit A: Eq[A]): Eq[FreeTListWrapper[A]] = new Eq[FreeTListWrapper[A]] { implicit val listWrapperMonad: MonadRec[ListWrapper] = ListWrapper.monadRec def eqv(a: FreeTListWrapper[A], b: FreeTListWrapper[A]) = Eq[ListWrapper[A]].eqv(a.runM(identity), b.runM(identity)) @@ -118,7 +201,7 @@ sealed trait FreeTTestsInstances { def eqv(a: FreeTListOption[A], b: FreeTListOption[A]) = Eq[Option[A]].eqv(a.runM(_.list.headOption), b.runM(_.list.headOption)) } - implicit def freeTListStateEq[A](implicit A : Eq[A], SM: MonadRec[IntState]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { + implicit def freeTListStateEq[A](implicit A: Eq[A], SM: MonadRec[IntState]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[State[Int, A]].eqv(a.runM(identity), b.runM(identity)) } From ee890fb84a85126c7ac4f6e3e4609547c7b89229 Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 4 Aug 2016 19:32:16 +0200 Subject: [PATCH 05/22] validation style and doc changes --- docs/src/main/tut/freemonad.md | 15 ++++++++++----- free/src/main/scala/cats/free/FreeT.scala | 19 ++++++++----------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/docs/src/main/tut/freemonad.md b/docs/src/main/tut/freemonad.md index 50ae248b79..3a3c4fc30b 100644 --- a/docs/src/main/tut/freemonad.md +++ b/docs/src/main/tut/freemonad.md @@ -508,6 +508,10 @@ As we can observe in this case `FreeT` offers us a the alternative to delegate d monad with stronger equational guarantees than if we were emulating the `State` ops in our own ADT. ```tut:book +import cats.free._ +import cats._ +import cats.data._ + /* A base ADT for the user interaction without state semantics */ sealed abstract class Teletype[A] extends Product with Serializable final case class WriteLine(line : String) extends Teletype[Unit] @@ -535,11 +539,10 @@ object TeletypeOps { type TeletypeState[A] = State[List[String], A] def program(implicit TO : TeletypeOps[TeletypeState]) : TeletypeT[TeletypeState, Unit] = { - import TO._ for { - userSaid <- readLine("say something") - _ <- log(s"user said : $userSaid") - _ <- writeLine("thanks!") + userSaid <- TO.readLine("what's up?!") + _ <- TO.log(s"user said : $userSaid") + _ <- TO.writeLine("thanks, see you soon!") } yield () } @@ -548,7 +551,7 @@ def interpreter = new (Teletype ~> TeletypeState) { fa match { case ReadLine(prompt) => println(prompt) - val userInput = scala.io.StdIn.readLine() + val userInput = "hanging in here" //scala.io.StdIn.readLine() StateT.pure[Eval, List[String], A](userInput) case WriteLine(line) => StateT.pure[Eval, List[String], A](println(line)) @@ -556,6 +559,8 @@ def interpreter = new (Teletype ~> TeletypeState) { } } +import TeletypeOps._ + val state = program.foldMap(interpreter) val initialState = Nil val (stored, _) = state.run(initialState).value diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index e61c83784f..32be6dfd8b 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -62,7 +62,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { M0.tailRecM(this)(go) } - /** Evaluates a single layer of the free monad **/ + /** Evaluates a single layer of the free monad */ def resume(implicit S: Functor[S], M0: FlatMapRec[M], M1: Applicative[M]): M[A Xor S[FreeT[S, M, A]]] = { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor (A Xor S[FreeT[S, M, A]])] = ft match { @@ -217,7 +217,7 @@ private[free] sealed trait FreeTInstances0 extends FreeTInstances1 { override def M2 = implicitly } } - + private[free] sealed trait FreeTInstances extends FreeTInstances0 { implicit def catsFreeMonadCombineForFreeT[S[_], M[_]: Alternative: FlatMapRec]: MonadCombine[FreeT[S, M, ?]] = new MonadCombine[FreeT[S, M, ?]] with FreeTCombine[S, M] with FreeTMonad[S, M] { @@ -228,30 +228,27 @@ private[free] sealed trait FreeTInstances extends FreeTInstances0 { override def empty[A] = FreeT.liftT[S, M, A](MonoidK[M].empty[A])(M) } } - + private[free] sealed trait FreeTFlatMap[S[_], M[_]] extends FlatMap[FreeT[S, M, ?]] { implicit def M: Applicative[M] override final def map[A, B](fa: FreeT[S, M, A])(f: A => B): FreeT[S, M, B] = fa.map(f) def flatMap[A, B](fa: FreeT[S, M, A])(f: A => FreeT[S, M, B]): FreeT[S, M, B] = fa.flatMap(f) } - + private[free] sealed trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] with FreeTFlatMap[S, M] { implicit def M: Applicative[M] - override final def pure[A](a: A) = + override final def pure[A](a: A): FreeT[S, M, A] = FreeT.pure[S, M, A](a) - override final def tailRecM[A, B](a: A)(f: A => FreeT[S, M, A Xor B]) = + override final def tailRecM[A, B](a: A)(f: A => FreeT[S, M, A Xor B]): FreeT[S, M, B] = FreeT.tailRecM(a)(f) } - + private[free] sealed trait FreeTCombine[S[_], M[_]] extends SemigroupK[FreeT[S, M, ?]] { implicit def M: Applicative[M] implicit def M1: FlatMapRec[M] def M2: SemigroupK[M] - override final def combineK[A](a: FreeT[S, M, A], b: FreeT[S, M, A]) = + override final def combineK[A](a: FreeT[S, M, A], b: FreeT[S, M, A]): FreeT[S, M, A] = FreeT.liftT(M2.combineK(a.toM, b.toM))(M).flatMap(identity) } - - - From a4bfec8b8efc6de21d4bb808c5ec5a1cc7b70ca5 Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 4 Aug 2016 22:23:13 +0200 Subject: [PATCH 06/22] Replace FlarMapRec+Applicative for MonadRec ev. --- free/src/main/scala/cats/free/FreeT.scala | 38 +++++++++++------------ 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 32be6dfd8b..48192e6197 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -43,52 +43,52 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { * Runs to completion, mapping the suspension with the given transformation * at each step and accumulating into the monad `M`. */ - def foldMap(f: S ~> M)(implicit M0: FlatMapRec[M], M1: Applicative[M]): M[A] = { + def foldMap(f: S ~> M)(implicit MR: MonadRec[M]): M[A] = { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = ft match { - case Suspend(ma) => M0.flatMap(ma) { - case Xor.Left(a) => M1.pure(Xor.Right(a)) - case Xor.Right(sa) => M0.map(f(sa))(Xor.right) + case Suspend(ma) => MR.flatMap(ma) { + case Xor.Left(a) => MR.pure(Xor.Right(a)) + case Xor.Right(sa) => MR.map(f(sa))(Xor.right) } case g @ Gosub(_, _) => g.a match { - case Suspend(mx) => M0.flatMap(mx) { - case Xor.Left(x) => M1.pure(Xor.left(g.f(x))) - case Xor.Right(sx) => M0.map(f(sx))(g.f andThen Xor.left) + case Suspend(mx) => MR.flatMap(mx) { + case Xor.Left(x) => MR.pure(Xor.left(g.f(x))) + case Xor.Right(sx) => MR.map(f(sx))(g.f andThen Xor.left) } - case g0 @ Gosub(_, _) => M1.pure(Xor.left(g0.a.flatMap(g0.f(_).flatMap(g.f)))) + case g0 @ Gosub(_, _) => MR.pure(Xor.left(g0.a.flatMap(g0.f(_).flatMap(g.f)))) } } - M0.tailRecM(this)(go) + MR.tailRecM(this)(go) } /** Evaluates a single layer of the free monad */ - def resume(implicit S: Functor[S], M0: FlatMapRec[M], M1: Applicative[M]): M[A Xor S[FreeT[S, M, A]]] = { + def resume(implicit S: Functor[S], MR: MonadRec[M]): M[A Xor S[FreeT[S, M, A]]] = { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor (A Xor S[FreeT[S, M, A]])] = ft match { - case Suspend(f) => M0.map(f)(as => Xor.right(as.map(S.map(_)(pure(_))))) + case Suspend(f) => MR.map(f)(as => Xor.right(as.map(S.map(_)(pure(_))))) case g1 @ Gosub(_, _) => g1.a match { - case Suspend(m1) => M0.map(m1) { + case Suspend(m1) => MR.map(m1) { case Xor.Left(a) => Xor.left(g1.f(a)) case Xor.Right(fc) => Xor.right(Xor.right(S.map(fc)(g1.f(_)))) } - case g2 @ Gosub(_, _) => M1.pure(Xor.left(g2.a.flatMap(g2.f(_).flatMap(g1.f)))) + case g2 @ Gosub(_, _) => MR.pure(Xor.left(g2.a.flatMap(g2.f(_).flatMap(g1.f)))) } } - M0.tailRecM(this)(go) + MR.tailRecM(this)(go) } /** * Runs to completion, using a function that maps the resumption from `S` to a monad `M`. */ - def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], M0: FlatMapRec[M], M1: Applicative[M]): M[A] = { + def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], MR: MonadRec[M]): M[A] = { def runM2(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = - M0.flatMap(ft.resume) { - case Xor.Left(a) => M1.pure(Xor.right(a)) - case Xor.Right(fc) => M0.map(interp(fc))(Xor.left) + MR.flatMap(ft.resume) { + case Xor.Left(a) => MR.pure(Xor.right(a)) + case Xor.Right(fc) => MR.map(interp(fc))(Xor.left) } - M0.tailRecM(this)(runM2) + MR.tailRecM(this)(runM2) } /** From a9a86d3a9ee497c2f71ed9a5d2a9d800933ac8de Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 4 Aug 2016 23:03:17 +0200 Subject: [PATCH 07/22] Fixed TransLift instance and added missing tests --- free/src/main/scala/cats/free/FreeT.scala | 2 +- free/src/test/scala/cats/free/FreeTTests.scala | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 48192e6197..99a2a7965f 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -194,7 +194,7 @@ private[free] sealed trait FreeTInstances1 extends FreeTInstances2 { implicit def M: Applicative[M] = M0 } - implicit def catsFreeTransLiftForFreeT[S[_]]: TransLift[FreeT[S, ?[_], ?]] = + implicit def catsFreeTransLiftForFreeT[S[_]]: TransLift.Aux[FreeT[S, ?[_], ?], Functor] = new TransLift[FreeT[S, ?[_], ?]] { type TC[M[_]] = Functor[M] diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index da744773bb..fddb8cb4ee 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -122,6 +122,11 @@ class FreeTTests extends CatsSuite { val b = a.hoist(FunctionK.id) } + test("transLift for FreeT requires only Functor") { + implicit val transLiftInstance = FreeT.catsFreeTransLiftForFreeT[JustFunctor] + val d: FreeT[JustFunctor, JustFunctor, Int] = transLiftInstance.liftT[JustFunctor, Int](JustFunctor(1)) + } + test("interpret to universal id equivalent to original instance") { forAll { a: FreeTListOption[Int] => val b = a.interpret(FunctionK.id) @@ -172,6 +177,12 @@ sealed trait FreeTTestsInstances { type FreeTListOption[A] = FreeTListW[Option, A] type FreeTListState[A] = FreeT[IntState, IntState, A] + case class JustFunctor[A](a: A) + + implicit val jfFunctor: Functor[JustFunctor] = new Functor[JustFunctor] { + override def map[A, B](fa: JustFunctor[A])(f: A => B): JustFunctor[B] = JustFunctor(f(fa.a)) + } + object headOption extends (ListWrapper ~> Option) { def apply[A](l: ListWrapper[A]): Option[A] = l.list.headOption } From 9654b3d6fc4c520ae321af1a903f96e1dde1159c Mon Sep 17 00:00:00 2001 From: raulraja Date: Fri, 5 Aug 2016 07:16:32 +0200 Subject: [PATCH 08/22] Renamed Gosub to FlatMapped --- free/src/main/scala/cats/free/FreeT.scala | 28 +++++++++++------------ 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 99a2a7965f..556ad6a107 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -16,7 +16,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { /** Binds the given continuation to the result of this computation. */ final def flatMap[B](f: A => FreeT[S, M, B]): FreeT[S, M, B] = - Gosub(this, f) + FlatMapped(this, f) /** * Changes the underlying `Monad` for this `FreeT`, ie. @@ -24,8 +24,8 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { */ def hoist[N[_]](mn: M ~> N): FreeT[S, N, A] = step match { - case e @ Gosub(_, _) => - Gosub(e.a.hoist(mn), e.f.andThen(_.hoist(mn))) + case e @ FlatMapped(_, _) => + FlatMapped(e.a.hoist(mn), e.f.andThen(_.hoist(mn))) case Suspend(m) => Suspend(mn(m)) } @@ -33,8 +33,8 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { /** Change the base functor `S` for a `FreeT` action. */ def interpret[T[_]](st: S ~> T)(implicit M: Functor[M]): FreeT[T, M, A] = step match { - case e @ Gosub(_, _) => - Gosub(e.a.interpret(st), e.f.andThen(_.interpret(st))) + case e @ FlatMapped(_, _) => + FlatMapped(e.a.interpret(st), e.f.andThen(_.interpret(st))) case Suspend(m) => Suspend(M.map(m)(_.map(s => st(s)))) } @@ -50,12 +50,12 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { case Xor.Left(a) => MR.pure(Xor.Right(a)) case Xor.Right(sa) => MR.map(f(sa))(Xor.right) } - case g @ Gosub(_, _) => g.a match { + case g @ FlatMapped(_, _) => g.a match { case Suspend(mx) => MR.flatMap(mx) { case Xor.Left(x) => MR.pure(Xor.left(g.f(x))) case Xor.Right(sx) => MR.map(f(sx))(g.f andThen Xor.left) } - case g0 @ Gosub(_, _) => MR.pure(Xor.left(g0.a.flatMap(g0.f(_).flatMap(g.f)))) + case g0 @ FlatMapped(_, _) => MR.pure(Xor.left(g0.a.flatMap(g0.f(_).flatMap(g.f)))) } } @@ -67,12 +67,12 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor (A Xor S[FreeT[S, M, A]])] = ft match { case Suspend(f) => MR.map(f)(as => Xor.right(as.map(S.map(_)(pure(_))))) - case g1 @ Gosub(_, _) => g1.a match { + case g1 @ FlatMapped(_, _) => g1.a match { case Suspend(m1) => MR.map(m1) { case Xor.Left(a) => Xor.left(g1.f(a)) case Xor.Right(fc) => Xor.right(Xor.right(S.map(fc)(g1.f(_)))) } - case g2 @ Gosub(_, _) => MR.pure(Xor.left(g2.a.flatMap(g2.f(_).flatMap(g1.f)))) + case g2 @ FlatMapped(_, _) => MR.pure(Xor.left(g2.a.flatMap(g2.f(_).flatMap(g1.f)))) } } @@ -103,20 +103,20 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { case Xor.Left(a) => pure(a) case Xor.Right(s) => liftF(s) } - case g1 @ Gosub(_, _) => g1.a match { + case g1 @ FlatMapped(_, _) => g1.a match { case Suspend(m) => M.map(m) { case Xor.Left(a) => g1.f(a) case Xor.Right(s) => liftF[S, M, g1.A](s).flatMap(g1.f) } - case g0 @ Gosub(_, _) => g0.a.flatMap(g0.f(_).flatMap(g1.f)).toM + case g0 @ FlatMapped(_, _) => g0.a.flatMap(g0.f(_).flatMap(g1.f)).toM } } @tailrec private def step: FreeT[S, M, A] = this match { - case g @ Gosub(_, _) => g.a match { - case g0 @ Gosub(_, _) => g0.a.flatMap(a => g0.f(a).flatMap(g.f)).step + case g @ FlatMapped(_, _) => g.a match { + case g0 @ FlatMapped(_, _) => g0.a.flatMap(a => g0.f(a).flatMap(g.f)).step case _ => g } case x => x @@ -129,7 +129,7 @@ object FreeT extends FreeTInstances { private[free] case class Suspend[S[_], M[_], A](a: M[A Xor S[A]]) extends FreeT[S, M, A] /** Call a subroutine and continue with the given function. */ - private[free] case class Gosub[S[_], M[_], A0, B](a0: FreeT[S, M, A0], f0: A0 => FreeT[S, M, B]) extends FreeT[S, M, B] { + private[free] case class FlatMapped[S[_], M[_], A0, B](a0: FreeT[S, M, A0], f0: A0 => FreeT[S, M, B]) extends FreeT[S, M, B] { type A = A0 def a: FreeT[S, M, A] = a0 def f: A => FreeT[S, M, B] = f0 From 014ff4009b42faa2c4e77ff303ae06319d62b032 Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 11 Aug 2016 07:28:06 +0200 Subject: [PATCH 09/22] Added proper attribution --- free/src/main/scala/cats/free/FreeT.scala | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 556ad6a107..bfa4975417 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -6,6 +6,10 @@ import scala.annotation.tailrec import cats.data.Xor /** FreeT is a monad transformer for Free monads over a Functor S + * + * This Scala implementation of `FreeT` and its usages are derived from + * [[https://github.com/scalaz/scalaz/blob/series/7.3.x/core/src/main/scala/scalaz/FreeT.scala Scalaz's FreeT]], + * originally written by Brian McKenna. */ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { From 11a11ae6424a3e7f52aa79c558fccb5d3e666459 Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 11 Aug 2016 07:42:00 +0200 Subject: [PATCH 10/22] Removed whitespace --- free/src/main/scala/cats/free/FreeT.scala | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index bfa4975417..76dc9fcfba 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -6,7 +6,7 @@ import scala.annotation.tailrec import cats.data.Xor /** FreeT is a monad transformer for Free monads over a Functor S - * + * * This Scala implementation of `FreeT` and its usages are derived from * [[https://github.com/scalaz/scalaz/blob/series/7.3.x/core/src/main/scala/scalaz/FreeT.scala Scalaz's FreeT]], * originally written by Brian McKenna. From 3245900bae5bcd35d3a0b2b8e7e88b23a56d0cd8 Mon Sep 17 00:00:00 2001 From: raulraja Date: Sun, 14 Aug 2016 21:54:59 +0200 Subject: [PATCH 11/22] Added mention to `Stack Safety for Free` by Phil Freeman --- free/src/main/scala/cats/free/FreeT.scala | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 76dc9fcfba..8eb7fbce1d 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -7,6 +7,9 @@ import cats.data.Xor /** FreeT is a monad transformer for Free monads over a Functor S * + * Stack safety for `Free` and `FreeT` is based on the paper + * [[http://functorial.com/stack-safety-for-free/index.pdf Stack Safety for Free]] by `Phil Freeman` + * * This Scala implementation of `FreeT` and its usages are derived from * [[https://github.com/scalaz/scalaz/blob/series/7.3.x/core/src/main/scala/scalaz/FreeT.scala Scalaz's FreeT]], * originally written by Brian McKenna. @@ -119,7 +122,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { @tailrec private def step: FreeT[S, M, A] = this match { - case g @ FlatMapped(_, _) => g.a match { + case FlatMapped(_, a) => g.a match { case g0 @ FlatMapped(_, _) => g0.a.flatMap(a => g0.f(a).flatMap(g.f)).step case _ => g } From 336a71d20fa5f9ec31839e13ef6d1e8e1253c50c Mon Sep 17 00:00:00 2001 From: raulraja Date: Sun, 14 Aug 2016 21:57:38 +0200 Subject: [PATCH 12/22] Provide concise toString() impl as in #1084 --- free/src/main/scala/cats/free/FreeT.scala | 2 ++ 1 file changed, 2 insertions(+) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 8eb7fbce1d..0662d7ded4 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -128,6 +128,8 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } case x => x } + + override def toString(): String = "FreeT(...)" } From fd119d84c6d45b34a6c881b1e35fb22e4bca298d Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 18 Aug 2016 19:09:38 +0200 Subject: [PATCH 13/22] MonadRec related changes (WIP) --- free/src/main/scala/cats/free/FreeT.scala | 26 +++--- .../src/test/scala/cats/free/FreeTTests.scala | 88 +++++++------------ .../test/scala/cats/tests/ListWrapper.scala | 4 +- 3 files changed, 49 insertions(+), 69 deletions(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 0662d7ded4..45f3abd83e 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -8,7 +8,7 @@ import cats.data.Xor /** FreeT is a monad transformer for Free monads over a Functor S * * Stack safety for `Free` and `FreeT` is based on the paper - * [[http://functorial.com/stack-safety-for-free/index.pdf Stack Safety for Free]] by `Phil Freeman` + * [[http://functorial.com/stack-safety-for-free/index.pdf Stack Safety for Free]] by Phil Freeman * * This Scala implementation of `FreeT` and its usages are derived from * [[https://github.com/scalaz/scalaz/blob/series/7.3.x/core/src/main/scala/scalaz/FreeT.scala Scalaz's FreeT]], @@ -50,7 +50,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { * Runs to completion, mapping the suspension with the given transformation * at each step and accumulating into the monad `M`. */ - def foldMap(f: S ~> M)(implicit MR: MonadRec[M]): M[A] = { + def foldMap(f: S ~> M)(implicit MR: Monad[M] with RecursiveTailRecM[M]): M[A] = { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = ft match { case Suspend(ma) => MR.flatMap(ma) { @@ -70,7 +70,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } /** Evaluates a single layer of the free monad */ - def resume(implicit S: Functor[S], MR: MonadRec[M]): M[A Xor S[FreeT[S, M, A]]] = { + def resume(implicit S: Functor[S], MR: Monad[M] with RecursiveTailRecM[M]): M[A Xor S[FreeT[S, M, A]]] = { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor (A Xor S[FreeT[S, M, A]])] = ft match { case Suspend(f) => MR.map(f)(as => Xor.right(as.map(S.map(_)(pure(_))))) @@ -89,7 +89,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { /** * Runs to completion, using a function that maps the resumption from `S` to a monad `M`. */ - def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], MR: MonadRec[M]): M[A] = { + def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], MR: Monad[M] with RecursiveTailRecM[M]): M[A] = { def runM2(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = MR.flatMap(ft.resume) { case Xor.Left(a) => MR.pure(Xor.right(a)) @@ -122,7 +122,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { @tailrec private def step: FreeT[S, M, A] = this match { - case FlatMapped(_, a) => g.a match { + case g @ FlatMapped(_, _) => g.a match { case g0 @ FlatMapped(_, _) => g0.a.flatMap(a => g0.f(a).flatMap(g.f)).step case _ => g } @@ -187,7 +187,7 @@ private[free] sealed trait FreeTInstances3 { } private[free] sealed trait FreeTInstances2 extends FreeTInstances3 { - implicit def catsFreeMonadErrorForFreeT[S[_], M[_]: FlatMapRec, E](implicit E: MonadError[M, E]): MonadError[FreeT[S, M, ?], E] = + implicit def catsFreeMonadErrorForFreeT[S[_], M[_]: RecursiveTailRecM, E](implicit E: MonadError[M, E]): MonadError[FreeT[S, M, ?], E] = new MonadError[FreeT[S, M, ?], E] with FreeTMonad[S, M] { override def M = implicitly override def handleErrorWith[A](fa: FreeT[S, M, A])(f: E => FreeT[S, M, A]) = @@ -214,12 +214,12 @@ private[free] sealed trait FreeTInstances1 extends FreeTInstances2 { } private[free] sealed trait FreeTInstances0 extends FreeTInstances1 { - implicit def catsFreeMonadForFreeT[S[_], M[_]](implicit M0: Applicative[M]): Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] = + implicit def catsFreeMonadForFreeT[S[_], M[_]](implicit M0: Applicative[M]): Monad[FreeT[S, M, ?]] with RecursiveTailRecM[FreeT[S, M, ?]] = new FreeTMonad[S, M] { def M = M0 } - implicit def catsFreeCombineForFreeT[S[_], M[_]: Applicative: FlatMapRec: SemigroupK]: SemigroupK[FreeT[S, M, ?]] = + implicit def catsFreeCombineForFreeT[S[_], M[_]: Applicative: RecursiveTailRecM: SemigroupK]: SemigroupK[FreeT[S, M, ?]] = new FreeTCombine[S, M] { override def M = implicitly override def M1 = implicitly @@ -228,7 +228,7 @@ private[free] sealed trait FreeTInstances0 extends FreeTInstances1 { } private[free] sealed trait FreeTInstances extends FreeTInstances0 { - implicit def catsFreeMonadCombineForFreeT[S[_], M[_]: Alternative: FlatMapRec]: MonadCombine[FreeT[S, M, ?]] = + implicit def catsFreeMonadCombineForFreeT[S[_], M[_]: Alternative: RecursiveTailRecM]: MonadCombine[FreeT[S, M, ?]] = new MonadCombine[FreeT[S, M, ?]] with FreeTCombine[S, M] with FreeTMonad[S, M] { override def M = implicitly override def M1 = implicitly @@ -243,20 +243,20 @@ private[free] sealed trait FreeTFlatMap[S[_], M[_]] extends FlatMap[FreeT[S, M, override final def map[A, B](fa: FreeT[S, M, A])(f: A => B): FreeT[S, M, B] = fa.map(f) def flatMap[A, B](fa: FreeT[S, M, A])(f: A => FreeT[S, M, B]): FreeT[S, M, B] = fa.flatMap(f) + override final def tailRecM[A, B](a: A)(f: A => FreeT[S, M, A Xor B]): FreeT[S, M, B] = + FreeT.tailRecM(a)(f) } -private[free] sealed trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with FlatMapRec[FreeT[S, M, ?]] with FreeTFlatMap[S, M] { +private[free] sealed trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with RecursiveTailRecM[FreeT[S, M, ?]] with FreeTFlatMap[S, M] { implicit def M: Applicative[M] override final def pure[A](a: A): FreeT[S, M, A] = FreeT.pure[S, M, A](a) - override final def tailRecM[A, B](a: A)(f: A => FreeT[S, M, A Xor B]): FreeT[S, M, B] = - FreeT.tailRecM(a)(f) } private[free] sealed trait FreeTCombine[S[_], M[_]] extends SemigroupK[FreeT[S, M, ?]] { implicit def M: Applicative[M] - implicit def M1: FlatMapRec[M] + implicit def M1: RecursiveTailRecM[M] def M2: SemigroupK[M] override final def combineK[A](a: FreeT[S, M, A], b: FreeT[S, M, A]): FreeT[S, M, A] = FreeT.liftT(M2.combineK(a.toM, b.toM))(M).flatMap(identity) diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index fddb8cb4ee..fbb90447ee 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -6,6 +6,7 @@ import cats.arrow.FunctionK import cats.data._ import cats.laws.discipline._ import cats.tests.{CatsSuite, ListWrapper} +import cats.instances.option._ import org.scalacheck.{Arbitrary, Gen} @@ -13,73 +14,37 @@ class FreeTTests extends CatsSuite { import ListWrapper._ import FreeTTests._ - - { - implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative - implicit val listWrapperFlatMap: FlatMap[ListWrapper] = ListWrapper.monadCombine - implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] - implicit val catsFlatMapForFreeT = FreeT.catsFreeFlatMapForFreeT[ListWrapper, ListWrapper] +/* checkAll("FreeT[ListWrapper, ListWrapper, Int]", FlatMapTests[FreeTListWrapper].flatMap[Int, Int, Int]) checkAll("FlatMap[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(FlatMap[FreeTListWrapper])) - } - { - implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative - implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec - implicit val catsFlatMapRecForFreeT = FreeT.catsFreeMonadForFreeT[ListWrapper, ListWrapper] - implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] - checkAll("FreeT[ListWrapper, ListWrapper, Int]", FlatMapRecTests[FreeTListWrapper].flatMapRec[Int, Int, Int]) - checkAll("FlatMapRec[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(FlatMapRec[FreeTListWrapper])) - } - - { - implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative - implicit val catsMonadForFreeT = FreeT.catsFreeMonadForFreeT[ListWrapper, ListWrapper] - implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadTests[FreeTListWrapper].monad[Int, Int, Int]) checkAll("Monad[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(Monad[FreeTListWrapper])) - } - - { - implicit val listWrapperApplicative: Applicative[ListWrapper] = ListWrapper.applicative - implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec - implicit val listSemigroupK: SemigroupK[ListWrapper] = ListWrapper.semigroupK - implicit val catsMonadCombineForFreeT = FreeT.catsFreeCombineForFreeT[ListWrapper, ListWrapper] - implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + checkAll("FreeT[ListWrapper, ListWrapper, Int]", SemigroupKTests[FreeTListWrapper].semigroupK[Int]) checkAll("SemigroupK[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(SemigroupK[FreeTListWrapper])) - } - - { - implicit val listWrapperApplicative: Alternative[ListWrapper] = ListWrapper.alternative - implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec - implicit val catsMonadCombineForFreeT = FreeT.catsFreeMonadCombineForFreeT[ListWrapper, ListWrapper] - implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadCombineTests[FreeTListWrapper].monadCombine[Int, Int, Int]) checkAll("MonadCombine[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(MonadCombine[FreeTListWrapper])) - } - + */ { - import cats.data.XorT - implicit val listWrapperFlatMapRec: FlatMapRec[ListWrapper] = ListWrapper.flatMapRec - implicit val catsMonadErrorForFreeT = FreeT.catsFreeMonadErrorForFreeT[ListWrapper, Option, Unit] - implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListOption] implicit val eqXortTFA: Eq[XorT[FreeTListOption, Unit, Int]] = XorT.catsDataEqForXorT[FreeTListOption, Unit, Int] checkAll("FreeT[ListWrapper, Option, Int]", MonadErrorTests[FreeTListOption, Unit].monadError[Int, Int, Int]) - checkAll("MonadError[FreeT[ListWrapper, Option, ?]]", SerializableTests.serializable(MonadError[FreeTListOption, Unit])) + checkAll("MonadError[FreeT[ListWrapper, Option, ?], Unit]", SerializableTests.serializable(MonadError[FreeTListOption, Unit])) } { - implicit val iso = CartesianTests.Isomorphisms.invariant[FreeTListState] - implicit val catsMonadStateForFreeT = FreeT.catsFreeMonadStateForFreeT[IntState, IntState, Int] + import StateT._ checkAll("FreeT[ListWrapper, State[Int, ?], Int]", MonadStateTests[FreeTListState, Int].monadState[Int, Int, Int]) checkAll("MonadState[FreeT[ListWrapper,State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTListState, Int])) - } - + } + + + test("FlatMap stack safety tested with 50k flatMaps") { val expected = Applicative[FreeTListOption].pure(()) val result = - FlatMapRec[FreeTListOption].tailRecM(0)((i: Int) => + Monad[FreeTListOption].tailRecM(0)((i: Int) => if (i < 50000) Applicative[FreeTListOption].pure(Xor.left[Int, Unit](i + 1)) else @@ -166,19 +131,34 @@ object FreeTTests extends FreeTTestsInstances sealed trait FreeTTestsInstances { + import FreeT._ import Arbitrary._ import org.scalacheck.Arbitrary import cats.kernel.instances.option._ import cats.tests.StateTTests._ + import CartesianTests._ type IntState[A] = State[Int, A] type FreeTListW[M[_], A] = FreeT[ListWrapper, M, A] type FreeTListWrapper[A] = FreeTListW[ListWrapper, A] type FreeTListOption[A] = FreeTListW[Option, A] type FreeTListState[A] = FreeT[IntState, IntState, A] + type MonadRec[F[_]] = Monad[F] with RecursiveTailRecM[F] case class JustFunctor[A](a: A) + implicit val listSemigroupK: SemigroupK[ListWrapper] = ListWrapper.semigroupK + + implicit val listWrapperMonad: MonadRec[ListWrapper] with Alternative[ListWrapper] = ListWrapper.monadCombine + + implicit val intStateMonad: MonadRec[IntState] = throw("can't summon this instance!") + + implicit val ftlWIso: Isomorphisms[FreeTListWrapper] = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] + + implicit val ftlOIso: Isomorphisms[FreeTListOption] = CartesianTests.Isomorphisms.invariant[FreeTListOption] + + implicit val ftlSIso: Isomorphisms[FreeTListState] = CartesianTests.Isomorphisms.invariant[FreeTListState] + implicit val jfFunctor: Functor[JustFunctor] = new Functor[JustFunctor] { override def map[A, B](fa: JustFunctor[A])(f: A => B): JustFunctor[B] = JustFunctor(f(fa.a)) } @@ -191,29 +171,29 @@ sealed trait FreeTTestsInstances { def eqv(a: Int, b: Int) = a == b } + implicit def evalEq[A: Eq]: Eq[Eval[A]] = Eval.catsEqForEval[A] + implicit def intStateEq[A: Eq]: Eq[IntState[A]] = stateEq[Int, A] - implicit def evalEq[A: Eq]: Eq[Eval[A]] = Eval.catsEqForEval[A] + implicit def intStateArb[A: Arbitrary]: Arbitrary[IntState[A]] = stateArbitrary[Int, A] implicit def listWrapperArbitrary[A: Arbitrary]: Arbitrary[ListWrapper[A]] = ListWrapper.listWrapperArbitrary[A] - implicit def freeTStateArb[A: Arbitrary](implicit LA: Arbitrary[ListWrapper[A]]): Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] + implicit def freeTListStateArb[A : Arbitrary]: Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] implicit def freeTArb[F[_], G[_]: Applicative, A](implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Arbitrary[FreeT[F, G, A]] = Arbitrary(freeTGen[F, G, A](4)) implicit def freeTListWrapperEq[A](implicit A: Eq[A]): Eq[FreeTListWrapper[A]] = new Eq[FreeTListWrapper[A]] { - implicit val listWrapperMonad: MonadRec[ListWrapper] = ListWrapper.monadRec def eqv(a: FreeTListWrapper[A], b: FreeTListWrapper[A]) = Eq[ListWrapper[A]].eqv(a.runM(identity), b.runM(identity)) } implicit def freeTListOptionEq[A](implicit A: Eq[A], OF: MonadRec[Option]): Eq[FreeTListOption[A]] = new Eq[FreeTListOption[A]] { - implicit val listWrapperMonad: MonadRec[ListWrapper] = ListWrapper.monadRec def eqv(a: FreeTListOption[A], b: FreeTListOption[A]) = Eq[Option[A]].eqv(a.runM(_.list.headOption), b.runM(_.list.headOption)) } - implicit def freeTListStateEq[A](implicit A: Eq[A], SM: MonadRec[IntState]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { - def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[State[Int, A]].eqv(a.runM(identity), b.runM(identity)) + implicit def freeTListStateEq[A](implicit A: Eq[A]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { + def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[IntState[A]].eqv(a.runM(identity), b.runM(identity)) } private def freeTGen[F[_], G[_]: Applicative, A](maxDepth: Int)(implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Gen[FreeT[F, G, A]] = { @@ -234,5 +214,5 @@ sealed trait FreeTTestsInstances { if (maxDepth <= 1) noFlatMapped else Gen.oneOf(noFlatMapped, withFlatMapped) } - + } diff --git a/tests/src/test/scala/cats/tests/ListWrapper.scala b/tests/src/test/scala/cats/tests/ListWrapper.scala index 92ae4c6e25..3adcc41f60 100644 --- a/tests/src/test/scala/cats/tests/ListWrapper.scala +++ b/tests/src/test/scala/cats/tests/ListWrapper.scala @@ -76,10 +76,10 @@ object ListWrapper { def semigroup[A]: Semigroup[ListWrapper[A]] = semigroupK.algebra[A] - val monadCombine: MonadCombine[ListWrapper] = { + val monadCombine: MonadCombine[ListWrapper] with RecursiveTailRecM[ListWrapper] = { val M = MonadCombine[List] - new MonadCombine[ListWrapper] { + new MonadCombine[ListWrapper] with RecursiveTailRecM[ListWrapper] { def pure[A](x: A): ListWrapper[A] = ListWrapper(M.pure(x)) def flatMap[A, B](fa: ListWrapper[A])(f: A => ListWrapper[B]): ListWrapper[B] = From a7e690f0b77cece18f4edbb69a659503eebef93a Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 18 Aug 2016 20:08:18 +0200 Subject: [PATCH 14/22] Fixed implicits for RecursiveTailRecM --- free/src/main/scala/cats/free/FreeT.scala | 38 +++++++------- .../src/test/scala/cats/free/FreeTTests.scala | 49 +++++++++---------- 2 files changed, 42 insertions(+), 45 deletions(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 45f3abd83e..b45ce9d534 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -5,15 +5,16 @@ import scala.annotation.tailrec import cats.data.Xor -/** FreeT is a monad transformer for Free monads over a Functor S - * - * Stack safety for `Free` and `FreeT` is based on the paper - * [[http://functorial.com/stack-safety-for-free/index.pdf Stack Safety for Free]] by Phil Freeman - * - * This Scala implementation of `FreeT` and its usages are derived from - * [[https://github.com/scalaz/scalaz/blob/series/7.3.x/core/src/main/scala/scalaz/FreeT.scala Scalaz's FreeT]], - * originally written by Brian McKenna. - */ +/** + * FreeT is a monad transformer for Free monads over a Functor S + * + * Stack safety for `Free` and `FreeT` is based on the paper + * [[http://functorial.com/stack-safety-for-free/index.pdf Stack Safety for Free]] by Phil Freeman + * + * This Scala implementation of `FreeT` and its usages are derived from + * [[https://github.com/scalaz/scalaz/blob/series/7.3.x/core/src/main/scala/scalaz/FreeT.scala Scalaz's FreeT]], + * originally written by Brian McKenna. + */ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { import FreeT._ @@ -47,10 +48,10 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } /** - * Runs to completion, mapping the suspension with the given transformation - * at each step and accumulating into the monad `M`. - */ - def foldMap(f: S ~> M)(implicit MR: Monad[M] with RecursiveTailRecM[M]): M[A] = { + * Runs to completion, mapping the suspension with the given transformation + * at each step and accumulating into the monad `M`. + */ + def foldMap(f: S ~> M)(implicit MR: Monad[M], RT: RecursiveTailRecM[M]): M[A] = { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = ft match { case Suspend(ma) => MR.flatMap(ma) { @@ -70,7 +71,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } /** Evaluates a single layer of the free monad */ - def resume(implicit S: Functor[S], MR: Monad[M] with RecursiveTailRecM[M]): M[A Xor S[FreeT[S, M, A]]] = { + def resume(implicit S: Functor[S], MR: Monad[M], RT: RecursiveTailRecM[M]): M[A Xor S[FreeT[S, M, A]]] = { def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor (A Xor S[FreeT[S, M, A]])] = ft match { case Suspend(f) => MR.map(f)(as => Xor.right(as.map(S.map(_)(pure(_))))) @@ -87,9 +88,9 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } /** - * Runs to completion, using a function that maps the resumption from `S` to a monad `M`. - */ - def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], MR: Monad[M] with RecursiveTailRecM[M]): M[A] = { + * Runs to completion, using a function that maps the resumption from `S` to a monad `M`. + */ + def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], MR: Monad[M], RT: RecursiveTailRecM[M]): M[A] = { def runM2(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = MR.flatMap(ft.resume) { case Xor.Left(a) => MR.pure(Xor.right(a)) @@ -132,7 +133,6 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { override def toString(): String = "FreeT(...)" } - object FreeT extends FreeTInstances { /** Suspend the computation with the given suspension. */ private[free] case class Suspend[S[_], M[_], A](a: M[A Xor S[A]]) extends FreeT[S, M, A] @@ -250,7 +250,7 @@ private[free] sealed trait FreeTFlatMap[S[_], M[_]] extends FlatMap[FreeT[S, M, private[free] sealed trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] with RecursiveTailRecM[FreeT[S, M, ?]] with FreeTFlatMap[S, M] { implicit def M: Applicative[M] - override final def pure[A](a: A): FreeT[S, M, A] = + override final def pure[A](a: A): FreeT[S, M, A] = FreeT.pure[S, M, A](a) } diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index fbb90447ee..9d7e4872be 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -14,19 +14,19 @@ class FreeTTests extends CatsSuite { import ListWrapper._ import FreeTTests._ -/* - checkAll("FreeT[ListWrapper, ListWrapper, Int]", FlatMapTests[FreeTListWrapper].flatMap[Int, Int, Int]) - checkAll("FlatMap[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(FlatMap[FreeTListWrapper])) - - checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadTests[FreeTListWrapper].monad[Int, Int, Int]) - checkAll("Monad[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(Monad[FreeTListWrapper])) - - checkAll("FreeT[ListWrapper, ListWrapper, Int]", SemigroupKTests[FreeTListWrapper].semigroupK[Int]) - checkAll("SemigroupK[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(SemigroupK[FreeTListWrapper])) - - checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadCombineTests[FreeTListWrapper].monadCombine[Int, Int, Int]) - checkAll("MonadCombine[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(MonadCombine[FreeTListWrapper])) - */ + + checkAll("FreeT[ListWrapper, ListWrapper, Int]", FlatMapTests[FreeTListWrapper].flatMap[Int, Int, Int]) + checkAll("FlatMap[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(FlatMap[FreeTListWrapper])) + + checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadTests[FreeTListWrapper].monad[Int, Int, Int]) + checkAll("Monad[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(Monad[FreeTListWrapper])) + + checkAll("FreeT[ListWrapper, ListWrapper, Int]", SemigroupKTests[FreeTListWrapper].semigroupK[Int]) + checkAll("SemigroupK[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(SemigroupK[FreeTListWrapper])) + + checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadCombineTests[FreeTListWrapper].monadCombine[Int, Int, Int]) + checkAll("MonadCombine[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(MonadCombine[FreeTListWrapper])) + { implicit val eqXortTFA: Eq[XorT[FreeTListOption, Unit, Int]] = XorT.catsDataEqForXorT[FreeTListOption, Unit, Int] checkAll("FreeT[ListWrapper, Option, Int]", MonadErrorTests[FreeTListOption, Unit].monadError[Int, Int, Int]) @@ -37,10 +37,8 @@ class FreeTTests extends CatsSuite { import StateT._ checkAll("FreeT[ListWrapper, State[Int, ?], Int]", MonadStateTests[FreeTListState, Int].monadState[Int, Int, Int]) checkAll("MonadState[FreeT[ListWrapper,State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTListState, Int])) - } - - - + } + test("FlatMap stack safety tested with 50k flatMaps") { val expected = Applicative[FreeTListOption].pure(()) val result = @@ -132,6 +130,7 @@ object FreeTTests extends FreeTTestsInstances sealed trait FreeTTestsInstances { import FreeT._ + import StateT._ import Arbitrary._ import org.scalacheck.Arbitrary import cats.kernel.instances.option._ @@ -148,17 +147,15 @@ sealed trait FreeTTestsInstances { case class JustFunctor[A](a: A) implicit val listSemigroupK: SemigroupK[ListWrapper] = ListWrapper.semigroupK - - implicit val listWrapperMonad: MonadRec[ListWrapper] with Alternative[ListWrapper] = ListWrapper.monadCombine - implicit val intStateMonad: MonadRec[IntState] = throw("can't summon this instance!") + implicit val listWrapperMonad: MonadRec[ListWrapper] with Alternative[ListWrapper] = ListWrapper.monadCombine implicit val ftlWIso: Isomorphisms[FreeTListWrapper] = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] implicit val ftlOIso: Isomorphisms[FreeTListOption] = CartesianTests.Isomorphisms.invariant[FreeTListOption] implicit val ftlSIso: Isomorphisms[FreeTListState] = CartesianTests.Isomorphisms.invariant[FreeTListState] - + implicit val jfFunctor: Functor[JustFunctor] = new Functor[JustFunctor] { override def map[A, B](fa: JustFunctor[A])(f: A => B): JustFunctor[B] = JustFunctor(f(fa.a)) } @@ -179,7 +176,7 @@ sealed trait FreeTTestsInstances { implicit def listWrapperArbitrary[A: Arbitrary]: Arbitrary[ListWrapper[A]] = ListWrapper.listWrapperArbitrary[A] - implicit def freeTListStateArb[A : Arbitrary]: Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] + implicit def freeTListStateArb[A: Arbitrary]: Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] implicit def freeTArb[F[_], G[_]: Applicative, A](implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Arbitrary[FreeT[F, G, A]] = Arbitrary(freeTGen[F, G, A](4)) @@ -188,12 +185,12 @@ sealed trait FreeTTestsInstances { def eqv(a: FreeTListWrapper[A], b: FreeTListWrapper[A]) = Eq[ListWrapper[A]].eqv(a.runM(identity), b.runM(identity)) } - implicit def freeTListOptionEq[A](implicit A: Eq[A], OF: MonadRec[Option]): Eq[FreeTListOption[A]] = new Eq[FreeTListOption[A]] { + implicit def freeTListOptionEq[A](implicit A: Eq[A], OM: MonadRec[Option]): Eq[FreeTListOption[A]] = new Eq[FreeTListOption[A]] { def eqv(a: FreeTListOption[A], b: FreeTListOption[A]) = Eq[Option[A]].eqv(a.runM(_.list.headOption), b.runM(_.list.headOption)) } - implicit def freeTListStateEq[A](implicit A: Eq[A]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { - def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[IntState[A]].eqv(a.runM(identity), b.runM(identity)) + implicit def freeTListStateEq[A](implicit A: Eq[A], SM: Monad[IntState], RT: RecursiveTailRecM[IntState]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { + def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[IntState[A]].eqv(a.runM(identity)(SM, SM, RT), b.runM(identity)(SM, SM, RT)) } private def freeTGen[F[_], G[_]: Applicative, A](maxDepth: Int)(implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Gen[FreeT[F, G, A]] = { @@ -214,5 +211,5 @@ sealed trait FreeTTestsInstances { if (maxDepth <= 1) noFlatMapped else Gen.oneOf(noFlatMapped, withFlatMapped) } - + } From 1ebc15c27e93eb68c8129e325adbd8e31dae476d Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 18 Aug 2016 20:26:05 +0200 Subject: [PATCH 15/22] Minor cleanup --- free/src/test/scala/cats/free/FreeTTests.scala | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index 9d7e4872be..88ce0d2329 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -35,8 +35,8 @@ class FreeTTests extends CatsSuite { { import StateT._ - checkAll("FreeT[ListWrapper, State[Int, ?], Int]", MonadStateTests[FreeTListState, Int].monadState[Int, Int, Int]) - checkAll("MonadState[FreeT[ListWrapper,State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTListState, Int])) + checkAll("FreeT[State[Int, ?], State[Int, ?], Int]", MonadStateTests[FreeTListState, Int].monadState[Int, Int, Int]) + checkAll("MonadState[FreeT[State[Int, ?],State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTListState, Int])) } test("FlatMap stack safety tested with 50k flatMaps") { @@ -142,13 +142,12 @@ sealed trait FreeTTestsInstances { type FreeTListWrapper[A] = FreeTListW[ListWrapper, A] type FreeTListOption[A] = FreeTListW[Option, A] type FreeTListState[A] = FreeT[IntState, IntState, A] - type MonadRec[F[_]] = Monad[F] with RecursiveTailRecM[F] - + case class JustFunctor[A](a: A) implicit val listSemigroupK: SemigroupK[ListWrapper] = ListWrapper.semigroupK - implicit val listWrapperMonad: MonadRec[ListWrapper] with Alternative[ListWrapper] = ListWrapper.monadCombine + implicit val listWrapperMonad: Monad[ListWrapper] with RecursiveTailRecM[ListWrapper] with Alternative[ListWrapper] = ListWrapper.monadCombine implicit val ftlWIso: Isomorphisms[FreeTListWrapper] = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] @@ -185,7 +184,7 @@ sealed trait FreeTTestsInstances { def eqv(a: FreeTListWrapper[A], b: FreeTListWrapper[A]) = Eq[ListWrapper[A]].eqv(a.runM(identity), b.runM(identity)) } - implicit def freeTListOptionEq[A](implicit A: Eq[A], OM: MonadRec[Option]): Eq[FreeTListOption[A]] = new Eq[FreeTListOption[A]] { + implicit def freeTListOptionEq[A](implicit A: Eq[A], OM: Monad[Option], RT: RecursiveTailRecM[Option]): Eq[FreeTListOption[A]] = new Eq[FreeTListOption[A]] { def eqv(a: FreeTListOption[A], b: FreeTListOption[A]) = Eq[Option[A]].eqv(a.runM(_.list.headOption), b.runM(_.list.headOption)) } From f4d8693935c1851a428c1906ea8c209d52ea9781 Mon Sep 17 00:00:00 2001 From: raulraja Date: Thu, 18 Aug 2016 20:53:38 +0200 Subject: [PATCH 16/22] Addresses PR comments regarding use of RecursiveTailRecM --- free/src/main/scala/cats/free/FreeT.scala | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index b45ce9d534..2ef6091c10 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -67,7 +67,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } } - MR.tailRecM(this)(go) + RT.sameType(MR).tailRecM(this)(go) } /** Evaluates a single layer of the free monad */ @@ -84,7 +84,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } } - MR.tailRecM(this)(go) + RT.sameType(MR).tailRecM(this)(go) } /** @@ -96,7 +96,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { case Xor.Left(a) => MR.pure(Xor.right(a)) case Xor.Right(fc) => MR.map(interp(fc))(Xor.left) } - MR.tailRecM(this)(runM2) + RT.sameType(MR).tailRecM(this)(runM2) } /** @@ -219,20 +219,18 @@ private[free] sealed trait FreeTInstances0 extends FreeTInstances1 { def M = M0 } - implicit def catsFreeCombineForFreeT[S[_], M[_]: Applicative: RecursiveTailRecM: SemigroupK]: SemigroupK[FreeT[S, M, ?]] = + implicit def catsFreeCombineForFreeT[S[_], M[_]: Applicative: SemigroupK]: SemigroupK[FreeT[S, M, ?]] = new FreeTCombine[S, M] { override def M = implicitly override def M1 = implicitly - override def M2 = implicitly } } private[free] sealed trait FreeTInstances extends FreeTInstances0 { - implicit def catsFreeMonadCombineForFreeT[S[_], M[_]: Alternative: RecursiveTailRecM]: MonadCombine[FreeT[S, M, ?]] = + implicit def catsFreeMonadCombineForFreeT[S[_], M[_]: Alternative]: MonadCombine[FreeT[S, M, ?]] = new MonadCombine[FreeT[S, M, ?]] with FreeTCombine[S, M] with FreeTMonad[S, M] { override def M = implicitly override def M1 = implicitly - override def M2 = implicitly override def empty[A] = FreeT.liftT[S, M, A](MonoidK[M].empty[A])(M) } @@ -256,8 +254,7 @@ private[free] sealed trait FreeTMonad[S[_], M[_]] extends Monad[FreeT[S, M, ?]] private[free] sealed trait FreeTCombine[S[_], M[_]] extends SemigroupK[FreeT[S, M, ?]] { implicit def M: Applicative[M] - implicit def M1: RecursiveTailRecM[M] - def M2: SemigroupK[M] + def M1: SemigroupK[M] override final def combineK[A](a: FreeT[S, M, A], b: FreeT[S, M, A]): FreeT[S, M, A] = - FreeT.liftT(M2.combineK(a.toM, b.toM))(M).flatMap(identity) + FreeT.liftT(M1.combineK(a.toM, b.toM))(M).flatMap(identity) } From ce62750a63e6c59e3f5f82df145398c74d85611b Mon Sep 17 00:00:00 2001 From: raulraja Date: Fri, 19 Aug 2016 02:06:23 +0200 Subject: [PATCH 17/22] Rearranged instance to workaround implicit search compiler bug in 2.10.6 --- .../src/test/scala/cats/free/FreeTTests.scala | 69 ++++++++++--------- 1 file changed, 37 insertions(+), 32 deletions(-) diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index 88ce0d2329..ebe81714a0 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -125,14 +125,46 @@ class FreeTTests extends CatsSuite { } } -object FreeTTests extends FreeTTestsInstances +object FreeTTests + extends FreeTTestsInstances -sealed trait FreeTTestsInstances { +trait FreeTTestsInstances extends FreeTTestsInstances0 { - import FreeT._ - import StateT._ import Arbitrary._ import org.scalacheck.Arbitrary + + implicit def listWrapperArbitrary[A: Arbitrary]: Arbitrary[ListWrapper[A]] = ListWrapper.listWrapperArbitrary[A] + + implicit def freeTListStateArb[A: Arbitrary]: Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] + + implicit def freeTArb[F[_], G[_]: Applicative, A](implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Arbitrary[FreeT[F, G, A]] = + Arbitrary(freeTGen[F, G, A](4)) + + private def freeTGen[F[_], G[_]: Applicative, A](maxDepth: Int)(implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Gen[FreeT[F, G, A]] = { + val noFlatMapped = Gen.oneOf( + A.arbitrary.map(FreeT.pure[F, G, A]), + F.arbitrary.map(FreeT.liftF[F, G, A]) + ) + + val nextDepth = Gen.chooseNum(1, maxDepth - 1) + + def withFlatMapped = for { + fDepth <- nextDepth + freeDepth <- nextDepth + f <- arbFunction1[A, FreeT[F, G, A]](Arbitrary(freeTGen[F, G, A](fDepth))).arbitrary + freeFGA <- freeTGen[F, G, A](freeDepth) + } yield freeFGA.flatMap(f) + + if (maxDepth <= 1) noFlatMapped + else Gen.oneOf(noFlatMapped, withFlatMapped) + } + +} + +trait FreeTTestsInstances0 { + + import FreeT._ + import StateT._ import cats.kernel.instances.option._ import cats.tests.StateTTests._ import CartesianTests._ @@ -142,7 +174,7 @@ sealed trait FreeTTestsInstances { type FreeTListWrapper[A] = FreeTListW[ListWrapper, A] type FreeTListOption[A] = FreeTListW[Option, A] type FreeTListState[A] = FreeT[IntState, IntState, A] - + case class JustFunctor[A](a: A) implicit val listSemigroupK: SemigroupK[ListWrapper] = ListWrapper.semigroupK @@ -173,13 +205,6 @@ sealed trait FreeTTestsInstances { implicit def intStateArb[A: Arbitrary]: Arbitrary[IntState[A]] = stateArbitrary[Int, A] - implicit def listWrapperArbitrary[A: Arbitrary]: Arbitrary[ListWrapper[A]] = ListWrapper.listWrapperArbitrary[A] - - implicit def freeTListStateArb[A: Arbitrary]: Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] - - implicit def freeTArb[F[_], G[_]: Applicative, A](implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Arbitrary[FreeT[F, G, A]] = - Arbitrary(freeTGen[F, G, A](4)) - implicit def freeTListWrapperEq[A](implicit A: Eq[A]): Eq[FreeTListWrapper[A]] = new Eq[FreeTListWrapper[A]] { def eqv(a: FreeTListWrapper[A], b: FreeTListWrapper[A]) = Eq[ListWrapper[A]].eqv(a.runM(identity), b.runM(identity)) } @@ -191,24 +216,4 @@ sealed trait FreeTTestsInstances { implicit def freeTListStateEq[A](implicit A: Eq[A], SM: Monad[IntState], RT: RecursiveTailRecM[IntState]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[IntState[A]].eqv(a.runM(identity)(SM, SM, RT), b.runM(identity)(SM, SM, RT)) } - - private def freeTGen[F[_], G[_]: Applicative, A](maxDepth: Int)(implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Gen[FreeT[F, G, A]] = { - val noFlatMapped = Gen.oneOf( - A.arbitrary.map(FreeT.pure[F, G, A]), - F.arbitrary.map(FreeT.liftF[F, G, A]) - ) - - val nextDepth = Gen.chooseNum(1, maxDepth - 1) - - def withFlatMapped = for { - fDepth <- nextDepth - freeDepth <- nextDepth - f <- arbFunction1[A, FreeT[F, G, A]](Arbitrary(freeTGen[F, G, A](fDepth))).arbitrary - freeFGA <- freeTGen[F, G, A](freeDepth) - } yield freeFGA.flatMap(f) - - if (maxDepth <= 1) noFlatMapped - else Gen.oneOf(noFlatMapped, withFlatMapped) - } - } From 16733ea8a2f0d59340334c8e8f4dafb8abb11fb2 Mon Sep 17 00:00:00 2001 From: raulraja Date: Fri, 19 Aug 2016 02:42:27 +0200 Subject: [PATCH 18/22] More compiler workarounds non-sense for hangs on 2.11 --- free/src/test/scala/cats/free/FreeTTests.scala | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index ebe81714a0..f7d4208d69 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -125,10 +125,7 @@ class FreeTTests extends CatsSuite { } } -object FreeTTests - extends FreeTTestsInstances - -trait FreeTTestsInstances extends FreeTTestsInstances0 { +object FreeTTests extends FreeTTestsInstances { import Arbitrary._ import org.scalacheck.Arbitrary @@ -161,7 +158,7 @@ trait FreeTTestsInstances extends FreeTTestsInstances0 { } -trait FreeTTestsInstances0 { +trait FreeTTestsInstances { import FreeT._ import StateT._ From ff46b5bd70f5340b17fd8177610d5a6fbe17cd3d Mon Sep 17 00:00:00 2001 From: raulraja Date: Fri, 19 Aug 2016 21:37:17 +0200 Subject: [PATCH 19/22] Simplified test instances --- .../src/test/scala/cats/free/FreeTTests.scala | 113 ++++++++---------- .../test/scala/cats/tests/ListWrapper.scala | 3 +- 2 files changed, 49 insertions(+), 67 deletions(-) diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index f7d4208d69..262cdd6ce8 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -5,82 +5,81 @@ import cats._ import cats.arrow.FunctionK import cats.data._ import cats.laws.discipline._ -import cats.tests.{CatsSuite, ListWrapper} +import cats.tests.CatsSuite import cats.instances.option._ import org.scalacheck.{Arbitrary, Gen} class FreeTTests extends CatsSuite { - import ListWrapper._ import FreeTTests._ - checkAll("FreeT[ListWrapper, ListWrapper, Int]", FlatMapTests[FreeTListWrapper].flatMap[Int, Int, Int]) - checkAll("FlatMap[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(FlatMap[FreeTListWrapper])) + checkAll("FreeT[Option, Option, Int]", FlatMapTests[FreeTOption].flatMap[Int, Int, Int]) + checkAll("FlatMap[FreeT[Option, Option, ?]]", SerializableTests.serializable(FlatMap[FreeTOption])) - checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadTests[FreeTListWrapper].monad[Int, Int, Int]) - checkAll("Monad[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(Monad[FreeTListWrapper])) + checkAll("FreeT[Option, Option, Int]", MonadTests[FreeTOption].monad[Int, Int, Int]) + checkAll("Monad[FreeT[Option, Option, ?]]", SerializableTests.serializable(Monad[FreeTOption])) - checkAll("FreeT[ListWrapper, ListWrapper, Int]", SemigroupKTests[FreeTListWrapper].semigroupK[Int]) - checkAll("SemigroupK[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(SemigroupK[FreeTListWrapper])) + checkAll("FreeT[Option, Option, Int]", SemigroupKTests[FreeTOption].semigroupK[Int]) + checkAll("SemigroupK[FreeT[Option, Option, ?]]", SerializableTests.serializable(SemigroupK[FreeTOption])) - checkAll("FreeT[ListWrapper, ListWrapper, Int]", MonadCombineTests[FreeTListWrapper].monadCombine[Int, Int, Int]) - checkAll("MonadCombine[FreeT[ListWrapper, ListWrapper, ?]]", SerializableTests.serializable(MonadCombine[FreeTListWrapper])) + checkAll("FreeT[Option, Option, Int]", MonadCombineTests[FreeTOption].monadCombine[Int, Int, Int]) + checkAll("MonadCombine[FreeT[Option, Option, ?]]", SerializableTests.serializable(MonadCombine[FreeTOption])) { - implicit val eqXortTFA: Eq[XorT[FreeTListOption, Unit, Int]] = XorT.catsDataEqForXorT[FreeTListOption, Unit, Int] - checkAll("FreeT[ListWrapper, Option, Int]", MonadErrorTests[FreeTListOption, Unit].monadError[Int, Int, Int]) - checkAll("MonadError[FreeT[ListWrapper, Option, ?], Unit]", SerializableTests.serializable(MonadError[FreeTListOption, Unit])) + implicit val eqXortTFA: Eq[XorT[FreeTOption, Unit, Int]] = XorT.catsDataEqForXorT[FreeTOption, Unit, Int] + checkAll("FreeT[Option, Option, Int]", MonadErrorTests[FreeTOption, Unit].monadError[Int, Int, Int]) + checkAll("MonadError[FreeT[Option, Option, ?], Unit]", SerializableTests.serializable(MonadError[FreeTOption, Unit])) } { import StateT._ - checkAll("FreeT[State[Int, ?], State[Int, ?], Int]", MonadStateTests[FreeTListState, Int].monadState[Int, Int, Int]) - checkAll("MonadState[FreeT[State[Int, ?],State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTListState, Int])) + checkAll("FreeT[State[Int, ?], State[Int, ?], Int]", MonadStateTests[FreeTState, Int].monadState[Int, Int, Int]) + checkAll("MonadState[FreeT[State[Int, ?],State[Int, ?], ?], Int]", SerializableTests.serializable(MonadState[FreeTState, Int])) } test("FlatMap stack safety tested with 50k flatMaps") { - val expected = Applicative[FreeTListOption].pure(()) + val expected = Applicative[FreeTOption].pure(()) val result = - Monad[FreeTListOption].tailRecM(0)((i: Int) => + Monad[FreeTOption].tailRecM(0)((i: Int) => if (i < 50000) - Applicative[FreeTListOption].pure(Xor.left[Int, Unit](i + 1)) + Applicative[FreeTOption].pure(Xor.left[Int, Unit](i + 1)) else - Applicative[FreeTListOption].pure(Xor.right[Int, Unit](()))) + Applicative[FreeTOption].pure(Xor.right[Int, Unit](()))) - Eq[FreeTListOption[Unit]].eqv(expected, result) should ===(true) + Eq[FreeTOption[Unit]].eqv(expected, result) should ===(true) } test("Stack safe with 50k left-associated flatMaps") { - val expected = Applicative[FreeTListOption].pure(()) + val expected = Applicative[FreeTOption].pure(()) val result = - (0 until 50000).foldLeft(Applicative[FreeTListOption].pure(()))( - (fu, i) => fu.flatMap(u => Applicative[FreeTListOption].pure(u)) + (0 until 50000).foldLeft(Applicative[FreeTOption].pure(()))( + (fu, i) => fu.flatMap(u => Applicative[FreeTOption].pure(u)) ) - Eq[FreeTListOption[Unit]].eqv(expected, result) should ===(true) + Eq[FreeTOption[Unit]].eqv(expected, result) should ===(true) } test("Stack safe with flatMap followed by 50k maps") { - val expected = Applicative[FreeTListOption].pure(()) + val expected = Applicative[FreeTOption].pure(()) val result = - (0 until 50000).foldLeft(().pure[FreeTListOption].flatMap(_.pure[FreeTListOption]))( + (0 until 50000).foldLeft(().pure[FreeTOption].flatMap(_.pure[FreeTOption]))( (fu, i) => fu.map(identity) ) - Eq[FreeTListOption[Unit]].eqv(expected, result) should ===(true) + Eq[FreeTOption[Unit]].eqv(expected, result) should ===(true) } test("hoist to universal id equivalent to original instance") { - forAll { a: FreeTListOption[Int] => + forAll { a: FreeTOption[Int] => val b = a.hoist(FunctionK.id) - Eq[FreeTListOption[Int]].eqv(a, b) should ===(true) + Eq[FreeTOption[Int]].eqv(a, b) should ===(true) } } test("hoist stack-safety") { - val a = (0 until 50000).foldLeft(Applicative[FreeTListOption].pure(()))( - (fu, i) => fu.flatMap(u => Applicative[FreeTListOption].pure(u)) + val a = (0 until 50000).foldLeft(Applicative[FreeTOption].pure(()))( + (fu, i) => fu.flatMap(u => Applicative[FreeTOption].pure(u)) ) val b = a.hoist(FunctionK.id) } @@ -91,24 +90,23 @@ class FreeTTests extends CatsSuite { } test("interpret to universal id equivalent to original instance") { - forAll { a: FreeTListOption[Int] => + forAll { a: FreeTOption[Int] => val b = a.interpret(FunctionK.id) - Eq[FreeTListOption[Int]].eqv(a, b) should ===(true) + Eq[FreeTOption[Int]].eqv(a, b) should ===(true) } } test("interpret stack-safety") { - val a = (0 until 50000).foldLeft(Applicative[FreeTListOption].pure(()))( - (fu, i) => fu.flatMap(u => Applicative[FreeTListOption].pure(u)) + val a = (0 until 50000).foldLeft(Applicative[FreeTOption].pure(()))( + (fu, i) => fu.flatMap(u => Applicative[FreeTOption].pure(u)) ) val b = a.interpret(FunctionK.id) // used to overflow } test("foldMap consistent with runM") { - implicit val listWrapperFunctor = ListWrapper.monad - forAll { a: FreeTListOption[Int] => - val x = a.runM(_.list.headOption) - val y = a.foldMap(headOption) + forAll { a: FreeTOption[Int] => + val x = a.runM(identity) + val y = a.foldMap(FunctionK.id) Eq[Option[Int]].eqv(x, y) should ===(true) } } @@ -123,6 +121,7 @@ class FreeTTests extends CatsSuite { val a: String Xor Int = Xor.right(42) val b: FreeT[Option, String Xor ?, Int] = FreeT.liftTU(a) } + } object FreeTTests extends FreeTTestsInstances { @@ -130,9 +129,7 @@ object FreeTTests extends FreeTTestsInstances { import Arbitrary._ import org.scalacheck.Arbitrary - implicit def listWrapperArbitrary[A: Arbitrary]: Arbitrary[ListWrapper[A]] = ListWrapper.listWrapperArbitrary[A] - - implicit def freeTListStateArb[A: Arbitrary]: Arbitrary[FreeTListState[A]] = freeTArb[IntState, IntState, A] + implicit def freeTIntStateArb[A: Arbitrary]: Arbitrary[FreeTState[A]] = freeTArb[IntState, IntState, A] implicit def freeTArb[F[_], G[_]: Applicative, A](implicit F: Arbitrary[F[A]], G: Arbitrary[G[A]], A: Arbitrary[A]): Arbitrary[FreeT[F, G, A]] = Arbitrary(freeTGen[F, G, A](4)) @@ -167,31 +164,19 @@ trait FreeTTestsInstances { import CartesianTests._ type IntState[A] = State[Int, A] - type FreeTListW[M[_], A] = FreeT[ListWrapper, M, A] - type FreeTListWrapper[A] = FreeTListW[ListWrapper, A] - type FreeTListOption[A] = FreeTListW[Option, A] - type FreeTListState[A] = FreeT[IntState, IntState, A] + type FreeTOption[A] = FreeT[Option, Option, A] + type FreeTState[A] = FreeT[IntState, IntState, A] case class JustFunctor[A](a: A) - implicit val listSemigroupK: SemigroupK[ListWrapper] = ListWrapper.semigroupK - - implicit val listWrapperMonad: Monad[ListWrapper] with RecursiveTailRecM[ListWrapper] with Alternative[ListWrapper] = ListWrapper.monadCombine - - implicit val ftlWIso: Isomorphisms[FreeTListWrapper] = CartesianTests.Isomorphisms.invariant[FreeTListWrapper] - - implicit val ftlOIso: Isomorphisms[FreeTListOption] = CartesianTests.Isomorphisms.invariant[FreeTListOption] + implicit val ftlWIso: Isomorphisms[FreeTOption] = CartesianTests.Isomorphisms.invariant[FreeTOption] - implicit val ftlSIso: Isomorphisms[FreeTListState] = CartesianTests.Isomorphisms.invariant[FreeTListState] + implicit val ftlSIso: Isomorphisms[FreeTState] = CartesianTests.Isomorphisms.invariant[FreeTState] implicit val jfFunctor: Functor[JustFunctor] = new Functor[JustFunctor] { override def map[A, B](fa: JustFunctor[A])(f: A => B): JustFunctor[B] = JustFunctor(f(fa.a)) } - object headOption extends (ListWrapper ~> Option) { - def apply[A](l: ListWrapper[A]): Option[A] = l.list.headOption - } - implicit val intEq: Eq[Int] = new Eq[Int] { def eqv(a: Int, b: Int) = a == b } @@ -202,15 +187,11 @@ trait FreeTTestsInstances { implicit def intStateArb[A: Arbitrary]: Arbitrary[IntState[A]] = stateArbitrary[Int, A] - implicit def freeTListWrapperEq[A](implicit A: Eq[A]): Eq[FreeTListWrapper[A]] = new Eq[FreeTListWrapper[A]] { - def eqv(a: FreeTListWrapper[A], b: FreeTListWrapper[A]) = Eq[ListWrapper[A]].eqv(a.runM(identity), b.runM(identity)) - } - - implicit def freeTListOptionEq[A](implicit A: Eq[A], OM: Monad[Option], RT: RecursiveTailRecM[Option]): Eq[FreeTListOption[A]] = new Eq[FreeTListOption[A]] { - def eqv(a: FreeTListOption[A], b: FreeTListOption[A]) = Eq[Option[A]].eqv(a.runM(_.list.headOption), b.runM(_.list.headOption)) + implicit def freeTOptionEq[A](implicit A: Eq[A], OM: Monad[Option], RT: RecursiveTailRecM[Option]): Eq[FreeTOption[A]] = new Eq[FreeTOption[A]] { + def eqv(a: FreeTOption[A], b: FreeTOption[A]) = Eq[Option[A]].eqv(a.runM(identity), b.runM(identity)) } - implicit def freeTListStateEq[A](implicit A: Eq[A], SM: Monad[IntState], RT: RecursiveTailRecM[IntState]): Eq[FreeTListState[A]] = new Eq[FreeTListState[A]] { - def eqv(a: FreeTListState[A], b: FreeTListState[A]) = Eq[IntState[A]].eqv(a.runM(identity)(SM, SM, RT), b.runM(identity)(SM, SM, RT)) + implicit def freeTStateEq[A](implicit A: Eq[A], SM: Monad[IntState], RT: RecursiveTailRecM[IntState]): Eq[FreeTState[A]] = new Eq[FreeTState[A]] { + def eqv(a: FreeTState[A], b: FreeTState[A]) = Eq[IntState[A]].eqv(a.runM(identity)(SM, SM, RT), b.runM(identity)(SM, SM, RT)) } } diff --git a/tests/src/test/scala/cats/tests/ListWrapper.scala b/tests/src/test/scala/cats/tests/ListWrapper.scala index 3adcc41f60..6211738f8b 100644 --- a/tests/src/test/scala/cats/tests/ListWrapper.scala +++ b/tests/src/test/scala/cats/tests/ListWrapper.scala @@ -78,6 +78,7 @@ object ListWrapper { val monadCombine: MonadCombine[ListWrapper] with RecursiveTailRecM[ListWrapper] = { val M = MonadCombine[List] + val RT = RecursiveTailRecM[List] new MonadCombine[ListWrapper] with RecursiveTailRecM[ListWrapper] { def pure[A](x: A): ListWrapper[A] = ListWrapper(M.pure(x)) @@ -91,7 +92,7 @@ object ListWrapper { ListWrapper(M.combineK(x.list, y.list)) def tailRecM[A, B](a: A)(f: A => ListWrapper[cats.data.Xor[A,B]]): ListWrapper[B] = - ListWrapper(M.tailRecM(a)(a => f(a).list)) + ListWrapper(RT.sameType(M).tailRecM(a)(a => f(a).list)) } } From a15b2676cea14eddde7224f90924fe8cc5b21774 Mon Sep 17 00:00:00 2001 From: raulraja Date: Fri, 19 Aug 2016 21:50:23 +0200 Subject: [PATCH 20/22] Reverted ListWrapper to its original state --- tests/src/test/scala/cats/tests/ListWrapper.scala | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/tests/src/test/scala/cats/tests/ListWrapper.scala b/tests/src/test/scala/cats/tests/ListWrapper.scala index 6211738f8b..92ae4c6e25 100644 --- a/tests/src/test/scala/cats/tests/ListWrapper.scala +++ b/tests/src/test/scala/cats/tests/ListWrapper.scala @@ -76,11 +76,10 @@ object ListWrapper { def semigroup[A]: Semigroup[ListWrapper[A]] = semigroupK.algebra[A] - val monadCombine: MonadCombine[ListWrapper] with RecursiveTailRecM[ListWrapper] = { + val monadCombine: MonadCombine[ListWrapper] = { val M = MonadCombine[List] - val RT = RecursiveTailRecM[List] - new MonadCombine[ListWrapper] with RecursiveTailRecM[ListWrapper] { + new MonadCombine[ListWrapper] { def pure[A](x: A): ListWrapper[A] = ListWrapper(M.pure(x)) def flatMap[A, B](fa: ListWrapper[A])(f: A => ListWrapper[B]): ListWrapper[B] = @@ -92,7 +91,7 @@ object ListWrapper { ListWrapper(M.combineK(x.list, y.list)) def tailRecM[A, B](a: A)(f: A => ListWrapper[cats.data.Xor[A,B]]): ListWrapper[B] = - ListWrapper(RT.sameType(M).tailRecM(a)(a => f(a).list)) + ListWrapper(M.tailRecM(a)(a => f(a).list)) } } From ba3c1d698c2485833d4eb67b30169d734716d69d Mon Sep 17 00:00:00 2001 From: raulraja Date: Fri, 19 Aug 2016 23:54:35 +0200 Subject: [PATCH 21/22] Added explicit instances and extra tests --- .../src/test/scala/cats/free/FreeTTests.scala | 36 ++++++++++++++----- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index 262cdd6ce8..721f93a485 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -14,17 +14,29 @@ class FreeTTests extends CatsSuite { import FreeTTests._ - checkAll("FreeT[Option, Option, Int]", FlatMapTests[FreeTOption].flatMap[Int, Int, Int]) - checkAll("FlatMap[FreeT[Option, Option, ?]]", SerializableTests.serializable(FlatMap[FreeTOption])) + { + implicit val freeTFlatMap: FlatMap[FreeTOption] = FreeT.catsFreeFlatMapForFreeT[Option, Option] + checkAll("FreeT[Option, Option, Int]", FlatMapTests[FreeTOption].flatMap[Int, Int, Int]) + checkAll("FlatMap[FreeT[Option, Option, ?]]", SerializableTests.serializable(FlatMap[FreeTOption])) + } - checkAll("FreeT[Option, Option, Int]", MonadTests[FreeTOption].monad[Int, Int, Int]) - checkAll("Monad[FreeT[Option, Option, ?]]", SerializableTests.serializable(Monad[FreeTOption])) + { + implicit val freeTMonad: Monad[FreeTOption] = FreeT.catsFreeMonadForFreeT[Option, Option] + checkAll("FreeT[Option, Option, Int]", MonadTests[FreeTOption].monad[Int, Int, Int]) + checkAll("Monad[FreeT[Option, Option, ?]]", SerializableTests.serializable(Monad[FreeTOption])) + } - checkAll("FreeT[Option, Option, Int]", SemigroupKTests[FreeTOption].semigroupK[Int]) - checkAll("SemigroupK[FreeT[Option, Option, ?]]", SerializableTests.serializable(SemigroupK[FreeTOption])) + { + implicit val freeTSemigroupK: SemigroupK[FreeTOption] = FreeT.catsFreeCombineForFreeT[Option, Option] + checkAll("FreeT[Option, Option, Int]", SemigroupKTests[FreeTOption].semigroupK[Int]) + checkAll("SemigroupK[FreeT[Option, Option, ?]]", SerializableTests.serializable(SemigroupK[FreeTOption])) + } - checkAll("FreeT[Option, Option, Int]", MonadCombineTests[FreeTOption].monadCombine[Int, Int, Int]) - checkAll("MonadCombine[FreeT[Option, Option, ?]]", SerializableTests.serializable(MonadCombine[FreeTOption])) + { + implicit val freeTCombine: MonadCombine[FreeTOption] = FreeT.catsFreeMonadCombineForFreeT[Option, Option] + checkAll("FreeT[Option, Option, Int]", MonadCombineTests[FreeTOption].monadCombine[Int, Int, Int]) + checkAll("MonadCombine[FreeT[Option, Option, ?]]", SerializableTests.serializable(MonadCombine[FreeTOption])) + } { implicit val eqXortTFA: Eq[XorT[FreeTOption, Unit, Int]] = XorT.catsDataEqForXorT[FreeTOption, Unit, Int] @@ -117,6 +129,14 @@ class FreeTTests extends CatsSuite { a == b should be(false) } + test("toString is stack-safe") { + val result = + (0 until 50000).foldLeft(().pure[FreeTOption].flatMap(_.pure[FreeTOption]))( + (fu, i) => fu.map(identity) + ) + result.toString.length should be > 0 + } + private[free] def liftTUCompilationTests() = { val a: String Xor Int = Xor.right(42) val b: FreeT[Option, String Xor ?, Int] = FreeT.liftTU(a) From d75686d25fb5cd7e5572d9ca55716f3f49b31bf8 Mon Sep 17 00:00:00 2001 From: Adelbert Chang Date: Fri, 19 Aug 2016 19:59:45 -0700 Subject: [PATCH 22/22] s/Xor/Either in FreeT --- free/src/main/scala/cats/free/FreeT.scala | 64 +++++++++---------- .../src/test/scala/cats/free/FreeTTests.scala | 10 +-- 2 files changed, 36 insertions(+), 38 deletions(-) diff --git a/free/src/main/scala/cats/free/FreeT.scala b/free/src/main/scala/cats/free/FreeT.scala index 2ef6091c10..558b58e740 100644 --- a/free/src/main/scala/cats/free/FreeT.scala +++ b/free/src/main/scala/cats/free/FreeT.scala @@ -1,10 +1,9 @@ package cats package free +import cats.syntax.either._ import scala.annotation.tailrec -import cats.data.Xor - /** * FreeT is a monad transformer for Free monads over a Functor S * @@ -16,7 +15,6 @@ import cats.data.Xor * originally written by Brian McKenna. */ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { - import FreeT._ final def map[B](f: A => B)(implicit M: Applicative[M]): FreeT[S, M, B] = @@ -52,18 +50,18 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { * at each step and accumulating into the monad `M`. */ def foldMap(f: S ~> M)(implicit MR: Monad[M], RT: RecursiveTailRecM[M]): M[A] = { - def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = + def go(ft: FreeT[S, M, A]): M[Either[FreeT[S, M, A], A]] = ft match { case Suspend(ma) => MR.flatMap(ma) { - case Xor.Left(a) => MR.pure(Xor.Right(a)) - case Xor.Right(sa) => MR.map(f(sa))(Xor.right) + case Left(a) => MR.pure(Right(a)) + case Right(sa) => MR.map(f(sa))(Right(_)) } case g @ FlatMapped(_, _) => g.a match { case Suspend(mx) => MR.flatMap(mx) { - case Xor.Left(x) => MR.pure(Xor.left(g.f(x))) - case Xor.Right(sx) => MR.map(f(sx))(g.f andThen Xor.left) + case Left(x) => MR.pure(Left(g.f(x))) + case Right(sx) => MR.map(f(sx))(x => Left(g.f(x))) } - case g0 @ FlatMapped(_, _) => MR.pure(Xor.left(g0.a.flatMap(g0.f(_).flatMap(g.f)))) + case g0 @ FlatMapped(_, _) => MR.pure(Left(g0.a.flatMap(g0.f(_).flatMap(g.f)))) } } @@ -71,16 +69,16 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { } /** Evaluates a single layer of the free monad */ - def resume(implicit S: Functor[S], MR: Monad[M], RT: RecursiveTailRecM[M]): M[A Xor S[FreeT[S, M, A]]] = { - def go(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor (A Xor S[FreeT[S, M, A]])] = + def resume(implicit S: Functor[S], MR: Monad[M], RT: RecursiveTailRecM[M]): M[Either[A, S[FreeT[S, M, A]]]] = { + def go(ft: FreeT[S, M, A]): M[Either[FreeT[S, M, A], Either[A, S[FreeT[S, M, A]]]]] = ft match { - case Suspend(f) => MR.map(f)(as => Xor.right(as.map(S.map(_)(pure(_))))) + case Suspend(f) => MR.map(f)(as => Right(as.map(S.map(_)(pure(_))))) case g1 @ FlatMapped(_, _) => g1.a match { case Suspend(m1) => MR.map(m1) { - case Xor.Left(a) => Xor.left(g1.f(a)) - case Xor.Right(fc) => Xor.right(Xor.right(S.map(fc)(g1.f(_)))) + case Left(a) => Left(g1.f(a)) + case Right(fc) => Right(Right(S.map(fc)(g1.f(_)))) } - case g2 @ FlatMapped(_, _) => MR.pure(Xor.left(g2.a.flatMap(g2.f(_).flatMap(g1.f)))) + case g2 @ FlatMapped(_, _) => MR.pure(Left(g2.a.flatMap(g2.f(_).flatMap(g1.f)))) } } @@ -91,10 +89,10 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { * Runs to completion, using a function that maps the resumption from `S` to a monad `M`. */ def runM(interp: S[FreeT[S, M, A]] => M[FreeT[S, M, A]])(implicit S: Functor[S], MR: Monad[M], RT: RecursiveTailRecM[M]): M[A] = { - def runM2(ft: FreeT[S, M, A]): M[FreeT[S, M, A] Xor A] = + def runM2(ft: FreeT[S, M, A]): M[Either[FreeT[S, M, A], A]] = MR.flatMap(ft.resume) { - case Xor.Left(a) => MR.pure(Xor.right(a)) - case Xor.Right(fc) => MR.map(interp(fc))(Xor.left) + case Left(a) => MR.pure(Right(a)) + case Right(fc) => MR.map(interp(fc))(Left(_)) } RT.sameType(MR).tailRecM(this)(runM2) } @@ -108,13 +106,13 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { private[cats] final def toM(implicit M: Applicative[M]): M[FreeT[S, M, A]] = this match { case Suspend(m) => M.map(m) { - case Xor.Left(a) => pure(a) - case Xor.Right(s) => liftF(s) + case Left(a) => pure(a) + case Right(s) => liftF(s) } case g1 @ FlatMapped(_, _) => g1.a match { case Suspend(m) => M.map(m) { - case Xor.Left(a) => g1.f(a) - case Xor.Right(s) => liftF[S, M, g1.A](s).flatMap(g1.f) + case Left(a) => g1.f(a) + case Right(s) => liftF[S, M, g1.A](s).flatMap(g1.f) } case g0 @ FlatMapped(_, _) => g0.a.flatMap(g0.f(_).flatMap(g1.f)).toM } @@ -135,7 +133,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable { object FreeT extends FreeTInstances { /** Suspend the computation with the given suspension. */ - private[free] case class Suspend[S[_], M[_], A](a: M[A Xor S[A]]) extends FreeT[S, M, A] + private[free] case class Suspend[S[_], M[_], A](a: M[Either[A, S[A]]]) extends FreeT[S, M, A] /** Call a subroutine and continue with the given function. */ private[free] case class FlatMapped[S[_], M[_], A0, B](a0: FreeT[S, M, A0], f0: A0 => FreeT[S, M, B]) extends FreeT[S, M, B] { @@ -145,22 +143,22 @@ object FreeT extends FreeTInstances { } /** Return the given value in the free monad. */ - def pure[S[_], M[_], A](value: A)(implicit M: Applicative[M]): FreeT[S, M, A] = Suspend(M.pure(Xor.left(value))) + def pure[S[_], M[_], A](value: A)(implicit M: Applicative[M]): FreeT[S, M, A] = Suspend(M.pure(Left(value))) - def suspend[S[_], M[_], A](a: M[A Xor S[FreeT[S, M, A]]])(implicit M: Applicative[M]): FreeT[S, M, A] = + def suspend[S[_], M[_], A](a: M[Either[A, S[FreeT[S, M, A]]]])(implicit M: Applicative[M]): FreeT[S, M, A] = liftT(a).flatMap({ - case Xor.Left(a) => pure(a) - case Xor.Right(s) => roll(s) + case Left(a) => pure(a) + case Right(s) => roll(s) }) - def tailRecM[S[_], M[_]: Applicative, A, B](a: A)(f: A => FreeT[S, M, A Xor B]): FreeT[S, M, B] = + def tailRecM[S[_], M[_]: Applicative, A, B](a: A)(f: A => FreeT[S, M, Either[A, B]]): FreeT[S, M, B] = f(a).flatMap { - case Xor.Left(a0) => tailRecM(a0)(f) - case Xor.Right(b) => pure[S, M, B](b) + case Left(a0) => tailRecM(a0)(f) + case Right(b) => pure[S, M, B](b) } def liftT[S[_], M[_], A](value: M[A])(implicit M: Functor[M]): FreeT[S, M, A] = - Suspend(M.map(value)(Xor.left)) + Suspend(M.map(value)(Left(_))) /** A version of `liftT` that infers the nested type constructor. */ def liftTU[S[_], MA](value: MA)(implicit M: Unapply[Functor, MA]): FreeT[S, M.M, M.A] = @@ -168,7 +166,7 @@ object FreeT extends FreeTInstances { /** Suspends a value within a functor in a single step. Monadic unit for a higher-order monad. */ def liftF[S[_], M[_], A](value: S[A])(implicit M: Applicative[M]): FreeT[S, M, A] = - Suspend(M.pure(Xor.right(value))) + Suspend(M.pure(Right(value))) def roll[S[_], M[_], A](value: S[FreeT[S, M, A]])(implicit M: Applicative[M]): FreeT[S, M, A] = liftF[S, M, FreeT[S, M, A]](value).flatMap(identity) @@ -241,7 +239,7 @@ private[free] sealed trait FreeTFlatMap[S[_], M[_]] extends FlatMap[FreeT[S, M, override final def map[A, B](fa: FreeT[S, M, A])(f: A => B): FreeT[S, M, B] = fa.map(f) def flatMap[A, B](fa: FreeT[S, M, A])(f: A => FreeT[S, M, B]): FreeT[S, M, B] = fa.flatMap(f) - override final def tailRecM[A, B](a: A)(f: A => FreeT[S, M, A Xor B]): FreeT[S, M, B] = + override final def tailRecM[A, B](a: A)(f: A => FreeT[S, M, Either[A, B]]): FreeT[S, M, B] = FreeT.tailRecM(a)(f) } diff --git a/free/src/test/scala/cats/free/FreeTTests.scala b/free/src/test/scala/cats/free/FreeTTests.scala index 721f93a485..d88a101503 100644 --- a/free/src/test/scala/cats/free/FreeTTests.scala +++ b/free/src/test/scala/cats/free/FreeTTests.scala @@ -39,7 +39,7 @@ class FreeTTests extends CatsSuite { } { - implicit val eqXortTFA: Eq[XorT[FreeTOption, Unit, Int]] = XorT.catsDataEqForXorT[FreeTOption, Unit, Int] + implicit val eqEithertTFA: Eq[EitherT[FreeTOption, Unit, Int]] = EitherT.catsDataEqForEitherT[FreeTOption, Unit, Int] checkAll("FreeT[Option, Option, Int]", MonadErrorTests[FreeTOption, Unit].monadError[Int, Int, Int]) checkAll("MonadError[FreeT[Option, Option, ?], Unit]", SerializableTests.serializable(MonadError[FreeTOption, Unit])) } @@ -55,9 +55,9 @@ class FreeTTests extends CatsSuite { val result = Monad[FreeTOption].tailRecM(0)((i: Int) => if (i < 50000) - Applicative[FreeTOption].pure(Xor.left[Int, Unit](i + 1)) + Applicative[FreeTOption].pure(Either.left[Int, Unit](i + 1)) else - Applicative[FreeTOption].pure(Xor.right[Int, Unit](()))) + Applicative[FreeTOption].pure(Either.right[Int, Unit](()))) Eq[FreeTOption[Unit]].eqv(expected, result) should ===(true) } @@ -138,8 +138,8 @@ class FreeTTests extends CatsSuite { } private[free] def liftTUCompilationTests() = { - val a: String Xor Int = Xor.right(42) - val b: FreeT[Option, String Xor ?, Int] = FreeT.liftTU(a) + val a: Either[String, Int]= Right(42) + val b: FreeT[Option, Either[String, ?], Int] = FreeT.liftTU(a) } }