{- | Access helper functions in the State monad class -}
module Data.Accessor.Monad.MTL.State where

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

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

set :: MonadState r m => Accessor.T r a -> a -> m ()
set :: forall r (m :: * -> *) a. MonadState r m => T r a -> a -> m ()
set T r a
f a
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall r a. T r a -> a -> r -> r
Accessor.set T r a
f a
x)

get :: MonadState r m => Accessor.T r a -> m a
get :: forall r (m :: * -> *) a. MonadState r m => T r a -> m a
get T r a
f = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (forall r a. T r a -> r -> a
Accessor.get T r a
f)

modify :: MonadState r m => Accessor.T r a -> (a -> a) -> m ()
modify :: forall r (m :: * -> *) a.
MonadState r m =>
T r a -> (a -> a) -> m ()
modify T r a
f a -> a
g = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall r a. T r a -> (a -> a) -> r -> r
Accessor.modify T r a
f a -> a
g)

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

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



infix 1 %=, %:

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

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



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

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

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

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