Skip to content

Instantly share code, notes, and snippets.

@xuwei-k
Forked from runarorama/gist:a8fab38e473fafa0921d
Last active October 26, 2016 05:39
Show Gist options
  • Save xuwei-k/fd34a5889f40f6b937bf to your computer and use it in GitHub Desktop.
Save xuwei-k/fd34a5889f40f6b937bf to your computer and use it in GitHub Desktop.
Coproduct Example
scalaVersion := "2.11.1"
libraryDependencies ++= Seq(
"org.scalaz" %% "scalaz-core" % "7.1.0-M7"
)
scalacOptions ++= Seq("-deprecation", "-language:_")
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]
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment