List

sealed trait List[+A]
case class Cons[A](head: A, tail: List[A]) extends List[A]
case object Nil extends List[Nothing]

object ListT {

  import Functor._
  import Monad._

  def apply[A, M[_]: Monad](x: M[List[A]]) =
    new MonadOps[A, ({ type λ[ɑ] = M[List[ɑ]] })#λ](x)

  implicit def monad[M[_]: Monad]: Monad[({ type λ[ɑ] = M[List[ɑ]] })#λ] =
    new Monad[({ type λ[ɑ] = M[List[ɑ]] })#λ] {

      private lazy val m: Monad[M] = implicitly[Monad[M]]

      def pure[A](a: A): M[List[A]] =
        if (a == null) m.pure(Nil) else m.pure(Cons(a, Nil))

      def join[A](xss: List[List[A]]): List[A] =
        xss match {
          case Nil => Nil
          case Cons(h, t) => List.semigroup.sconcat(h, join(t))
        }

      override def map[A, B](ma: M[List[A]])(f: A => B): M[List[B]] =
        m.map(ma) { as =>
          def map(xs: List[A]): List[B] =
            xs match {
              case Cons(h, t) => Cons(f(h), map(t))
              case Nil        => Nil
            }
          map(as)
        }

      def flatMap[A, B](ma: M[List[A]])(f: A => M[List[B]]): M[List[B]] =
        m.flatMap(ma) { as =>
          List.traversable.sequence(as map f) map { join (_) }
        }
    }

}

object List {

  import Functor._
  import Semigroup._

  def apply[A](h: A, t: List[A]): List[A] =
    Cons(h, t)

  implicit def semigroup[A]: Semigroup[List[A]] =
    new Semigroup[List[A]] {
      def sconcat(a1: List[A], a2: List[A]): List[A] =
        a1 match {
          case Cons(h, t) => Cons(h, t <> a2)
          case Nil        => a2
        }
    }

  implicit val monad: Monad[List] = ListT.monad[ID]

  implicit val foldable: Foldable[List] =
    new Foldable[List] {
      override def foldr[A, B](f: (A, B) => B)(z: B)(fa: List[A]): B =
        fa match {
          case Cons(h, t) => foldr(f)(f(h, z))(t)
          case Nil        => z
        }
    }

  implicit val traversable: Traversable[List] =
    new Traversable[List] {
      override def sequence[A, F[_]: Applicative](x: List[F[A]])
                                                 (implicit ft: Functor[List]): F[List[A]] =
        foldable.foldr(
          (a: F[A], b: F[List[A]]) =>
            implicitly[Applicative[F]].ap(
              b map {
                as => {
                  a: A =>
                    semigroup.sconcat(as, Cons(a, Nil))
                }
              }
            )(a)
        )(implicitly[Applicative[F]].pure(Nil))(x)
    }
}

import Applicative._
import Foldable._
import Monad._
import Traversable._

println {
  for {
    x <- List(6, List(3, Nil))
    y <- List(7, List(3, Nil))
    z  = x * y
  } yield z
} // Cons(42,Cons(18,Cons(21,Cons(9,Nil))))

println {
  foldr((x: Int, y: Int) => x * y)(7)(List(2, List(3, Nil)))
} // 42

println {
  sequence(List(List(6, Nil), List(List(7, Nil), Nil)))
} // Cons(Cons(6,Cons(7,Nil)),Nil)

case class Box[A](a: A)
implicit def boxMonad[M[_]: Monad]: Monad[Box] =
  new Monad[Box] {
    def pure[A](a: A): Box[A] =
      Box(a)
    def flatMap[A, B](ma: Box[A])(f: A => Box[B]): Box[B] =
      f(ma.a)
  }

println {
  for {
    x <- ListT(Box(List(6, Nil)))
    y <- ListT(Box(List(7, Nil)))
  } yield x * y
} // Box(Cons(42,Nil))