RoomConf Talk: Free as in Monads

example.scala

// data FS a
sealed trait FSOp[A]

object FSOp {
  final case class Read(name: String)
      extends FSOp[Array[Byte]]

  def read(name: String): Free[FSOp, Array[Byte]] =
    Free.liftF(Read(name))

  final case class Write(name: String, contents: Array[Byte])
      extends FSOp[Unit]

  def write(name: String, contents: Array[Byte]): Free[FSOp, Unit] =
    Free.liftF(Write(name, contents))

  final case class Exists(name: String) extends FSOp[Boolean]

  def exists(name: String): Free[FSOp, Boolean] =
    Free.liftF(Exists(name))
}

// program :: Free FSOp ()
val program: Free[FSOp, Unit] = for {
  exists <- FSOp.exists("names.csv")

  _ <- if (exists) {
    for {
      names <- FSOp.read("names.csv")
      names2 <- FSOp.read("names2.csv")
      parsed = parseCsv(names)
      _ <- FSOp.write("status.txt", "done!".getBytes)
    } yield ()
  } else {
    pure(())
  }
} yield ()

// interpreter :: FSOp a -> IO a
val interpreter = new (FSOp ~> IO) {
  def apply[A](fa: FSOp[A]): IO[A] = fa match {
    case Read(name) => readFromFile(name): IO[Array[Byte]]
    case _ => ???
  }
}

foldMap(program)(interpreter): IO[Unit]

val tester = for {
  name <- expect {
    case Exists(name) => IO((name, false))
  }
} yield ()

(tester run program): IO[Unit]

Free.hs

data Free f a =
  Return a |
  forall e . Bind (Free f e) (e -> Free f a) |
  LiftF (f a)

instance Monad (Free f) where
  return = Return
  (>>=) = Bind

liftF :: f a -> Free f a
liftF = LiftF

-- def foldMap[A, F[_], G[_]: Monad](fa: Free[F, A])(nt: F ~> G): G[A]
foldMap :: Monad g => (forall e . f e -> g e) -> Free f a -> g a
foldMap _ (Return a) = return a
foldMap k (LiftF fa) = k fa
foldMap k (Bind fe fun) = 
  (foldMap k fe) >>= (\e -> foldMap $ k (fun e))

---------------

-- operational library
data FSOp a =
  Read String ([Byte] -> a) |
  Write String [Byte] a |
  Exists String (Bool -> a)


data FSOp' a where
  Read :: String -> FSOp' [Byte]
  Write :: String -> [Byte] -> FSOp' ()
  Exists :: String -> FSOp' Bool

FreeMon.hs

data FreeMon a =
  MEmpty |
  MAppend (FreeMon a) (FreeMon a) |
  LiftM a

instance Monoid (FreeMon a) where
  mempty = MEmpty
  mappend = MAppend

liftM :: a -> FreeMon a
liftM = LiftM

foldM :: Monoid b => (a -> b) -> FreeMon a -> b
foldM _ MEmpty = mempty
foldM f (MAppend fm1 fm2) = mappend (foldM f fm1) (foldM f fm2)
foldM f (LiftM a) = f a

init.scala

// free beer and free monads

// data Free (f :: * -> *) a
sealed trait Free[F[_], A]

object Free {
  // instance Monad (Free f)
  implicit def instance[F[_]]: Monad[Free[F, ?]] = new Monad[Free[F, ?]] {

    // pure :: a -> Free f a
    def pure[A](a: A): Free[F, A] =
      Free.Pure[F, A](a)

    // bind :: Free f a -> (a -> Free f b) -> Free f b
    def bind[A, B](fa: Free[F, A])(f: A => Free[F, B]): Free[F, B] =
      Free.Bind[F, A, B](fa, f)
  }

  // data Free f a = ... | Pure a
  final case class Pure[F[_], A](a: A) extends Free[F, A]

  // data Free f a = ... | forall e . Bind (Free f e) (e -> Free f a)
  final case class Bind[F[_], E, A](fe: Free[F, E], f: E => Free[F, A]) extends Free[F, A]
}

notes.md

"Monad" = "monoid in the category of endofunctors"

• List[Char] is in the category of sets
• FreeMon = List
• List is the "free monoid (in the category of sets)"
• Free is the free monad
  • Free is the free monoid (in the category of endofunctors)