Some rudimentary interaction with state monads.

Author: zrho

bower.json

@@ -22,6 +22,7 @@
     "purescript-maps": "~0.5.2",
     "purescript-profunctor": "~0.3.0",
     "purescript-sets": "~0.5.1",
-    "purescript-unsafe-coerce": "~0.1.0"
+    "purescript-unsafe-coerce": "~0.1.0",
+    "purescript-transformers": "~0.7.1"
   }
 }

src/Data/Lens/Getter.purs

@@ -2,7 +2,7 @@
 
 module Data.Lens.Getter
   ( (^.)
-  , view, to
+  , view, to, use
   , module Data.Lens.Types
   ) where
 
@@ -11,6 +11,7 @@ import Prelude ((<<<))
 import Data.Const (Const(..), getConst)
 import Data.Functor.Contravariant (Contravariant, cmap)
 import Data.Profunctor.Star (Star(..), runStar)
+import Control.Monad.State.Class (MonadState, gets)
 
 import Data.Lens.Types (Getter(), Optic())
 
@@ -27,3 +28,6 @@ view l s = getConst (runStar (l (Star Const)) s)
 -- | Convert a function into a getter.
 to :: forall s a f. (Contravariant f) => (s -> a) -> Optic (Star f) s s a a
 to f p = Star (cmap f <<< runStar p <<< f)
+
+use :: forall s t a b m. (MonadState s m) => Getter s t a b -> m a
+use p = gets (^. p)

src/Data/Lens/Internal/Focusing.purs

@@ -0,0 +1,25 @@
+-- | This module defines the `Focusing` functor
+
+module Data.Lens.Internal.Focusing
+  ( Focusing (..)
+  , runFocusing
+  ) where
+
+import Prelude
+import Data.Monoid (Monoid)
+import Data.Tuple (Tuple ())
+
+-- | The functor used to zoom into `StateT`.
+newtype Focusing m s a = Focusing (m (Tuple s a))
+
+runFocusing :: forall m s a. Focusing m s a -> m (Tuple s a)
+runFocusing (Focusing r) = r
+
+instance focusingFunctor :: (Functor m) => Functor (Focusing m s) where
+  map f (Focusing r) = Focusing (map (map f) r)
+
+instance focusingApply :: (Apply m, Semigroup s) => Apply (Focusing m s) where
+  apply (Focusing rf) (Focusing rx) = Focusing (map (<*>) rf <*> rx)
+
+instance focusingApplicative :: (Applicative m, Monoid s) => Applicative (Focusing m s) where
+  pure = Focusing <<< pure <<< pure

src/Data/Lens/Setter.purs

