Composition.md

 -- In Haskell

import Control.Applicative

newtype Compose f g a = Compose { getCompose :: f (g a) }

instance (Functor f, Functor g) => Functor (Compose f g) where
  fmap f (Compose fga) = Compose $ (fmap . fmap) f fga

instance (Applicative f, Applicative g) => Applicative (Compose f g) where
  pure = Compose . pure . pure
  Compose f <*> Compose a = Compose $ (liftA2 . liftA2) ($) f a

instance (Foldable f, Foldable g) => Foldable (Compose f g) where
  foldMap f (Compose fga)= (foldMap . foldMap) f fga

instance (Traversable f, Traversable g) => Traversable (Compose f g) where
  traverse f (Compose fga) = Compose <$> (traverse . traverse) f fga

// In Scala

import scala.language.higherKinds

trait Functor[F[_]] {
  def fmap[A, B](fa: F[A])(f: A => B): F[B]
}

object Functor {
  def apply[F[_]](implicit fa: Functor[F]): Functor[F] = fa

  implicit val listF : Functor[List] = new Functor[List] {
    def fmap[A, B](fa: List[A])(f: A => B) = fa.map(f)
  }
}

implicit def fc[F[_]: Functor, G[_]: Functor] : Functor[({type M[A] = F[G[A]]})#M] = new Functor[({type M[A] = F[G[A]]})#M] {
  def fmap[A, B](fga: F[G[A]])(f: A => B): F[G[B]] = Functor[F].fmap(fga)(Functor[G].fmap(_)(f))
}

def curry[A, B, C](f: (A, B) => C): A => B => C =
  a => b => f(a, b)

trait Applicative[F[_]] extends Functor[F] {
  def pure[A](a: => A): F[A]
  def apply[A, B](fab: F[A => B])(fa: => F[A]): F[B] = map2(fab)(fa)(_(_))
  def map2[A, B, C](fa: F[A])(fb: => F[B])(f: (A, B) => C): F[C] = {
    val ff = pure(curry(f))
    apply(apply(ff)(fa))(fb)
  }
  override def fmap[A, B](fa: F[A])(f: A => B): F[B] = {
    val ff = pure(f)
    apply(ff)(fa)
  }
}

object Applicative {
  def apply[F[_]](implicit fa: Applicative[F]): Applicative[F] = fa

  implicit val listA : Applicative[List] = new Applicative[List] {
    def pure[A](a: => A) = List(a)
    override def apply[A, B](fab: List[A => B])(fa: => List[A]): List[B] = fab.flatMap(f => fa.map(f(_)))
  }
}

implicit def ac[F[_]: Applicative, G[_]: Applicative] : Applicative[({type M[A] = F[G[A]]})#M] = new Applicative[({type M[A] = F[G[A]]})#M] {
  def pure[A](a: => A) = Applicative[F].pure(Applicative[G].pure(a))
  override def map2[A, B, C](fa: F[G[A]])(fb: => F[G[B]])(f: (A, B) => C): F[G[C]] =
    Applicative[F].map2(fa)(fb)(Applicative[G].map2(_)(_)(f))
}

trait Monoid[A] {
  def mempty : A
  def mappend(a1: A, a2: => A): A
}

object Monoid {
  def apply[A](implicit ma: Monoid[A]): Monoid[A] = ma
}

trait Foldable[F[_]] {
  def foldMap[A, B: Monoid](f: A => B)(fa: => F[A]): B
  def fold[A : Monoid](fa: => F[A]): A = foldMap((a: A) => a)(fa)
}

object Foldable {
  def apply[F[_]](implicit f: Foldable[F]): Foldable[F] = f

  implicit val listF : Foldable[List] = new Foldable[List] {
    def foldMap[A, B: Monoid](f: A => B)(fa: => List[A]): B =
      fa.foldRight(Monoid[B].mempty)((a, b) => Monoid[B].mappend(f(a), b))
  }
}

implicit def fc[F[_]: Foldable, G[_]: Foldable]: Foldable[({type M[A] = F[G[A]]})#M] = new Foldable[({type M[A] = F[G[A]]})#M] {
  def foldMap[A, B : Monoid](f: A => B)(fga: => F[G[A]]): B =
    Foldable[F].foldMap(Foldable[G].foldMap(f)(_ : G[A]))(fga)
}

trait Traversable[F[_]] {
  def traverse[G[_]: Applicative, A, B](f: A => G[B])(fa: => F[A]): G[F[B]]
}

object Traversable {
  def apply[F[_]](implicit ta: Traversable[F]): Traversable[F] = ta

  implicit val listT : Traversable[List] = new Traversable[List] {
    def traverse[G[_]: Applicative, A, B](f: A => G[B])(fa: => List[A]): G[List[B]] =
      Functor[List].fmap(fa)(f).foldRight(Applicative[G].pure(List.empty[B]))(Applicative[G].map2(_)(_)(_ :: _))
  }
}

implicit def tc[F[_]: Traversable, G[_]: Traversable]: Traversable[({type M[A] = F[G[A]]})#M] = new Traversable[({type M[A] = F[G[A]]})#M] {
  def traverse[H[_]: Applicative, A, B](f: A => H[B])(fga: => F[G[A]]): H[F[G[B]]] =
    Traversable[F].traverse(Traversable[G].traverse(f)(_: G[A]))(fga)
}