diff --git a/core/src/main/scala/cats/MonadWriter.scala b/core/src/main/scala/cats/MonadWriter.scala new file mode 100644 index 0000000000..5481e4cb96 --- /dev/null +++ b/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 +} diff --git a/core/src/main/scala/cats/data/WriterT.scala b/core/src/main/scala/cats/data/WriterT.scala index 515d63f5a5..8f91f27159 100644 --- a/core/src/main/scala/cats/data/WriterT.scala +++ b/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] diff --git a/laws/src/main/scala/cats/laws/MonadWriterLaws.scala b/laws/src/main/scala/cats/laws/MonadWriterLaws.scala new file mode 100644 index 0000000000..07c55eb656 --- /dev/null +++ b/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 } +} diff --git a/laws/src/main/scala/cats/laws/discipline/MonadWriterTests.scala b/laws/src/main/scala/cats/laws/discipline/MonadWriterTests.scala new file mode 100644 index 0000000000..e3f92eb563 --- /dev/null +++ b/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] + } +} diff --git a/tests/src/test/scala/cats/tests/WriterTTests.scala b/tests/src/test/scala/cats/tests/WriterTTests.scala index 7d8e874f9b..60ef44d7fb 100644 --- a/tests/src/test/scala/cats/tests/WriterTTests.scala +++ b/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], ?]]