FFree

FFree.scala

sealed abstract class FFree[F[_], A] {

  def map[B](f: A => B): FFree[F, B] =
    flatMap[B](a => FFree.pure[F, B](f(a)))

  def flatMap[B](k: A => FFree[F, B]): FFree[F, B] =
    this match {
      case FFree.Pure(a) => k(a)
      case FFree.Impure(ff, rs) => FFree.impure(ff, rs.:+(Kleisli.wrapKleisli(k)))
    }
}

object FFree {
  private[FFree] type Arr[F[_], A, B] = Kleisli[FFree[F, ?], A, B]
  private[FFree] type Arrs[F[_], A, B] = ACatenable1[Arr[F, ?, ?], A, B]

  final case class Pure[F[_], A](a: A) extends FFree[F, A]
  final case class Impure[F[_], E, A](ff: FFree[F, E], rs: Arrs[F, E, A]) extends FFree[F, A] {
    type EE = E
    def fa: FFree[F, EE] = ff
    def kk: Arrs[F, E, A] = rs
  }

  def pure[F[_], A](a: A): Pure[F, A] = Pure(a)
  def impure[F[_], E, A](ff: FFree[F, E], rs: Arrs[F, E, A]): FFree[F, A] = Impure(ff, rs)

  private[FFree] def tsingleton[F[_], A, B](f: A => FFree[F, B]): Arrs[F, A, B] =
    ACatenable1.lift[Arr[F, ?, ?], A, B](Kleisli.wrapKleisli[FFree[F, ?], A, B](f))

  private[FFree] def singleK[F[_], A, B](r: Arr[F, A, B]): Arrs[F, A, B] =
    ACatenable1.lift[Arr[F, ?, ?], A, B](r)

  def monad[F[_]]: MonadClass[FFree[F, ?]] = new MonadClass.Template[FFree[F, ?]] {
    override def flatMap[A, B](ma: FFree[F, A])(f: A => FFree[F, B]): FFree[F, B] = ma flatMap f
    override def ap[A, B](fa: FFree[F, A])(f: FFree[F, A => B]): FFree[F, B] = flatMap(f)(map(fa))
    override def pure[A](a: A): FFree[F, A] = Pure(a)
  }
}