Sketch of approach to fix #168

build.sbt

@@ -94,8 +94,8 @@ lazy val docs = project
 lazy val cats = project.in(file("."))
   .settings(moduleName := "cats")
   .settings(catsSettings)
-  .aggregate(macros, core, laws, tests, docs, free, std, bench, state)
-  .dependsOn(macros, core, laws, tests, docs, free, std, bench, state)
+  .aggregate(macros, core, canon, laws, tests, docs, free, std, bench, state)
+  .dependsOn(macros, core, canon, laws, tests, docs, free, std, bench, state)
 
 lazy val macros = project
   .settings(moduleName := "cats-macros")
@@ -108,7 +108,11 @@ lazy val core = project.dependsOn(macros)
     sourceGenerators in Compile <+= (sourceManaged in Compile).map(Boilerplate.gen)
   )
 
-lazy val laws = project.dependsOn(macros, core, free, std)
+lazy val canon = project.dependsOn(macros, core)
+  .settings(moduleName := "cats-canon")
+  .settings(catsSettings)
+
+lazy val laws = project.dependsOn(macros, core, canon, free, std)
   .settings(moduleName := "cats-laws")
   .settings(catsSettings)
   .settings(
@@ -124,7 +128,7 @@ lazy val std = project.dependsOn(macros, core)
     libraryDependencies += "org.spire-math" %% "algebra-std" % "0.2.0-SNAPSHOT"
   )
 
-lazy val tests = project.dependsOn(macros, core, free, std, laws)
+lazy val tests = project.dependsOn(macros, core, canon, free, std, laws)
   .settings(moduleName := "cats-tests")
   .settings(catsSettings)
   .settings(noPublishSettings)

canon/src/main/scala/cats/canon/ApplicativeFromMonad.scala

@@ -0,0 +1,7 @@
+package cats
+package canon
+
+trait ApplicativeFromMonad[F[_]] extends Applicative[F] with FunctorFromApplicative[F] { self: Monad[F] =>
+  def ap[A, B](fa: F[A])(ff: F[A => B]): F[B] =
+    flatMap(ff)(f => flatMap(fa)(a => pure(f(a))))
+}

canon/src/main/scala/cats/canon/FunctorFromApplicative.scala

@@ -0,0 +1,7 @@
+package cats
+package canon
+
+trait FunctorFromApplicative[F[_]] extends Functor[F] { self: Applicative[F] =>
+  def map[A, B](fa: F[A])(f: A => B): F[B] = ap(fa)(pure(f))
+}
+

canon/src/main/scala/cats/canon/package.scala

@@ -0,0 +1,14 @@
+package cats
+
+package object canon {
+  def canonicalApplicative[F[_]](implicit F: Applicative[F]): Applicative[F] =
+    new Applicative[F] with FunctorFromApplicative[F] {
+      override def pure[A](x: A): F[A] = F.pure(x)
+      override def ap[A, B](fa: F[A])(f: F[(A) => B]): F[B] = F.ap(fa)(f)
+    }
+  def canonicalMonad[F[_]](implicit F: Monad[F]): Monad[F] =
+    new Monad[F] with ApplicativeFromMonad[F] {
+      override def pure[A](x: A): F[A] = F.pure(x)
+      override def flatMap[A, B](fa: F[A])(f: A => F[B]): F[B] = F.flatMap(fa)(f)
+    }
+}

core/src/main/scala/cats/Applicative.scala

@@ -20,8 +20,6 @@ import simulacrum._
    */
   def pure[A](x: A): F[A]
 
-  override def map[A, B](fa: F[A])(f: A => B): F[B] = ap(fa)(pure(f))
-
   /**
    * Two sequentially dependent Applicatives can be composed.
    *

core/src/main/scala/cats/FlatMap.scala

@@ -26,9 +26,6 @@ import simulacrum._
   def flatten[A](ffa: F[F[A]]): F[A] =
     flatMap(ffa)(fa => fa)
 
-  override def ap[A, B](fa: F[A])(ff: F[A => B]): F[B] =
-    flatMap(ff)(f => map(fa)(f))
-
   /**
    *  Pair `A` with the result of function application.
    */

