Monad writer, fixes #889

core/src/main/scala/cats/MonadWriter.scala

@@ -0,0 +1,28 @@
+package cats
+
+/** A monad that support monoidal accumulation (e.g. logging List[String]) */
+trait MonadWriter[F[_], W] extends Monad[F] {
+  /** Lift a writer action into the effect */
+  def writer[A](aw: (W, A)): F[A]
+
+  /** Run the effect and pair the accumulator with the result */
+  def listen[A](fa: F[A]): F[(W, A)]
+
+  /** Apply the effectful function to the accumulator */
+  def pass[A](fa: F[(W => W, A)]): F[A]
+
+  /** Lift the log into the effect */
+  def tell(w: W): F[Unit] = writer((w, ()))
+
+  /** Pair the value with an inspection of the accumulator */
+  def listens[A, B](fa: F[A])(f: W => B): F[(B, A)] =
+    map(listen(fa)) { case (w, a) => (f(w), a) }
+
+  /** Modify the accumulator */
+  def censor[A](fa: F[A])(f: W => W): F[A] =
+    flatMap(listen(fa)) { case (w, a) => writer((f(w), a)) }
+}
+
+object MonadWriter {
+  def apply[F[_], W](implicit F: MonadWriter[F, W]): MonadWriter[F, W] = F
+}

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

