{- | Access helper functions in State and Reader monads -}
module Data.Accessor.MonadLib 
  (-- * accessors in the form of actions in the state monad
  set, get, modify
  ,getAndModify, modifyAndGet 
  ,(%=), (%:)
  -- * lift a state monadic accessor to an accessor of a parent record
  ,lift, liftT
  -- * accessors in the form of actions in the reader monad
  ,ask
  -- * lift a reader monadic accessor to an accessor of a parent record
  ,focusingOn, focusingOnT
  ) where

import qualified MonadLib
import qualified MonadLib.Monads as Monads
import Control.Monad

import qualified Data.Accessor.Basic as Accessor

monadLibModify f = MonadLib.get >>= MonadLib.set . f

set :: MonadLib.StateM m r => Accessor.T r a -> a -> m ()
set f x = monadLibModify (Accessor.set f x)

get :: MonadLib.StateM m r => Accessor.T r a -> m a
get f = (Accessor.get f) `liftM` MonadLib.get

modify :: MonadLib.StateM m r => Accessor.T r a -> (a -> a) -> m ()
modify f g = monadLibModify (Accessor.modify f g)

{- |
Modify a record element and return its old value.
-}
getAndModify :: MonadLib.StateM m r => Accessor.T r 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 :: MonadLib.StateM m r => Accessor.T r a -> (a -> a) -> m a
modifyAndGet f g =
   do modify f g
      get f

infix 1 %=, %:

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

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

lift :: MonadLib.StateM m r => Accessor.T r s -> Monads.State s a -> m a
lift f m =
   do s0 <- get f
      let (a,s1) = Monads.runState s0 m
      set f s1
      return a

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

ask :: MonadLib.ReaderM m r => Accessor.T r a -> m a
ask f = (Accessor.get f) `liftM` MonadLib.ask

focusingOn :: MonadLib.ReaderM m r => Accessor.T r s -> Monads.Reader s a -> m a
focusingOn f m =
   do s <- ask f
      return $ Monads.runReader s m


focusingOnT :: (Monad m ) =>
  Accessor.T r s -> MonadLib.ReaderT s m a -> MonadLib.ReaderT r m a
focusingOnT f m =
   do s <- ask f
      MonadLib.lift $ Monads.runReaderT s m