ListT / NondetT - a sensible ListT layered with a cut operation.

ListT.scala

import scalaz._, Scalaz._

case class ListT[F[+_], +A](stepListT: F[TStep[A, ListT[F, A]]]) {
  def ++[AA >: A](other: ListT[F, AA])(implicit F: Monad[F]): ListT[F, AA] = ListT(for {
    s <- stepListT
    r <- s match {
      case TNil() =>
        other.stepListT
      case TCons(a, x) =>
        TStep.cons(a, x ++ other).pure[F]
    }
  } yield r)

  def map[B](f: A => B)(implicit F: Monad[F]): ListT[F, B] =
    ListT(stepListT.map(x => x.bimap(f, _.map(f))))

  def flatMap[B](f: A => ListT[F, B])(implicit F: Monad[F]): ListT[F, B] = ListT(for {
    s <- stepListT
    r <- s match {
      case TNil() =>
        TStep.nil[B, ListT[F, B]].pure[F]
      case TCons(a, x) =>
        (f(a) ++ x.flatMap(f)).stepListT
    }
  } yield r)

  def run(implicit F: Monad[F]): F[List[A]] = for {
    s <- stepListT
    r <- s match {
      case TNil() => List().pure[F]
      case TCons(a, x) => x.run.map(a :: _)
    }
  } yield r

  def take(n: Int)(implicit F: Monad[F]): ListT[F, A] =
    if (n == 0)
      ListT.nil[F, A]
    else
      ListT(stepListT.map(x => x.bimap(identity, _.take(n - 1))))
}

object ListT {
  def singleton[F[+_]: Monad, A](a: A): ListT[F, A] =
    cons(a, nil[F, A])

  def nil[F[+_]: Monad, A]: ListT[F, A] =
    ListT(TStep.nil[A, ListT[F, A]].pure[F])

  def cons[F[+_]: Monad, A](a: A, as: ListT[F, A]): ListT[F, A]  =
    ListT(TStep.cons[A, ListT[F, A]](a, as).pure[F])

  def hoist[F[+_]: Monad, A](xs: List[A]): ListT[F, A] =
    xs.foldRight(nil[F, A])((el, acc) => cons(el, acc))

  def lift[F[+_]: Monad, A](f: F[A]): ListT[F, A] =
    ListT(f.map(x => TStep.cons(x, nil[F, A])))

  implicit def ListTInstances[F[+_]: Monad]: Monad[({ type l[a] = ListT[F, a] })#l] with MonadPlus[({ type l[a] = ListT[F, a] })#l]  = new Monad[({ type l[a] = ListT[F, a] })#l] with MonadPlus[({ type l[a] = ListT[F, a] })#l]{
    def point[A](a: => A) = singleton[F, A](a)
    override def map[A, B](a: ListT[F, A])(f: A => B) = a map f
    def bind[A, B](a: ListT[F, A])(f: A => ListT[F, B]) = a flatMap f
    def empty[A] = nil[F, A]
    def plus[A](a: ListT[F, A], b: => ListT[F, A]) = a ++ b
  }
}

sealed trait TStep[+A, +X] {
  def bimap[B, Y](f: A => B, g: X => Y): TStep[B, Y] =
    this match {
      case TNil() => TNil()
      case TCons(a, x) => TCons(f(a), g(x))
    }
}

case class TNil[A, X]() extends TStep[A, X]
case class TCons[A, X](a: A, x: X) extends TStep[A, X]

object TStep {
  def nil[A, X]: TStep[A, X] =
    TNil[A, X]()

  def cons[A, X](a: A, x: X): TStep[A, X] =
    TCons(a, x)
}

NondetT.scala

import scalaz._, Scalaz._

import NondetT.{Cut, CutT}

