Free.scala

package com.twitter.finagle.util

//import language.{ higherKinds, implicitConversions }
 
trait Unapply[TC[_[+_]], FA] {
  type F[+_]
  type A
  def TC: TC[F]
  def apply(fa: FA): F[A]
}
 
object Unapply {
  implicit def unapply0[TC[_[+_]], F0[+_], A0](implicit TC0: TC[F0]) =
    new Unapply[TC, F0[A0]] {
      type F[+α] = F0[α]
      type A = A0
      def TC = TC0
      def apply(fa: F0[A0]): F[A] = fa
    }
 
  implicit def unapply1[TC[_[+_]], F0[_[+_], +_], G0[+_], A0](
    implicit TC0: TC[({ type λ[+α] = F0[G0, α] })#λ]
  ) = new Unapply[TC, F0[G0, A0]] {
    type F[+α] = F0[G0, α]
    type A = A0
    def TC = TC0
    def apply(fa: F0[G0, A0]): F[A] = fa
  }
}
 
trait Functor[F[+_]] {
  def fmap[A, B](fa: F[A])(f: A => B): F[B]
}
 
object Functor {
  final class Ops[F[+_], A](fa: F[A], F: Functor[F]) {
    def map[B](f: A => B): F[B] = F.fmap(fa)(f)
  }
  implicit def functorOps[FA](fa: FA)(implicit FA: Unapply[Functor, FA]) =
    new Ops(FA(fa), FA.TC)
}
 
trait Applicative[F[+_]] extends Functor[F] {
  def pure[A](a: A): F[A]
  def ap[A, B](fa: F[A])(ff: F[A => B]): F[B]
  override def fmap[A, B](fa: F[A])(f: A => B): F[B] = ap(fa)(pure(f))
}
 
object Applicative {
  final class Ops[F[+_], A](fa: F[A], F: Applicative[F]) {
    def ap[B](ff: F[A => B]): F[B] = F.ap(fa)(ff)
  }
  implicit def applicativeOps[FA](fa: FA)(implicit FA: Unapply[Applicative, FA]) =
    new Ops(FA(fa), FA.TC)
}
 
trait Monad[F[+_]] extends Applicative[F] {
  def bind[A, B](fa: F[A])(f: A => F[B]): F[B]
  override def fmap[A, B](fa: F[A])(f: A => B): F[B] = bind(fa)(f andThen pure)
  override def ap[A, B](fa: F[A])(ff: F[A => B]): F[B] = bind(ff)(fmap(fa))
}
 
object Monad {
  final class Ops[F[+_], A](fa: F[A], F: Monad[F]) {
    def flatMap[B](f: A => F[B]): F[B] = F.bind(fa)(f)
  }
  implicit def monadOps[FA](fa: FA)(implicit FA: Unapply[Monad, FA]) =
    new Ops(FA(fa), FA.TC)
}
 
sealed trait Free[F[+_], +A]
object Free {
  case class Pure[F[+_], +A](get: A) extends Free[F, A]
  case class Bind[F[+_], +A](run: F[Free[F, A]]) extends Free[F, A]
 
  implicit def freeMonad[F[+_]](implicit F: Functor[F]) =
    new Monad[({ type λ[+α] = Free[F, α] })#λ] {
      override def pure[A](a: A): Free[F, A] = Pure(a)
      override def bind[A, B](fa: Free[F, A])(f: A => Free[F, B]): Free[F, B] =
        fa match {
          case Pure(a) => f(a)
          case Bind(ff) => Bind(F.fmap(ff) { bind(_)(f) })
        }
    }
 
  import Functor._
  def lift[F[+_]: Functor, A](fa: F[A]): Free[F, A] = Bind(fa map { Pure(_) })
}

sealed trait Toy[+A]
object Toy {
  case class Output[+A](message: String, cont: A) extends Toy[A]
  case class Bell[+A](cont: A) extends Toy[A]
  case object Done extends Toy[Nothing]
 
  implicit val toyFunctor = new Functor[Toy] {
    override def fmap[A, B](fa: Toy[A])(f: A => B): Toy[B] = fa match {
      case Output(message, cont) => Output(message, f(cont))
      case Bell(cont) => Bell(f(cont))
      case Done => Done
    }
  }
 
  def output(message: String) = Free.lift(Output(message, ()): Toy[Unit])
  def bell = Free.lift(Bell(): Toy[Unit])
  def done = Free.lift(Done: Toy[Unit])
 
  def test: Unit = {
    import Functor._
    import Monad._
 
    val lol = for {
      _ <- output("hello")
      _ <- output("world")
      _ <- bell
      _ <- done
    } yield ()
    println(lol)
  }
}

class Morph[-A, +B](f: A => B) extends (A => B) {
  def apply(a: A): B = f(a)
  override def andThen[C](g: B => C) = new Morph(f andThen g)
}

object IntMorph {
  class IntMorph[+B](f: Int => B) extends Morph[Int, B](f){
    override def andThen[C](g: B => C) = new IntMorph(f andThen g)
  }

  implicit val intMorphFunctor = new Functor[IntMorph] {
    override def fmap[A, B](fa: IntMorph[A])(f: A => B) = fa andThen f
  }

  def run[A](init: Int, prog: Free[IntMorph, A]): A = {
    import Functor._
    import Free._
    prog match {
      case Pure(x)    => println(x); x
      case Bind(next) => run(init, next(init))
    }
  }

  def test(init: Int) = {
    import Monad._
    import Functor._
    val prog = for {
      a <- Free.lift(new IntMorph({ x: Int => x * 30 }): IntMorph[Int])
      b <- Free.lift(new IntMorph({ x: Int => x - 2 }): IntMorph[Int])
    } yield a + b

    run(init, prog)
  }
}

//object Morph {
//  trait MorphR[R] {
//    type Apply[+A] = Morph[R, A]
//  }
//
//  implicit def morphFunctor[R] = new Functor[MorphR[R]#Apply] {
//    override def fmap[A, B](fa: Morph[R, A])(f: A => B): Morph[R, B] = fa andThen f
//  }
//
//  def test: Unit = {
//    import Monad._
//    import Functor._
//    val x = for {
//      _ <- Free.lift[MorphR[Int]#Apply, Unit](new Morph({ x: Int => x * 30 }): Morph[Int, Unit])
//      //                                     ^
//      // could not find implicit value for parameter FA: Unapply[Monad,Free[[+A]Morph[Int,A],Unit]]
//      _ <- Free.lift[MorphR[Int]#Apply, Unit](new Morph({ x: Int => x - 2 }): Morph[Int, Unit])
//    } yield ()
//  }
//}