{-# 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)
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)
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
$cpure :: forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
pure :: forall a. a -> JournalT w m a
$c<*> :: forall w (m :: * -> *) a b.
Monad m =>
JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b
<*> :: forall a b.
JournalT w m (a -> b) -> JournalT w m a -> JournalT w m b
$cliftA2 :: forall w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> JournalT w m a -> JournalT w m b -> JournalT w m c
liftA2 :: forall a b c.
(a -> b -> c) -> JournalT w m a -> JournalT w m b -> JournalT w m c
$c*> :: forall w (m :: * -> *) a b.
Monad m =>
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 b
$c<* :: forall w (m :: * -> *) a b.
Monad m =>
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 a
Applicative
, Applicative (JournalT w m)
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)
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
$cempty :: forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
empty :: forall a. JournalT w m a
$c<|> :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m a -> JournalT w m a
<|> :: forall a. JournalT w m a -> JournalT w m a -> JournalT w m a
$csome :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m [a]
some :: forall a. JournalT w m a -> JournalT w m [a]
$cmany :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m [a]
many :: forall a. JournalT w m a -> JournalT w m [a]
Alternative
, (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
$cfmap :: forall w (m :: * -> *) a b.
Functor m =>
(a -> b) -> JournalT w m a -> JournalT w m b
fmap :: forall a b. (a -> b) -> JournalT w m a -> JournalT w m b
$c<$ :: forall w (m :: * -> *) a b.
Functor m =>
a -> JournalT w m b -> JournalT w m a
<$ :: forall a b. a -> JournalT w m b -> JournalT w m a
Functor
, Applicative (JournalT w m)
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)
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
$c>>= :: forall w (m :: * -> *) a b.
Monad m =>
JournalT w m a -> (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
$c>> :: forall w (m :: * -> *) a b.
Monad m =>
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 b
$creturn :: forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
return :: forall a. a -> JournalT w m a
Monad
, MonadError e
, Monad (JournalT w m)
Monad (JournalT w m)
-> (forall a. IO a -> JournalT w m a) -> MonadIO (JournalT w m)
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
$cliftIO :: forall w (m :: * -> *) a. MonadIO m => IO a -> JournalT w m a
liftIO :: forall a. IO a -> JournalT w m a
MonadIO
, Monad (JournalT w m)
Alternative (JournalT w m)
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)
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
$cmzero :: forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
mzero :: forall a. JournalT w m a
$cmplus :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m a -> JournalT w m a
mplus :: forall a. JournalT w m a -> JournalT w m a -> JournalT w m a
MonadPlus
, MonadReader r
, (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
$clift :: forall w (m :: * -> *) a. Monad m => m a -> JournalT w m a
lift :: forall (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 (m :: * -> *) a. Monad m => m a -> JournalT w m a
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 (m :: * -> *) a. Monad m => m a -> JournalT w m a
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 :: forall a. (s -> (a, s)) -> JournalT w m a
state = m a -> JournalT w m a
forall (m :: * -> *) a. Monad m => 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 a. (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 :: forall α. 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 :: forall (m :: * -> *) a.
Monad m =>
(Run (JournalT w) -> m a) -> JournalT w m a
liftWith 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 ->
(a -> (a, w)) -> m a -> m (a, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\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
$ \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 a b. JournalT w n a -> 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 :: forall (m :: * -> *) a.
Monad m =>
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 :: forall a. (RunInBase (JournalT w m) b -> b a) -> JournalT w m a
liftBaseWith = (RunInBaseDefault (JournalT w) m b -> b a) -> JournalT w m a
(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 :: forall a. StM (JournalT w m) a -> JournalT w m a
restoreM = ComposeSt (JournalT w) m a -> JournalT w m a
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 :: forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
JournalT w m a -> m (a, w)
runJournalT (JournalT 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 :: forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
JournalT w m a -> m a
evalJournalT (JournalT 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 :: forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
JournalT w m a -> m w
execJournalT (JournalT 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