{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, TypeFamilies
, UndecidableInstances #-}
{-# OPTIONS_HADDOCK prune #-}
module Control.Monad.Trans.Journal (
JournalT
, runJournalT
, evalJournalT
, execJournalT
, module Control.Monad.Journal.Class
) where
import Control.Applicative ( Applicative, Alternative )
import Control.Monad ( MonadPlus, liftM )
import Control.Monad.Base ( MonadBase, liftBase, liftBaseDefault )
import Control.Monad.Error.Class ( MonadError(..) )
import Control.Monad.Journal.Class
import Control.Monad.Reader.Class ( MonadReader(..) )
import Control.Monad.State.Class ( MonadState )
import Control.Monad.Trans ( MonadTrans, MonadIO, lift )
import Control.Monad.Trans.State ( StateT(..), evalStateT, execStateT, get
, modify, put, runStateT )
import Control.Monad.Trans.Control ( MonadTransControl(..)
, MonadBaseControl(..), ComposeSt
, defaultLiftBaseWith, defaultRestoreM )
import Control.Monad.Writer.Class ( MonadWriter(..) )
import Data.Monoid ( Monoid(..) )
import qualified Control.Monad.State.Class as MS ( MonadState(..) )
newtype JournalT w m a = JournalT (StateT w m a)
deriving ( Functor (JournalT w m)
a -> JournalT w m a
Functor (JournalT w m) =>
(forall a. a -> JournalT w m a)
-> (forall a b.
JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b)
-> (forall a b c.
(a -> b -> c)
-> JournalT w m a -> JournalT w m b -> JournalT w m c)
-> (forall a b. JournalT w m a -> JournalT w m b -> JournalT w m b)
-> (forall a b. JournalT w m a -> JournalT w m b -> JournalT w m a)
-> Applicative (JournalT w m)
JournalT w m a -> JournalT w m b -> JournalT w m b
JournalT w m a -> JournalT w m b -> JournalT w m a
JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b
(a -> b -> c) -> JournalT w m a -> JournalT w m b -> JournalT w m c
forall a. a -> JournalT w m a
forall a b. JournalT w m a -> JournalT w m b -> JournalT w m a
forall a b. JournalT w m a -> JournalT w m b -> JournalT w m b
forall a b.
JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b
forall a b c.
(a -> b -> c) -> JournalT w m a -> JournalT w m b -> JournalT w m c
forall w (m :: * -> *). Monad m => Functor (JournalT w m)
forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> JournalT w m b -> JournalT w m a
forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> JournalT w m b -> JournalT w m b
forall w (m :: * -> *) a b.
Monad m =>
JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b
forall w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> JournalT w m a -> JournalT w m b -> JournalT w m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: JournalT w m a -> JournalT w m b -> JournalT w m a
$c<* :: forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> JournalT w m b -> JournalT w m a
*> :: JournalT w m a -> JournalT w m b -> JournalT w m b
$c*> :: forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> JournalT w m b -> JournalT w m b
liftA2 :: (a -> b -> c) -> JournalT w m a -> JournalT w m b -> JournalT w m c
$cliftA2 :: forall w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> JournalT w m a -> JournalT w m b -> JournalT w m c
<*> :: JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b
$c<*> :: forall w (m :: * -> *) a b.
Monad m =>
JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b
pure :: a -> JournalT w m a
$cpure :: forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
$cp1Applicative :: forall w (m :: * -> *). Monad m => Functor (JournalT w m)
Applicative
, Applicative (JournalT w m)
JournalT w m a
Applicative (JournalT w m) =>
(forall a. JournalT w m a)
-> (forall a. JournalT w m a -> JournalT w m a -> JournalT w m a)
-> (forall a. JournalT w m a -> JournalT w m [a])
-> (forall a. JournalT w m a -> JournalT w m [a])
-> Alternative (JournalT w m)
JournalT w m a -> JournalT w m a -> JournalT w m a
JournalT w m a -> JournalT w m [a]
JournalT w m a -> JournalT w m [a]
forall a. JournalT w m a
forall a. JournalT w m a -> JournalT w m [a]
forall a. JournalT w m a -> JournalT w m a -> JournalT w m a
forall w (m :: * -> *). MonadPlus m => Applicative (JournalT w m)
forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m [a]
forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m a -> JournalT w m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: JournalT w m a -> JournalT w m [a]
$cmany :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m [a]
some :: JournalT w m a -> JournalT w m [a]
$csome :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m [a]
<|> :: JournalT w m a -> JournalT w m a -> JournalT w m a
$c<|> :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m a -> JournalT w m a
empty :: JournalT w m a
$cempty :: forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
$cp1Alternative :: forall w (m :: * -> *). MonadPlus m => Applicative (JournalT w m)
Alternative
, a -> JournalT w m b -> JournalT w m a
(a -> b) -> JournalT w m a -> JournalT w m b
(forall a b. (a -> b) -> JournalT w m a -> JournalT w m b)
-> (forall a b. a -> JournalT w m b -> JournalT w m a)
-> Functor (JournalT w m)
forall a b. a -> JournalT w m b -> JournalT w m a
forall a b. (a -> b) -> JournalT w m a -> JournalT w m b
forall w (m :: * -> *) a b.
Functor m =>
a -> JournalT w m b -> JournalT w m a
forall w (m :: * -> *) a b.
Functor m =>
(a -> b) -> JournalT w m a -> JournalT w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> JournalT w m b -> JournalT w m a
$c<$ :: forall w (m :: * -> *) a b.
Functor m =>
a -> JournalT w m b -> JournalT w m a
fmap :: (a -> b) -> JournalT w m a -> JournalT w m b
$cfmap :: forall w (m :: * -> *) a b.
Functor m =>
(a -> b) -> JournalT w m a -> JournalT w m b
Functor
, Applicative (JournalT w m)
a -> JournalT w m a
Applicative (JournalT w m) =>
(forall a b.
JournalT w m a -> (a -> JournalT w m b) -> JournalT w m b)
-> (forall a b. JournalT w m a -> JournalT w m b -> JournalT w m b)
-> (forall a. a -> JournalT w m a)
-> Monad (JournalT w m)
JournalT w m a -> (a -> JournalT w m b) -> JournalT w m b
JournalT w m a -> JournalT w m b -> JournalT w m b
forall a. a -> JournalT w m a
forall a b. JournalT w m a -> JournalT w m b -> JournalT w m b
forall a b.
JournalT w m a -> (a -> JournalT w m b) -> JournalT w m b
forall w (m :: * -> *). Monad m => Applicative (JournalT w m)
forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> JournalT w m b -> JournalT w m b
forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> (a -> JournalT w m b) -> JournalT w m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> JournalT w m a
$creturn :: forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
>> :: JournalT w m a -> JournalT w m b -> JournalT w m b
$c>> :: forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> JournalT w m b -> JournalT w m b
>>= :: JournalT w m a -> (a -> JournalT w m b) -> JournalT w m b
$c>>= :: forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> (a -> JournalT w m b) -> JournalT w m b
$cp1Monad :: forall w (m :: * -> *). Monad m => Applicative (JournalT w m)
Monad
, MonadError e
, Monad (JournalT w m)
Monad (JournalT w m) =>
(forall a. IO a -> JournalT w m a) -> MonadIO (JournalT w m)
IO a -> JournalT w m a
forall a. IO a -> JournalT w m a
forall w (m :: * -> *). MonadIO m => Monad (JournalT w m)
forall w (m :: * -> *) a. MonadIO m => IO a -> JournalT w m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> JournalT w m a
$cliftIO :: forall w (m :: * -> *) a. MonadIO m => IO a -> JournalT w m a
$cp1MonadIO :: forall w (m :: * -> *). MonadIO m => Monad (JournalT w m)
MonadIO
, Monad (JournalT w m)
Alternative (JournalT w m)
JournalT w m a
(Alternative (JournalT w m), Monad (JournalT w m)) =>
(forall a. JournalT w m a)
-> (forall a. JournalT w m a -> JournalT w m a -> JournalT w m a)
-> MonadPlus (JournalT w m)
JournalT w m a -> JournalT w m a -> JournalT w m a
forall a. JournalT w m a
forall a. JournalT w m a -> JournalT w m a -> JournalT w m a
forall w (m :: * -> *). MonadPlus m => Monad (JournalT w m)
forall w (m :: * -> *). MonadPlus m => Alternative (JournalT w m)
forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m a -> JournalT w m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
mplus :: JournalT w m a -> JournalT w m a -> JournalT w m a
$cmplus :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m a -> JournalT w m a
mzero :: JournalT w m a
$cmzero :: forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
$cp2MonadPlus :: forall w (m :: * -> *). MonadPlus m => Monad (JournalT w m)
$cp1MonadPlus :: forall w (m :: * -> *). MonadPlus m => Alternative (JournalT w m)
MonadPlus
, MonadReader r
, m a -> JournalT w m a
(forall (m :: * -> *) a. Monad m => m a -> JournalT w m a)
-> MonadTrans (JournalT w)
forall w (m :: * -> *) a. Monad m => m a -> JournalT w m a
forall (m :: * -> *) a. Monad m => m a -> JournalT w m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> JournalT w m a
$clift :: forall w (m :: * -> *) a. Monad m => m a -> JournalT w m a
MonadTrans
, MonadWriter w'
)
instance (Monoid w,Monad m) => MonadJournal w (JournalT w m) where
journal :: w -> JournalT w m ()
journal !w
w = StateT w m () -> JournalT w m ()
forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT (StateT w m () -> JournalT w m ())
-> ((w -> w) -> StateT w m ()) -> (w -> w) -> JournalT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> w) -> StateT w m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((w -> w) -> JournalT w m ()) -> (w -> w) -> JournalT w m ()
forall a b. (a -> b) -> a -> b
$ (w -> w -> w) -> w -> w -> w
forall a b c. (a -> b -> c) -> b -> a -> c
flip w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
w
history :: JournalT w m w
history = StateT w m w -> JournalT w m w
forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT StateT w m w
forall (m :: * -> *) s. Monad m => StateT s m s
get
clear :: JournalT w m ()
clear = StateT w m () -> JournalT w m ()
forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT (w -> StateT w m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put w
forall a. Monoid a => a
mempty)
instance MonadState s m => MonadState s (JournalT w m) where
get :: JournalT w m s
get = m s -> JournalT w m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
MS.get
put :: s -> JournalT w m ()
put = m () -> JournalT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> JournalT w m ()) -> (s -> m ()) -> s -> JournalT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
MS.put
state :: (s -> (a, s)) -> JournalT w m a
state = m a -> JournalT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> JournalT w m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> JournalT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
MS.state
instance (MonadBase b m) => MonadBase b (JournalT w m) where
liftBase :: b α -> JournalT w m α
liftBase = b α -> JournalT w m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault
#if MIN_VERSION_monad_control(1,0,0)
instance Monoid w => MonadTransControl (JournalT w) where
type StT (JournalT w) a = (a,w)
liftWith :: (Run (JournalT w) -> m a) -> JournalT w m a
liftWith f :: Run (JournalT w) -> m a
f = StateT w m a -> JournalT w m a
forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT (StateT w m a -> JournalT w m a) -> StateT w m a -> JournalT w m a
forall a b. (a -> b) -> a -> b
$ (w -> m (a, w)) -> StateT w m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((w -> m (a, w)) -> StateT w m a)
-> (w -> m (a, w)) -> StateT w m a
forall a b. (a -> b) -> a -> b
$ \w :: w
w ->
(a -> (a, w)) -> m a -> m (a, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\x :: a
x -> (a
x, w
w))
(Run (JournalT w) -> m a
f (Run (JournalT w) -> m a) -> Run (JournalT w) -> m a
forall a b. (a -> b) -> a -> b
$ \t :: JournalT w n b
t -> JournalT w n b -> n (b, w)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
JournalT w m a -> m (a, w)
runJournalT (w -> JournalT w n ()
forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w JournalT w n () -> JournalT w n b -> JournalT w n b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JournalT w n b
t))
restoreT :: m (StT (JournalT w) a) -> JournalT w m a
restoreT = StateT w m a -> JournalT w m a
forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT (StateT w m a -> JournalT w m a)
-> (m (a, w) -> StateT w m a) -> m (a, w) -> JournalT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> m (a, w)) -> StateT w m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((w -> m (a, w)) -> StateT w m a)
-> (m (a, w) -> w -> m (a, w)) -> m (a, w) -> StateT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, w) -> w -> m (a, w)
forall a b. a -> b -> a
const
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
instance (Monoid w,MonadBaseControl b m) => MonadBaseControl b (JournalT w m) where
type StM (JournalT w m) a = ComposeSt (JournalT w) m a
liftBaseWith :: (RunInBase (JournalT w m) b -> b a) -> JournalT w m a
liftBaseWith = (RunInBase (JournalT w m) b -> b a) -> JournalT w m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: StM (JournalT w m) a -> JournalT w m a
restoreM = StM (JournalT w m) a -> JournalT w m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}
#else
instance Monoid w => MonadTransControl (JournalT w) where
newtype StT (JournalT w) a = StJournal {unStJournal :: (a, w)}
liftWith f = JournalT $ StateT $ \w ->
liftM (\x -> (x, w))
(f $ \t -> liftM StJournal $ runJournalT (journal w >> t))
restoreT = JournalT . StateT . const . liftM unStJournal
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
instance (Monoid w,MonadBaseControl b m) => MonadBaseControl b (JournalT w m) where
newtype StM (JournalT w m) a =
StMJournal { unStMJournal :: ComposeSt (JournalT w) m a }
liftBaseWith = defaultLiftBaseWith StMJournal
restoreM = defaultRestoreM unStMJournal
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}
#endif
runJournalT :: (Monoid w,Monad m) => JournalT w m a -> m (a,w)
runJournalT :: JournalT w m a -> m (a, w)
runJournalT (JournalT s :: StateT w m a
s) = StateT w m a -> w -> m (a, w)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT w m a
s w
forall a. Monoid a => a
mempty
evalJournalT :: (Monoid w,Monad m) => JournalT w m a -> m a
evalJournalT :: JournalT w m a -> m a
evalJournalT (JournalT s :: StateT w m a
s) = StateT w m a -> w -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT w m a
s w
forall a. Monoid a => a
mempty
execJournalT :: (Monoid w,Monad m) => JournalT w m a -> m w
execJournalT :: JournalT w m a -> m w
execJournalT (JournalT s :: StateT w m a
s) = StateT w m a -> w -> m w
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT w m a
s w
forall a. Monoid a => a
mempty