Merge pull request #1614 from japgolly/store-monad

Add Store monad and State comonad
scalaz · Jan 24, 2018 · f2a4608 · f2a4608
2 parents 289c80f + 6674b08
commit f2a4608
Show file tree

Hide file tree

Showing 4 changed files with 60 additions and 9 deletions.
diff --git a/core/src/main/scala/scalaz/StateT.scala b/core/src/main/scala/scalaz/StateT.scala
@@ -228,6 +228,23 @@ sealed abstract class StateTInstances1 extends StateTInstances2 {
 sealed abstract class StateTInstances0 extends StateTInstances1 {
   implicit def StateMonadTrans[S]: Hoist[λ[(g[_], a) => StateT[g, S, a]]] =
     new StateTHoist[S] {}
+
+  implicit def stateComonad[S](implicit S: Monoid[S]): Comonad[State[S, ?]] =
+    new Comonad[State[S, ?]] {
+      override def copoint[A](fa: State[S, A]): A =
+        fa.eval(S.zero)
+
+      override def cojoin[A](fa: State[S, A]): State[S, State[S, A]] =
+        State[S, State[S, A]](s => (
+          fa.exec(s),
+          State((t: S) => fa.run(S.append(s, t)))))
+
+      override def map[A, B](fa: State[S, A])(f: A => B): State[S, B] =
+        fa map f
+
+      override def cobind[A, B](fa: State[S, A])(f: State[S, A] => B): State[S, B] =
+        cojoin(fa).map(f)
+    }
 }
 
 abstract class StateTInstances extends StateTInstances0 {

diff --git a/core/src/main/scala/scalaz/StoreT.scala b/core/src/main/scala/scalaz/StoreT.scala
@@ -144,6 +144,17 @@ sealed abstract class StoreTInstances0 extends StoreTInstances1 {
 abstract class StoreTInstances extends StoreTInstances0 {
   implicit def storeTCohoist[S]: Cohoist[λ[(ƒ[_], α) => StoreT[ƒ, S, α]]] =
     new StoreTCohoist[S] {}
+
+  implicit def storeMonad[S](implicit S: Monoid[S]): Monad[Store[S, ?]] =
+    new Monad[Store[S, ?]] {
+      override def point[A](a: => A): Store[S, A] =
+        Store[S, A](_ => a, S.zero)
+
+      override def bind[A, B](fa: Store[S, A])(f: A => Store[S, B]): Store[S, B] =
+        Store[S, B](
+          s => f(fa.peek(s)).peek(s),
+          S.append(fa.pos, f(fa.peek(S.zero)).pos))
+    }
 }
 
 private trait IndexedStoreTFunctorLeft[F[_], A0, B0] extends Functor[IndexedStoreT[F, ?, A0, B0]]{

diff --git a/tests/src/test/scala/scalaz/StateTTest.scala b/tests/src/test/scala/scalaz/StateTTest.scala
@@ -1,5 +1,6 @@
 package scalaz
 
+import org.scalacheck.Arbitrary
 import scalaz.Id._
 import scalaz.scalacheck.ScalazProperties._
 import scalaz.scalacheck.ScalazArbitrary._
@@ -11,12 +12,10 @@ object StateTTest extends SpecLite {
   type StateTListInt[A] = StateTList[Int, A]
   type IStateTList[S, A] = IndexedStateT[List, S, Int, A]
 
-  implicit def stateTListEqual = Equal[List[(Int, Int)]].contramap((_: StateTListInt[Int]).runZero[Int])
+  private[this] val stateTestInts = (-10 to 10).toList
 
-  private[this] implicit def stateTEitherEqual: Equal[StateT[Either[Int, ?], Int, Int]] =
-    Equal[List[Either[Int, (Int, Int)]]].contramap{ s: StateT[Either[Int, ?], Int, Int] =>
-      (1 to 10).map(s.run(_)).toList
-    }
+  private[this] implicit def stateTIntEqual[F[_]: Bind](implicit e: Equal[List[F[(Int, Int)]]]): Equal[StateT[F, Int, Int]] =
+    e.contramap((s: StateT[F, Int, Int]) => stateTestInts.map(s.run(_)))
 
   checkAll(equal.laws[StateTListInt[Int]])
   checkAll(bindRec.laws[StateTListInt])
@@ -25,6 +24,14 @@ object StateTTest extends SpecLite {
   checkAll(monadTrans.laws[StateT[?[_], Int, ?], List])
   checkAll(monadError.laws[StateT[Either[Int, ?], Int, ?], Int])
 
+  checkAll {
+    // Not sure why this is needed explicitly
+    val am: Arbitrary[State[Int, Int]]        = implicitly
+    val af: Arbitrary[State[Int, Int] => Int] = implicitly
+    val eq: Equal[State[Int, Int]]            = implicitly
+    comonad.laws[State[Int, ?]](implicitly, am, af, eq)
+  }
+
   object instances {
     def functor[S, F[_] : Applicative] = Functor[StateT[F, S, ?]]
     def plus[F[_]: Monad: Plus, S1, S2] = Plus[IndexedStateT[F, S1, S2, ?]]

diff --git a/tests/src/test/scala/scalaz/StoreTTest.scala b/tests/src/test/scala/scalaz/StoreTTest.scala
@@ -1,19 +1,35 @@
 package scalaz
 
+import org.scalacheck.Arbitrary
 import std.AllInstances._
 import scalaz.scalacheck.ScalazProperties._
 import scalaz.scalacheck.ScalazArbitrary._
 
 object StoreTTest extends SpecLite {
 
-  implicit def storeTuple1IntEqual = new Equal[StoreT[Tuple1, Int, Int]] {
-    def equal(a1: StoreT[Tuple1, Int, Int], a2: StoreT[Tuple1, Int, Int]) = (a1.run, a2.run) match {
-      case ((tf1, x1), (tf2, x2)) => Equal[Int].equal(x1, x2) && Equal[Int].equal(tf1._1(0), tf2._1(0))
+  private[this] val storeTestInts = (-10 to 10).toList
+
+  implicit def storeTIntEqual[F[_]: Comonad]: Equal[StoreT[F, Int, Int]] =
+    new Equal[StoreT[F, Int, Int]] {
+      def equal(a1: StoreT[F, Int, Int], a2: StoreT[F, Int, Int]) =
+        (a1.run, a2.run) match {
+          case ((tf1, x1), (tf2, x2)) =>
+            Equal[Int].equal(x1, x2) && storeTestInts.forall(i =>
+              Equal[Int].equal(Comonad[F].copoint(tf1)(i), Comonad[F].copoint(tf2)(i)))
+        }
     }
-  }
 
   checkAll(comonad.laws[StoreT[Tuple1, Int, ?]])
 
+  checkAll {
+    // Not sure why this is needed explicitly
+    val am: Arbitrary[Store[Int, Int]]        = implicitly
+    val af: Arbitrary[Int => Store[Int, Int]] = implicitly
+    val ag: Arbitrary[Store[Int, Int => Int]] = implicitly
+    val eq: Equal[Store[Int, Int]]            = implicitly
+    monad.laws[Store[Int, ?]](implicitly, am, af, ag, eq)
+  }
+
   object instances {
     type A = Int
     def functor[F[_] : Functor] = Functor[StoreT[F, A, ?]]