core/src/main/scala/cats/Monad.scala

@@ -11,7 +11,4 @@ import simulacrum._
  *
  * Must obey the laws defined in cats.laws.MonadLaws.
  */
-@typeclass trait Monad[F[_]] extends FlatMap[F] with Applicative[F] {
-  override def map[A, B](fa: F[A])(f: A => B): F[B] =
-    flatMap(fa)(a => pure(f(a)))
-}
+@typeclass trait Monad[F[_]] extends FlatMap[F] with Applicative[F]

core/src/main/scala/cats/Traverse.scala

@@ -42,9 +42,6 @@ def traverseU[A, GB](fa: F[A])(f: A => GB)(implicit U: Unapply[Applicative, GB])
   def sequenceU[GA](fga: F[GA])(implicit U: Unapply[Applicative,GA]): U.M[F[U.A]] =
     traverse(fga)(U.subst)(U.TC)
 
-  override def map[A, B](fa: F[A])(f: A => B): F[B] =
-    traverse[Id, A, B](fa)(f)
-
   def traversal[G[_]: Applicative]: Traversal[G] =
     new Traversal[G]
 

core/src/main/scala/cats/data/Cokleisli.scala

@@ -19,6 +19,9 @@ final case class Cokleisli[F[_], A, B](run: F[A] => B) { self =>
   def map[C](f: B => C): Cokleisli[F, A, C] =
     Cokleisli(f compose run)
 
+  def ap[C](f: Cokleisli[F, A, B => C]): Cokleisli[F, A, C] =
+    Cokleisli(fa => f.run(fa)(self.run(fa)))
+
   def contramapValue[C](f: F[C] => F[A]): Cokleisli[F, C,  B] =
     Cokleisli(run compose f)
 
@@ -62,6 +65,8 @@ sealed abstract class CokleisliInstances extends CokleisliInstances0 {
 
     override def map[B, C](fa: Cokleisli[F, A, B])(f: B => C): Cokleisli[F, A, C] =
       fa.map(f)
+
+    override def ap[B, C](fa: Cokleisli[F, A, B])(f: Cokleisli[F, A, B => C]): Cokleisli[F, A, C] = fa.ap(f)
   }
 }
 

core/src/main/scala/cats/data/Const.scala

