{-# LANGUAGE TypeFamilies #-}
module Control.Monad.Trans.ReaderWriterIO (
    -- * Synopsis
    -- | An implementation of the reader/writer monad transformer
    -- using an 'IORef' for the writer.

    -- * Documentation
    ReaderWriterIOT, readerWriterIOT, runReaderWriterIOT, tell, listen, ask, local,
    ) where

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

{-----------------------------------------------------------------------------
    Type and class instances
------------------------------------------------------------------------------}
newtype ReaderWriterIOT r w m a = ReaderWriterIOT { ReaderWriterIOT r w m a -> r -> IORef w -> m a
run :: r -> IORef w -> m a }

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

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

instance Monad m => Monad (ReaderWriterIOT r w m) where
    return :: a -> ReaderWriterIOT r w m a
return = a -> ReaderWriterIOT r w m a
forall (m :: * -> *) a r w. Monad m => a -> ReaderWriterIOT r w m a
returnR
    >>= :: ReaderWriterIOT r w m a
-> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b
(>>=)  = ReaderWriterIOT r w m a
-> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b
forall (m :: * -> *) r w a b.
Monad m =>
ReaderWriterIOT r w m a
-> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b
bindR

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

instance (Monad m, a ~ ()) => Semigroup (ReaderWriterIOT r w m a) where
    ReaderWriterIOT r w m a
mx <> :: ReaderWriterIOT r w m a
-> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m a
<> ReaderWriterIOT r w m a
my = ReaderWriterIOT r w m a
mx ReaderWriterIOT r w m a
-> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderWriterIOT r w m a
my

instance (Monad m, a ~ ()) => Monoid (ReaderWriterIOT r w m a) where
    mempty :: ReaderWriterIOT r w m a
mempty  = () -> ReaderWriterIOT r w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    mappend :: ReaderWriterIOT r w m a
-> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m a
mappend = ReaderWriterIOT r w m a
-> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m a
forall a. Semigroup a => a -> a -> a
(<>)

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

liftR :: m a -> ReaderWriterIOT r w m a
liftR :: m a -> ReaderWriterIOT r w m a
liftR m a
m = (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m a) -> ReaderWriterIOT r w m a)
-> (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall a b. (a -> b) -> a -> b
$ \r
_ IORef w
_ -> m a
m

fmapR :: Functor m => (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b
fmapR :: (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b
fmapR a -> b
f ReaderWriterIOT r w m a
m = (r -> IORef w -> m b) -> ReaderWriterIOT r w m b
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m b) -> ReaderWriterIOT r w m b)
-> (r -> IORef w -> m b) -> ReaderWriterIOT r w m b
forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderWriterIOT r w m a -> r -> IORef w -> m a
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run ReaderWriterIOT r w m a
m r
x IORef w
y)

returnR :: Monad m => a -> ReaderWriterIOT r w m a
returnR :: a -> ReaderWriterIOT r w m a
returnR a
a = (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m a) -> ReaderWriterIOT r w m a)
-> (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall a b. (a -> b) -> a -> b
$ \r
_ IORef w
_ -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

bindR :: Monad m => ReaderWriterIOT r w m a -> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b
bindR :: ReaderWriterIOT r w m a
-> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b
bindR ReaderWriterIOT r w m a
m a -> ReaderWriterIOT r w m b
k = (r -> IORef w -> m b) -> ReaderWriterIOT r w m b
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m b) -> ReaderWriterIOT r w m b)
-> (r -> IORef w -> m b) -> ReaderWriterIOT r w m b
forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> ReaderWriterIOT r w m a -> r -> IORef w -> m a
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run ReaderWriterIOT r w m a
m r
x IORef w
y m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> ReaderWriterIOT r w m b -> r -> IORef w -> m b
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run (a -> ReaderWriterIOT r w m b
k a
a) r
x IORef w
y

mfixR :: MonadFix m => (a -> ReaderWriterIOT r w m a) -> ReaderWriterIOT r w m a
mfixR :: (a -> ReaderWriterIOT r w m a) -> ReaderWriterIOT r w m a
mfixR a -> ReaderWriterIOT r w m a
f = (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m a) -> ReaderWriterIOT r w m a)
-> (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\a
a -> ReaderWriterIOT r w m a -> r -> IORef w -> m a
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run (a -> ReaderWriterIOT r w m a
f a
a) r
x IORef w
y)

pureR :: Applicative m => a -> ReaderWriterIOT r w m a
pureR :: a -> ReaderWriterIOT r w m a
pureR a
a = (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m a) -> ReaderWriterIOT r w m a)
-> (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall a b. (a -> b) -> a -> b
$ \r
_ IORef w
_ -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

apR :: Applicative m => ReaderWriterIOT r w m (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b
apR :: ReaderWriterIOT r w m (a -> b)
-> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b
apR ReaderWriterIOT r w m (a -> b)
f ReaderWriterIOT r w m a
a = (r -> IORef w -> m b) -> ReaderWriterIOT r w m b
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m b) -> ReaderWriterIOT r w m b)
-> (r -> IORef w -> m b) -> ReaderWriterIOT r w m b
forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> ReaderWriterIOT r w m (a -> b) -> r -> IORef w -> m (a -> b)
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run ReaderWriterIOT r w m (a -> b)
f r
x IORef w
y m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderWriterIOT r w m a -> r -> IORef w -> m a
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run ReaderWriterIOT r w m a
a r
x IORef w
y

readerWriterIOT :: (MonadIO m, Monoid w) =>
    (r -> IO (a, w)) -> ReaderWriterIOT r w m a
readerWriterIOT :: (r -> IO (a, w)) -> ReaderWriterIOT r w m a
readerWriterIOT r -> IO (a, w)
f = do
    r
r <- ReaderWriterIOT r w m r
forall (m :: * -> *) r w. Monad m => ReaderWriterIOT r w m r
ask
    (a
a,w
w) <- IO (a, w) -> ReaderWriterIOT r w m (a, w)
forall (m :: * -> *) a r w.
MonadIO m =>
IO a -> ReaderWriterIOT r w m a
liftIOR (IO (a, w) -> ReaderWriterIOT r w m (a, w))
-> IO (a, w) -> ReaderWriterIOT r w m (a, w)
forall a b. (a -> b) -> a -> b
$ r -> IO (a, w)
f r
r
    w -> ReaderWriterIOT r w m ()
forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
tell w
w
    a -> ReaderWriterIOT r w m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

runReaderWriterIOT :: (MonadIO m, Monoid w) => ReaderWriterIOT r w m a -> r -> m (a,w)
runReaderWriterIOT :: ReaderWriterIOT r w m a -> r -> m (a, w)
runReaderWriterIOT ReaderWriterIOT r w m a
m r
r = do
    IORef w
ref <- 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
    a
a   <- ReaderWriterIOT r w m a -> r -> IORef w -> m a
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run ReaderWriterIOT r w m a
m r
r IORef w
ref
    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
ref
    (a, w) -> m (a, w)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,w
w)

tell :: (MonadIO m, Monoid w) => w -> ReaderWriterIOT r w m ()
tell :: w -> ReaderWriterIOT r w m ()
tell w
w = (r -> IORef w -> m ()) -> ReaderWriterIOT r w m ()
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m ()) -> ReaderWriterIOT r w m ())
-> (r -> IORef w -> m ()) -> ReaderWriterIOT r w m ()
forall a b. (a -> b) -> a -> b
$ \r
_ IORef w
ref -> 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
ref (w -> w -> w
forall a. Monoid a => a -> a -> a
`mappend` w
w)

listen :: (MonadIO m, Monoid w) => ReaderWriterIOT r w m a -> ReaderWriterIOT r w m (a, w)
listen :: ReaderWriterIOT r w m a -> ReaderWriterIOT r w m (a, w)
listen ReaderWriterIOT r w m a
m = (r -> IORef w -> m (a, w)) -> ReaderWriterIOT r w m (a, w)
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m (a, w)) -> ReaderWriterIOT r w m (a, w))
-> (r -> IORef w -> m (a, w)) -> ReaderWriterIOT r w m (a, w)
forall a b. (a -> b) -> a -> b
$ \r
r IORef w
ref -> do
    a
a <- ReaderWriterIOT r w m a -> r -> IORef w -> m a
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run ReaderWriterIOT r w m a
m r
r IORef w
ref
    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
ref
    (a, w) -> m (a, w)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,w
w)

local :: MonadIO m => (r -> r) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m a
local :: (r -> r) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m a
local r -> r
f ReaderWriterIOT r w m a
m = (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT ((r -> IORef w -> m a) -> ReaderWriterIOT r w m a)
-> (r -> IORef w -> m a) -> ReaderWriterIOT r w m a
forall a b. (a -> b) -> a -> b
$ \r
r IORef w
ref -> ReaderWriterIOT r w m a -> r -> IORef w -> m a
forall r w (m :: * -> *) a.
ReaderWriterIOT r w m a -> r -> IORef w -> m a
run ReaderWriterIOT r w m a
m (r -> r
f r
r) IORef w
ref

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