{-# LANGUAGE FunctionalDependencies, UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) Dimitri Sabadie
-- License     :  BSD3
-- 
-- Maintainer  :  dimitri.sabadie@gmail.com
-- Stability   :  stable
-- Portability :  portable
--
-- 'MonadWriter' on steroids.
--
-- 'MonadJournal' is a more controlable version of 'MonadWriter' because it
-- enables you to access the 'Monoid' being computed up. You can then access
-- logs inside the computation itself, whereas you cannot with
-- 'MonadWriter' – unless you use specific functions like 'listen', but that
-- still stacks 'Monoid' in the monad.
--
-- Typically, you can use 'MonadJournal' when you come across the logging
-- problem and you need logs as long as you proceed.
-----------------------------------------------------------------------------

module Control.Monad.Journal.Class (
    -- * MonadJournal
    MonadJournal(..)
  , sink
  , absorb
  ) where

import Control.Monad ( Monad )
import Control.Monad.Trans ( MonadIO, MonadTrans, lift, liftIO )
import Control.Monad.Trans.Except ( ExceptT )
import Control.Monad.Trans.Identity ( IdentityT )
import Control.Monad.Trans.List ( ListT )
import Control.Monad.Trans.Maybe ( MaybeT )
import Control.Monad.Trans.RWS ( RWST )
import Control.Monad.Trans.Reader ( ReaderT )
import Control.Monad.Trans.State ( StateT )
import Control.Monad.Trans.Writer ( WriterT )
import Data.Monoid ( Monoid, mappend, mempty )

-- |This typeclass provides the ability to accumulate 'Monoid' in a monad
-- via the 'journal' function; to get them via the 'history' function and
-- finally, to purge them all with the 'clear' function.
--
-- In most cases, you won’t need 'history' neither 'clear'. There’s a 
-- cool function that combines both and enables you to deal with the
-- 'Monoid': 'sink'.
class (Monoid w, Monad m) => MonadJournal w m | m -> w where
  -- |Log something.
  journal :: w -> m ()
  -- |Extract the logs history.
  history :: m w
  -- |Clear the logs history.
  clear :: m ()

-- |Sink all logs history through 'MonadIO' then clean it.
sink :: (MonadJournal w m, MonadIO m) => (w -> IO ()) -> m ()
sink :: forall w (m :: * -> *).
(MonadJournal w m, MonadIO m) =>
(w -> IO ()) -> m ()
sink w -> IO ()
out = forall w (m :: * -> *). MonadJournal w m => m w
history forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> IO ()
out forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall w (m :: * -> *). MonadJournal w m => m ()
clear

-- |Absorb a logs history and pass around the value.
absorb :: (MonadJournal w m) => (a,w) -> m a
absorb :: forall w (m :: * -> *) a. MonadJournal w m => (a, w) -> m a
absorb (a
a,w
w) = forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
a

instance  (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (IdentityT m) where
  journal :: w -> IdentityT m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: IdentityT m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: IdentityT m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear

instance  (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (ListT m) where
  journal :: w -> ListT m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: ListT m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: ListT m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear

instance  (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (MaybeT m) where
  journal :: w -> MaybeT m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: MaybeT m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: MaybeT m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear

instance  (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (RWST r w s m) where
  journal :: w -> RWST r w s m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: RWST r w s m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: RWST r w s m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear

instance  (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (ReaderT r m) where
  journal :: w -> ReaderT r m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: ReaderT r m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: ReaderT r m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear

instance  (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (StateT s m) where
  journal :: w -> StateT s m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: StateT s m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: StateT s m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear

instance  (Monad m, Monoid w, Monoid q, MonadJournal w m) => MonadJournal w (WriterT q m) where
  journal :: w -> WriterT q m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: WriterT q m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: WriterT q m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear

instance  (Monad m, Monoid w, MonadJournal w m) => MonadJournal w (ExceptT e m) where
  journal :: w -> ExceptT e m ()
journal !w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadJournal w m => w -> m ()
journal w
w)
  history :: ExceptT e m w
history    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m w
history
  clear :: ExceptT e m ()
clear      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadJournal w m => m ()
clear