Remove a recursive flatMap from Free

free/src/main/scala/cats/free/Free.scala

@@ -79,12 +79,14 @@ sealed abstract class Free[S[_], A] extends Product with Serializable {
    * Run to completion, using a function that maps the resumption
    * from `S` to a monad `M`.
    */
-  final def runM[M[_]](f: S[Free[S, A]] => M[Free[S, A]])(implicit S: Functor[S], M: Monad[M]): M[A] = {
-    def runM2(t: Free[S, A]): M[A] = t.resume match {
-      case Xor.Left(s) => Monad[M].flatMap(f(s))(runM2)
-      case Xor.Right(r) => Monad[M].pure(r)
+  final def runM[M[_]](f: S[Free[S, A]] => M[Free[S, A]])(implicit S: Functor[S], M: Monad[M], R: RecursiveTailRecM[M]): M[A] = {
+    def step(t: S[Free[S, A]]): M[Either[S[Free[S, A]], A]] =
+      M.map(f(t))(_.resume.toEither)
+
+    resume match {
+      case Xor.Left(s) => R.sameType(M).tailRecM(s)(step)
+      case Xor.Right(r) => M.pure(r)
     }
-    runM2(this)
   }
 
   /**

free/src/main/scala/cats/free/FreeT.scala

@@ -1,7 +1,6 @@
 package cats
 package free
 
-import cats.syntax.either._
 import scala.annotation.tailrec
 
 /**
@@ -42,7 +41,7 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable {
       case e @ FlatMapped(_, _) =>
         FlatMapped(e.a.interpret(st), e.f.andThen(_.interpret(st)))
       case Suspend(m) =>
-        Suspend(M.map(m)(_.map(s => st(s))))
+        Suspend(M.map(m)(_.left.map(s => st(s))))
     }
 
   /**
@@ -53,13 +52,13 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable {
     def go(ft: FreeT[S, M, A]): M[Either[FreeT[S, M, A], A]] =
       ft match {
         case Suspend(ma) => MR.flatMap(ma) {
-          case Left(a) => MR.pure(Right(a))
-          case Right(sa) => MR.map(f(sa))(Right(_))
+          case Right(a) => MR.pure(Right(a))
+          case Left(sa) => MR.map(f(sa))(Right(_))
         }
         case g @ FlatMapped(_, _) => g.a match {
           case Suspend(mx) => MR.flatMap(mx) {
-            case Left(x) => MR.pure(Left(g.f(x)))
-            case Right(sx) => MR.map(f(sx))(x => Left(g.f(x)))
+            case Right(x) => MR.pure(Left(g.f(x)))
+            case Left(sx) => MR.map(f(sx))(x => Left(g.f(x)))
           }
           case g0 @ FlatMapped(_, _) => MR.pure(Left(g0.a.flatMap(g0.f(_).flatMap(g.f))))
         }
@@ -69,14 +68,14 @@ 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[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]]]]] =
+  def resume(implicit S: Functor[S], MR: Monad[M], RT: RecursiveTailRecM[M]): M[Either[S[FreeT[S, M, A]], A]] = {
+    def go(ft: FreeT[S, M, A]): M[Either[FreeT[S, M, A], Either[S[FreeT[S, M, A]], A]]] =
       ft match {
-        case Suspend(f) => MR.map(f)(as => Right(as.map(S.map(_)(pure(_)))))
+        case Suspend(f) => MR.map(f)(as => Right(as.left.map(S.map(_)(pure(_)))))
         case g1 @ FlatMapped(_, _) => g1.a match {
           case Suspend(m1) => MR.map(m1) {
-            case Left(a) => Left(g1.f(a))
-            case Right(fc) => Right(Right(S.map(fc)(g1.f(_))))
+            case Right(a) => Left(g1.f(a))
+            case Left(fc) => Right(Left(S.map(fc)(g1.f(_))))
           }
           case g2 @ FlatMapped(_, _) => MR.pure(Left(g2.a.flatMap(g2.f(_).flatMap(g1.f))))
         }
@@ -91,8 +90,8 @@ sealed abstract class FreeT[S[_], M[_], A] extends Product with Serializable {
   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[Either[FreeT[S, M, A], A]] =
       MR.flatMap(ft.resume) {
-        case Left(a) => MR.pure(Right(a))
-        case Right(fc) => MR.map(interp(fc))(Left(_))
+        case Right(a) => MR.pure(Right(a))
+        case Left(fc) => MR.map(interp(fc))(Left(_))
       }
     RT.sameType(MR).tailRecM(this)(runM2)
   }
@@ -106,13 +105,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 Left(a) => pure(a)
-        case Right(s) => liftF(s)
+        case Right(a) => pure(a)
+        case Left(s) => liftF(s)
       }
       case g1 @ FlatMapped(_, _) => g1.a match {
         case Suspend(m) => M.map(m) {
-          case Left(a) => g1.f(a)
-          case Right(s) => liftF[S, M, g1.A](s).flatMap(g1.f)
+          case Right(a) => g1.f(a)
+          case Left(s) => liftF[S, M, g1.A](s).flatMap(g1.f)
         }
         case g0 @ FlatMapped(_, _) => g0.a.flatMap(g0.f(_).flatMap(g1.f)).toM
       }
@@ -133,7 +132,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[Either[A, S[A]]]) extends FreeT[S, M, A]
+  private[free] case class Suspend[S[_], M[_], A](a: M[Either[S[A], 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] {
@@ -143,7 +142,7 @@ 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(Left(value)))
+  def pure[S[_], M[_], A](value: A)(implicit M: Applicative[M]): FreeT[S, M, A] = Suspend(M.pure(Right(value)))
 
   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({
@@ -158,15 +157,15 @@ object FreeT extends FreeTInstances {
     }
 
   def liftT[S[_], M[_], A](value: M[A])(implicit M: Functor[M]): FreeT[S, M, A] =
-    Suspend(M.map(value)(Left(_)))
+    Suspend(M.map(value)(Right(_)))
 
   /** 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(Right(value)))
+    Suspend(M.pure(Left(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)

free/src/test/scala/cats/free/FreeTTests.scala

@@ -39,7 +39,7 @@ class FreeTTests extends CatsSuite {
   }
 
   {
-    implicit val eqEithertTFA: Eq[EitherT[FreeTOption, Unit, Int]] = EitherT.catsDataEqForEitherT[FreeTOption, Unit, Int]
+    implicit val eqXorTFA: 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]))
   }

free/src/test/scala/cats/free/FreeTests.scala

@@ -142,7 +142,7 @@ sealed trait FreeTestsInstances {
   implicit def freeArbitrary[F[_], A](implicit F: Arbitrary[F[A]], A: Arbitrary[A]): Arbitrary[Free[F, A]] =
     Arbitrary(freeGen[F, A](4))
 
-  implicit def freeEq[S[_]: Monad, A](implicit SA: Eq[S[A]]): Eq[Free[S, A]] =
+  implicit def freeEq[S[_]: Monad: RecursiveTailRecM, A](implicit SA: Eq[S[A]]): Eq[Free[S, A]] =
     new Eq[Free[S, A]] {
       def eqv(a: Free[S, A], b: Free[S, A]): Boolean =
         SA.eqv(a.runM(identity),  b.runM(identity))