{- | Access helper functions in a Reader-Writer-State monad -}
module Data.Accessor.Monad.Trans.RWS where

import qualified Data.Accessor.Basic as Accessor
import qualified Control.Monad.Trans.RWS as RWS
import qualified Control.Monad.Trans.Class as Trans
import Control.Monad.Trans.RWS (RWS, runRWS, RWST(runRWST), )
import Data.Monoid (Monoid)


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

set :: (Monad m, Monoid w) => Accessor.T s a -> a -> RWST r w s m ()
set :: forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> a -> RWST r w s m ()
set T s a
f a
x = forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
RWS.modify (forall r a. T r a -> a -> r -> r
Accessor.set T s a
f a
x)

get :: (Monad m, Monoid w) => Accessor.T s a -> RWST r w s m a
get :: forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> RWST r w s m a
get T s a
f = forall w (m :: * -> *) s a r.
(Monoid w, Monad m) =>
(s -> a) -> RWST r w s m a
RWS.gets (forall r a. T r a -> r -> a
Accessor.get T s a
f)

modify :: (Monad m, Monoid w) => Accessor.T s a -> (a -> a) -> RWST r w s m ()
modify :: forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> (a -> a) -> RWST r w s m ()
modify T s a
f a -> a
g = forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
RWS.modify (forall r a. T r a -> (a -> a) -> r -> r
Accessor.modify T s a
f a -> a
g)

{- |
Modify a record element and return its old value.
-}
getAndModify :: (Monad m, Monoid w) => Accessor.T s a -> (a -> a) -> RWST r w s m a
getAndModify :: forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> (a -> a) -> RWST r w s m a
getAndModify T s a
f a -> a
g =
   do a
x <- forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> RWST r w s m a
get T s a
f
      forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> (a -> a) -> RWST r w s m ()
modify T s 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 :: (Monad m, Monoid w) => Accessor.T s a -> (a -> a) -> RWST r w s m a
modifyAndGet :: forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> (a -> a) -> RWST r w s m a
modifyAndGet T s a
f a -> a
g =
   do forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> (a -> a) -> RWST r w s m ()
modify T s a
f a -> a
g
      forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> RWST r w s m a
get T s a
f



infix 1 %=, %:

{- |
Infix variant of 'set'.
-}
(%=) :: (Monad m, Monoid w) => Accessor.T s a -> a -> RWST r w s m ()
%= :: forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> a -> RWST r w s m ()
(%=) = forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> a -> RWST r w s m ()
set

{- |
Infix variant of 'modify'.
-}
(%:) :: (Monad m, Monoid w) => Accessor.T s a -> (a -> a) -> RWST r w s m ()
%: :: forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> (a -> a) -> RWST r w s m ()
(%:) = forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> (a -> a) -> RWST r w s m ()
modify



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

lift :: (Monad m, Monoid w) => Accessor.T s1 s0 -> RWS r w s0 a -> RWST r w s1 m a
lift :: forall (m :: * -> *) w s1 s0 r a.
(Monad m, Monoid w) =>
T s1 s0 -> RWS r w s0 a -> RWST r w s1 m a
lift T s1 s0
f RWS r w s0 a
m =
   do r
r <- forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
RWS.ask
      s0
s0 <- forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> RWST r w s m a
get T s1 s0
f
      let (a
a,s0
s1,w
w) = forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS RWS r w s0 a
m r
r s0
s0
      forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> a -> RWST r w s m ()
set T s1 s0
f s0
s1
      forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWS.tell w
w
      forall (m :: * -> *) a. Monad m => a -> m a
return a
a

liftT :: (Monad m, Monoid w) =>
   Accessor.T s1 s0 -> RWST r w s0 m a -> RWST r w s1 m a
liftT :: forall (m :: * -> *) w s1 s0 r a.
(Monad m, Monoid w) =>
T s1 s0 -> RWST r w s0 m a -> RWST r w s1 m a
liftT T s1 s0
f RWST r w s0 m a
m =
   do r
r <- forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
RWS.ask
      s0
s0 <- forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> RWST r w s m a
get T s1 s0
f
      (a
a,s0
s1,w
w) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST r w s0 m a
m r
r s0
s0
      forall (m :: * -> *) w s a r.
(Monad m, Monoid w) =>
T s a -> a -> RWST r w s m ()
set T s1 s0
f s0
s1
      forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWS.tell w
w
      forall (m :: * -> *) a. Monad m => a -> m a
return a
a