Coproduct Example

build.sbt

scalaVersion := "2.11.1"

libraryDependencies ++= Seq(
  "org.scalaz" %% "scalaz-core" % "7.1.0-M7"
)

scalacOptions ++= Seq("-deprecation", "-language:_")

gistfile1.scala

import scalaz._
import scalaz.Id.Id
import Free.FreeC

import CoproductExample._

sealed trait Interact[A]

case class Ask(prompt: String)
  extends Interact[String]

case class Tell(msg: String)
  extends Interact[Unit]

object Console 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 TestConsole extends (Interact ~> Tester) {
  def apply[A](i: Interact[A]) = i match {
    case Ask(prompt) => tester(m => (List(), m(prompt)))
    case Tell(msg) => tester(_ => (List(msg), ()))
  }
}

object CoproductExample {

  type Tester[A] =
    WriterT[({type l[a] = Map[String, String] => a})#l, List[String], A]

  def tester[A](f: Map[String, String] => (List[String], A)): Tester[A] =
    WriterT[({type l[a] = Map[String, String] => a})#l, List[String], A](f)

  type UserID = String
  type Password = String
  type Permission = String
  type App[A] = Coproduct[Auth, Interact, A]

  val KnowSecret = "KnowSecret"

  def freeCMonad[F[_]] = Free.freeMonad[({type l[a] = Coyoneda[F, a]})#l]

  def prg[F[_]](implicit I: Interacts[F], A: Auths[F]) = {
    import I._; import A._
    for {
      uid <- ask("What's your user ID?")
      pwd <- ask("Password, please.")
      u <- login(uid, pwd)
      b <- u.map(hasPermission(_, KnowSecret)).getOrElse(freeCMonad[F].point(false))
      _ <- if (b) tell("UUDDLRLRBA") else tell("Go away!")
    } yield ()
  }

  val app = prg[App]

  val TestAuth: Auth ~> Id = new (Auth ~> Id) {
    def apply[A](a: Auth[A]) = a match {
      case Login(uid, pwd) =>
        if (uid == "john.snow" && pwd == "Ghost")
          Some(User("john.snow"))
        else None
      case HasPermission(u, _) =>
        u.id == "john.snow"
    }
  }

  def lift[F[_],G[_],A](f: F[A])(implicit I: Inject[F,G]): FreeC[G,A] =
    Free.liftFC(I.inj(f))

  def or[F[_], H[_], G[_]](
    fg: F ~> G, hg: H ~> G
  ): ({ type f[x] = Coproduct[F, H, x]})#f ~> G =
    new (({type f[x] = Coproduct[F,H,x]})#f ~> G) {
      def apply[A](c: Coproduct[F,H,A]): G[A] = c.run match {
        case -\/(fa) => fg(fa)
        case \/-(ha) => hg(ha)
      }
    }

  // https://github.com/scalaz/scalaz/blob/5904d7f6/core/src/main/scala/scalaz/Free.scala#L328
  def runFC[S[_], M[_], A](sa: FreeC[S, A])(interp: S ~> M)(implicit M: Monad[M]): M[A] =
    sa.foldMap(new (({type λ[x] = Coyoneda[S, x]})#λ ~> M) {
      def apply[A](cy: Coyoneda[S, A]): M[A] =
        M.map(interp(cy.fi))(cy.k)
      }
    )

  def consolePrg[F[_]](implicit I: Interacts[F]) = {
    import I._
    for {
      first <- ask("first name?")
      last <- ask("last name?")
       _  <- tell(s"Hello, $first , $last!")
    } yield ()
  }

  import std.list._, std.function._
  implicit val testerMonad =
    WriterT.writerTMonad[({type l[a] = Map[String, String] => a})#l, List[String]]
 
  def consoleApp = runFC(consolePrg[Interact])(TestConsole)

  def main(args: Array[String]){
    println(
      consoleApp.run(Map(
        "first name?" -> "foo",
        "last name?" -> "bar"
      ))
    )
  }

  def runApp = runFC(app)(or(TestAuth, Console))
}


case class User(id: String)

sealed trait Auth[A]

final case class Login(u: UserID, p: Password) extends Auth[Option[User]]

final case class HasPermission(
  u: User, p: Permission) extends Auth[Boolean]

class Interacts[F[_]](implicit I: Inject[Interact,F]) {
  def tell(msg: String): FreeC[F, Unit] = lift(Tell(msg))
  def ask(prompt: String): FreeC[F, String] = lift(Ask(prompt))
}

class Auths[F[_]](implicit I: Inject[Auth,F]) {
  def login(id: UserID, pwd: Password): FreeC[F, Option[User]] =
    lift(Login(id, pwd))
  def hasPermission(u: User, p: Permission): FreeC[F, Boolean] =
    lift(HasPermission(u, p))
}

object Auths {
  implicit def instance[F[_]](implicit I: Inject[Auth,F]): Auths[F] = new Auths[F]
}

object Interacts {
  implicit def instance[F[_]](implicit I: Inject[Interact,F]): Interacts[F] = new Interacts[F]
}