module Control.Monad.Trans.RWSIO (
    -- * Synopsis
    -- | An implementation of the reader/writer/state monad transformer
    -- using an 'IORef'.

    -- * Documentation
    RWSIOT(..), Tuple(..), rwsT, runRWSIOT, tell, ask, get, put,
    ) where

import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.IORef

{-----------------------------------------------------------------------------
    Type and class instances
------------------------------------------------------------------------------}
data Tuple r w s = Tuple !r !(IORef w) !(IORef s)

newtype RWSIOT r w s m a = R { forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run :: Tuple r w s -> m a }

instance Functor m => Functor (RWSIOT r w s m) where fmap :: forall a b. (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
fmap = forall (m :: * -> *) a b r w s.
Functor m =>
(a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
fmapR

instance Applicative m => Applicative (RWSIOT r w s m) where
    pure :: forall a. a -> RWSIOT r w s m a
pure  = forall (m :: * -> *) a r w s.
Applicative m =>
a -> RWSIOT r w s m a
pureR
    <*> :: forall a b.
RWSIOT r w s m (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
(<*>) = forall (m :: * -> *) r w s a b.
Applicative m =>
RWSIOT r w s m (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
apR

instance Monad m => Monad (RWSIOT r w s m) where
    >>= :: forall a b.
RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m b
(>>=)  = forall (m :: * -> *) r w s a b.
Monad m =>
RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m b
bindR

instance MonadFix m => MonadFix (RWSIOT r w s m) where mfix :: forall a. (a -> RWSIOT r w s m a) -> RWSIOT r w s m a
mfix = forall (m :: * -> *) a r w s.
MonadFix m =>
(a -> RWSIOT r w s m a) -> RWSIOT r w s m a
mfixR
instance MonadIO m => MonadIO (RWSIOT r w s m)   where liftIO :: forall a. IO a -> RWSIOT r w s m a
liftIO = forall (m :: * -> *) a r w s. MonadIO m => IO a -> RWSIOT r w s m a
liftIOR
instance MonadTrans (RWSIOT r w s)               where lift :: forall (m :: * -> *) a. Monad m => m a -> RWSIOT r w s m a
lift = forall (m :: * -> *) a r w s. m a -> RWSIOT r w s m a
liftR

{-----------------------------------------------------------------------------
    Functions
------------------------------------------------------------------------------}
liftIOR :: MonadIO m => IO a -> RWSIOT r w s m a
liftIOR :: forall (m :: * -> *) a r w s. MonadIO m => IO a -> RWSIOT r w s m a
liftIOR IO a
m = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \Tuple r w s
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m

liftR :: m a -> RWSIOT r w s m a
liftR :: forall (m :: * -> *) a r w s. m a -> RWSIOT r w s m a
liftR   m a
m = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \Tuple r w s
_ -> m a
m

fmapR :: Functor m => (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
fmapR :: forall (m :: * -> *) a b r w s.
Functor m =>
(a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
fmapR a -> b
f RWSIOT r w s m a
m = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run RWSIOT r w s m a
m Tuple r w s
x)

bindR :: Monad m => RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m b
bindR :: forall (m :: * -> *) r w s a b.
Monad m =>
RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m b
bindR RWSIOT r w s m a
m a -> RWSIOT r w s m b
k = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run RWSIOT r w s m a
m Tuple r w s
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run (a -> RWSIOT r w s m b
k a
a) Tuple r w s
x

mfixR :: MonadFix m => (a -> RWSIOT r w s m a) -> RWSIOT r w s m a
mfixR :: forall (m :: * -> *) a r w s.
MonadFix m =>
(a -> RWSIOT r w s m a) -> RWSIOT r w s m a
mfixR a -> RWSIOT r w s m a
f   = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\a
a -> forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run (a -> RWSIOT r w s m a
f a
a) Tuple r w s
x)

pureR :: Applicative m => a -> RWSIOT r w s m a
pureR :: forall (m :: * -> *) a r w s.
Applicative m =>
a -> RWSIOT r w s m a
pureR a
a   = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \Tuple r w s
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

apR :: Applicative m => RWSIOT r w s m (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
apR :: forall (m :: * -> *) r w s a b.
Applicative m =>
RWSIOT r w s m (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
apR RWSIOT r w s m (a -> b)
f RWSIOT r w s m a
a   = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run RWSIOT r w s m (a -> b)
f Tuple r w s
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run RWSIOT r w s m a
a Tuple r w s
x

rwsT :: (MonadIO m, Monoid w) => (r -> s -> IO (a, s, w)) -> RWSIOT r w s m a
rwsT :: forall (m :: * -> *) w r s a.
(MonadIO m, Monoid w) =>
(r -> s -> IO (a, s, w)) -> RWSIOT r w s m a
rwsT r -> s -> IO (a, s, w)
f = do
    r
r <- forall (m :: * -> *) r w s. Monad m => RWSIOT r w s m r
ask
    s
s <- forall (m :: * -> *) r w s. MonadIO m => RWSIOT r w s m s
get
    (a
a,s
s,w
w) <- forall (m :: * -> *) a r w s. MonadIO m => IO a -> RWSIOT r w s m a
liftIOR forall a b. (a -> b) -> a -> b
$ r -> s -> IO (a, s, w)
f r
r s
s
    forall (m :: * -> *) s r w. MonadIO m => s -> RWSIOT r w s m ()
put  s
s
    forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
tell w
w
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a

runRWSIOT :: (MonadIO m, Monoid w) => RWSIOT r w s m a -> (r -> s -> m (a,s,w))
runRWSIOT :: forall (m :: * -> *) w r s a.
(MonadIO m, Monoid w) =>
RWSIOT r w s m a -> r -> s -> m (a, s, w)
runRWSIOT RWSIOT r w s m a
m r
r s
s = do
    IORef w
w' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
    IORef s
s' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef s
s
    a
a  <- forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
run RWSIOT r w s m a
m (forall r w s. r -> IORef w -> IORef s -> Tuple r w s
Tuple r
r IORef w
w' IORef s
s')
    s
s  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef s
s'
    w
w  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef w
w'
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,s
s,w
w)

tell :: (MonadIO m, Monoid w) => w -> RWSIOT r w s m ()
tell :: forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
tell w
w = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \(Tuple r
_ IORef w
w' IORef s
_) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef w
w' (forall a. Monoid a => a -> a -> a
`mappend` w
w)

ask :: Monad m => RWSIOT r w s m r
ask :: forall (m :: * -> *) r w s. Monad m => RWSIOT r w s m r
ask = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \(Tuple r
r IORef w
_ IORef s
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return r
r

get :: MonadIO m => RWSIOT r w s m s
get :: forall (m :: * -> *) r w s. MonadIO m => RWSIOT r w s m s
get = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \(Tuple r
_ IORef w
_ IORef s
s') -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef s
s'

put :: MonadIO m => s -> RWSIOT r w s m ()
put :: forall (m :: * -> *) s r w. MonadIO m => s -> RWSIOT r w s m ()
put s
s = forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R forall a b. (a -> b) -> a -> b
$ \(Tuple r
_ IORef w
_ IORef s
s') -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef s
s' s
s