ListT.scala

package cats.data

import cats._
import cats.functor.Contravariant
import ListT._

/**
  * ListT monad transformer.
  */
sealed class ListT[M[_], A](val value: M[Step[A, ListT[M, A]]]) {
  def uncons(implicit M: Monad[M]): M[Option[(A, ListT[M, A])]] = {
    M.flatMap(value){
      case Take(a, ast) => M.pure(Some((a, ast)))
      case Skip(ast) => ast.uncons
      case Done() => M.pure(None)
    }
  }

  def ::(a: A)(implicit M: Applicative[M]): ListT[M, A] = ListT[M, A](M.pure(Take(a, this)))

  def isEmpty(implicit M: Monad[M]) : M[Boolean] = M.map(uncons)(_.isEmpty)

  def headOption(implicit M: Monad[M]): M[Option[A]] = M.map(uncons)(_.map(_._1))

  //def find(predicate: A => Boolean)(implicit M: Functor[M]) : OptionT[M, A] = OptionT(M.map(uncons)(_.find(predicate)))

  def tailM(implicit M: Monad[M]) : M[ListT[M, A]] = M.map(uncons)(_.get._2)

  def filter(p: A => Boolean)(implicit m: Functor[M]): ListT[M, A] = ListT[M, A](m.map(value) {
    case Take(a , as) => if (p(a)) Take(a, as.filter(p)) else Skip(as.filter(p))
    case Skip(as) => Skip(as.filter(p))
    case d @ Done() => d
  })

  def ++(bs: => ListT[M, A])(implicit m: Functor[M]): ListT[M, A] = ListT[M, A](m.map(value) {
    case Take(a, as) => Take(a, as ++ bs)
    case Skip(as) => Skip(as ++ bs)
    case Done() => Skip(bs)
  } )

  def flatMap[B](f: A => ListT[M, B])(implicit m: Functor[M]): ListT[M, B] = ListT[M, B](m.map(value) {
    case Take(a, as) => Skip(f(a) ++ (as flatMap f))
    case Skip(as) => Skip(as flatMap f)
    case d @ Done() => d
  } )

  def map[B](f: A => B)(implicit m: Functor[M]): ListT[M, B] = ListT[M, B](m.map(value) {
    case Take(a, as) => Take(f(a), as map f)
    case Skip(as) => Skip(as map f)
    case d @ Done() => d
  } )

  def transform[N[_]](t: M ~> N)(implicit M: Functor[M], N: Functor[N]): ListT[N, A] =
    ListT[N, A]( t( M.map(value) {
      case Take(a, as) => Take(a, as transform t)
      case Skip(as) => Skip(as transform t)
      case d @ Done() => d
     }
    ))

  def toList(implicit M: Monad[M]): M[List[A]] = M.map(rev)(_.reverse)

  private def rev(implicit M: Monad[M]): M[List[A]] = {
    def loop(xs: ListT[M, A], ys: List[A]): M[List[A]] =
      M.flatMap(xs.value) {
        case Take(a, as) => loop(as, a :: ys)
        case Skip(as) => loop(as, ys)
        case Done() => M.pure(ys)
      }
    loop(this, List.empty[A])
  }
}

object ListT extends ListTInstances with ListTFunctions {

  abstract class Step[+A, +L]

  case class Take[A, L](a: A, ast: L) extends Step[A, L]
  case class Skip[L](ast: L) extends Step[Nothing, L]
  case class Done() extends Step[Nothing, Nothing]
}

private[data] sealed trait ListTFunctions {

  def apply[M[_], A](value: M[Step[A, ListT[M, A]]]): ListT[M, A] = new ListT[M, A](value)

  def empty[M[_], A](implicit M: Applicative[M]): ListT[M, A] = new ListT[M, A](M pure Done())

  final def fromList[M[_], A](mas: M[List[A]])(implicit M: Applicative[M]): ListT[M, A] = {
    def loop(as: List[A]): Step[A, ListT[M, A]] = as match {
      case head :: tail => Take(head, apply[M, A](M.pure(loop(tail))))
      case _ => Done()
    }

    apply[M, A](M.map(mas)(loop))
  }
}

sealed abstract class ListTInstances2 {
  implicit def listTFunctor[F[_]](implicit F0: Functor[F]): Functor[ListT[F, ?]] =
    new ListTFunctor[F]{
      implicit val F: Functor[F] = F0
    }

  implicit def listTSemigroupK[F[_], A](implicit M: Monad[F]): SemigroupK[ListT[F, ?]] = {
    new ListTSemigroupK[F] { implicit val F = M }
  }
}

sealed abstract class ListTInstances1 extends ListTInstances2 {
  implicit def listTMonoid[F[_]](implicit F0: Monad[F]): MonoidK[ListT[F, ?]] =
    new ListTMonoid[F] {
      implicit val F: Monad[F] = F0
    }
}

sealed abstract class ListTInstances extends ListTInstances1 {
  implicit def listTMonad[M[_]](implicit F0: Monad[M]): Monad[ListT[M, ?]] =
    new ListTMonad[M] {
      implicit val M: Monad[M] = F0
    }

  implicit def listTShow[F[_], A](implicit E: Show[F[List[A]]], M: Monad[F]): Show[ListT[F, A]] =
    Contravariant[Show].contramap(E)((_: ListT[F, A]).toList)
}

private trait ListTFunctor[F[_]] extends Functor[ListT[F, ?]] {
  implicit val F: Functor[F]
  def map[A, B](fa: ListT[F, A])(f: A => B): ListT[F, B] = fa map f
}

private trait ListTSemigroupK[F[_]] extends SemigroupK[ListT[F, ?]] {
  implicit val F: Monad[F]
  def combineK[A](l1: ListT[F, A], l2: ListT[F, A]): ListT[F, A] = l1 ++ l2
}

private trait ListTMonoid[F[_]] extends MonoidK[ListT[F, ?]] with ListTSemigroupK[F] {
  implicit val F: Monad[F]

  def empty[A]: ListT[F, A] = ListT.empty[F, A]
}

private trait ListTMonad[M[_]] extends Monad[ListT[M, ?]] {
  implicit val M: Monad[M]

  def flatMap[A, B](fa: ListT[M, A])(f: A => ListT[M, B]): ListT[M, B] = fa flatMap f

  def pure[A](a: A): ListT[M, A] = a :: ListT.empty[M, A]
}