@@ -2,12 +2,14 @@
 
 module Data.Lens.Setter
   ( (%~), (.~), (+~), (-~), (*~), (//~), (||~), (&&~), (<>~), (++~), (?~)
+  , (.=), (%=), (+=), (*=), (-=), (//=), (||=), (&&=), (<>=), (++=), (?=)
   , over, set
   , module Data.Lens.Types
   ) where
 
 import Prelude
 
+import Control.Monad.State.Class (MonadState, modify)
 import Data.Maybe (Maybe(..))
 
 import Data.Lens.Types (Setter(), SetterP())
@@ -24,6 +26,18 @@ infixr 4 <>~
 infixr 4 ++~
 infixr 4 ?~
 
+infix 4 .=
+infix 4 %=
+infix 4 +=
+infix 4 *=
+infix 4 -=
+infix 4 //=
+infix 4 ||=
+infix 4 &&=
+infix 4 <>=
+infix 4 ++=
+infix 4 ?=
+
 -- | Apply a function to the foci of a `Setter`.
 over :: forall s t a b. Setter s t a b -> (a -> b) -> s -> t
 over l = l
@@ -66,3 +80,48 @@ set l b = over l (const b)
 
 (?~) :: forall s t a b. Setter s t a (Maybe b) -> b -> s -> t
 (?~) p = set p <<< Just
+
+-- Stateful
+
+-- | Set the foci of a `Setter` in a monadic state to a constant value.
+assign :: forall s a b m. (MonadState s m) => Setter s s a b -> b -> m Unit
+assign p b = modify (set p b)
+
+-- | Modify the foci of a `Setter` in a monadic state.
+modifying :: forall s a b m. (MonadState s m) => Setter s s a b -> (a -> b) -> m Unit
+modifying p f = modify (over p f)
+
+-- | Synonym for `assign`
+(.=) :: forall s a b m. (MonadState s m) => Setter s s a b -> b -> m Unit
+(.=) = assign
+
+-- | Synonym for `modifying`
+(%=) :: forall s a b m. (MonadState s m) => Setter s s a b -> (a -> b) -> m Unit
+(%=) = modifying
+
+(+=) :: forall s a m. (MonadState s m, Semiring a) => SetterP s a -> a -> m Unit
+(+=) p = modifying p <<< add
+
+(*=) :: forall s a m. (MonadState s m, Semiring a) => SetterP s a -> a -> m Unit
+(*=) p = modifying p <<< flip mul
+
+(-=) :: forall s a m. (MonadState s m, Ring a) => SetterP s a -> a -> m Unit
+(-=) p = modifying p <<< flip sub
+
+(//=) :: forall s a m. (MonadState s m, DivisionRing a) => SetterP s a -> a -> m Unit
+(//=) p = modifying p <<< flip div
+
+(||=) :: forall s a m. (MonadState s m, BooleanAlgebra a) => SetterP s a -> a -> m Unit
+(||=) p = modifying p <<< flip disj
+
+(&&=) :: forall s a m. (MonadState s m, BooleanAlgebra a) => SetterP s a -> a -> m Unit
+(&&=) p = modifying p <<< flip conj
+
+(<>=) :: forall s a m. (MonadState s m, Semigroup a) => SetterP s a -> a -> m Unit
+(<>=) p = modifying p <<< flip append
+
+(++=) :: forall s a m. (MonadState s m, Semigroup a) => SetterP s a -> a -> m Unit
+(++=) p = modifying p <<< flip append
+
+(?=) :: forall s a b m. (MonadState s m) => Setter s s a (Maybe b) -> b -> m Unit
+(?=) p = assign p <<< Just

src/Data/Lens/Zoom.purs

@@ -0,0 +1,18 @@
+-- | This module defines functions for zooming in a state monad.
+
+module Data.Lens.Zoom
+  ( zoom
+  , module Data.Lens.Types
+  ) where
+
+import Prelude
+
+import Control.Monad.State.Trans (StateT (..), runStateT)
+import Data.Profunctor.Star (Star (..), runStar)
+
+import Data.Lens.Types
+import Data.Lens.Internal.Focusing (Focusing (..), runFocusing)
+
+-- | Zooms into a substate in a `StateT` transformer.
+zoom :: forall a s r m. OpticP (Star (Focusing m r)) s a -> StateT a m r -> StateT s m r
+zoom p ma = StateT $ runFocusing <<< runStar (p $ Star $ Focusing <<< runStateT ma)

test/Main.purs

@@ -5,10 +5,12 @@ import Prelude
 import Data.Maybe
 import Data.Either
 import Data.Lens
+import Data.Lens.Zoom
 import Data.Tuple
 import Data.Traversable (Traversable)
 
 import Control.Monad.Eff.Console
+import Control.Monad.State
 
 foo :: forall a b r. Lens { foo :: a | r } { foo :: b | r } a b
 foo = lens _.foo (_ { foo = _ })
@@ -24,4 +26,10 @@ doc = { foo: Just { bar: [ "Hello", " ", "World" ]} }
 bars :: forall a b. Traversal (Foo a) (Foo b) a b
 bars = foo <<< _Just <<< bar <<< traversed
 
-main = print $ view bars doc
+stateTest :: Tuple Int String
+stateTest = evalState go (Tuple 4 ["Foo", "Bar"]) where
+  go = Tuple <$> zoom _1 get <*> zoom (_2 <<< traversed) get
+
+main = do
+  print $ view bars doc
+  print stateTest