@@ -50,6 +50,8 @@ sealed abstract class ConstInstances extends ConstInstances0 {
     def traverse[G[_]: Applicative, A, B](fa: Const[C, A])(f: A => G[B]): G[Const[C, B]] =
       fa.traverse(f)
 
+    def map[A, B](fa: Const[C, A])(f: A => B): Const[C, B] = fa.retag[B]
+
     def foldLeft[A, B](fa: Const[C, A], b: B)(f: (B, A) => B): B = b
 
     override def foldRight[A, B](fa: Const[C, A], b: Lazy[B])(f: A => Fold[B]): Lazy[B] = b
@@ -76,6 +78,8 @@ sealed abstract class ConstInstances0 extends ConstInstances1 {
     def pure[A](x: A): Const[C, A] =
       Const.empty
 
+    def map[A, B](fa: Const[C, A])(f: A => B): Const[C, B] = fa.retag[B]
+
     def ap[A, B](fa: Const[C, A])(f: Const[C, A => B]): Const[C, B] =
       fa.retag[B] combine f.retag[B]
   }

core/src/main/scala/cats/data/Ior.scala

@@ -60,6 +60,18 @@ sealed abstract class Ior[+A, +B] extends Product with Serializable {
   final def map[D](f: B => D): A Ior D = bimap(identity, f)
   final def leftMap[C](f: A => C): C Ior B = bimap(f, identity)
 
+  final def ap[AA >: A, D](f: AA Ior (B => D))(implicit AA: Semigroup[AA]): AA Ior D = {
+    (f, this) match {
+      case (Ior.Left(fl), _) => Ior.Left(fl)
+      case (Ior.Right(fr), Ior.Left(l)) => Ior.Left(l)
+      case (Ior.Right(fr), Ior.Right(r)) => Ior.Right(fr(r))
+      case (Ior.Right(fr), Ior.Both(l, r)) => Ior.Both(l, fr(r))
+      case (Ior.Both(fl, fr), Ior.Left(l)) => Ior.Left(AA.combine(fl, l))
+      case (Ior.Both(fl, fr), Ior.Right(r)) => Ior.Both(fl, fr(r))
+      case (Ior.Both(fl, fr), Ior.Both(l, r)) => Ior.Both(AA.combine(fl, l), fr(r))
+    }
+  }
+
   final def flatMap[AA >: A, D](f: B => AA Ior D)(implicit AA: Semigroup[AA]): AA Ior D = this match {
     case l @ Ior.Left(_) => l
     case Ior.Right(b) => f(b)
@@ -137,6 +149,8 @@ sealed abstract class IorInstances extends IorInstances0 {
 
   implicit def iorMonad[A: Semigroup]: Monad[A Ior ?] = new Monad[A Ior ?] {
     def pure[B](b: B): A Ior B = Ior.right(b)
+    def map[B, C](fa: A Ior B)(f: B => C): A Ior C = fa.map(f)
+    def ap[B, C](fa: A Ior B)(f: A Ior (B => C)): A Ior C = fa.ap(f)
     def flatMap[B, C](fa: A Ior B)(f: B => A Ior C): A Ior C = fa.flatMap(f)
   }
 }

core/src/main/scala/cats/data/Kleisli.scala

@@ -24,6 +24,9 @@ final case class Kleisli[F[_], A, B](run: A => F[B]) { self =>
   def mapF[N[_], C](f: F[B] => N[C]): Kleisli[N, A, C] =
     Kleisli(run andThen f)
 
+  def ap[C](f: Kleisli[F, A, B => C])(implicit F: Apply[F]): Kleisli[F, A, C] =
+    Kleisli(a => F.ap(run(a))(f.run(a)))
+
   def flatMap[C](f: B => Kleisli[F, A, C])(implicit F: FlatMap[F]): Kleisli[F, A, C] =
     Kleisli((r: A) => F.flatMap[B, C](run(r))((b: B) => f(b).run(r)))
 
@@ -83,6 +86,12 @@ sealed abstract class KleisliInstances extends KleisliInstances0 {
     def pure[B](x: B): Kleisli[F, A, B] =
       Kleisli.pure[F, A, B](x)
 
+    def map[B, C](fa: Kleisli[F, A, B])(f: B => C): Kleisli[F, A, C] =
+      fa.map(f)
+
+    override def ap[B, C](fa: Kleisli[F, A, B])(f: Kleisli[F, A, B => C]): Kleisli[F, A, C] =
+      fa.ap(f)
+
     def flatMap[B, C](fa: Kleisli[F, A, B])(f: B => Kleisli[F, A, C]): Kleisli[F, A, C] =
       fa.flatMap(f)
   }
@@ -99,6 +108,9 @@ sealed abstract class KleisliInstances0 extends KleisliInstances1 {
     def flatMap[B, C](fa: Kleisli[F, A, B])(f: B => Kleisli[F, A, C]): Kleisli[F, A, C] =
       fa.flatMap(f)
 
+    def ap[B, C](fa: Kleisli[F, A, B])(f: Kleisli[F, A, B => C]): Kleisli[F, A, C] =
+      fa.ap(f)
+
     def map[B, C](fa: Kleisli[F, A, B])(f: B => C): Kleisli[F, A, C] =
       fa.map(f)
   }
@@ -109,6 +121,9 @@ sealed abstract class KleisliInstances1 extends KleisliInstances2 {
     def pure[B](x: B): Kleisli[F, A, B] =
       Kleisli.pure[F, A, B](x)
 
+    def map[B, C](fa: Kleisli[F, A, B])(f: B => C): Kleisli[F, A, C] =
+      fa.map(f)
+
     def ap[B, C](fa: Kleisli[F, A, B])(f: Kleisli[F, A, B => C]): Kleisli[F, A, C] =
       fa(f)
   }

core/src/main/scala/cats/data/OneAnd.scala

@@ -126,6 +126,9 @@ trait OneAndInstances {
       def pure[A](x: A): OneAnd[A, F] =
         OneAnd(x, monad.empty)
 
+      override def ap[A, B](fa: OneAnd[A, F])(f: OneAnd[A => B, F]): OneAnd[B, F] =
+        flatMap(f)(ff => map(fa)(ff))
+
       def flatMap[A, B](fa: OneAnd[A, F])(f: A => OneAnd[B, F]): OneAnd[B, F] = {
         val end = monad.flatMap(fa.tail) { a =>
           val fa = f(a)

core/src/main/scala/cats/data/Xor.scala

@@ -79,6 +79,15 @@ sealed abstract class Xor[+A, +B] extends Product with Serializable {
     case r @ Xor.Right(_) => r
   }
 
+  def ap[AA >: A, D](f: AA Xor (B => D)): AA Xor D = f match {
+    case l @ Xor.Left(_) => l
+    case Xor.Right(ff) =>
+      this match {
+        case l @ Xor.Left(_) => l
+        case Xor.Right(b) => Xor.Right(ff(b))
+      }
+  }
+
   def flatMap[AA >: A, D](f: B => AA Xor D): AA Xor D = this match {
     case l @ Xor.Left(_) => l
     case Xor.Right(b) => f(b)
@@ -153,7 +162,8 @@ sealed abstract class XorInstances extends XorInstances1 {
       def partialFold[B, C](fa: A Xor B)(f: B => Fold[C]): Fold[C] = fa.partialFold(f)
       def flatMap[B, C](fa: A Xor B)(f: B => A Xor C): A Xor C = fa.flatMap(f)
       def pure[B](b: B): A Xor B = Xor.right(b)
-      override def map[B, C](fa: A Xor B)(f: B => C): A Xor C = fa.map(f)
+      def map[B, C](fa: A Xor B)(f: B => C): A Xor C = fa.map(f)
+      def ap[B, C](fa: A Xor B)(f: A Xor (B => C)): A Xor C = fa.ap(f)
     }
 }
 

core/src/main/scala/cats/data/XorT.scala

@@ -39,6 +39,9 @@ case class XorT[F[_], A, B](value: F[A Xor B]) {
   def applyAlt[D](ff: XorT[F, A, B => D])(implicit F: Apply[F]): XorT[F, A, D] =
     XorT[F, A, D](F.map2(this.value, ff.value)((xb, xbd) => Apply[A Xor ?].ap(xb)(xbd)))
 
+  def ap[D](ff: XorT[F, A, B => D])(implicit F: Monad[F]): XorT[F, A, D] =
+    ff.flatMap(f => map(f))
+
   def flatMap[AA >: A, D](f: B => XorT[F, AA, D])(implicit F: Monad[F]): XorT[F, AA, D] =
     XorT(F.flatMap(value) {
       case l @ Xor.Left(_) => F.pure(l)
@@ -156,12 +159,13 @@ private[data] abstract class XorTInstances3 {
 
 private[data] trait XorTFunctor[F[_], L] extends Functor[XorT[F, L, ?]] {
   implicit val F: Functor[F]
-  override def map[A, B](fa: XorT[F, L, A])(f: A => B): XorT[F, L, B] = fa map f
+  def map[A, B](fa: XorT[F, L, A])(f: A => B): XorT[F, L, B] = fa map f
 }
 
 private[data] trait XorTMonad[F[_], L] extends Monad[XorT[F, L, ?]] with XorTFunctor[F, L] {
   implicit val F: Monad[F]
   def pure[A](a: A): XorT[F, L, A] = XorT.pure[F, L, A](a)
+  def ap[A, B](fa: XorT[F, L, A])(f: XorT[F, L, A => B]): XorT[F, L, B] = fa ap f
   def flatMap[A, B](fa: XorT[F, L, A])(f: A => XorT[F, L, B]): XorT[F, L, B] = fa flatMap f
 }
 

free/src/main/scala/cats/free/Free.scala

@@ -54,7 +54,8 @@ object Free {
   implicit def freeMonad[S[_]:Functor]: Monad[Free[S, ?]] =
     new Monad[Free[S, ?]] {
       def pure[A](a: A): Free[S, A] = Pure(a)
-      override def map[A, B](fa: Free[S, A])(f: A => B): Free[S, B] = fa map f
+      def map[A, B](fa: Free[S, A])(f: A => B): Free[S, B] = fa map f
+      def ap[A, B](fa: Free[S, A])(f: Free[S, A => B]): Free[S, B] = fa ap f
       def flatMap[A, B](a: Free[S, A])(f: A => Free[S, B]): Free[S, B] = a flatMap f
     }
 }
@@ -71,6 +72,9 @@ sealed abstract class Free[S[_], A] extends Serializable {
   final def map[B](f: A => B): Free[S, B] =
     flatMap(a => Pure(f(a)))
 
+  final def ap[B](f: Free[S, A => B]): Free[S, B] =
+    f.flatMap(ff => map(ff))
+
   /**
    * Bind the given continuation to the result of this computation.
    * All left-associated binds are reassociated to the right.

free/src/main/scala/cats/free/FreeApplicative.scala

@@ -65,6 +65,7 @@ object FreeApplicative {
   implicit final def freeApplicative[S[_]]: Applicative[FA[S, ?]] = {
     new Applicative[FA[S, ?]] {
       def ap[A, B](fa: FA[S, A])(f: FA[S, A => B]): FA[S, B] = fa.ap(f)
+      override def map[A, B](fa: FA[S, A])(f: A => B): FA[S, B] = fa.map(f)
       def pure[A](a: A): FA[S, A] = Pure(a)
     }
   }

laws/src/main/scala/cats/laws/ApplicativeLaws.scala

@@ -1,6 +1,7 @@
 package cats
 package laws
 
+import cats.canon.canonicalApplicative
 import cats.syntax.apply._
 import cats.syntax.functor._
 
@@ -19,8 +20,11 @@ trait ApplicativeLaws[F[_]] extends ApplyLaws[F] {
   def applicativeInterchange[A, B](a: A, ff: F[A => B]): IsEq[F[B]] =
     F.pure(a).ap(ff) <-> ff.ap(F.pure(f => f(a)))
 
+  // Test that implementation matches the canonical one (except for performance)
   def applicativeMap[A, B](fa: F[A], f: A => B): IsEq[F[B]] =
-    fa.map(f) <-> fa.ap(F.pure(f))
+    fa.map(f) <-> canonicalApplicative[F].map(fa)(f)
+  def applicativeMap2[A, B, C](fa: F[A], fb: F[B], f: (A, B) => C): IsEq[F[C]] =
+    F.map2(fa, fb)(f) <-> canonicalApplicative[F].map2(fa, fb)(f)
 
   /**
    * This law is [[applyComposition]] stated in terms of `pure`. It is a

laws/src/main/scala/cats/laws/MonadLaws.scala

@@ -1,6 +1,7 @@
 package cats
 package laws
 
+import cats.canon.canonicalMonad
 import cats.data.Kleisli
 import cats.syntax.flatMap._
 
@@ -16,6 +17,9 @@ trait MonadLaws[F[_]] extends ApplicativeLaws[F] with FlatMapLaws[F] {
   def monadRightIdentity[A](fa: F[A]): IsEq[F[A]] =
     fa.flatMap(F.pure) <-> fa
 
+  def monadAp[A, B](fa: F[A], ff: F[A => B]): IsEq[F[B]] =
+    F.ap(fa)(ff) <-> canonicalMonad[F].ap(fa)(ff)
+
   /**
    * `pure` is the left identity element under left-to-right composition of
    * [[cats.data.Kleisli]] arrows. This is analogous to [[monadLeftIdentity]].

laws/src/main/scala/cats/laws/TraverseLaws.scala

@@ -3,6 +3,7 @@ package laws
 
 import cats.Id
 import cats.arrow.Compose
+import cats.canon.FunctorFromApplicative
 import cats.syntax.functor._
 import cats.syntax.traverse._
 
@@ -37,8 +38,9 @@ trait TraverseLaws[F[_]] extends FunctorLaws[F] with FoldableLaws[F] {
     M: Applicative[M]
   ): IsEq[(M[F[B]], N[F[B]])] = {
     type MN[Z] = (M[Z], N[Z])
-    implicit val MN = new Applicative[MN] {
+    implicit val MN = new Applicative[MN] with FunctorFromApplicative[MN] {
       override def pure[X](x: X): MN[X] = (M.pure(x), N.pure(x))
+
       override def ap[X, Y](fa: MN[X])(f: MN[X => Y]): MN[Y] = {
         val (fam, fan) = fa
         val (fm, fn) = f

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

@@ -16,6 +16,7 @@ trait ApplicativeTests[F[_]] extends ApplyTests[F] {
     EqFC: Eq[F[C]]
   ): RuleSet = {
     implicit def ArbFA: Arbitrary[F[A]] = ArbF.synthesize[A]
+    implicit def ARBFB: Arbitrary[F[B]] = ArbF.synthesize[B]
     implicit def ArbFAB: Arbitrary[F[A => B]] = ArbF.synthesize[A => B]
 
     new DefaultRuleSet(
@@ -24,7 +25,8 @@ trait ApplicativeTests[F[_]] extends ApplyTests[F] {
       "applicative identity" -> forAll(laws.applicativeIdentity[A] _),
       "applicative homomorphism" -> forAll(laws.applicativeHomomorphism[A, B] _),
       "applicative interchange" -> forAll(laws.applicativeInterchange[A, B] _),
-      "applicative map" -> forAll(laws.applicativeMap[A, B] _))
+      "applicative map" -> forAll(laws.applicativeMap[A, B] _),
+      "applicative map2" -> forAll(laws.applicativeMap2[A, B, C] _))
   }
 }
 

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

@@ -17,14 +17,16 @@ trait MonadTests[F[_]] extends ApplicativeTests[F] with FlatMapTests[F] {
   ): RuleSet = {
     implicit def ArbFA: Arbitrary[F[A]] = ArbF.synthesize[A]
     implicit def ArbFB: Arbitrary[F[B]] = ArbF.synthesize[B]
+    implicit def ArbFAB: Arbitrary[F[A => B]] = ArbF.synthesize[A => B]
 
     new RuleSet {
       def name: String = "monad"
       def bases: Seq[(String, RuleSet)] = Nil
       def parents: Seq[RuleSet] = Seq(applicative[A, B, C], flatMap[A, B, C])
       def props: Seq[(String, Prop)] = Seq(
         "monad left identity" -> forAll(laws.monadLeftIdentity[A, B] _),
-        "monad right identity" -> forAll(laws.monadRightIdentity[A] _)
+        "monad right identity" -> forAll(laws.monadRightIdentity[A] _),
+        "monad ap" -> forAll(laws.monadAp[A,B] _)
       )
     }
   }