module Lens.Family.State.Strict
( focus
, access
, (%=)
, (~=)
, (%%=)
, (+=), (-=), (*=)
, (//=)
, (&&=), (||=)
, Focusing
) where
import Control.Monad (liftM)
import Control.Monad.Trans.State.Strict (StateT(..), get, modify)
import Lens.Family (Getter, Setter, (^.), (^%=))
import Lens.Family.Stock (Lens)
newtype Focusing m c a = Focusing { unFocusing :: m (c, a) }
instance Monad m => Functor (Focusing m c) where
fmap f (Focusing m) = Focusing (liftM (fmap f) m)
focus :: Monad m => Lens (Focusing m c) a b -> StateT b m c -> StateT a m c
focus l m = StateT $ unFocusing . l (Focusing . (runStateT m))
access :: Monad m => Getter a b -> StateT a m b
access l = (^. l) `liftM` get
infix 4 %=
(%=) :: Monad m => Setter a b -> (b -> b) -> StateT a m ()
l %= f = modify (l ^%= f)
infix 4 ~=
(~=) :: Monad m => Setter a b -> b -> StateT a m ()
l ~= v = l %= const v
infix 4 %%=
(%%=) :: Monad m => Lens (Focusing m c) a b -> (b -> (c, b)) -> StateT a m c
l %%= f = focus l (StateT (return . f))
infixr 4 +=, -=, *=
(+=), (-=), (*=) :: (Monad m, Num b) => Setter a b -> b -> StateT a m ()
f += b = f %= (+ b)
f -= b = f %= subtract b
f *= b = f %= (* b)
infixr 4 //=
(//=) :: (Monad m, Fractional b) => Setter a b -> b -> StateT a m ()
f //= b = f %= (/ b)
infixr 4 &&=, ||=
(&&=), (||=) :: Monad m => Setter a Bool -> Bool -> StateT a m ()
f &&= b = f %= (&& b)
f ||= b = f %= (|| b)