module Control.Monad.Trans.RWSIO (
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
data Tuple r w s = Tuple !r !(IORef w) !(IORef s)
newtype RWSIOT r w s m a = R { 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 :: (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
fmap = (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
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 :: a -> RWSIOT r w s m a
pure = a -> RWSIOT r w s m a
forall (m :: * -> *) a r w s.
Applicative m =>
a -> RWSIOT r w s m a
pureR
<*> :: RWSIOT r w s m (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m 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
return :: a -> RWSIOT r w s m a
return = a -> RWSIOT r w s m a
forall (m :: * -> *) a r w s. Monad m => a -> RWSIOT r w s m a
returnR
>>= :: RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m 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 :: (a -> RWSIOT r w s m a) -> RWSIOT r w s m a
mfix = (a -> RWSIOT r w s m a) -> RWSIOT r w s m a
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 :: IO a -> RWSIOT r w s m a
liftIO = IO a -> RWSIOT r w s m a
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 :: m a -> RWSIOT r w s m a
lift = m a -> RWSIOT r w s m a
forall (m :: * -> *) a r w s. m a -> RWSIOT r w s m a
liftR
liftIOR :: MonadIO m => IO a -> RWSIOT r w s m a
liftIOR :: IO a -> RWSIOT r w s m a
liftIOR IO a
m = (Tuple r w s -> m a) -> RWSIOT r w s m a
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m a) -> RWSIOT r w s m a)
-> (Tuple r w s -> m a) -> RWSIOT r w s m a
forall a b. (a -> b) -> a -> b
$ \Tuple r w s
_ -> IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
liftR :: m a -> RWSIOT r w s m a
liftR :: m a -> RWSIOT r w s m a
liftR m a
m = (Tuple r w s -> m a) -> RWSIOT r w s m a
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m a) -> RWSIOT r w s m a)
-> (Tuple r w s -> m a) -> RWSIOT r w s m a
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 :: (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 = (Tuple r w s -> m b) -> RWSIOT r w s m b
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m b) -> RWSIOT r w s m b)
-> (Tuple r w s -> m b) -> RWSIOT r w s m b
forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (RWSIOT r w s m a -> Tuple r w s -> m 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 Tuple r w s
x)
returnR :: Monad m => a -> RWSIOT r w s m a
returnR :: a -> RWSIOT r w s m a
returnR a
a = (Tuple r w s -> m a) -> RWSIOT r w s m a
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m a) -> RWSIOT r w s m a)
-> (Tuple r w s -> m a) -> RWSIOT r w s m a
forall a b. (a -> b) -> a -> b
$ \Tuple r w s
_ -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
bindR :: 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 -> (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 = (Tuple r w s -> m b) -> RWSIOT r w s m b
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m b) -> RWSIOT r w s m b)
-> (Tuple r w s -> m b) -> RWSIOT r w s m b
forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> RWSIOT r w s m a -> Tuple r w s -> m 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 Tuple r w s
x m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> RWSIOT r w s m b -> Tuple r w s -> m b
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 :: (a -> RWSIOT r w s m a) -> RWSIOT r w s m a
mfixR a -> RWSIOT r w s m a
f = (Tuple r w s -> m a) -> RWSIOT r w s m a
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m a) -> RWSIOT r w s m a)
-> (Tuple r w s -> m a) -> RWSIOT r w s m a
forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\a
a -> RWSIOT r w s m a -> Tuple r w s -> m 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 :: a -> RWSIOT r w s m a
pureR a
a = (Tuple r w s -> m a) -> RWSIOT r w s m a
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m a) -> RWSIOT r w s m a)
-> (Tuple r w s -> m a) -> RWSIOT r w s m a
forall a b. (a -> b) -> a -> b
$ \Tuple r w s
_ -> a -> m a
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 :: 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 = (Tuple r w s -> m b) -> RWSIOT r w s m b
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m b) -> RWSIOT r w s m b)
-> (Tuple r w s -> m b) -> RWSIOT r w s m b
forall a b. (a -> b) -> a -> b
$ \Tuple r w s
x -> RWSIOT r w s m (a -> b) -> Tuple r w s -> m (a -> 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 -> b)
f Tuple r w s
x m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RWSIOT r w s m a -> Tuple r w s -> m 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
a Tuple r w s
x
rwsT :: (MonadIO m, Monoid w) => (r -> s -> IO (a, s, w)) -> RWSIOT r w s m a
rwsT :: (r -> s -> IO (a, s, w)) -> RWSIOT r w s m a
rwsT r -> s -> IO (a, s, w)
f = do
r
r <- RWSIOT r w s m r
forall (m :: * -> *) r w s. Monad m => RWSIOT r w s m r
ask
s
s <- RWSIOT r w s m s
forall (m :: * -> *) r w s. MonadIO m => RWSIOT r w s m s
get
(a
a,s
s,w
w) <- IO (a, s, w) -> RWSIOT r w s m (a, s, w)
forall (m :: * -> *) a r w s. MonadIO m => IO a -> RWSIOT r w s m a
liftIOR (IO (a, s, w) -> RWSIOT r w s m (a, s, w))
-> IO (a, s, w) -> RWSIOT r w s m (a, s, w)
forall a b. (a -> b) -> a -> b
$ r -> s -> IO (a, s, w)
f r
r s
s
s -> RWSIOT r w s m ()
forall (m :: * -> *) s r w. MonadIO m => s -> RWSIOT r w s m ()
put s
s
w -> RWSIOT r w s m ()
forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
tell w
w
a -> RWSIOT r w s m a
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 :: 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' <- IO (IORef w) -> m (IORef w)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef w) -> m (IORef w)) -> IO (IORef w) -> m (IORef w)
forall a b. (a -> b) -> a -> b
$ w -> IO (IORef w)
forall a. a -> IO (IORef a)
newIORef w
forall a. Monoid a => a
mempty
IORef s
s' <- IO (IORef s) -> m (IORef s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef s) -> m (IORef s)) -> IO (IORef s) -> m (IORef s)
forall a b. (a -> b) -> a -> b
$ s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s
a
a <- RWSIOT r w s m a -> Tuple r w s -> m 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 (r -> IORef w -> IORef s -> Tuple r w s
forall r w s. r -> IORef w -> IORef s -> Tuple r w s
Tuple r
r IORef w
w' IORef s
s')
s
s <- IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
s'
w
w <- IO w -> m w
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO w -> m w) -> IO w -> m w
forall a b. (a -> b) -> a -> b
$ IORef w -> IO w
forall a. IORef a -> IO a
readIORef IORef w
w'
(a, s, w) -> m (a, s, 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 :: w -> RWSIOT r w s m ()
tell w
w = (Tuple r w s -> m ()) -> RWSIOT r w s m ()
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m ()) -> RWSIOT r w s m ())
-> (Tuple r w s -> m ()) -> RWSIOT r w s m ()
forall a b. (a -> b) -> a -> b
$ \(Tuple r
_ IORef w
w' IORef s
_) -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef w -> (w -> w) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef w
w' (w -> w -> w
forall a. Monoid a => a -> a -> a
`mappend` w
w)
ask :: Monad m => RWSIOT r w s m r
ask :: RWSIOT r w s m r
ask = (Tuple r w s -> m r) -> RWSIOT r w s m r
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m r) -> RWSIOT r w s m r)
-> (Tuple r w s -> m r) -> RWSIOT r w s m r
forall a b. (a -> b) -> a -> b
$ \(Tuple r
r IORef w
_ IORef s
_) -> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
get :: MonadIO m => RWSIOT r w s m s
get :: RWSIOT r w s m s
get = (Tuple r w s -> m s) -> RWSIOT r w s m s
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m s) -> RWSIOT r w s m s)
-> (Tuple r w s -> m s) -> RWSIOT r w s m s
forall a b. (a -> b) -> a -> b
$ \(Tuple r
_ IORef w
_ IORef s
s') -> IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
s'
put :: MonadIO m => s -> RWSIOT r w s m ()
put :: s -> RWSIOT r w s m ()
put s
s = (Tuple r w s -> m ()) -> RWSIOT r w s m ()
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
R ((Tuple r w s -> m ()) -> RWSIOT r w s m ())
-> (Tuple r w s -> m ()) -> RWSIOT r w s m ()
forall a b. (a -> b) -> a -> b
$ \(Tuple r
_ IORef w
_ IORef s
s') -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef s
s' s
s