contravariant coyoneda (#2150)

* contravariant coyoneda

* fix typos

* lame test

free/src/main/scala/cats/free/ContravariantCoyoneda.scala

@@ -0,0 +1,75 @@
+package cats
+package free
+
+/**
+ * The free contravariant functor on `F`. This is isomorphic to `F` as long as `F` itself is a
+ * contravariant functor. The function from `F[A]` to `ContravariantCoyoneda[F,A]` exists even when
+ * `F` is not a contravariant functor. Implemented using a List of functions for stack-safety.
+ */
+sealed abstract class ContravariantCoyoneda[F[_], A] extends Serializable { self =>
+  import ContravariantCoyoneda.{Aux, unsafeApply}
+
+  /** The pivot between `fi` and `k`, usually existential. */
+  type Pivot
+
+  /** The underlying value. */
+  val fi: F[Pivot]
+
+  /** The list of transformer functions, to be composed and lifted into `F` by `run`. */
+  private[cats] val ks: List[Any => Any]
+
+  /** The composed transformer function, to be lifted into `F` by `run`. */
+  final def k: A => Pivot = Function.chain(ks)(_).asInstanceOf[Pivot]
+
+  /** Converts to `F[A]` given that `F` is a contravariant functor */
+  final def run(implicit F: Contravariant[F]): F[A] = F.contramap(fi)(k)
+
+  /** Converts to `G[A]` given that `G` is a contravariant functor */
+  final def foldMap[G[_]](trans: F ~> G)(implicit G: Contravariant[G]): G[A] =
+    G.contramap(trans(fi))(k)
+
+  /** Simple function composition. Allows contramap fusion without touching the underlying `F`. */
+  final def contramap[B](f: B => A): Aux[F, B, Pivot] =
+    unsafeApply(fi)(f.asInstanceOf[Any => Any] :: ks)
+
+  /** Modify the context `F` using transformation `f`. */
+  final def mapK[G[_]](f: F ~> G): Aux[G, A, Pivot] =
+    unsafeApply(f(fi))(ks)
+
+}
+
+object ContravariantCoyoneda {
+
+  /**
+   * Lift the `Pivot` type member to a parameter. It is usually more convenient to use `Aux` than
+   * a refinment type.
+   */
+  type Aux[F[_], A, B] = ContravariantCoyoneda[F, A] { type Pivot = B }
+
+  /** `F[A]` converts to `ContravariantCoyoneda[F,A]` for any `F` */
+  def lift[F[_], A](fa: F[A]): ContravariantCoyoneda[F, A] =
+    apply(fa)(identity[A])
+
+  /** Like `lift(fa).contramap(k0)`. */
+  def apply[F[_], A, B](fa: F[A])(k0: B => A): Aux[F, B, A] =
+    unsafeApply(fa)(k0.asInstanceOf[Any => Any] :: Nil)
+
+  /**
+   * Creates a `ContravariantCoyoneda[F, A]` for any `F`, taking an `F[A]` and a list of
+   * [[Contravariant.contramap]]ped functions to apply later
+   */
+  private[cats] def unsafeApply[F[_], A, B](fa: F[A])(ks0: List[Any => Any]): Aux[F, B, A] =
+    new ContravariantCoyoneda[F, B] {
+      type Pivot = A
+      val ks = ks0
+      val fi = fa
+    }
+
+  /** `ContravariantCoyoneda[F, ?]` provides a contravariant functor for any `F`. */
+  implicit def catsFreeContravariantFunctorForContravariantCoyoneda[F[_]]: Contravariant[ContravariantCoyoneda[F, ?]] =
+    new Contravariant[ContravariantCoyoneda[F, ?]] {
+      def contramap[A, B](cfa: ContravariantCoyoneda[F, A])(f: B => A): ContravariantCoyoneda[F, B] =
+        cfa.contramap(f)
+    }
+
+}

free/src/test/scala/cats/free/ContravariantCoyonedaSuite.scala

@@ -0,0 +1,73 @@
+package cats
+package free
+
+import cats.arrow.FunctionK
+import cats.tests.CatsSuite
+import cats.laws.discipline.{ ContravariantTests, SerializableTests }
+
+import org.scalacheck.{ Arbitrary }
+
+class ContravariantCoyonedaSuite extends CatsSuite {
+
+  // If we can generate functions we can generate an interesting ContravariantCoyoneda.
+  implicit def contravariantCoyonedaArbitrary[F[_], A, T](
+    implicit F: Arbitrary[A => T]
+  ): Arbitrary[ContravariantCoyoneda[? => T, A]] =
+    Arbitrary(F.arbitrary.map(ContravariantCoyoneda.lift[? => T, A](_)))
+
+  // We can't really test that functions are equal but we can try it with a bunch of test data.
+  implicit def contravariantCoyonedaEq[A: Arbitrary, T](
+    implicit eqft: Eq[T]): Eq[ContravariantCoyoneda[? => T, A]] =
+    new Eq[ContravariantCoyoneda[? => T, A]] {
+      def eqv(cca: ContravariantCoyoneda[? => T, A], ccb: ContravariantCoyoneda[? => T, A]): Boolean =
+        Arbitrary.arbitrary[List[A]].sample.get.forall { a =>
+          eqft.eqv(cca.run.apply(a), ccb.run.apply(a))
+        }
+    }
+
+  // This instance cannot be summoned implicitly. This is not specific to contravariant coyoneda;
+  // it doesn't work for Functor[Coyoneda[? => String, ?]] either.
+  implicit val contravariantContravariantCoyonedaToString: Contravariant[ContravariantCoyoneda[? => String, ?]] =
+    ContravariantCoyoneda.catsFreeContravariantFunctorForContravariantCoyoneda[? => String]
+
+  checkAll("ContravariantCoyoneda[? => String, Int]", ContravariantTests[ContravariantCoyoneda[? => String, ?]].contravariant[Int, Int, Int])
+  checkAll("Contravariant[ContravariantCoyoneda[Option, ?]]", SerializableTests.serializable(Contravariant[ContravariantCoyoneda[Option, ?]]))
+
+  test("mapK and run is same as applying natural trans") {
+    forAll { (b: Boolean) =>
+      val nt = λ[(? => String) ~> (? => Int)](f => s => f(s).length)
+      val o = (b: Boolean) => b.toString
+      val c = ContravariantCoyoneda.lift[? => String, Boolean](o)
+      c.mapK[? => Int](nt).run.apply(b) === nt(o).apply(b)
+    }
+  }
+
+  test("contramap order") {
+    ContravariantCoyoneda
+      .lift[? => Int, String](_.count(_ == 'x'))
+      .contramap((s: String) => s + "x")
+      .contramap((s: String) => s * 3)
+      .run.apply("foo") === 3
+  }
+
+  test("stack-safe contramapmap") {
+    def loop(n: Int, acc: ContravariantCoyoneda[? => Int, Int]): ContravariantCoyoneda[? => Int, Int] =
+      if (n <= 0) acc
+      else loop(n - 1, acc.contramap((_: Int) + 1))
+    loop(20000, ContravariantCoyoneda.lift[? => Int, Int](a => a)).run.apply(10)
+  }
+
+  test("run, foldMap consistent") {
+    forAll { (
+      c: ContravariantCoyoneda[? => Int, String],
+      f: Byte => String,
+      g: Float => Byte,
+      s: Float
+    ) =>
+      val cʹ = c.contramap(f).contramap(g) // just to ensure there's some structure
+      val h  = cʹ.foldMap[? => Int](FunctionK.id[? => Int])
+      cʹ.run.apply(s) === h(s)
+    }
+  }
+
+}