Notes for Scala Days

gistfile1.scala

sealed trait Interact[A]

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

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

trait Monad[M[_]] {
  def pure[A](a: A): M[A]  
  def flatMap[A,B](a: M[A])(f: A => M[B]): M[B]    
}

object Monad {
  def apply[F[_]:Monad]: Monad[F] = implicitly[Monad[F]]
}

sealed trait ~>[F[_],G[_]] {
  def apply[A](f: F[A]): G[A]
}

sealed trait Free[F[_],A] {
  def flatMap[B](f: A => Free[F,B]): Free[F,B] =
    this match {
      case Pure(a) => f(a)
      case FlatMap(fx, g) =>
        FlatMap(fx, g andThen (_ flatMap f))
    }

  def map[B](f: A => B): Free[F,B] =
    flatMap(a => Pure(f(a))) 

  def foldMap[G[_]:Monad](f: F ~> G): G[A] =
    this match {
      case Pure(a) => Monad[G].pure(a)
      case FlatMap(fx, g) =>
        Monad[G].flatMap(f(fx)) { a =>
	        g(a).foldMap(f)     
        }
      }
}


case class Pure[F[_],A](a: A)
  extends Free[F,A]

case class FlatMap[F[_],I,A](
  a: F[I],
  f: I => Free[F,A]) extends Free[F,A]

//implicit def lift[F[_],A](f: F[A]): Free[F,A] =
//  FlatMap(f, (a: A) => Pure(a))

//val prg = for {
//  first <- Ask("What’s your first name?")
//  last  <- Ask("What's your last name?")
//  _     <- Tell(s"Hello, $first, $last!")
//} yield ()

type Id[A] = A

object Console extends (Interact ~> Id) {
  def apply[A](i: Interact[A]) = i match {
    case Ask(prompt) =>
      println(prompt)
      readLine
    case Tell(msg) =>
      println(msg)
  }   
}

type Tester[A] =
  Map[String, String] => (List[String], A)

object Test extends (Interact ~> Tester) {
  def apply[A](i: Interact[A]) = i match {
    case Ask(prompt) => m => (List(), m(prompt))
    case Tell(msg) => _ => (List(msg), ())
  }   
}

implicit val testerMonad = new Monad[Tester] {
  def pure[A](a: A) = _ => (List(), a)
  def flatMap[A,B](t: Tester[A])(f: A => Tester[B]) =
    m => {
      val (o1, a) = t(m)
      val (o2, b) = f(a)(m)
      (o1 ++ o2, b)
    }
}

type UserID = String
type Password = String
type Permission = String
case class User(id: String)

sealed trait Auth[A]

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

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

case class Coproduct[F[_],G[_],A](run: Either[F[A],G[A]])

sealed trait Inject[F[_],G[_]] {
  def inj[A](sub: F[A]): G[A]
  def prj[A](sup: G[A]): Option[F[A]]
}

object Inject {
  implicit def injRefl[F[_]] = new Inject[F,F] {
    def inj[A](sub: F[A]) = sub
    def prj[A](sup: F[A]) = Some(sup)
  }
    
  implicit def injLeft[F[_],G[_]] = new Inject[F,({type λ[α] = Coproduct[F,G,α]})#λ] {
    def inj[A](sub: F[A]) = Coproduct(Left(sub))
    def prj[A](sup: Coproduct[F,G,A]) = sup.run match {
      case Left(fa) => Some(fa)
      case Right(_) => None
    }
  }

  implicit def injRight[F[_],G[_],H[_]](implicit I: Inject[F,G]) =
    new Inject[F,({type f[x] = Coproduct[H,G,x]})#f] {
      def inj[A](sub: F[A]) = Coproduct(Right(I.inj(sub)))
      def prj[A](sup: Coproduct[H,G,A]) = sup.run match {
        case Left(_) => None
        case Right(x) => I.prj(x)
    }
  }
}

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

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

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

val KnowSecret = "KnowSecret"

def prg[F[_]](I: Interacts[F], A: Auths[F]) = {
  import I._; import A._
  for {
    uid <- ask("User ID?")
    pwd <- ask("Password?")
    u <- login(uid, pwd)
    b <- hasPermission(u, KnowSecret)
    _ <- if (b) tell("UUDDLRLRBA") else tell("Go away!")
  } yield ()
}

type App[A] = Coproduct[Auth, Interact, A]

val app = prg[App](new Intera