Merge pull request #671 from 47deg/master

Request to Include `cats.data.Coproduct` and `cats.free.Inject`

core/src/main/scala/cats/arrow/NaturalTransformation.scala

@@ -1,6 +1,8 @@
 package cats
 package arrow
 
+import cats.data.{Xor, Coproduct}
+
 trait NaturalTransformation[F[_], G[_]] extends Serializable { self =>
   def apply[A](fa: F[A]): G[A]
 
@@ -18,4 +20,12 @@ object NaturalTransformation {
     new NaturalTransformation[F, F] {
       def apply[A](fa: F[A]): F[A] = fa
     }
+
+  def or[F[_], G[_], H[_]](f: F ~> H, g: G ~> H): Coproduct[F, G, ?] ~> H =
+    new (Coproduct[F, G, ?] ~> H) {
+      def apply[A](fa: Coproduct[F, G, A]): H[A] = fa.run match {
+        case Xor.Left(ff) => f(ff)
+        case Xor.Right(gg) => g(gg)
+      }
+    }
 }

core/src/main/scala/cats/data/Coproduct.scala

@@ -0,0 +1,217 @@
+package cats
+package data
+
+import cats.functor.Contravariant
+
+/** `F` on the left and `G` on the right of [[Xor]].
+  *
+  * @param run The underlying [[Xor]]. */
+final case class Coproduct[F[_], G[_], A](run: F[A] Xor G[A]) {
+
+  import Coproduct._
+
+  def map[B](f: A => B)(implicit F: Functor[F], G: Functor[G]): Coproduct[F, G, B] =
+    Coproduct(run.bimap(F.lift(f), G.lift(f)))
+
+  def coflatMap[B](f: Coproduct[F, G, A] => B)(implicit F: CoflatMap[F], G: CoflatMap[G]): Coproduct[F, G, B] =
+    Coproduct(
+      run.bimap(a => F.coflatMap(a)(x => f(leftc(x))), a => G.coflatMap(a)(x => f(rightc(x))))
+    )
+
+  def duplicate(implicit F: CoflatMap[F], G: CoflatMap[G]): Coproduct[F, G, Coproduct[F, G, A]] =
+    Coproduct(run.bimap(
+      x => F.coflatMap(x)(a => leftc(a))
+      , x => G.coflatMap(x)(a => rightc(a)))
+    )
+
+  def extract(implicit F: Comonad[F], G: Comonad[G]): A =
+    run.fold(F.extract, G.extract)
+
+  def contramap[B](f: B => A)(implicit F: Contravariant[F], G: Contravariant[G]): Coproduct[F, G, B] =
+    Coproduct(run.bimap(F.contramap(_)(f), G.contramap(_)(f)))
+
+  def foldRight[B](z: Eval[B])(f: (A, Eval[B]) => Eval[B])(implicit F: Foldable[F], G: Foldable[G]): Eval[B] =
+    run.fold(a => F.foldRight(a, z)(f), a => G.foldRight(a, z)(f))
+
+  def foldLeft[B](z: B)(f: (B, A) => B)(implicit F: Foldable[F], G: Foldable[G]): B =
+    run.fold(a => F.foldLeft(a, z)(f), a => G.foldLeft(a, z)(f))
+
+  def foldMap[B](f: A => B)(implicit F: Foldable[F], G: Foldable[G], M: Monoid[B]): B =
+    run.fold(F.foldMap(_)(f), G.foldMap(_)(f))
+
+  def traverse[X[_], B](g: A => X[B])(implicit F: Traverse[F], G: Traverse[G], A: Applicative[X]): X[Coproduct[F, G, B]] =
+    run.fold(
+      x => A.map(F.traverse(x)(g))(leftc(_))
+      , x => A.map(G.traverse(x)(g))(rightc(_))
+    )
+
+  def isLeft: Boolean =
+    run.isLeft
+
+  def isRight: Boolean =
+    run.isRight
+
+  def swap: Coproduct[G, F, A] =
+    Coproduct(run.swap)
+
+  def toValidated: Validated[F[A], G[A]] =
+    run.toValidated
+
+}
+
+object Coproduct extends CoproductInstances {
+
+  def leftc[F[_], G[_], A](x: F[A]): Coproduct[F, G, A] =
+    Coproduct(Xor.left(x))
+
+  def rightc[F[_], G[_], A](x: G[A]): Coproduct[F, G, A] =
+    Coproduct(Xor.right(x))
+
+  final class CoproductLeft[G[_]] private[Coproduct] {
+    def apply[F[_], A](fa: F[A]): Coproduct[F, G, A] = Coproduct(Xor.left(fa))
+  }
+
+  final class CoproductRight[F[_]] private[Coproduct] {
+    def apply[G[_], A](ga: G[A]): Coproduct[F, G, A] = Coproduct(Xor.right(ga))
+  }
+
+  def left[G[_]]: CoproductLeft[G] = new CoproductLeft[G]
+
+  def right[F[_]]: CoproductRight[F] = new CoproductRight[F]
+
+}
+
+private[data] sealed abstract class CoproductInstances3 {
+
+  implicit def coproductEq[F[_], G[_], A](implicit E: Eq[F[A] Xor G[A]]): Eq[Coproduct[F, G, A]] =
+    Eq.by(_.run)
+
+  implicit def coproductFunctor[F[_], G[_]](implicit F0: Functor[F], G0: Functor[G]): Functor[Coproduct[F, G, ?]] =
+    new CoproductFunctor[F, G] {
+      implicit def F: Functor[F] = F0
+
+      implicit def G: Functor[G] = G0
+    }
+
+  implicit def coproductFoldable[F[_], G[_]](implicit F0: Foldable[F], G0: Foldable[G]): Foldable[Coproduct[F, G, ?]] =
+    new CoproductFoldable[F, G] {
+      implicit def F: Foldable[F] = F0
+
+      implicit def G: Foldable[G] = G0
+    }
+}
+
+private[data] sealed abstract class CoproductInstances2 extends CoproductInstances3 {
+
+  implicit def coproductContravariant[F[_], G[_]](implicit F0: Contravariant[F], G0: Contravariant[G]): Contravariant[Coproduct[F, G, ?]] =
+    new CoproductContravariant[F, G] {
+      implicit def F: Contravariant[F] = F0
+
+      implicit def G: Contravariant[G] = G0
+    }
+}
+
+private[data] sealed abstract class CoproductInstances1 extends CoproductInstances2 {
+  implicit def coproductCoflatMap[F[_], G[_]](implicit F0: CoflatMap[F], G0: CoflatMap[G]): CoflatMap[Coproduct[F, G, ?]] =
+    new CoproductCoflatMap[F, G] {
+      implicit def F: CoflatMap[F] = F0
+
+      implicit def G: CoflatMap[G] = G0
+    }
+}
+
+private[data] sealed abstract class CoproductInstances0 extends CoproductInstances1 {
+  implicit def coproductTraverse[F[_], G[_]](implicit F0: Traverse[F], G0: Traverse[G]): Traverse[Coproduct[F, G, ?]] =
+    new CoproductTraverse[F, G] {
+      implicit def F: Traverse[F] = F0
+
+      implicit def G: Traverse[G] = G0
+    }
+}
+
+sealed abstract class CoproductInstances extends CoproductInstances0 {
+
+  implicit def coproductComonad[F[_], G[_]](implicit F0: Comonad[F], G0: Comonad[G]): Comonad[Coproduct[F, G, ?]] =
+    new CoproductComonad[F, G] {
+      implicit def F: Comonad[F] = F0
+
+      implicit def G: Comonad[G] = G0
+    }
+}
+
+private[data] trait CoproductFunctor[F[_], G[_]] extends Functor[Coproduct[F, G, ?]] {
+  implicit def F: Functor[F]
+
+  implicit def G: Functor[G]
+
+  def map[A, B](a: Coproduct[F, G, A])(f: A => B): Coproduct[F, G, B] =
+    a map f
+}
+
+private[data] trait CoproductContravariant[F[_], G[_]] extends Contravariant[Coproduct[F, G, ?]] {
+  implicit def F: Contravariant[F]
+
+  implicit def G: Contravariant[G]
+
+  def contramap[A, B](a: Coproduct[F, G, A])(f: B => A): Coproduct[F, G, B] =
+    a contramap f
+}
+
+private[data] trait CoproductFoldable[F[_], G[_]] extends Foldable[Coproduct[F, G, ?]] {
+  implicit def F: Foldable[F]
+
+  implicit def G: Foldable[G]
+
+  def foldRight[A, B](fa: Coproduct[F, G, A], z: Eval[B])(f: (A, Eval[B]) => Eval[B]): Eval[B] =
+    fa.foldRight(z)(f)
+
+  def foldLeft[A, B](fa: Coproduct[F, G, A], z: B)(f: (B, A) => B): B =
+    fa.foldLeft(z)(f)
+
+  override def foldMap[A, B](fa: Coproduct[F, G, A])(f: A => B)(implicit M: Monoid[B]): B =
+    fa foldMap f
+}
+
+private[data] trait CoproductTraverse[F[_], G[_]] extends CoproductFoldable[F, G] with Traverse[Coproduct[F, G, ?]] {
+  implicit def F: Traverse[F]
+
+  implicit def G: Traverse[G]
+
+  override def map[A, B](a: Coproduct[F, G, A])(f: A => B): Coproduct[F, G, B] =
+    a map f
+
+  override def traverse[X[_] : Applicative, A, B](fa: Coproduct[F, G, A])(f: A => X[B]): X[Coproduct[F, G, B]] =
+    fa traverse f
+}
+
+private[data] trait CoproductCoflatMap[F[_], G[_]] extends CoflatMap[Coproduct[F, G, ?]] {
+  implicit def F: CoflatMap[F]
+
+  implicit def G: CoflatMap[G]
+
+  def map[A, B](a: Coproduct[F, G, A])(f: A => B): Coproduct[F, G, B] =
+    a map f
+
+  def coflatMap[A, B](a: Coproduct[F, G, A])(f: Coproduct[F, G, A] => B): Coproduct[F, G, B] =
+    a coflatMap f
+
+}
+
+private[data] trait CoproductComonad[F[_], G[_]] extends Comonad[Coproduct[F, G, ?]] {
+  implicit def F: Comonad[F]
+
+  implicit def G: Comonad[G]
+
+  def map[A, B](a: Coproduct[F, G, A])(f: A => B): Coproduct[F, G, B] =
+    a map f
+
+  def extract[A](p: Coproduct[F, G, A]): A =
+    p.extract
+
+  def coflatMap[A, B](a: Coproduct[F, G, A])(f: Coproduct[F, G, A] => B): Coproduct[F, G, B] =
+    a coflatMap f
+
+  def duplicate[A](a: Coproduct[F, G, A]): Coproduct[F, G, Coproduct[F, G, A]] =
+    a.duplicate
+}
+

core/src/main/scala/cats/syntax/all.scala

@@ -32,3 +32,4 @@ trait AllSyntax
     with TraverseSyntax
     with XorSyntax
     with ValidatedSyntax
+    with CoproductSyntax

core/src/main/scala/cats/syntax/coproduct.scala

@@ -0,0 +1,13 @@
+package cats
+package syntax
+
+import cats.data.Coproduct
+
+trait CoproductSyntax {
+  implicit def coproductSyntax[F[_], A](a: F[A]): CoproductOps[F, A] = new CoproductOps(a)
+}
+
+final class CoproductOps[F[_], A](val a: F[A]) extends AnyVal {
+  def leftc[G[_]]: Coproduct[F, G, A] = Coproduct.leftc(a)
+  def rightc[G[_]]: Coproduct[G, F, A] = Coproduct.rightc(a)
+}

docs/src/main/tut/freemonad.md

@@ -348,6 +348,109 @@ it's not too hard to get around.)
 val result: Map[String, Int] = compilePure(program, Map.empty)
 ```
 
+## Composing Free monads ADTs.
+
+Real world applications often time combine different algebras. 
+The `Inject` typeclass described by Swierstra in [Data types à la carte](http://www.staff.science.uu.nl/~swier004/Publications/DataTypesALaCarte.pdf)
+lets us compose different algebras in the context of `Free`.
+
+Let's see a trivial example of unrelated ADT's getting composed as a `Coproduct` that can form a more complex program.
+
+```tut
+import cats.arrow.NaturalTransformation
+import cats.data.{Xor, Coproduct}
+import cats.free.{Inject, Free}
+import cats.{Id, ~>}
+import scala.collection.mutable.ListBuffer
+```
+
+```tut
+/* Handles user interaction */
+sealed trait Interact[A]
+case class Ask(prompt: String) extends Interact[String]
+case class Tell(msg: String) extends Interact[Unit]
+
+/* Represents persistence operations */
+sealed trait DataOp[A]
+case class AddCat(a: String) extends DataOp[Unit]
+case class GetAllCats() extends DataOp[List[String]]
+```
+
+Once the ADTs are defined we can formally state that a `Free` program is the Coproduct of it's Algebras.
+
+```tut
+type CatsApp[A] = Coproduct[DataOp, Interact, A]
+```
+
+In order to take advantage of monadic composition we use smart constructors to lift our Algebra to the `Free` context.
+
+```tut
+class Interacts[F[_]](implicit I: Inject[Interact, F]) {
+  def tell(msg: String): Free[F, Unit] = Free.inject[Interact, F](Tell(msg))
+  def ask(prompt: String): Free[F, String] = Free.inject[Interact, F](Ask(prompt))
+}
+
+object Interacts {
+  implicit def interacts[F[_]](implicit I: Inject[Interact, F]): Interacts[F] = new Interacts[F]
+}
+
+class DataSource[F[_]](implicit I: Inject[DataOp, F]) {
+  def addCat(a: String): Free[F, Unit] = Free.inject[DataOp, F](AddCat(a))
+  def getAllCats: Free[F, List[String]] = Free.inject[DataOp, F](GetAllCats())
+}
+
+object DataSource {
+  implicit def dataSource[F[_]](implicit I: Inject[DataOp, F]): DataSource[F] = new DataSource[F]
+}
+```
+
+ADTs are now easily composed and trivially intertwined inside monadic contexts.
+
+```tut 
+def program(implicit I : Interacts[CatsApp], D : DataSource[CatsApp]) = {
+
+  import I._, D._
+
+  for {
+    cat <- ask("What's the kitty's name")
+    _ <- addCat(cat)
+    cats <- getAllCats
+    _ <- tell(cats.toString)
+  } yield ()
+}
+```
+
+Finally we write one interpreter per ADT and combine them with a `NaturalTransformation` to `Coproduct` so they can be
+compiled and applied to our `Free` program.
+
+```scala
+object ConsoleCatsInterpreter extends (Interact ~> Id) {
+  def apply[A](i: Interact[A]) = i match {
+    case Ask(prompt) =>
+      println(prompt)
+      scala.io.StdIn.readLine()
+    case Tell(msg) =>
+      println(msg)
+  }
+}
+
+object InMemoryDatasourceInterpreter extends (DataOp ~> Id) {
+
+  private[this] val memDataSet = new ListBuffer[String]
+
+  def apply[A](fa: DataOp[A]) = fa match {
+    case AddCat(a) => memDataSet.append(a); ()
+    case GetAllCats() => memDataSet.toList
+  }
+}
+
+val interpreter: CatsApp ~> Id = NaturalTransformation.or(InMemoryDatasourceInterpreter, ConsoleCatsInterpreter)
+
+import DataSource._, Interacts._
+
+val evaled = program.foldMap(interpreter)
+```
+
 ## <a name="what-is-free-in-theory"></a>For the curious ones: what is Free in theory?
 
 Mathematically-speaking, a *free monad* (at least in the programming

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

@@ -30,6 +30,13 @@ object Free {
   /** Lift a pure value into Free */
   def pure[S[_], A](a: A): Free[S, A] = Pure(a)
 
+  final class FreeInjectPartiallyApplied[F[_], G[_]] private[free] {
+    def apply[A](fa: F[A])(implicit I : Inject[F, G]): Free[G, A] =
+      Free.liftF(I.inj(fa))
+  }
+
+  def inject[F[_], G[_]]: FreeInjectPartiallyApplied[F, G] = new FreeInjectPartiallyApplied
+
   /**
    * `Free[S, ?]` has a monad for any type constructor `S[_]`.
    */