{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, TypeFamilies
                , UndecidableInstances #-}
{-# OPTIONS_HADDOCK prune #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) Dimitri Sabadie
-- License     :  BSD3
--
-- Maintainer  :  dimitri.sabadie@gmail.com
-- Stability   :  stable
-- Portability :  portable
--
-- Monad transformer version of 'MonadJournal'. 'JournalT' provides
-- journaling over a monad.
--
-- This modules defines a few useful instances. Check the list below for
-- further information.
-----------------------------------------------------------------------------

module Control.Monad.Trans.Journal (
    -- * JournalT monad transformer
    JournalT
  , runJournalT
  , evalJournalT
  , execJournalT
    -- * Re-exported
  , 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(..) )

-- |Transformer version of 'MonadJournal'.
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 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 (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

-- |Retrieve the value and the log history.
runJournalT :: (Monoid w,Monad m) => JournalT w m a -> m (a,w)
runJournalT :: 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

-- |Only retrieve the value.
evalJournalT :: (Monoid w,Monad m) => JournalT w m a -> m a
evalJournalT :: 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

-- |Only retrieve the log history.
execJournalT :: (Monoid w,Monad m) => JournalT w m a -> m w
execJournalT :: 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