Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- object FreeMonadExplained {
- import scala.language.higherKinds
- import scala.language.implicitConversions
- sealed trait Interact[A]
- case class Ask(prompt: String) extends Interact[String]
- case class Tell(message: String) extends Interact[Unit]
- // No access to the username captured by the Ask
- // val prog = List(
- // Ask("What's your name?"),
- // Tell("Hello, ???")
- // )
- // doesn't compile because Interact isn't a monad
- // val prog = for {
- // name <- Ask("What's your name?")
- // _ <- Tell(s"Hello, $name")
- // } yield ()
- // We need Interact to be a Monad
- trait Monad[M[_]] {
- def pure[A](a: A): M[A]
- def flatMap[A, B](ma: M[A])(f: A => M[B]): M[B]
- // need to obey some rules
- }
- // Free monad
- sealed trait Free[F[_], A] {
- def flatMap[B](f: A => Free[F, B]): Free[F, B] = this match {
- case Return(a) => f(a)
- case Bind(i, k) => Bind(i, k andThen (_ flatMap f))
- }
- def map[B](f: A => B): Free[F, B] = flatMap(a => Return(f(a)))
- // F = compile time language (e.g Interact)
- // G = runtime language (e.g. Id)
- // this version is not stack safe (but possible to write it in tail recursive way)
- def foldMap[G[_]](f: F ~> G)(implicit monad: Monad[G]): G[A] = this match {
- case Return(a) => monad.pure(a)
- case Bind(i, k) =>
- monad.flatMap(f(i)) { a =>
- k(a).foldMap(f)
- }
- }
- }
- case class Return[F[_], A](a: A) extends Free[F, A] // same as pure
- case class Bind[F[_], I, A](i: F[I], k: I => Free[F, A]) extends Free[F, A] // same as flatMap
- // Interact will be F and we can generate a monad of Free[Interact[_], A]
- implicit def liftIntoFree[F[_], A](fa: F[A]): Free[F, A] = Bind[F, A, A](fa, (a: A) => Return(a))
- // with lift we can write our program
- val prog: Free[Interact, Unit] = for {
- name <- Ask("What's your name?")
- _ <- Tell(s"Hello, $name")
- } yield ()
- // Is it really stacksafe ? Not with this implementation of flatMap
- val expandedProg: Free[Interact, Unit] =
- Ask("What's your name?").flatMap(name => Tell(s"Hello, $name").map[Unit](_ => Unit))
- val expandedProg2: Free[Interact, Unit] =
- Bind[Interact, String, Unit](
- Ask("What's your name?"),
- name =>
- Bind[Interact, Unit, Unit](
- Tell(s"Hello, $name"),
- _ => Return(Unit)
- )
- )
- // we need a way to convert from F to G so that our Free monad can be turned into another monad
- sealed trait ~>[F[_], G[_]] { self =>
- def apply[A](f: F[A]): G[A]
- // the 'or' method allows to compose the transformers
- // if we have a transformer that turn F into G
- // and another transformer that turn H into G
- // we can have a transformer that can turn F or H into G
- // That's neat because we can write our interpreter independently of each other
- // and combine them together to run our program
- def or[H[_]](h: H ~> G) = new (({ type T[x] = CoProduct[F, H, x] })#T ~> G) {
- def apply[A](c: CoProduct[F, H, A]): G[A] =
- c.value match {
- case Left(fa) => self.apply(fa)
- case Right(ha) => h(ha)
- }
- }
- }
- type Id[A] = A
- // run the program using the console interpreter
- object Console extends (Interact ~> Id) {
- def apply[A](i: Interact[A]) = i match {
- case Ask(prompt) =>
- println(prompt)
- scala.io.StdIn.readLine()
- case Tell(message) =>
- println(message)
- }
- }
- type Tester[A] = Map[String, String] => (List[String], A)
- // run the program as a test
- // the map is our input (prompt -> user input)
- // List[String] is what printed to the user
- object Test extends (Interact ~> Tester) {
- def apply[A](i: Interact[A]) = i match {
- case Ask(prompt) =>
- inputs =>
- (List(), inputs(prompt))
- case Tell(message) =>
- _ =>
- (List(message), ())
- }
- }
- // we need to prove that Tester is a monad (to provide the implicit param for foldMap)
- // sort of combination between a Reader and a Writer monad
- implicit val testerMonad = new Monad[Tester] {
- def pure[A](a: A): Tester[A] = _ => (List(), a)
- def flatMap[A, B](t: Tester[A])(f: A => Tester[B]): Tester[B] =
- inputs => {
- val (out1, a) = t(inputs)
- val (out2, b) = f(a)(inputs)
- (out1 ++ out2, b)
- }
- }
- implicit val idMonad = new Monad[Id] {
- def pure[A](a: A): Id[A] = a
- def flatMap[A, B](a: Id[A])(f: A => Id[B]): Id[B] = f(a)
- }
- // Execute the program on the console
- prog.foldMap(Console)
- // Execute the program using the given inputs for testing
- prog.foldMap(Test).apply(Map("What's your name?" -> "Kilroy"))
- // let's add another feature: Authorisation
- // that's a new concern so instead of extending Interact
- // we create an Auth algebra
- case class UserId(value: String)
- case class Password(value: String)
- case class User(userId: UserId)
- case class Permission(name: String)
- sealed trait Auth[A]
- case class Login(userId: UserId, password: Password) extends Auth[Option[User]]
- case class HasPermission(user: User, permission: Permission) extends Auth[Boolean]
- object AuthOnlyJohn extends (Auth ~> Id) {
- override def apply[A](auth: Auth[A]): Id[A] = auth match {
- case Login(UserId("John"), _) => Some(User(UserId("John"))) // don't care what the password is
- case _: Login => None
- case HasPermission(user, permission) => permission.name == "share_secret" && user.userId.value == "John"
- }
- }
- // doesn't compile
- // we need a type ??? that can be Either an Interact or an Auth
- // val prog: Free[???, Unit] = for {
- // userId <- Ask("What's your login?")
- // password <- Ask("What's your password?")
- // user <- Login(UserId(userId), Password(password))
- // hasAccess <- HasPermission(user, Permission("secret"))
- // _ <- if (hasAccess) Tell("The secret is BLABLABLA")
- // else Tell("Sorry, I can't tell you anything")
- // } yield ()
- // let's create a type that can be either G[A] or F[A]
- case class CoProduct[F[_], G[_], A](value: Either[F[A], G[A]])
- type Appli[A] = CoProduct[Interact, Auth, A]
- // val prog2: Free[Appli, Unit] = ...
- // In order to avoid navigating in nested left/right (because of the underlying Either)
- // we need to make our types (Interact or Auth) "appear as the same type" (CoProduct)
- // we inject them into the CoProduct
- sealed trait Inject[F[_], G[_]] {
- def inject[A](f: F[A]): G[A]
- }
- object Inject {
- // lift F into the co-product of F and F
- implicit def reflexive[F[_]]: Inject[F, F] = new Inject[F, F] {
- def inject[A](f: F[A]): F[A] = f
- }
- // lift F into G where G is the co-product of F and something else
- implicit def left[F[_], G[_]]: Inject[F, ({ type T[x] = CoProduct[F, G, x] })#T] =
- new Inject[F, ({ type T[x] = CoProduct[F, G, x] })#T] {
- def inject[A](f: F[A]): CoProduct[F, G, A] = CoProduct(Left(f))
- }
- // lift G into F where F is the co-product of G and something else
- implicit def right[F[_], G[_], H[_]](implicit i: Inject[F, G]): Inject[F, ({ type T[x] = CoProduct[H, G, x] })#T] =
- new Inject[F, ({ type T[x] = CoProduct[H, G, x] })#T] {
- // i.inject(f) is a G
- def inject[A](f: F[A]): CoProduct[H, G, A] = CoProduct(Right(i.inject(f)))
- }
- }
- // now that we have inject we can create a lift that turns an F (e.g. Interact) into a larger type G (e.g. Appli)
- def lift[F[_], G[_], A](f: F[A])(implicit i: Inject[F, G]): Free[G, A] =
- Bind(i.inject(f), (a: A) => Return(a))
- // smart constructor that lift an Interact into a CoProduct[Interact, ?]
- class Interacts[F[_]](implicit i: Inject[Interact, F]) {
- def tell(message: String): Free[F, Unit] = lift(Tell(message))
- def ask(prompt: String): Free[F, String] = lift(Ask(prompt))
- }
- // smart constructor that lift an Auth into a CoProduct[Auth, ?]
- class Auths[F[_]](implicit i: Inject[Auth, F]) {
- def login(userId: UserId, password: Password): Free[F, Option[User]] = lift(Login(userId, password))
- def hasPermission(user: User, permission: Permission): Free[F, Boolean] = lift(HasPermission(user, permission))
- }
- // we can finally write our program
- def program[F[_]](implicit interacts: Interacts[F], auths: Auths[F]) = {
- import interacts._
- import auths._
- val shareSecret = Permission("share_secret")
- for {
- userId <- ask("What's your login?")
- password <- ask("What's your password?")
- user <- login(UserId(userId), Password(password))
- hasAccess <- user.map(hasPermission(_, shareSecret)).getOrElse(Return(false))
- _ <- if (hasAccess) tell("The secret is BLBALBAL")
- else tell("Can't tell you anything")
- } yield ()
- }
- // huge achievement but how do we run it ?
- // we need a co-product interpreter (see above)
- // now we can proceed
- implicit val interacts = new Interacts[Appli]
- implicit val auths = new Auths[Appli]
- val app: Free[Appli, Unit] = program[Appli]
- def runApp() = app.foldMap(Console or AuthOnlyJohn)
- }
- // to define a library based on Free
- // - define your algebra data types (sealed trait and case classes)
- // - make smart constructors to lift them into coproduct
- // - define individual interpreters
- // to use a library defined above
- // - write programs using smart constructor
- // - compose the appropriate interpreters
- // - fold the program using the interpreter
- // if G is the Free monad it gives stratified application
- // def foldMap[G[_]](f: F ~> G)(implicit monad: Monad[G]): G[A]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement