{-# 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 { forall r w (m :: * -> *) a.
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 :: forall a b.
(a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b
fmap = 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 :: forall a. a -> ReaderWriterIOT r w m a
pure  = forall (m :: * -> *) a r w.
Applicative m =>
a -> ReaderWriterIOT r w m a
pureR
    <*> :: forall a 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
    >>= :: forall a 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 :: forall a. (a -> ReaderWriterIOT r w m a) -> ReaderWriterIOT r w m a
mfix = 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 :: forall a. IO a -> ReaderWriterIOT r w m a
liftIO = forall (m :: * -> *) a r w.
MonadIO m =>
IO a -> ReaderWriterIOT r w m a
liftIOR
instance MonadTrans (ReaderWriterIOT r w)               where lift :: forall (m :: * -> *) a. Monad m => m a -> ReaderWriterIOT r w m a
lift = 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 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  = 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 = forall a. Semigroup a => a -> a -> a
(<>)

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

liftR :: m a -> ReaderWriterIOT r w m a
liftR :: forall (m :: * -> *) a r w. m a -> ReaderWriterIOT r w m a
liftR m a
m = forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT 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 :: forall (m :: * -> *) a b r w.
Functor m =>
(a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b
fmapR a -> b
f ReaderWriterIOT r w m a
m = forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (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)

bindR :: Monad m => ReaderWriterIOT r w m a -> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b
bindR :: 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 ReaderWriterIOT r w m a
m a -> ReaderWriterIOT r w m b
k = forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> 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 :: forall (m :: * -> *) a r w.
MonadFix m =>
(a -> ReaderWriterIOT r w m a) -> ReaderWriterIOT r w m a
mfixR a -> ReaderWriterIOT r w m a
f = forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\a
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 :: forall (m :: * -> *) a r w.
Applicative m =>
a -> ReaderWriterIOT r w m a
pureR a
a = forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT forall a b. (a -> b) -> a -> b
$ \r
_ IORef w
_ -> 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 :: 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 ReaderWriterIOT r w m (a -> b)
f ReaderWriterIOT r w m a
a = forall r w (m :: * -> *) a.
(r -> IORef w -> m a) -> ReaderWriterIOT r w m a
ReaderWriterIOT forall a b. (a -> b) -> a -> b
$ \r
x IORef w
y -> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
(r -> IO (a, w)) -> ReaderWriterIOT r w m a
readerWriterIOT r -> IO (a, w)
f = do
    r
r <- forall (m :: * -> *) r w. Monad m => ReaderWriterIOT r w m r
ask
    (a
a,w
w) <- forall (m :: * -> *) a r w.
MonadIO m =>
IO a -> ReaderWriterIOT r w m a
liftIOR forall a b. (a -> b) -> a -> b
$ r -> IO (a, w)
f r
r
    forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
tell w
w
    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 :: forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
ReaderWriterIOT r w m a -> r -> m (a, w)
runReaderWriterIOT ReaderWriterIOT r w m a
m r
r = do
    IORef w
ref <- 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
    a
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   <- 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
ref
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,w
w)

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