@@ -48,9 +48,8 @@ final case class WriterT[F[_], L, V](run: F[(L, V)]) {
 object WriterT extends WriterTInstances with WriterTFunctions
 
 private[data] sealed abstract class WriterTInstances extends WriterTInstances0 {
-
   implicit def writerTIdMonad[L:Monoid]: Monad[WriterT[Id, L, ?]] =
-    writerTMonad[Id, L]
+    writerTMonadWriter[Id, L]
 
   // The Eq[(L, V)] can be derived from an Eq[L] and Eq[V], but we are waiting
   // on an algebra release that includes https://github.com/non/algebra/pull/82
@@ -95,8 +94,8 @@ private[data] sealed abstract class WriterTInstances1 extends WriterTInstances2
     }
 }
 private[data] sealed abstract class WriterTInstances2 extends WriterTInstances3 {
-  implicit def writerTMonad[F[_], L](implicit F: Monad[F], L: Monoid[L]): Monad[WriterT[F, L, ?]] =
-    new WriterTMonad[F, L] {
+  implicit def writerTMonadWriter[F[_], L](implicit F: Monad[F], L: Monoid[L]): MonadWriter[WriterT[F, L, ?], L] =
+    new WriterTMonadWriter[F, L] {
       implicit val F0: Monad[F] = F
       implicit val L0: Monoid[L] = L
     }
@@ -191,6 +190,17 @@ private[data] sealed trait WriterTMonad[F[_], L] extends WriterTApplicative[F, L
     fa.flatMap(f)
 }
 
+private[data] sealed trait WriterTMonadWriter[F[_], L] extends MonadWriter[WriterT[F, L, ?], L] with WriterTMonad[F, L] {
+  def writer[A](aw: (L, A)): WriterT[F, L, A] =
+    WriterT.put(aw._2)(aw._1)
+
+  def listen[A](fa: WriterT[F, L, A]): WriterT[F, L, (L, A)] =
+    WriterT(F0.flatMap(fa.value)(a => F0.map(fa.written)(l => (l, (l, a)))))
+
+  def pass[A](fa: WriterT[F, L, (L => L, A)]): WriterT[F, L, A] =
+    WriterT(F0.flatMap(fa.value) { case (f, a) => F0.map(fa.written)(l => (f(l), a)) })
+}
+
 private[data] sealed trait WriterTSemigroupK[F[_], L] extends SemigroupK[WriterT[F, L, ?]] {
   implicit def F0: SemigroupK[F]
 

laws/src/main/scala/cats/laws/MonadWriterLaws.scala

@@ -0,0 +1,23 @@
+package cats
+package laws
+
+trait MonadWriterLaws[F[_], W] extends MonadLaws[F] {
+  implicit override def F: MonadWriter[F, W]
+
+  def monadWriterWriterPure[A](a: A)(implicit W: Monoid[W]): IsEq[F[A]] =
+    F.writer((W.empty, a)) <-> F.pure(a)
+
+  def monadWriterTellFusion(x: W, y: W)(implicit W: Monoid[W]): IsEq[F[Unit]] =
+    F.flatMap(F.tell(x))(_ => F.tell(y)) <-> F.tell(W.combine(x, y))
+
+  def monadWriterListenPure[A](a: A)(implicit W: Monoid[W]): IsEq[F[(W, A)]] =
+    F.listen(F.pure(a)) <-> F.pure((W.empty, a))
+
+  def monadWriterListenWriter[A](aw: (W, A)): IsEq[F[(W, A)]] =
+    F.listen(F.writer(aw)) <-> F.map(F.tell(aw._1))(_ => aw)
+}
+
+object MonadWriterLaws {
+  def apply[F[_], W](implicit FW: MonadWriter[F, W]): MonadWriterLaws[F, W] =
+    new MonadWriterLaws[F, W] { def F: MonadWriter[F, W] = FW }
+}

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

@@ -0,0 +1,46 @@
+package cats
+package laws
+package discipline
+
+import cats.laws.discipline.CartesianTests.Isomorphisms
+import org.scalacheck.Arbitrary
+import org.scalacheck.Prop.forAll
+
+trait MonadWriterTests[F[_], W] extends MonadTests[F] {
+  def laws: MonadWriterLaws[F, W]
+
+  def monadWriter[A: Arbitrary: Eq, B: Arbitrary: Eq, C: Arbitrary: Eq](implicit
+    ArbFA: Arbitrary[F[A]],
+    ArbFB: Arbitrary[F[B]],
+    ArbFC: Arbitrary[F[C]],
+    ArbFAtoB: Arbitrary[F[A => B]],
+    ArbFBtoC: Arbitrary[F[B => C]],
+    EqFA: Eq[F[A]],
+    EqFAW: Eq[F[(W, A)]],
+    EqFB: Eq[F[B]],
+    EqFC: Eq[F[C]],
+    EqFU: Eq[F[Unit]],
+    EqFABC: Eq[F[(A, B, C)]],
+    WA: Arbitrary[W],
+    WM: Monoid[W],
+    iso: Isomorphisms[F]
+  ): RuleSet =
+    new RuleSet {
+      def name = "monadWriter"
+      def bases = Nil
+      def parents = Seq(monad[A, B, C])
+      def props = Seq(
+        "monadWriter writer pure" -> forAll(laws.monadWriterWriterPure[A] _),
+        "monadWriter tell fusion" -> forAll(laws.monadWriterTellFusion _),
+        "monadWriter listen pure" -> forAll(laws.monadWriterListenPure[A] _),
+        "monadWriter listen writer" -> forAll(laws.monadWriterListenWriter[A] _)
+      )
+    }
+}
+
+object MonadWriterTests {
+  def apply[F[_], W](implicit FW: MonadWriter[F, W]): MonadWriterTests[F, W] =
+    new MonadWriterTests[F, W] {
+      def laws: MonadWriterLaws[F, W] = MonadWriterLaws[F, W]
+    }
+}

tests/src/test/scala/cats/tests/WriterTTests.scala

@@ -178,8 +178,8 @@ class WriterTTests extends CatsSuite {
     Apply[WriterT[ListWrapper, ListWrapper[Int], ?]]
     Applicative[WriterT[ListWrapper, ListWrapper[Int], ?]]
     FlatMap[WriterT[ListWrapper, ListWrapper[Int], ?]]
-    checkAll("WriterT[ListWrapper, ListWrapper[Int], ?]", MonadTests[WriterT[ListWrapper, ListWrapper[Int], ?]].monad[Int, Int, Int])
-    checkAll("Monad[WriterT[ListWrapper, ListWrapper[Int], ?]]", SerializableTests.serializable(Monad[WriterT[ListWrapper, ListWrapper[Int], ?]]))
+    checkAll("WriterT[ListWrapper, ListWrapper[Int], ?]", MonadWriterTests[WriterT[ListWrapper, ListWrapper[Int], ?], ListWrapper[Int]].monadWriter[Int, Int, Int])
+    checkAll("MonadWriter[WriterT[ListWrapper, ListWrapper[Int], ?], List[String]]", SerializableTests.serializable(MonadWriter[WriterT[ListWrapper, ListWrapper[Int], ?], ListWrapper[Int]]))
 
     Functor[WriterT[Id, ListWrapper[Int], ?]]
     Apply[WriterT[Id, ListWrapper[Int], ?]]