{-# 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 ( 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
<* :: forall a b. 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
*> :: 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 b
liftA2 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> JournalT w m a
$cpure :: forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
Applicative
             , 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 :: 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]
some :: forall a. JournalT w m a -> JournalT w m [a]
$csome :: forall w (m :: * -> *) a.
MonadPlus m =>
JournalT w m a -> JournalT w m [a]
<|> :: forall 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 :: forall a. JournalT w m a
$cempty :: forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
Alternative
             , 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
<$ :: forall a b. 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 :: forall a b. (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
             , 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 :: forall a. a -> JournalT w m a
$creturn :: forall w (m :: * -> *) a. Monad m => a -> JournalT w m a
>> :: 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 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 -> (a -> JournalT w m b) -> JournalT w m b
Monad
             , MonadError e
             , 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 :: forall a. IO a -> JournalT w m a
$cliftIO :: forall w (m :: * -> *) a. MonadIO m => IO a -> JournalT w m a
MonadIO
             , 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 :: forall a. 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 :: forall a. JournalT w m a
$cmzero :: forall w (m :: * -> *) a. MonadPlus m => JournalT w m a
MonadPlus
             , MonadReader r
             , 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 :: forall (m :: * -> *) a. Monad m => 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 = forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend w
w
  history :: JournalT w m w
history = forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT forall (m :: * -> *) s. Monad m => StateT s m s
get
  clear :: JournalT w m ()
clear   = forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT (forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a. Monoid a => a
mempty)

instance MonadState s m => MonadState s (JournalT w m) where
    get :: JournalT w m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
MS.get
    put :: s -> JournalT w m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
MS.put
    state :: forall a. (s -> (a, s)) -> JournalT w m a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \w
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 forall a b. (a -> b) -> a -> b
$ \JournalT w n b
t -> forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
JournalT w m a -> m (a, w)
runJournalT (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w 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 = forall w (m :: * -> *) a. StateT w m a -> JournalT w m a
JournalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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     = 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 :: forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
JournalT w m a -> m (a, w)
runJournalT (JournalT StateT w m a
s) = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT w m a
s forall a. Monoid a => a
mempty

-- |Only retrieve the value.
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) = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT w m a
s forall a. Monoid a => a
mempty

-- |Only retrieve the log history.
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) = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT w m a
s forall a. Monoid a => a
mempty