{- | 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 (MonadTrans)
import qualified Control.Monad.Trans 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
-}