Merge pull request #1299 from typelevel/oscar/tuple2monad

Add ContravariantCartesian typeclass and for Tuple2 add Monad and FlatMap

core/src/main/scala/cats/Cartesian.scala

@@ -25,4 +25,5 @@ object Cartesian extends CartesianArityFunctions with KernelCartesianInstances
 private[cats] sealed trait KernelCartesianInstances {
   implicit val catsInvariantSemigroup: Cartesian[Semigroup] = InvariantMonoidal.catsInvariantMonoidalSemigroup
   implicit val catsInvariantMonoid: Cartesian[Monoid] = InvariantMonoidal.catsInvariantMonoidalMonoid
+  implicit val catsCartesianEq: Cartesian[Eq] = ContravariantCartesian.catsContravariantCartesianEq
 }

core/src/main/scala/cats/Composed.scala

@@ -122,6 +122,16 @@ private[cats] trait ComposedContravariantCovariant[F[_], G[_]] extends Contravar
     F.contramap(fga)(gb => G.map(gb)(f))
 }
 
+private[cats] trait ComposedCartesian[F[_], G[_]] extends ContravariantCartesian[λ[α => F[G[α]]]] with ComposedContravariantCovariant[F, G] { outer =>
+  def F: ContravariantCartesian[F]
+  def G: Functor[G]
+
+  def product[A, B](fa: F[G[A]], fb: F[G[B]]): F[G[(A, B)]] =
+    F.contramap(F.product(fa, fb)) { g: G[(A, B)] =>
+      (G.map(g)(_._1), G.map(g)(_._2))
+    }
+}
+
 private[cats] trait ComposedCovariantContravariant[F[_], G[_]] extends Contravariant[λ[α => F[G[α]]]] { outer =>
   def F: Functor[F]
   def G: Contravariant[G]

core/src/main/scala/cats/ContravariantCartesian.scala

@@ -0,0 +1,26 @@
+package cats
+
+import functor.Contravariant
+import simulacrum.typeclass
+
+/**
+ * [[ContravariantCartesian]] is nothing more than something both contravariant
+ * and Cartesian. It comes up enough to be useful, and composes well
+ */
+@typeclass trait ContravariantCartesian[F[_]] extends Cartesian[F] with Contravariant[F] { self =>
+  override def composeFunctor[G[_]: Functor]: ContravariantCartesian[λ[α => F[G[α]]]] =
+    new ComposedCartesian[F, G] {
+      def F = self
+      def G = Functor[G]
+    }
+}
+
+object ContravariantCartesian extends KernelContravariantCartesianInstances
+
+private[cats] sealed trait KernelContravariantCartesianInstances {
+  implicit val catsContravariantCartesianEq: ContravariantCartesian[Eq] = new ContravariantCartesian[Eq] {
+    def contramap[A, B](fa: Eq[A])(fn: B => A): Eq[B] = fa.on(fn)
+    def product[A, B](fa: Eq[A], fb: Eq[B]): Eq[(A, B)] =
+      Eq.instance { (left, right) => fa.eqv(left._1, right._1) && fb.eqv(left._2, right._2) }
+  }
+}

core/src/main/scala/cats/InvariantMonoidal.scala

@@ -26,10 +26,14 @@ private[cats] trait KernelInvariantMonoidalInstances {
 
     def imap[A, B](fa: Semigroup[A])(f: A => B)(g: B => A): Semigroup[B] = new Semigroup[B] {
       def combine(x: B, y: B): B = f(fa.combine(g(x), g(y)))
+      override def combineAllOption(bs: TraversableOnce[B]): Option[B] =
+        fa.combineAllOption(bs.map(g)).map(f)
     }
 
     def pure[A](a: A): Semigroup[A] = new Semigroup[A] {
       def combine(x: A, y: A): A = a
+      override def combineAllOption(as: TraversableOnce[A]): Option[A] =
+        if (as.isEmpty) None else Some(a)
     }
   }
 
@@ -42,11 +46,14 @@ private[cats] trait KernelInvariantMonoidalInstances {
     def imap[A, B](fa: Monoid[A])(f: A => B)(g: B => A): Monoid[B] = new Monoid[B] {
       val empty = f(fa.empty)
       def combine(x: B, y: B): B = f(fa.combine(g(x), g(y)))
+      override def combineAll(bs: TraversableOnce[B]): B =
+        f(fa.combineAll(bs.map(g)))
     }
 
     def pure[A](a: A): Monoid[A] = new Monoid[A] {
       val empty = a
       def combine(x: A, y: A): A = a
+      override def combineAll(as: TraversableOnce[A]): A = a
     }
   }
 }

core/src/main/scala/cats/functor/Contravariant.scala

