data-accessor-monads-tf-0.2.1.1: src/Data/Accessor/Monad/TF/State.hs

{- | Access helper functions in the State monad type family -}
module Data.Accessor.Monad.TF.State where

import qualified Control.Monad.State as State
import Control.Monad.State (MonadState, StateType)
import Control.Monad.Trans.Class (MonadTrans, )
import qualified Control.Monad.Trans.Class as Trans
import Control.Monad.Trans.State (State, runState, StateT, runStateT)
import qualified Data.Accessor.Basic as Accessor

-- * accessors in the form of actions in the state monad

set :: MonadState m => Accessor.T (StateType m) a -> a -> m ()
set f x = State.modify (Accessor.set f x)

get :: MonadState m => Accessor.T (StateType m) a -> m a
get f = State.gets (Accessor.get f)

modify :: MonadState m => Accessor.T (StateType m) a -> (a -> a) -> m ()
modify f g = State.modify (Accessor.modify f g)

{- |
Modify a record element and return its old value.
-}
getAndModify :: MonadState m => Accessor.T (StateType m) a -> (a -> a) -> m a
getAndModify f g =
   do x <- get f
      modify f g
      return x

{- |
Modify a record element and return its new value.
-}
modifyAndGet :: MonadState m => Accessor.T (StateType m) a -> (a -> a) -> m a
modifyAndGet f g =
   do modify f g
      get f



infix 1 %=, %:

{- |
Infix variant of 'set'.
-}
(%=) :: MonadState m => Accessor.T (StateType m) a -> a -> m ()
(%=) = set

{- |
Infix variant of 'modify'.
-}
(%:) :: MonadState m => Accessor.T (StateType m) a -> (a -> a) -> m ()
(%:) = modify



-- * lift a state monadic accessor to an accessor of a parent record

lift :: (MonadState mr) =>
   Accessor.T (StateType mr) s -> State s a -> mr a
lift f m =
   do s0 <- get f
      let (a,s1) = runState m s0
      set f s1
      return a

-- liftT :: (Monad m) =>
--    Accessor.T r s -> StateT s m a -> StateT r m a
liftT :: (Monad m, MonadTrans t, MonadState (t m)) =>
   Accessor.T (StateType (t m)) s -> StateT s m a -> t m a
liftT f m =
   do s0 <- get f
      (a,s1) <- Trans.lift $ runStateT m s0
      set f s1
      return a

{- not possible in this generality
lift :: (MonadState r mr, MonadState s ms) =>
   Accessor.T r s -> ms a -> mr a
-}