como.scala

package p {

  object Test {
    import construction.Monadic
    import execution.Bimonad

    def main(args: Array[String]): Unit = {

      val expression = Monadic[List](10) flatMap (1 to _ toList) coflatMap (_.sum)

      val result = expression runWith ListBimonad

      println(result + " <- " + expression)
      // output: 55 <- CoflatMap(FlatMap(Pure(10),<function1>),<function1>)
    }

    private object ListBimonad extends Bimonad.Of[List] {
      def fmap[A, B] = _ map _
      def join[A] = _.flatten
      def pure[A] = List(_)
      def cojoin[A] = List(_)
      def copure[A] = _.head
    }
  }

  package execution {
    trait `Some name in the domain`                 { type F[_] }
    trait Functor extends `Some name in the domain` { def fmap[A, B]: (F[A], (A => B)) => F[B] }
    trait Copointed extends Functor                 { def copure[A]: F[A] => A }
    trait Comonad extends Copointed                 { def cojoin[A]: F[A] => F[F[A]] }
    trait Pointed extends Functor                   { def pure[A]: A => F[A] }
    trait Monad extends Pointed                     { def join[A]: F[F[A]] => F[A] }
    
    trait Bimonad extends Monad with Comonad
    object Bimonad {

      type Of[G[_]] = `It should not be necessary to add this trait`[G]

      trait `It should not be necessary to add this trait`[G[_]] extends Bimonad {
        type F[x] = G[x]
      }
    }
  }

  package construction {
    import execution.Bimonad

    sealed trait Monadic[F[_], A] extends Monadic.Operations[F, A]
    object Monadic {
      def apply[F[_], A](fa: F[A]): Monadic[F, A] = Copure(fa)
      def apply[F[_]]: Factory[F] = new Factory[F]

      class Factory[F[_]] {
        def apply[A](a: A): Monadic[F, A] = Pure[F, A](a)
      }

      private case class Pure[F[_], A](x: A)                                      extends Monadic[F, A]
      private case class Copure[F[_], A](x: F[A])                                 extends Monadic[F, A]
      private case class Map[F[_], A, B](prev: Monadic[F, A], f: A => B)          extends Monadic[F, B]
      private case class FlatMap[F[_], A, B](prev: Monadic[F, A], f: A => F[B])   extends Monadic[F, B]
      private case class CoflatMap[F[_], A, B](prev: Monadic[F, A], f: F[A] => B) extends Monadic[F, B]

      trait Operations[F[_], A] { _: Monadic[F, A] =>
        private type Result[B] = Monadic[F, B]

        def map[B](f: A => B): Result[B]          = Map(this, f)
        def flatMap[B](f: A => F[B]): Result[B]   = FlatMap(this, f)
        def coflatMap[B](f: F[A] => B): Result[B] = CoflatMap(this, f)

        def runWith(implicit F: Bimonad.Of[F]): A = executed |> F.copure

        private[Operations] def executed(implicit F: Bimonad.Of[F]): F[A] = {
          def fmap[A, B]: (A => B) => F[A] => F[B] = f => fa => F.fmap(fa, f)

          this match {
            case Pure(x)            => x |> F.pure
            case Copure(x)          => x
            case Map(prev, f)       => prev.executed |> fmap(f)
            case FlatMap(prev, f)   => prev.executed |> fmap(f) |> F.join
            case CoflatMap(prev, f) => prev.executed |> F.cojoin |> fmap(f)
          }
        }

        private implicit class ForwardPipe[A](x: A) { def |>[B](f: A => B): B = f(x) }
      }
    }
  }
}