Replace scalaz ListT with semantically equivalent

问题:

cats does not provide ListT monad transformer so how could we rewrite the following snippet which uses scalaz ListT in a for-comprehension to a semantically equivalent snippet in cats

import scalaz._
import ListT._
import scalaz.std.option._

val seeds: Option[List[String]] = Some(List("apple", "orange", "tomato"))
def grow(seed: String): Option[List[String]] = Some(List(seed.toUpperCase))
def family(seed: String, plant: String): Option[List[(String, String)]] = Some(List(seed -> plant))

(for {
  seed    <- listT(seeds)
  plant   <- listT(grow(seed))
  result  <- listT(family(seed, plant))
} yield result).run

Here is my attempt utilising flatMap and flatTraverse

import cats.implicits._

seeds
  .flatMap {
    _.flatTraverse { seed =>
      grow(seed)
        .flatMap {
          _.flatTraverse { plant =>
            family(seed, plant)
          }
        }
    }
  }

This refactoring seems to satisfy the typechecker however I am unsure if happy compiler ensures 100% semantic equivalence.

回答1:

Cats does not provide ListT because it breaks the associativity Monad law. See Cats FAQ and associated proof using scalaz ListT.

Still the following ListT implementation based on .flatTraverse as you suggest passes all cats-core law tests (a bug?).

I have no experience with software proving but you might find the successful tests good enough to consider the 2 implementations as equivalent.

ListT implementation

case class ListT[M[_], A](value: M[List[A]])
implicit def listTMonad[M[_]: Monad] = new Monad[ListT[M, *]] {
  override def flatMap[A, B](fa: ListT[M, A])(f: A => ListT[M, B]): ListT[M, B] =
    ListT(
      Monad[M].flatMap[List[A], List[B]](fa.value)(
        list => Traverse[List].flatTraverse[M, A, B](list)(a => f(a).value)
      )
    )
  override def pure[A](a: A): ListT[M, A] = ListT(Monad[M].pure(List(a)))
  // unsafe impl, can be ignored for this question
  override def tailRecM[A, B](a: A)(f: A => ListT[M, Either[A, B]]): ListT[M, B] =
    flatMap(f(a)) {
      case Right(b) => pure(b)
      case Left(nextA) => tailRecM(nextA)(f)
    }
}

sbt

name := "listT_tests"
version := "0.1"
scalaVersion := "2.11.12"

scalacOptions += "-Ypartial-unification"

libraryDependencies ++= Seq(
  "org.typelevel" %% "cats-core" % "2.0.0",
  "org.scalaz" %% "scalaz-core" % "7.2.30",
  "org.scalacheck" %% "scalacheck" % "1.14.1" % "test",
  "org.scalatest" %% "scalatest" % "2.2.6" % "test",
  "org.typelevel" %% "discipline-scalatest" % "1.0.1",
  "org.typelevel" %% "discipline-core" % "1.0.2",
  "org.typelevel" %% "cats-laws" % "2.0.0" % Test,
  "com.github.alexarchambault" %% "scalacheck-shapeless_1.14" % "1.2.3" % Test
)

addCompilerPlugin("org.typelevel" %% "kind-projector" % "0.11.0" cross CrossVersion.full)

law tests

class TreeLawTests extends AnyFunSpec with Checkers with FunSpecDiscipline {

  implicit def listTEq[M[_], A] = Eq.fromUniversalEquals[ListT[M, A]]
  checkAll("ListT Monad Laws", MonadTests[ListT[Option, *]].stackUnsafeMonad[Int, Int, String])
}

law tests results

- monad (stack-unsafe).ap consistent with product + map
- monad (stack-unsafe).applicative homomorphism
- monad (stack-unsafe).applicative identity
- monad (stack-unsafe).applicative interchange
- monad (stack-unsafe).applicative map
- monad (stack-unsafe).applicative unit
- monad (stack-unsafe).apply composition
- monad (stack-unsafe).covariant composition
- monad (stack-unsafe).covariant identity
- monad (stack-unsafe).flatMap associativity
- monad (stack-unsafe).flatMap consistent apply
- monad (stack-unsafe).flatMap from tailRecM consistency
- monad (stack-unsafe).invariant composition
- monad (stack-unsafe).invariant identity
- monad (stack-unsafe).map flatMap coherence
- monad (stack-unsafe).map2/map2Eval consistency
- monad (stack-unsafe).map2/product-map consistency
- monad (stack-unsafe).monad left identity
- monad (stack-unsafe).monad right identity
- monad (stack-unsafe).monoidal left identity
- monad (stack-unsafe).monoidal right identity
- monad (stack-unsafe).mproduct consistent flatMap
- monad (stack-unsafe).productL consistent map2
- monad (stack-unsafe).productR consistent map2
- monad (stack-unsafe).semigroupal associativity
- monad (stack-unsafe).tailRecM consistent flatMap