Skip to content

Instantly share code, notes, and snippets.

@leandrob13
Last active April 16, 2016 16:17
Show Gist options
  • Save leandrob13/8010a0f12609f562349668def6f20149 to your computer and use it in GitHub Desktop.
Save leandrob13/8010a0f12609f562349668def6f20149 to your computer and use it in GitHub Desktop.
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]
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment