como.scala

package p {
  trait Functor[F[X]]   extends Any                      { def fmap[A, B](x: A => B): F[A] => F[B] }
  trait Pointed[F[X]]   extends Functor[F]               { def pure[A](x: A): F[A]                 }
  trait Monad[F[X]]     extends Pointed[F]               { def join[A](x: F[F[A]]): F[A]           }
  trait Copointed[F[X]] extends Functor[F]               { def copure[A](x: F[A]): A               }
  trait Comonad[F[X]]   extends Copointed[F]             { def cojoin[A](x: F[A]): F[F[A]]         }
  trait Bimonad[F[X]]   extends Monad[F] with Comonad[F]

  sealed trait Monadic[F[X], A]                                             extends Any
  final case class Pure[F[X], A](x: A)                                      extends Monadic[F, A]
  final case class Copure[F[X], A](x: F[A])                                 extends Monadic[F, A]
  final case class Map[F[X], A, B](prev: Monadic[F, A], f: A => B)          extends Monadic[F, B]
  final case class FlatMap[F[X], A, B](prev: Monadic[F, A], f: A => F[B])   extends Monadic[F, B]
  final case class CoflatMap[F[X], A, B](prev: Monadic[F, A], f: F[A] => B) extends Monadic[F, B]

  class MonadicInfix[F[X], A](prev: Monadic[F, A]) {
    def map[B](f: A => B): Monadic[F, B]          = Map(prev, f)
    def flatMap[B](f: A => F[B]): Monadic[F, B]   = FlatMap(prev, f)
    def coflatMap[B](f: F[A] => B): Monadic[F, B] = CoflatMap(prev, f)
    def run(implicit z: Bimonad[F]): A            = z copure resolve(prev)
  }
  object Test {
    implicit object ListMonad extends Bimonad[List] {
      def fmap[A, B](f: A => B)      = _ map f
      def join[A](xs: List[List[A]]) = xs.flatten
      def pure[A](x: A)              = List(x)
      def cojoin[A](xs: List[A])     = List(xs)
      def copure[A](x: List[A])      = x.head
    }
    def main(args: Array[String]): Unit = {
      val m = pure[List](10) flatMap (1 to _ toList) coflatMap (_.sum)
      println(m.run + " <- " + m)
      // output: 55 <- CoflatMap(FlatMap(Pure(10),<function1>),<function1>)
    }
  }
}
package object p {
  def pure[F[X]]                             = new { def apply[A](x: A): Pure[F, A] = Pure[F, A](x) }
  def copure[F[X], A](x: F[A]): Copure[F, A] = Copure(x)
  def resolve[F[X], A](x: Monadic[F, A])(implicit z: Bimonad[F]): F[A] = x match {
    case Pure(x)            => z pure x
    case Copure(x)          => x
    case Map(prev, f)       => resolve(prev) |> (z fmap f)
    case FlatMap(prev, f)   => resolve(prev) |> (z fmap f)   |> (z join _)
    case CoflatMap(prev, f) => resolve(prev) |> (z cojoin _) |> (z fmap f)
  }

  implicit def monadicInfix[F[X], A](x: Monadic[F, A]): MonadicInfix[F, A] = new MonadicInfix(x)
  implicit class ForwardPipe[A](x: A) { def |>[B](f: A => B): B = f(x) }
}