@@ -36,14 +36,8 @@ object Contravariant extends KernelContravariantInstances
  * can't have instances for this type class in their companion objects.
  */
 private[functor] sealed trait KernelContravariantInstances {
-  implicit val catsFunctorContravariantForEq: Contravariant[Eq] =
-    new Contravariant[Eq] {
-      /** Derive a `Eq` for `B` given a `Eq[A]` and a function `B => A`.
-       *
-       * Note: resulting instances are law-abiding only when the functions used are injective (represent a one-to-one mapping)
-       */
-      def contramap[A, B](fa: Eq[A])(f: B => A): Eq[B] = fa.on(f)
-    }
+  implicit def catsFunctorContravariantForEq: Contravariant[Eq] =
+    ContravariantCartesian.catsContravariantCartesianEq
 
   implicit val catsFunctorContravariantForPartialOrder: Contravariant[PartialOrder] =
     new Contravariant[PartialOrder] {

core/src/main/scala/cats/instances/tuple.scala

@@ -1,9 +1,11 @@
 package cats
 package instances
 
+import scala.annotation.tailrec
+
 trait TupleInstances extends Tuple2Instances with cats.kernel.instances.TupleInstances
 
-sealed trait Tuple2Instances {
+sealed trait Tuple2Instances extends Tuple2Instances1 {
   implicit val catsStdBitraverseForTuple2: Bitraverse[Tuple2] =
     new Bitraverse[Tuple2] {
       def bitraverse[G[_]: Applicative, A, B, C, D](fab: (A, B))(f: A => G[C], g: B => G[D]): G[(C, D)] =
@@ -40,3 +42,59 @@ sealed trait Tuple2Instances {
       override def coflatten[A](fa: (X, A)): (X, (X, A)) = (fa._1, fa)
     }
 }
+
+sealed trait Tuple2Instances1 extends Tuple2Instances2 {
+  implicit def catsStdMonadForTuple2[X](implicit MX: Monoid[X]): Monad[(X, ?)] with RecursiveTailRecM[(X, ?)] =
+    new FlatMapTuple2[X](MX) with Monad[(X, ?)] {
+      def pure[A](a: A): (X, A) = (MX.empty, a)
+    }
+}
+
+sealed trait Tuple2Instances2 {
+  implicit def catsStdFlatMapForTuple2[X](implicit SX: Semigroup[X]): FlatMap[(X, ?)] with RecursiveTailRecM[(X, ?)]=
+    new FlatMapTuple2[X](SX)
+}
+
+private[instances] class FlatMapTuple2[X](s: Semigroup[X]) extends FlatMap[(X, ?)] with RecursiveTailRecM[(X, ?)] {
+  override def ap[A, B](ff: (X, A => B))(fa: (X, A)): (X, B) = {
+    val x = s.combine(ff._1, fa._1)
+    val b = ff._2(fa._2)
+    (x, b)
+  }
+
+  override def product[A, B](fa: (X, A), fb: (X, B)): (X, (A, B)) = {
+    val x = s.combine(fa._1, fb._1)
+    (x, (fa._2, fb._2))
+  }
+
+  override def map[A, B](fa: (X, A))(f: A => B): (X, B) =
+    (fa._1, f(fa._2))
+
+  def flatMap[A, B](fa: (X, A))(f: A => (X, B)): (X, B) = {
+    val xb = f(fa._2)
+    val x = s.combine(fa._1, xb._1)
+    (x, xb._2)
+  }
+
+  override def followedBy[A, B](a: (X, A))(b: (X, B)): (X, B) =
+    (s.combine(a._1, b._1), b._2)
+
+  override def mproduct[A, B](fa: (X, A))(f: A => (X, B)): (X, (A, B)) = {
+    val xb = f(fa._2)
+    val x = s.combine(fa._1, xb._1)
+    (x, (fa._2, xb._2))
+  }
+
+  def tailRecM[A, B](a: A)(f: A => (X, Either[A, B])): (X, B) = {
+    @tailrec
+    def loop(x: X, aa: A): (X, B) =
+      f(aa) match {
+        case (nextX, Left(nextA)) => loop(s.combine(x, nextX), nextA)
+        case (nextX, Right(b)) => (s.combine(x, nextX), b)
+      }
+    f(a) match {
+      case (x, Right(b)) => (x, b)
+      case (x, Left(nextA)) => loop(x, nextA)
+    }
+  }
+}

laws/src/main/scala/cats/laws/FlatMapLaws.scala

@@ -18,6 +18,9 @@ trait FlatMapLaws[F[_]] extends ApplyLaws[F] {
   def flatMapConsistentApply[A, B](fa: F[A], fab: F[A => B]): IsEq[F[B]] =
     fab.ap(fa) <-> fab.flatMap(f => fa.map(f))
 
+  def followedByConsistency[A, B](fa: F[A], fb: F[B]): IsEq[F[B]] =
+    F.followedBy(fa)(fb) <-> F.flatMap(fa)(_ => fb)
+
   /**
    * The composition of `cats.data.Kleisli` arrows is associative. This is
    * analogous to [[flatMapAssociativity]].
@@ -27,6 +30,9 @@ trait FlatMapLaws[F[_]] extends ApplyLaws[F] {
     ((kf andThen kg) andThen kh).run(a) <-> (kf andThen (kg andThen kh)).run(a)
   }
 
+  def mproductConsistency[A, B](fa: F[A], fb: A => F[B]): IsEq[F[(A, B)]] =
+    F.mproduct(fa)(fb) <-> F.flatMap(fa)(a => F.map(fb(a))((a, _)))
+
   def tailRecMConsistentFlatMap[A](count: Int, a: A, f: A => F[A]): IsEq[F[A]] = {
     def bounce(n: Int) = F.tailRecM[(A, Int), A]((a, n)) { case (a0, i) =>
       if (i > 0) f(a0).map(a1 => Left((a1, i-1)))

laws/src/main/scala/cats/laws/discipline/FlatMapTests.scala

@@ -22,11 +22,17 @@ trait FlatMapTests[F[_]] extends ApplyTests[F] {
     EqFABC: Eq[F[(A, B, C)]],
     iso: Isomorphisms[F]
   ): RuleSet = {
+    implicit def functorF: Functor[F] = laws.F
+    implicit val EqFAB: Eq[F[(A, B)]] =
+      ContravariantCartesian[Eq].composeFunctor[F].product(EqFA, EqFB)
+
     new DefaultRuleSet(
       name = "flatMap",
       parent = Some(apply[A, B, C]),
       "flatMap associativity" -> forAll(laws.flatMapAssociativity[A, B, C] _),
       "flatMap consistent apply" -> forAll(laws.flatMapConsistentApply[A, B] _),
+      "followedBy consistent flatMap" -> forAll(laws.followedByConsistency[A, B] _),
+      "mproduct consistent flatMap" -> forAll(laws.mproductConsistency[A, B] _),
       "tailRecM consistent flatMap" -> forAll(laws.tailRecMConsistentFlatMap[A] _))
   }
 }

tests/src/test/scala/cats/tests/TupleTests.scala

@@ -1,9 +1,18 @@
 package cats
 package tests
 
-import cats.laws.discipline.{BitraverseTests, ComonadTests, SerializableTests, TraverseTests}
+import data.NonEmptyList
+
+import cats.laws.discipline.{
+  BitraverseTests, ComonadTests, SerializableTests, TraverseTests, MonadTests, FlatMapTests, CartesianTests
+}
+import cats.laws.discipline.arbitrary._
 
 class TupleTests extends CatsSuite {
+
+  implicit val iso1 = CartesianTests.Isomorphisms.invariant[(NonEmptyList[Int], ?)]
+  implicit val iso2 = CartesianTests.Isomorphisms.invariant[(String, ?)]
+
   checkAll("Tuple2", BitraverseTests[Tuple2].bitraverse[Option, Int, Int, Int, String, String, String])
   checkAll("Bitraverse[Tuple2]", SerializableTests.serializable(Bitraverse[Tuple2]))
 
@@ -13,6 +22,21 @@ class TupleTests extends CatsSuite {
   checkAll("Tuple2[String, Int]", ComonadTests[(String, ?)].comonad[Int, Int, Int])
   checkAll("Comonad[(String, ?)]", SerializableTests.serializable(Comonad[(String, ?)]))
 
+  // Note that NonEmptyList has no Monoid, so we can make a FlatMap, but not a Monad
+  checkAll("FlatMap[(NonEmptyList[Int], ?)]", FlatMapTests[(NonEmptyList[Int], ?)].flatMap[String, Long, String])
+  checkAll("FlatMap[(String, ?)] serializable", SerializableTests.serializable(FlatMap[(String, ?)]))
+
+  checkAll("Monad[(String, ?)]", MonadTests[(String, ?)].monad[Int, Int, String])
+  checkAll("Monad[(String, ?)] serializable", SerializableTests.serializable(Monad[(String, ?)]))
+
+  test("Cartesian composition") {
+    val cart = ContravariantCartesian[Eq].composeFunctor[(Int, ?)]
+    val eq = cart.product(Eq[(Int, String)], Eq[(Int, Int)])
+    forAll { (a: (Int, (String, Int)), b: (Int, (String, Int))) =>
+      (a == b) should === (eq.eqv(a, b))
+    }
+  }
+
   test("eqv") {
     val eq = Eq[(Int, Long)]
     forAll { t: (Int, Long) => eq.eqv(t, t) should === (true) }