case class NondetT[F[+_], +A](runNondetT: ListT[CutT[F]#l, A]) {
  def ++[AA >: A](other: NondetT[F, AA])(implicit F: Monad[F]): NondetT[F, AA] =
    NondetT(runNondetT ++ other.runNondetT)

  def map[B](f: A => B)(implicit F: Monad[F]): NondetT[F, B] =
    NondetT(runNondetT.map(f))

  def flatMap[B](f: A => NondetT[F, B])(implicit F: Monad[F]): NondetT[F, B] =
    NondetT(runNondetT.flatMap(a => f(a).runNondetT))

  def <|>[AA >: A](other: NondetT[F, AA])(implicit F: Monad[F]): NondetT[F, AA] =
    NondetT(runNondetT ++ (for {
      s <- NondetT.getl[F]
      _ <- if (s) ListT.nil[CutT[F]#l, Unit] else ListT.singleton[CutT[F]#l, Unit](())
      r <- other.runNondetT
    } yield r))

  def disamb(implicit F: Monad[F]): F[Option[A]] =
    runNondetT.take(1).run.run(false).map(x => x._2 match {
      case h :: Nil => Some(h)
      case _ => None
    })
}

object NondetT {
  type Cut[F[+_], +A] = StateT[F, Boolean, A]
  trait CutT[F[+_]] { type l[+a] = Cut[F, a] }

  def nil[F[+_]: Monad, A]: NondetT[F, A] =
    NondetT(ListT.nil[CutT[F]#l, A])

  def singleton[F[+_]: Monad, A](a: A): NondetT[F, A] =
    NondetT(ListT.singleton[CutT[F]#l, A](a))

  def gets[F[+_]: Monad]: StateT[F, Boolean, Boolean] =
    StateT[F, Boolean, Boolean](s => (s, s).pure[F])

  def getc[F[+_]: Monad]: Cut[F, TStep[Boolean, ListT[CutT[F]#l, Boolean]]] =
    gets[F].map(b => TStep.cons(b, ListT.nil[CutT[F]#l, Boolean]))

  def getl[F[+_]: Monad]: ListT[CutT[F]#l, Boolean] =
    ListT[CutT[F]#l, Boolean](getc[F])

  def get[F[+_]: Monad]: NondetT[F, Boolean] =
    NondetT[F, Boolean](getl[F])

  def cuts[F[+_]: Monad]: StateT[F, Boolean, Unit] =
    StateT[F, Boolean, Unit](_ => (true, ()).pure[F])

  def cutc[F[+_]: Monad]: Cut[F, TStep[Unit, ListT[CutT[F]#l, Unit]]] =
    cuts[F].map(b => TStep.cons(b, ListT.nil[CutT[F]#l, Unit]))

  def cutl[F[+_]: Monad]: ListT[CutT[F]#l, Unit] =
    ListT[CutT[F]#l, Unit](cutc[F])

  def cut[F[+_]: Monad]: NondetT[F, Unit] =
    NondetT[F, Unit](cutl[F])

  def hoistMaybe[F[+_]: Monad, A](o: Option[A]): NondetT[F, A] =
    o.map(singleton[F, A]).getOrElse(nil[F, A])

  def lift[F[+_]: Monad, A](f: F[A]): NondetT[F, A] =
    NondetT[F, A](ListT.lift[CutT[F]#l, A](f.liftM[Cut]))

  implicit def NondetTMonad[F[+_]: Monad]: Monad[({ type l[a] = NondetT[F, a] })#l] with MonadPlus[({ type l[a] = NondetT[F, a] })#l] = new Monad[({ type l[a] = NondetT[F, a] })#l] with MonadPlus[({ type l[a] = NondetT[F, a] })#l] {
    def point[A](a: => A) = singleton[F, A](a)
    def bind[A, B](a: NondetT[F, A])(f: A => NondetT[F, B]) = a flatMap f
    def empty[A] = nil[F, A]
    def plus[A](a: NondetT[F, A], b: => NondetT[F, A]) = NondetT(a.runNondetT ++ b.runNondetT)
  }
}