FreeMonadExplained.scala

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]