Cayley.scala

import cats.Applicative
import cats.arrow.Arrow
import cats.implicits._

/**
  Theorem 1.1 (Cayley representation for (Set) monoids)
  Every monoid (M,⊕,e) is a sub-monoid of the monoid of endomorphisms on M.

  Notions of Computation as Monoids
  EXEQUIEL RIVAS, MAURO JASKELIOFF
  https://arxiv.org/pdf/1406.4823v1.pdf
  p. 4
  */
object Cayley {
  import cats._
  import cats.implicits._

  // abs ◦ rep = id
  def rep[A](a: A)(implicit m: Monoid[A]): A => A = m.combine(a, _)
  def abs[A](f: A => A)(implicit m: Monoid[A]): A = f(m.empty)

  object laws {
    import cats.laws._

    def monoidMorphism[A: Monoid](a: A) = abs(rep(a)) <-> a

    def monoidMorphism[A: Monoid]: MonoidMorphism[A, A => A] =
      MonoidMorphism(rep(_))
  }

  type EList[A] = List[A] => List[A]

  object EList {
    def rep[A](a: List[A]): EList[A] = Cayley.rep(a)
    def abs[A](e: EList[A]): List[A] = Cayley.abs(e)
  }

  // data Exp f g x = Exp (∀y. (x → f y) → g y)
  trait Exp[F[_], G[_], A] {
    def apply[B](f: A => F[B]): G[B]
  }

  /*
    Nat(H ◦ F,G) ∼= Nat(H, G^F)       (3.1)

    The components of isomorphism 3.1 are:

    ϕ :: Functor h ⇒ (∀x. h (f x) → g x) → h y → Exp f g y
    ϕ t y = Exp (λk → t (fmap k y))

    ϕ−1 :: (∀y. h y → Exp f g y) → h (f x) → g x
    ϕ−1 t x = let Exp g = t x in g id
   */
  object Exp {
    def apply[F[_]: Functor, G[_], A](fa: F[A]): Exp[F, G, A] =
      new Exp[F, G, A] {
        def apply[B](f: A => F[B]): G[B] = ???
      }
  }
}

/**
  * 8.1 The Cayley Functor
  *
  *  We consider the Cayley functor (Pastro & Street, 2008)
  *    C : End⋆ → SPro
  *  defined by
  *    C(F)(X,Y) = F(Y^X)
  *
  * The resulting construction is the static arrow over (→),
  * augmented with the original applicative (McBride & Paterson, 2008).
  *   data Cayley f x y = Cayley (f (x → y))
  * For every applicative functor, the Cayley functor constructs an arrow.
  *   instance Applicative f ⇒ PreArrow (Cayley f) where
  *     arr f = Cayley (pure f)
  *     (Cayley x) ≫ (Cayley y) = Cayley (pure (◦) ⊛ y ⊛ x)
  *   instance Applicative f ⇒ StrongProfunctor (Cayley f) where
  *     first (Cayley x) = Cayley (pure (λf → λ(b,d) → (f b,d))⊛x)
  *   instance Applicative f ⇒ Arrow (Cayley f)
  */
case class CayleyF[F[_], A, B](run: F[A => B])

object CayleyF {
  implicit def arrow[F[_]: Applicative]: Arrow[CayleyF[F, *, *]] =
    new Arrow[CayleyF[F, *, *]] {
      def compose[A, B, C](
          f: CayleyF[F, B, C],
          g: CayleyF[F, A, B]
      ): CayleyF[F, A, C] =
        CayleyF((f.run, g.run).mapN(_ compose _))
      def lift[A, B](f: A => B): CayleyF[F, A, B] = CayleyF(f.pure[F])
      def first[A, B, C](fa: CayleyF[F, A, B]): CayleyF[F, (A, C), (B, C)] =
        CayleyF(fa.run.map(f => { case (a, c) => (f(a), c) }))
    }
}