{-# LANGUAGE CPP #-}
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Monad.Log
       ( -- * Introduction
         -- $intro

         -- * Getting Started
         -- $tutorialIntro

         -- ** Working with @logging-effect@
         -- *** Emitting log messages
         -- $tutorial-monadlog

         -- *** Outputting with 'LoggingT'
         -- $tutorial-loggingt

         -- *** Adapting and composing logging
         -- $tutorial-composing

         -- * @MonadLog@
         logMessage, mapLogMessage, mapLogMessageM,
         MonadLog(..),

         -- * Convenience logging combinators
         -- $convenience
         logDebug, logInfo, logNotice, logWarning, logError, logCritical, logAlert, logEmergency,

         -- * Message transformers
         PP.layoutPretty,
         -- ** Timestamps
         WithTimestamp(..), timestamp, renderWithTimestamp,
         -- ** Severity
         WithSeverity(..), Severity(..), renderWithSeverity,
         -- ** Call stacks
         WithCallStack(..), withCallStack, renderWithCallStack,

         -- * @LoggingT@, a general handler
         LoggingT(..), runLoggingT, mapLoggingT,

         -- ** 'LoggingT' Handlers
         Handler, withFDHandler,

         -- *** Batched handlers
         withBatchedHandler, BatchingOptions(..), defaultBatchingOptions,

         -- * Pure logging
         PureLoggingT(..), runPureLoggingT,

         -- * Discarding logs
         DiscardLoggingT(DiscardLoggingT,discardLogging)

         -- * Aside: An @mtl@ refresher
         -- $tutorialMtl
       ) where

import Prelude hiding (foldMap)
import Control.Applicative
import Control.Concurrent.Async (async, wait)
import Control.Concurrent.STM
import Control.Concurrent.STM.Delay
import Control.Monad (MonadPlus, guard)
import Control.Monad.Base
import Control.Monad.Catch (MonadThrow(..), MonadMask(..), MonadCatch(..), bracket)
import Control.Monad.Cont.Class (MonadCont(..))
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Fix
import Control.Monad.Free.Class (MonadFree(..))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.IO.Unlift (MonadUnliftIO(..), UnliftIO(..), withUnliftIO)
import Control.Monad.RWS.Class (MonadRWS)
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Control
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State.Strict (StateT(..))
import Control.Monad.Writer.Class (MonadWriter(..))
import Data.Semigroup ((<>))
import Data.Time (UTCTime, getCurrentTime)
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
#if !MIN_VERSION_base(4, 9, 0)
import GHC.SrcLoc (SrcLoc, showSrcLoc)
import GHC.Stack
#else
import GHC.Stack (SrcLoc, CallStack, getCallStack, prettySrcLoc)
#endif
import System.IO (Handle, hFlush)
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Prettyprint.Doc as PP
import qualified Data.Text.Prettyprint.Doc.Render.Text as PP
import qualified Data.List.NonEmpty as NEL

-- For 'MonadLog' pass-through instances.
import qualified Control.Monad.Trans.Identity as Identity
import qualified Control.Monad.Trans.Reader as Reader
import qualified Control.Monad.Trans.State.Lazy as LazyState
import qualified Control.Monad.Trans.State.Strict as StrictState
import qualified Control.Monad.Trans.Writer.Lazy as LazyWriter
import qualified Control.Monad.Trans.Writer.Strict as StrictWriter
import qualified Control.Monad.Trans.Maybe as Maybe
import qualified Control.Monad.Trans.Except as Except
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS
import qualified Control.Monad.Trans.Cont as Cont
import qualified Control.Monad.Trans.Free as Free
import qualified Control.Monad.Trans.Free.Church as Free
import qualified Control.Monad.Catch.Pure as Exceptions

--------------------------------------------------------------------------------
-- | The class of monads that support logging.
--
-- Laws:
--
-- /Monoid homomorphism/:
--
-- @
-- 'logMessageFree' a '*>' 'logMessageFree' b = 'logMessageFree' (a '<>' b)
-- @
class Monad m => MonadLog message m | m -> message where
  -- | Fold log messages into this computation. Looking to just log a
  -- message? You probably want 'logMessage'.
  --
  -- The perhaps strange type here allows us to construct a monoid out of /any/
  -- type of log message. You can think of this as the simpler type:
  --
  -- @
  -- logMessageFree :: [message] -> m ()
  -- @
  logMessageFree :: (forall n. Monoid n => (message -> n) -> n) -> m ()
  default logMessageFree :: (m ~ t n, MonadTrans t, MonadLog message n) => (forall mon. Monoid mon => (message -> mon) -> mon) -> m ()
  logMessageFree forall mon. Monoid mon => (message -> mon) -> mon
inj = n () -> t n ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((forall mon. Monoid mon => (message -> mon) -> mon) -> n ()
forall message (m :: * -> *).
MonadLog message m =>
(forall mon. Monoid mon => (message -> mon) -> mon) -> m ()
logMessageFree (message -> n) -> n
forall mon. Monoid mon => (message -> mon) -> mon
inj)
  {-# INLINEABLE logMessageFree #-}

-- | Append a message to the log for this computation.
logMessage :: MonadLog message m => message -> m ()
logMessage :: forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage message
m = (forall n. Monoid n => (message -> n) -> n) -> m ()
forall message (m :: * -> *).
MonadLog message m =>
(forall mon. Monoid mon => (message -> mon) -> mon) -> m ()
logMessageFree (\message -> n
inject -> message -> n
inject message
m)
{-# INLINEABLE logMessage #-}

-- | Re-interpret the log messages in one computation. This can be useful to
-- embed a computation with one log type in a larger general computation.
mapLogMessage
  :: MonadLog message' m
  => (message -> message') -> LoggingT message m a -> m a
mapLogMessage :: forall message' (m :: * -> *) message a.
MonadLog message' m =>
(message -> message') -> LoggingT message m a -> m a
mapLogMessage message -> message'
f LoggingT message m a
m =
  LoggingT message m a -> Handler m message -> m a
forall message (m :: * -> *) a.
LoggingT message m a -> Handler m message -> m a
runLoggingT LoggingT message m a
m
              (message' -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (message' -> m ()) -> (message -> message') -> Handler m message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. message -> message'
f)
{-# INLINEABLE mapLogMessage #-}

-- | Monadic version of 'mapLogMessage'. This can be used to annotate a
-- message with something that can only be computed in a monad. See e.g.
-- 'timestamp'.
mapLogMessageM
  :: MonadLog message' m
  => (message -> m message') -> LoggingT message m a -> m a
mapLogMessageM :: forall message' (m :: * -> *) message a.
MonadLog message' m =>
(message -> m message') -> LoggingT message m a -> m a
mapLogMessageM message -> m message'
f LoggingT message m a
m =
  LoggingT message m a -> Handler m message -> m a
forall message (m :: * -> *) a.
LoggingT message m a -> Handler m message -> m a
runLoggingT LoggingT message m a
m ((m message' -> (message' -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= message' -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage) (m message' -> m ())
-> (message -> m message') -> Handler m message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. message -> m message'
f)
{-# INLINEABLE mapLogMessageM #-}

instance MonadLog message m => MonadLog message (Identity.IdentityT m)
instance MonadLog message m => MonadLog message (Reader.ReaderT r m)
instance MonadLog message m => MonadLog message (StrictState.StateT s m)
instance MonadLog message m => MonadLog message (LazyState.StateT s m)
instance (Monoid w, MonadLog message m) => MonadLog message (StrictWriter.WriterT w m)
instance (Monoid w, MonadLog message m) => MonadLog message (LazyWriter.WriterT w m)
instance MonadLog message m => MonadLog message (Maybe.MaybeT m)
instance MonadLog message m => MonadLog message (Except.ExceptT e m)
instance (Monoid w, MonadLog message m) => MonadLog message (StrictRWS.RWST r w s m)
instance (Monoid w, MonadLog message m) => MonadLog message (LazyRWS.RWST r w s m)
instance MonadLog message m => MonadLog message (Cont.ContT r m)
instance (Functor f, MonadLog message m) => MonadLog message (Free.FreeT f m)
instance (Functor f, MonadLog message m) => MonadLog message (Free.FT f m)
instance MonadLog message m => MonadLog message (Exceptions.CatchT m)

--------------------------------------------------------------------------------
-- | Add \"Severity\" information to a log message. This is often used to convey
-- how significant a log message is.
data WithSeverity a =
  WithSeverity {forall a. WithSeverity a -> Severity
msgSeverity :: Severity -- ^ Retrieve the 'Severity' a message.
               ,forall a. WithSeverity a -> a
discardSeverity :: a -- ^ View the underlying message.
               }
  deriving (WithSeverity a -> WithSeverity a -> Bool
(WithSeverity a -> WithSeverity a -> Bool)
-> (WithSeverity a -> WithSeverity a -> Bool)
-> Eq (WithSeverity a)
forall a. Eq a => WithSeverity a -> WithSeverity a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithSeverity a -> WithSeverity a -> Bool
== :: WithSeverity a -> WithSeverity a -> Bool
$c/= :: forall a. Eq a => WithSeverity a -> WithSeverity a -> Bool
/= :: WithSeverity a -> WithSeverity a -> Bool
Eq,Eq (WithSeverity a)
Eq (WithSeverity a) =>
(WithSeverity a -> WithSeverity a -> Ordering)
-> (WithSeverity a -> WithSeverity a -> Bool)
-> (WithSeverity a -> WithSeverity a -> Bool)
-> (WithSeverity a -> WithSeverity a -> Bool)
-> (WithSeverity a -> WithSeverity a -> Bool)
-> (WithSeverity a -> WithSeverity a -> WithSeverity a)
-> (WithSeverity a -> WithSeverity a -> WithSeverity a)
-> Ord (WithSeverity a)
WithSeverity a -> WithSeverity a -> Bool
WithSeverity a -> WithSeverity a -> Ordering
WithSeverity a -> WithSeverity a -> WithSeverity a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (WithSeverity a)
forall a. Ord a => WithSeverity a -> WithSeverity a -> Bool
forall a. Ord a => WithSeverity a -> WithSeverity a -> Ordering
forall a.
Ord a =>
WithSeverity a -> WithSeverity a -> WithSeverity a
$ccompare :: forall a. Ord a => WithSeverity a -> WithSeverity a -> Ordering
compare :: WithSeverity a -> WithSeverity a -> Ordering
$c< :: forall a. Ord a => WithSeverity a -> WithSeverity a -> Bool
< :: WithSeverity a -> WithSeverity a -> Bool
$c<= :: forall a. Ord a => WithSeverity a -> WithSeverity a -> Bool
<= :: WithSeverity a -> WithSeverity a -> Bool
$c> :: forall a. Ord a => WithSeverity a -> WithSeverity a -> Bool
> :: WithSeverity a -> WithSeverity a -> Bool
$c>= :: forall a. Ord a => WithSeverity a -> WithSeverity a -> Bool
>= :: WithSeverity a -> WithSeverity a -> Bool
$cmax :: forall a.
Ord a =>
WithSeverity a -> WithSeverity a -> WithSeverity a
max :: WithSeverity a -> WithSeverity a -> WithSeverity a
$cmin :: forall a.
Ord a =>
WithSeverity a -> WithSeverity a -> WithSeverity a
min :: WithSeverity a -> WithSeverity a -> WithSeverity a
Ord,ReadPrec [WithSeverity a]
ReadPrec (WithSeverity a)
Int -> ReadS (WithSeverity a)
ReadS [WithSeverity a]
(Int -> ReadS (WithSeverity a))
-> ReadS [WithSeverity a]
-> ReadPrec (WithSeverity a)
-> ReadPrec [WithSeverity a]
-> Read (WithSeverity a)
forall a. Read a => ReadPrec [WithSeverity a]
forall a. Read a => ReadPrec (WithSeverity a)
forall a. Read a => Int -> ReadS (WithSeverity a)
forall a. Read a => ReadS [WithSeverity a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (WithSeverity a)
readsPrec :: Int -> ReadS (WithSeverity a)
$creadList :: forall a. Read a => ReadS [WithSeverity a]
readList :: ReadS [WithSeverity a]
$creadPrec :: forall a. Read a => ReadPrec (WithSeverity a)
readPrec :: ReadPrec (WithSeverity a)
$creadListPrec :: forall a. Read a => ReadPrec [WithSeverity a]
readListPrec :: ReadPrec [WithSeverity a]
Read,Int -> WithSeverity a -> ShowS
[WithSeverity a] -> ShowS
WithSeverity a -> String
(Int -> WithSeverity a -> ShowS)
-> (WithSeverity a -> String)
-> ([WithSeverity a] -> ShowS)
-> Show (WithSeverity a)
forall a. Show a => Int -> WithSeverity a -> ShowS
forall a. Show a => [WithSeverity a] -> ShowS
forall a. Show a => WithSeverity a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithSeverity a -> ShowS
showsPrec :: Int -> WithSeverity a -> ShowS
$cshow :: forall a. Show a => WithSeverity a -> String
show :: WithSeverity a -> String
$cshowList :: forall a. Show a => [WithSeverity a] -> ShowS
showList :: [WithSeverity a] -> ShowS
Show,(forall a b. (a -> b) -> WithSeverity a -> WithSeverity b)
-> (forall a b. a -> WithSeverity b -> WithSeverity a)
-> Functor WithSeverity
forall a b. a -> WithSeverity b -> WithSeverity a
forall a b. (a -> b) -> WithSeverity a -> WithSeverity b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithSeverity a -> WithSeverity b
fmap :: forall a b. (a -> b) -> WithSeverity a -> WithSeverity b
$c<$ :: forall a b. a -> WithSeverity b -> WithSeverity a
<$ :: forall a b. a -> WithSeverity b -> WithSeverity a
Functor,Functor WithSeverity
Foldable WithSeverity
(Functor WithSeverity, Foldable WithSeverity) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WithSeverity a -> f (WithSeverity b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithSeverity (f a) -> f (WithSeverity a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WithSeverity a -> m (WithSeverity b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithSeverity (m a) -> m (WithSeverity a))
-> Traversable WithSeverity
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithSeverity (m a) -> m (WithSeverity a)
forall (f :: * -> *) a.
Applicative f =>
WithSeverity (f a) -> f (WithSeverity a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSeverity a -> m (WithSeverity b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSeverity a -> f (WithSeverity b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSeverity a -> f (WithSeverity b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSeverity a -> f (WithSeverity b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithSeverity (f a) -> f (WithSeverity a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithSeverity (f a) -> f (WithSeverity a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSeverity a -> m (WithSeverity b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSeverity a -> m (WithSeverity b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithSeverity (m a) -> m (WithSeverity a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WithSeverity (m a) -> m (WithSeverity a)
Traversable,(forall m. Monoid m => WithSeverity m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithSeverity a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithSeverity a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithSeverity a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithSeverity a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithSeverity a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithSeverity a -> b)
-> (forall a. (a -> a -> a) -> WithSeverity a -> a)
-> (forall a. (a -> a -> a) -> WithSeverity a -> a)
-> (forall a. WithSeverity a -> [a])
-> (forall a. WithSeverity a -> Bool)
-> (forall a. WithSeverity a -> Int)
-> (forall a. Eq a => a -> WithSeverity a -> Bool)
-> (forall a. Ord a => WithSeverity a -> a)
-> (forall a. Ord a => WithSeverity a -> a)
-> (forall a. Num a => WithSeverity a -> a)
-> (forall a. Num a => WithSeverity a -> a)
-> Foldable WithSeverity
forall a. Eq a => a -> WithSeverity a -> Bool
forall a. Num a => WithSeverity a -> a
forall a. Ord a => WithSeverity a -> a
forall m. Monoid m => WithSeverity m -> m
forall a. WithSeverity a -> Bool
forall a. WithSeverity a -> Int
forall a. WithSeverity a -> [a]
forall a. (a -> a -> a) -> WithSeverity a -> a
forall m a. Monoid m => (a -> m) -> WithSeverity a -> m
forall b a. (b -> a -> b) -> b -> WithSeverity a -> b
forall a b. (a -> b -> b) -> b -> WithSeverity a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithSeverity m -> m
fold :: forall m. Monoid m => WithSeverity m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithSeverity a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithSeverity a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithSeverity a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithSeverity a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithSeverity a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithSeverity a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithSeverity a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithSeverity a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithSeverity a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithSeverity a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithSeverity a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithSeverity a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithSeverity a -> a
foldr1 :: forall a. (a -> a -> a) -> WithSeverity a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithSeverity a -> a
foldl1 :: forall a. (a -> a -> a) -> WithSeverity a -> a
$ctoList :: forall a. WithSeverity a -> [a]
toList :: forall a. WithSeverity a -> [a]
$cnull :: forall a. WithSeverity a -> Bool
null :: forall a. WithSeverity a -> Bool
$clength :: forall a. WithSeverity a -> Int
length :: forall a. WithSeverity a -> Int
$celem :: forall a. Eq a => a -> WithSeverity a -> Bool
elem :: forall a. Eq a => a -> WithSeverity a -> Bool
$cmaximum :: forall a. Ord a => WithSeverity a -> a
maximum :: forall a. Ord a => WithSeverity a -> a
$cminimum :: forall a. Ord a => WithSeverity a -> a
minimum :: forall a. Ord a => WithSeverity a -> a
$csum :: forall a. Num a => WithSeverity a -> a
sum :: forall a. Num a => WithSeverity a -> a
$cproduct :: forall a. Num a => WithSeverity a -> a
product :: forall a. Num a => WithSeverity a -> a
Foldable)

-- | Classes of severity for log messages. These have been chosen to match
-- @syslog@ severity levels
data Severity =
 Emergency -- ^ System is unusable. By @syslog@ convention, this level should not be used by applications.
 | Alert -- ^ Should be corrected immediately.
 | Critical -- ^ Critical conditions.
 | Error -- ^ Error conditions.
 | Warning -- ^ May indicate that an error will occur if action is not taken.
 | Notice -- ^ Events that are unusual, but not error conditions.
 | Informational -- ^ Normal operational messages that require no action.
 | Debug -- ^ Information useful to developers for debugging the application.
  deriving (Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
/= :: Severity -> Severity -> Bool
Eq,Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Severity -> Severity
succ :: Severity -> Severity
$cpred :: Severity -> Severity
pred :: Severity -> Severity
$ctoEnum :: Int -> Severity
toEnum :: Int -> Severity
$cfromEnum :: Severity -> Int
fromEnum :: Severity -> Int
$cenumFrom :: Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
Enum,Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
$cminBound :: Severity
minBound :: Severity
$cmaxBound :: Severity
maxBound :: Severity
Bounded,ReadPrec [Severity]
ReadPrec Severity
Int -> ReadS Severity
ReadS [Severity]
(Int -> ReadS Severity)
-> ReadS [Severity]
-> ReadPrec Severity
-> ReadPrec [Severity]
-> Read Severity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Severity
readsPrec :: Int -> ReadS Severity
$creadList :: ReadS [Severity]
readList :: ReadS [Severity]
$creadPrec :: ReadPrec Severity
readPrec :: ReadPrec Severity
$creadListPrec :: ReadPrec [Severity]
readListPrec :: ReadPrec [Severity]
Read,Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Severity -> ShowS
showsPrec :: Int -> Severity -> ShowS
$cshow :: Severity -> String
show :: Severity -> String
$cshowList :: [Severity] -> ShowS
showList :: [Severity] -> ShowS
Show,Eq Severity
Eq Severity =>
(Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Severity -> Severity -> Ordering
compare :: Severity -> Severity -> Ordering
$c< :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
>= :: Severity -> Severity -> Bool
$cmax :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
min :: Severity -> Severity -> Severity
Ord)

instance PP.Pretty Severity where
  pretty :: forall ann. Severity -> Doc ann
pretty = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
PP.pretty (Text -> Doc ann) -> (Severity -> Text) -> Severity -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack (String -> Text) -> (Severity -> String) -> Severity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> String
forall a. Show a => a -> String
show

-- | Given a way to render the underlying message @a@, render a message with its
-- severity.
--
-- >>> renderWithSeverity id (WithSeverity Informational "Flux capacitor is functional")
-- [Informational] Flux capacitor is functional
renderWithSeverity
  :: (a -> PP.Doc ann) -> (WithSeverity a -> PP.Doc ann)
renderWithSeverity :: forall a ann. (a -> Doc ann) -> WithSeverity a -> Doc ann
renderWithSeverity a -> Doc ann
k (WithSeverity Severity
u a
a) =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.brackets (Severity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Severity -> Doc ann
PP.pretty Severity
u) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.align (a -> Doc ann
k a
a)

-- | @
-- 'logDebug' = 'logMessage' . 'WithSeverity' 'Debug'
-- @
logDebug :: MonadLog (WithSeverity a) m => a -> m ()
logDebug :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logDebug = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Debug
{-# INLINEABLE logDebug #-}

-- | @
-- 'logInfo' = 'logMessage' . 'WithSeverity' 'Informational'
-- @
logInfo :: MonadLog (WithSeverity a) m => a -> m ()
logInfo :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logInfo      = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Informational
{-# INLINEABLE logInfo #-}

-- | @
-- 'logNotice' = 'logMessage' . 'WithSeverity' 'Notice'
-- @
logNotice :: MonadLog (WithSeverity a) m => a -> m ()
logNotice :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logNotice    = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Notice
{-# INLINEABLE logNotice #-}

-- | @
-- 'logWarning' = 'logMessage' . 'WithSeverity' 'Warning'
-- @
logWarning :: MonadLog (WithSeverity a) m => a -> m ()
logWarning :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logWarning   = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Warning
{-# INLINEABLE logWarning #-}

-- | @
-- 'logError' = 'logMessage' . 'WithSeverity' 'Error'
-- @
logError :: MonadLog (WithSeverity a) m => a -> m ()
logError :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logError     = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Error
{-# INLINEABLE logError #-}

-- | @
-- 'logCritical' = 'logMessage' . 'WithSeverity' 'Critical'
-- @
logCritical :: MonadLog (WithSeverity a) m => a -> m ()
logCritical :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logCritical  = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Critical
{-# INLINEABLE logCritical #-}

-- | @
-- 'logAlert' = 'logMessage' . 'WithSeverity' 'Alert'
-- @
logAlert :: MonadLog (WithSeverity a) m => a -> m ()
logAlert :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logAlert     = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Alert
{-# INLINEABLE logAlert #-}

-- | @
-- 'logEmergency' = 'logMessage' . 'WithSeverity' 'Emergency'
-- @
logEmergency :: MonadLog (WithSeverity a) m => a -> m ()
logEmergency :: forall a (m :: * -> *). MonadLog (WithSeverity a) m => a -> m ()
logEmergency = WithSeverity a -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (WithSeverity a -> m ()) -> (a -> WithSeverity a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
Emergency
{-# INLINEABLE logEmergency #-}

--------------------------------------------------------------------------------
-- | Add a timestamp to log messages.
--
-- Note that while most log message transformers are designed to be used at the
-- point of logging, this transformer is best applied within the handler.
-- This is advised as timestamps are generally applied uniformly, so doing it
-- in the handler is fine (no extra information or context of the program is
-- required). The other reason is that logging with a timestamp requires
-- 'MonadIO' - while the rest of your computation is free to use 'MonadIO',
-- it's best to avoid incurring this constraint as much as possible, as it is
-- generally untestable.
data WithTimestamp a =
  WithTimestamp {forall a. WithTimestamp a -> a
discardTimestamp :: a  -- ^ View the underlying message.
                ,forall a. WithTimestamp a -> UTCTime
msgTimestamp :: UTCTime -- ^ Retireve the time a message was logged.
                }
  deriving (WithTimestamp a -> WithTimestamp a -> Bool
(WithTimestamp a -> WithTimestamp a -> Bool)
-> (WithTimestamp a -> WithTimestamp a -> Bool)
-> Eq (WithTimestamp a)
forall a. Eq a => WithTimestamp a -> WithTimestamp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithTimestamp a -> WithTimestamp a -> Bool
== :: WithTimestamp a -> WithTimestamp a -> Bool
$c/= :: forall a. Eq a => WithTimestamp a -> WithTimestamp a -> Bool
/= :: WithTimestamp a -> WithTimestamp a -> Bool
Eq,Eq (WithTimestamp a)
Eq (WithTimestamp a) =>
(WithTimestamp a -> WithTimestamp a -> Ordering)
-> (WithTimestamp a -> WithTimestamp a -> Bool)
-> (WithTimestamp a -> WithTimestamp a -> Bool)
-> (WithTimestamp a -> WithTimestamp a -> Bool)
-> (WithTimestamp a -> WithTimestamp a -> Bool)
-> (WithTimestamp a -> WithTimestamp a -> WithTimestamp a)
-> (WithTimestamp a -> WithTimestamp a -> WithTimestamp a)
-> Ord (WithTimestamp a)
WithTimestamp a -> WithTimestamp a -> Bool
WithTimestamp a -> WithTimestamp a -> Ordering
WithTimestamp a -> WithTimestamp a -> WithTimestamp a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (WithTimestamp a)
forall a. Ord a => WithTimestamp a -> WithTimestamp a -> Bool
forall a. Ord a => WithTimestamp a -> WithTimestamp a -> Ordering
forall a.
Ord a =>
WithTimestamp a -> WithTimestamp a -> WithTimestamp a
$ccompare :: forall a. Ord a => WithTimestamp a -> WithTimestamp a -> Ordering
compare :: WithTimestamp a -> WithTimestamp a -> Ordering
$c< :: forall a. Ord a => WithTimestamp a -> WithTimestamp a -> Bool
< :: WithTimestamp a -> WithTimestamp a -> Bool
$c<= :: forall a. Ord a => WithTimestamp a -> WithTimestamp a -> Bool
<= :: WithTimestamp a -> WithTimestamp a -> Bool
$c> :: forall a. Ord a => WithTimestamp a -> WithTimestamp a -> Bool
> :: WithTimestamp a -> WithTimestamp a -> Bool
$c>= :: forall a. Ord a => WithTimestamp a -> WithTimestamp a -> Bool
>= :: WithTimestamp a -> WithTimestamp a -> Bool
$cmax :: forall a.
Ord a =>
WithTimestamp a -> WithTimestamp a -> WithTimestamp a
max :: WithTimestamp a -> WithTimestamp a -> WithTimestamp a
$cmin :: forall a.
Ord a =>
WithTimestamp a -> WithTimestamp a -> WithTimestamp a
min :: WithTimestamp a -> WithTimestamp a -> WithTimestamp a
Ord,ReadPrec [WithTimestamp a]
ReadPrec (WithTimestamp a)
Int -> ReadS (WithTimestamp a)
ReadS [WithTimestamp a]
(Int -> ReadS (WithTimestamp a))
-> ReadS [WithTimestamp a]
-> ReadPrec (WithTimestamp a)
-> ReadPrec [WithTimestamp a]
-> Read (WithTimestamp a)
forall a. Read a => ReadPrec [WithTimestamp a]
forall a. Read a => ReadPrec (WithTimestamp a)
forall a. Read a => Int -> ReadS (WithTimestamp a)
forall a. Read a => ReadS [WithTimestamp a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (WithTimestamp a)
readsPrec :: Int -> ReadS (WithTimestamp a)
$creadList :: forall a. Read a => ReadS [WithTimestamp a]
readList :: ReadS [WithTimestamp a]
$creadPrec :: forall a. Read a => ReadPrec (WithTimestamp a)
readPrec :: ReadPrec (WithTimestamp a)
$creadListPrec :: forall a. Read a => ReadPrec [WithTimestamp a]
readListPrec :: ReadPrec [WithTimestamp a]
Read,Int -> WithTimestamp a -> ShowS
[WithTimestamp a] -> ShowS
WithTimestamp a -> String
(Int -> WithTimestamp a -> ShowS)
-> (WithTimestamp a -> String)
-> ([WithTimestamp a] -> ShowS)
-> Show (WithTimestamp a)
forall a. Show a => Int -> WithTimestamp a -> ShowS
forall a. Show a => [WithTimestamp a] -> ShowS
forall a. Show a => WithTimestamp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithTimestamp a -> ShowS
showsPrec :: Int -> WithTimestamp a -> ShowS
$cshow :: forall a. Show a => WithTimestamp a -> String
show :: WithTimestamp a -> String
$cshowList :: forall a. Show a => [WithTimestamp a] -> ShowS
showList :: [WithTimestamp a] -> ShowS
Show,(forall a b. (a -> b) -> WithTimestamp a -> WithTimestamp b)
-> (forall a b. a -> WithTimestamp b -> WithTimestamp a)
-> Functor WithTimestamp
forall a b. a -> WithTimestamp b -> WithTimestamp a
forall a b. (a -> b) -> WithTimestamp a -> WithTimestamp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithTimestamp a -> WithTimestamp b
fmap :: forall a b. (a -> b) -> WithTimestamp a -> WithTimestamp b
$c<$ :: forall a b. a -> WithTimestamp b -> WithTimestamp a
<$ :: forall a b. a -> WithTimestamp b -> WithTimestamp a
Functor,Functor WithTimestamp
Foldable WithTimestamp
(Functor WithTimestamp, Foldable WithTimestamp) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WithTimestamp a -> f (WithTimestamp b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithTimestamp (f a) -> f (WithTimestamp a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WithTimestamp a -> m (WithTimestamp b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithTimestamp (m a) -> m (WithTimestamp a))
-> Traversable WithTimestamp
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithTimestamp (m a) -> m (WithTimestamp a)
forall (f :: * -> *) a.
Applicative f =>
WithTimestamp (f a) -> f (WithTimestamp a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithTimestamp a -> m (WithTimestamp b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithTimestamp a -> f (WithTimestamp b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithTimestamp a -> f (WithTimestamp b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithTimestamp a -> f (WithTimestamp b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithTimestamp (f a) -> f (WithTimestamp a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithTimestamp (f a) -> f (WithTimestamp a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithTimestamp a -> m (WithTimestamp b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithTimestamp a -> m (WithTimestamp b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithTimestamp (m a) -> m (WithTimestamp a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WithTimestamp (m a) -> m (WithTimestamp a)
Traversable,(forall m. Monoid m => WithTimestamp m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithTimestamp a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithTimestamp a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithTimestamp a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithTimestamp a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithTimestamp a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithTimestamp a -> b)
-> (forall a. (a -> a -> a) -> WithTimestamp a -> a)
-> (forall a. (a -> a -> a) -> WithTimestamp a -> a)
-> (forall a. WithTimestamp a -> [a])
-> (forall a. WithTimestamp a -> Bool)
-> (forall a. WithTimestamp a -> Int)
-> (forall a. Eq a => a -> WithTimestamp a -> Bool)
-> (forall a. Ord a => WithTimestamp a -> a)
-> (forall a. Ord a => WithTimestamp a -> a)
-> (forall a. Num a => WithTimestamp a -> a)
-> (forall a. Num a => WithTimestamp a -> a)
-> Foldable WithTimestamp
forall a. Eq a => a -> WithTimestamp a -> Bool
forall a. Num a => WithTimestamp a -> a
forall a. Ord a => WithTimestamp a -> a
forall m. Monoid m => WithTimestamp m -> m
forall a. WithTimestamp a -> Bool
forall a. WithTimestamp a -> Int
forall a. WithTimestamp a -> [a]
forall a. (a -> a -> a) -> WithTimestamp a -> a
forall m a. Monoid m => (a -> m) -> WithTimestamp a -> m
forall b a. (b -> a -> b) -> b -> WithTimestamp a -> b
forall a b. (a -> b -> b) -> b -> WithTimestamp a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithTimestamp m -> m
fold :: forall m. Monoid m => WithTimestamp m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithTimestamp a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithTimestamp a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithTimestamp a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithTimestamp a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithTimestamp a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithTimestamp a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithTimestamp a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithTimestamp a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithTimestamp a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithTimestamp a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithTimestamp a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithTimestamp a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithTimestamp a -> a
foldr1 :: forall a. (a -> a -> a) -> WithTimestamp a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithTimestamp a -> a
foldl1 :: forall a. (a -> a -> a) -> WithTimestamp a -> a
$ctoList :: forall a. WithTimestamp a -> [a]
toList :: forall a. WithTimestamp a -> [a]
$cnull :: forall a. WithTimestamp a -> Bool
null :: forall a. WithTimestamp a -> Bool
$clength :: forall a. WithTimestamp a -> Int
length :: forall a. WithTimestamp a -> Int
$celem :: forall a. Eq a => a -> WithTimestamp a -> Bool
elem :: forall a. Eq a => a -> WithTimestamp a -> Bool
$cmaximum :: forall a. Ord a => WithTimestamp a -> a
maximum :: forall a. Ord a => WithTimestamp a -> a
$cminimum :: forall a. Ord a => WithTimestamp a -> a
minimum :: forall a. Ord a => WithTimestamp a -> a
$csum :: forall a. Num a => WithTimestamp a -> a
sum :: forall a. Num a => WithTimestamp a -> a
$cproduct :: forall a. Num a => WithTimestamp a -> a
product :: forall a. Num a => WithTimestamp a -> a
Foldable)

-- | Given a way to render the underlying message @a@ and a way to format
-- 'UTCTime', render a message with its timestamp.
--
-- >>> renderWithTimestamp (formatTime defaultTimeLocale rfc822DateFormat) id timestamppedLogMessage
-- [Tue, 19 Jan 2016 11:29:42 UTC] Setting target speed to plaid
renderWithTimestamp :: (UTCTime -> String)
                       -- ^ How to format the timestamp.
                    -> (a -> PP.Doc ann)
                       -- ^ How to render the rest of the message.
                    -> (WithTimestamp a -> PP.Doc ann)
renderWithTimestamp :: forall a ann.
(UTCTime -> String) -> (a -> Doc ann) -> WithTimestamp a -> Doc ann
renderWithTimestamp UTCTime -> String
formatter a -> Doc ann
k (WithTimestamp a
a UTCTime
t) =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.brackets (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
PP.pretty (String -> Text
LT.pack (UTCTime -> String
formatter UTCTime
t))) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.align (a -> Doc ann
k a
a)

-- | Add the current time as a timestamp to a message.
timestamp :: (MonadIO m) => a -> m (WithTimestamp a)
timestamp :: forall (m :: * -> *) a. MonadIO m => a -> m (WithTimestamp a)
timestamp a
msg = do
       now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
       pure (WithTimestamp msg now)
{-# INLINEABLE timestamp #-}

--------------------------------------------------------------------------------
-- | Add call stack information to log lines.
--
-- This functional requires that you pass around the call stack via implicit
-- parameters. For more information, see the GHC manual (section 9.14.4.5).
data WithCallStack a = WithCallStack { forall a. WithCallStack a -> CallStack
msgCallStack :: CallStack
                                     , forall a. WithCallStack a -> a
discardCallStack :: a }
  deriving ((forall a b. (a -> b) -> WithCallStack a -> WithCallStack b)
-> (forall a b. a -> WithCallStack b -> WithCallStack a)
-> Functor WithCallStack
forall a b. a -> WithCallStack b -> WithCallStack a
forall a b. (a -> b) -> WithCallStack a -> WithCallStack b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithCallStack a -> WithCallStack b
fmap :: forall a b. (a -> b) -> WithCallStack a -> WithCallStack b
$c<$ :: forall a b. a -> WithCallStack b -> WithCallStack a
<$ :: forall a b. a -> WithCallStack b -> WithCallStack a
Functor,Functor WithCallStack
Foldable WithCallStack
(Functor WithCallStack, Foldable WithCallStack) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WithCallStack a -> f (WithCallStack b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithCallStack (f a) -> f (WithCallStack a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WithCallStack a -> m (WithCallStack b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithCallStack (m a) -> m (WithCallStack a))
-> Traversable WithCallStack
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithCallStack (m a) -> m (WithCallStack a)
forall (f :: * -> *) a.
Applicative f =>
WithCallStack (f a) -> f (WithCallStack a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithCallStack a -> m (WithCallStack b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithCallStack a -> f (WithCallStack b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithCallStack a -> f (WithCallStack b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithCallStack a -> f (WithCallStack b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithCallStack (f a) -> f (WithCallStack a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithCallStack (f a) -> f (WithCallStack a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithCallStack a -> m (WithCallStack b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithCallStack a -> m (WithCallStack b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithCallStack (m a) -> m (WithCallStack a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WithCallStack (m a) -> m (WithCallStack a)
Traversable,(forall m. Monoid m => WithCallStack m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithCallStack a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithCallStack a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithCallStack a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithCallStack a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithCallStack a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithCallStack a -> b)
-> (forall a. (a -> a -> a) -> WithCallStack a -> a)
-> (forall a. (a -> a -> a) -> WithCallStack a -> a)
-> (forall a. WithCallStack a -> [a])
-> (forall a. WithCallStack a -> Bool)
-> (forall a. WithCallStack a -> Int)
-> (forall a. Eq a => a -> WithCallStack a -> Bool)
-> (forall a. Ord a => WithCallStack a -> a)
-> (forall a. Ord a => WithCallStack a -> a)
-> (forall a. Num a => WithCallStack a -> a)
-> (forall a. Num a => WithCallStack a -> a)
-> Foldable WithCallStack
forall a. Eq a => a -> WithCallStack a -> Bool
forall a. Num a => WithCallStack a -> a
forall a. Ord a => WithCallStack a -> a
forall m. Monoid m => WithCallStack m -> m
forall a. WithCallStack a -> Bool
forall a. WithCallStack a -> Int
forall a. WithCallStack a -> [a]
forall a. (a -> a -> a) -> WithCallStack a -> a
forall m a. Monoid m => (a -> m) -> WithCallStack a -> m
forall b a. (b -> a -> b) -> b -> WithCallStack a -> b
forall a b. (a -> b -> b) -> b -> WithCallStack a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithCallStack m -> m
fold :: forall m. Monoid m => WithCallStack m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithCallStack a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithCallStack a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithCallStack a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithCallStack a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithCallStack a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithCallStack a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithCallStack a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithCallStack a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithCallStack a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithCallStack a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithCallStack a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithCallStack a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithCallStack a -> a
foldr1 :: forall a. (a -> a -> a) -> WithCallStack a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithCallStack a -> a
foldl1 :: forall a. (a -> a -> a) -> WithCallStack a -> a
$ctoList :: forall a. WithCallStack a -> [a]
toList :: forall a. WithCallStack a -> [a]
$cnull :: forall a. WithCallStack a -> Bool
null :: forall a. WithCallStack a -> Bool
$clength :: forall a. WithCallStack a -> Int
length :: forall a. WithCallStack a -> Int
$celem :: forall a. Eq a => a -> WithCallStack a -> Bool
elem :: forall a. Eq a => a -> WithCallStack a -> Bool
$cmaximum :: forall a. Ord a => WithCallStack a -> a
maximum :: forall a. Ord a => WithCallStack a -> a
$cminimum :: forall a. Ord a => WithCallStack a -> a
minimum :: forall a. Ord a => WithCallStack a -> a
$csum :: forall a. Num a => WithCallStack a -> a
sum :: forall a. Num a => WithCallStack a -> a
$cproduct :: forall a. Num a => WithCallStack a -> a
product :: forall a. Num a => WithCallStack a -> a
Foldable,Int -> WithCallStack a -> ShowS
[WithCallStack a] -> ShowS
WithCallStack a -> String
(Int -> WithCallStack a -> ShowS)
-> (WithCallStack a -> String)
-> ([WithCallStack a] -> ShowS)
-> Show (WithCallStack a)
forall a. Show a => Int -> WithCallStack a -> ShowS
forall a. Show a => [WithCallStack a] -> ShowS
forall a. Show a => WithCallStack a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithCallStack a -> ShowS
showsPrec :: Int -> WithCallStack a -> ShowS
$cshow :: forall a. Show a => WithCallStack a -> String
show :: WithCallStack a -> String
$cshowList :: forall a. Show a => [WithCallStack a] -> ShowS
showList :: [WithCallStack a] -> ShowS
Show)

-- | Given a way to render the underlying message @a@ render a message with a
-- callstack.
--
-- The callstack will be pretty-printed underneath the log message itself.
renderWithCallStack :: (a -> PP.Doc ann) -> WithCallStack a -> PP.Doc ann
renderWithCallStack :: forall a ann. (a -> Doc ann) -> WithCallStack a -> Doc ann
renderWithCallStack a -> Doc ann
k (WithCallStack CallStack
stack a
msg) =
  a -> Doc ann
k a
msg Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
PP.line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
2 ([(String, SrcLoc)] -> Doc ann
forall ann. [(String, SrcLoc)] -> Doc ann
prettyCallStack (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
stack))

#if MIN_VERSION_base(4, 9, 0)
showSrcLoc :: SrcLoc -> String
showSrcLoc :: SrcLoc -> String
showSrcLoc = SrcLoc -> String
prettySrcLoc
#endif

prettyCallStack :: [(String,SrcLoc)] -> PP.Doc ann
prettyCallStack :: forall ann. [(String, SrcLoc)] -> Doc ann
prettyCallStack [] = Doc ann
"empty callstack"
prettyCallStack ((String, SrcLoc)
root:[(String, SrcLoc)]
rest) =
  (String, SrcLoc) -> Doc ann
forall {ann}. (String, SrcLoc) -> Doc ann
prettyCallSite (String, SrcLoc)
root Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
PP.line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
PP.vsep (((String, SrcLoc) -> Doc ann) -> [(String, SrcLoc)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (String, SrcLoc) -> Doc ann
forall {ann}. (String, SrcLoc) -> Doc ann
prettyCallSite [(String, SrcLoc)]
rest))
  where prettyCallSite :: (String, SrcLoc) -> Doc ann
prettyCallSite (String
f,SrcLoc
loc) =
          Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
PP.pretty (String -> Text
LT.pack String
f) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", called at " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
          Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
PP.pretty (String -> Text
LT.pack (SrcLoc -> String
showSrcLoc SrcLoc
loc))

-- | Construct a 'WithCallStack' log message.
--
-- This should normally be preferred over just using 'WithCallStack' as it will
-- append a new entry to the stack - pointing to this exact log line. However,
-- if you are creating a combinator (such as a wrapper that logs and throws
-- an exception), you may be better manually capturing the 'CallStack' and
-- using 'WithCallStack'.
withCallStack :: (?stack :: CallStack) => a -> WithCallStack a
withCallStack :: forall a. (?stack::CallStack) => a -> WithCallStack a
withCallStack = CallStack -> a -> WithCallStack a
forall a. CallStack -> a -> WithCallStack a
WithCallStack ?stack::CallStack
CallStack
?stack

--------------------------------------------------------------------------------
-- | 'LoggingT' is a very general handler for the 'MonadLog' effect. Whenever a
-- log entry is emitted, the given 'Handler' is invoked, producing some
-- side-effect (such as writing to @stdout@, or appending a database table).
newtype LoggingT message m a =
  LoggingT (ReaderT (Handler m message) m a)
  deriving (Applicative (LoggingT message m)
Applicative (LoggingT message m) =>
(forall a b.
 LoggingT message m a
 -> (a -> LoggingT message m b) -> LoggingT message m b)
-> (forall a b.
    LoggingT message m a
    -> LoggingT message m b -> LoggingT message m b)
-> (forall a. a -> LoggingT message m a)
-> Monad (LoggingT message m)
forall a. a -> LoggingT message m a
forall a b.
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
forall a b.
LoggingT message m a
-> (a -> LoggingT message m b) -> LoggingT message m b
forall message (m :: * -> *).
Monad m =>
Applicative (LoggingT message m)
forall message (m :: * -> *) a.
Monad m =>
a -> LoggingT message m a
forall message (m :: * -> *) a b.
Monad m =>
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
forall message (m :: * -> *) a b.
Monad m =>
LoggingT message m a
-> (a -> LoggingT message m b) -> LoggingT message 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 message (m :: * -> *) a b.
Monad m =>
LoggingT message m a
-> (a -> LoggingT message m b) -> LoggingT message m b
>>= :: forall a b.
LoggingT message m a
-> (a -> LoggingT message m b) -> LoggingT message m b
$c>> :: forall message (m :: * -> *) a b.
Monad m =>
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
>> :: forall a b.
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
$creturn :: forall message (m :: * -> *) a.
Monad m =>
a -> LoggingT message m a
return :: forall a. a -> LoggingT message m a
Monad,Functor (LoggingT message m)
Functor (LoggingT message m) =>
(forall a. a -> LoggingT message m a)
-> (forall a b.
    LoggingT message m (a -> b)
    -> LoggingT message m a -> LoggingT message m b)
-> (forall a b c.
    (a -> b -> c)
    -> LoggingT message m a
    -> LoggingT message m b
    -> LoggingT message m c)
-> (forall a b.
    LoggingT message m a
    -> LoggingT message m b -> LoggingT message m b)
-> (forall a b.
    LoggingT message m a
    -> LoggingT message m b -> LoggingT message m a)
-> Applicative (LoggingT message m)
forall a. a -> LoggingT message m a
forall a b.
LoggingT message m a
-> LoggingT message m b -> LoggingT message m a
forall a b.
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
forall a b.
LoggingT message m (a -> b)
-> LoggingT message m a -> LoggingT message m b
forall a b c.
(a -> b -> c)
-> LoggingT message m a
-> LoggingT message m b
-> LoggingT message m c
forall message (m :: * -> *).
Applicative m =>
Functor (LoggingT message m)
forall message (m :: * -> *) a.
Applicative m =>
a -> LoggingT message m a
forall message (m :: * -> *) a b.
Applicative m =>
LoggingT message m a
-> LoggingT message m b -> LoggingT message m a
forall message (m :: * -> *) a b.
Applicative m =>
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
forall message (m :: * -> *) a b.
Applicative m =>
LoggingT message m (a -> b)
-> LoggingT message m a -> LoggingT message m b
forall message (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> LoggingT message m a
-> LoggingT message m b
-> LoggingT message 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 message (m :: * -> *) a.
Applicative m =>
a -> LoggingT message m a
pure :: forall a. a -> LoggingT message m a
$c<*> :: forall message (m :: * -> *) a b.
Applicative m =>
LoggingT message m (a -> b)
-> LoggingT message m a -> LoggingT message m b
<*> :: forall a b.
LoggingT message m (a -> b)
-> LoggingT message m a -> LoggingT message m b
$cliftA2 :: forall message (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> LoggingT message m a
-> LoggingT message m b
-> LoggingT message m c
liftA2 :: forall a b c.
(a -> b -> c)
-> LoggingT message m a
-> LoggingT message m b
-> LoggingT message m c
$c*> :: forall message (m :: * -> *) a b.
Applicative m =>
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
*> :: forall a b.
LoggingT message m a
-> LoggingT message m b -> LoggingT message m b
$c<* :: forall message (m :: * -> *) a b.
Applicative m =>
LoggingT message m a
-> LoggingT message m b -> LoggingT message m a
<* :: forall a b.
LoggingT message m a
-> LoggingT message m b -> LoggingT message m a
Applicative,(forall a b.
 (a -> b) -> LoggingT message m a -> LoggingT message m b)
-> (forall a b. a -> LoggingT message m b -> LoggingT message m a)
-> Functor (LoggingT message m)
forall a b. a -> LoggingT message m b -> LoggingT message m a
forall a b.
(a -> b) -> LoggingT message m a -> LoggingT message m b
forall message (m :: * -> *) a b.
Functor m =>
a -> LoggingT message m b -> LoggingT message m a
forall message (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggingT message m a -> LoggingT message 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 message (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggingT message m a -> LoggingT message m b
fmap :: forall a b.
(a -> b) -> LoggingT message m a -> LoggingT message m b
$c<$ :: forall message (m :: * -> *) a b.
Functor m =>
a -> LoggingT message m b -> LoggingT message m a
<$ :: forall a b. a -> LoggingT message m b -> LoggingT message m a
Functor,Monad (LoggingT message m)
Monad (LoggingT message m) =>
(forall a. (a -> LoggingT message m a) -> LoggingT message m a)
-> MonadFix (LoggingT message m)
forall a. (a -> LoggingT message m a) -> LoggingT message m a
forall message (m :: * -> *).
MonadFix m =>
Monad (LoggingT message m)
forall message (m :: * -> *) a.
MonadFix m =>
(a -> LoggingT message m a) -> LoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall message (m :: * -> *) a.
MonadFix m =>
(a -> LoggingT message m a) -> LoggingT message m a
mfix :: forall a. (a -> LoggingT message m a) -> LoggingT message m a
MonadFix,Applicative (LoggingT message m)
Applicative (LoggingT message m) =>
(forall a. LoggingT message m a)
-> (forall a.
    LoggingT message m a
    -> LoggingT message m a -> LoggingT message m a)
-> (forall a. LoggingT message m a -> LoggingT message m [a])
-> (forall a. LoggingT message m a -> LoggingT message m [a])
-> Alternative (LoggingT message m)
forall a. LoggingT message m a
forall a. LoggingT message m a -> LoggingT message m [a]
forall a.
LoggingT message m a
-> LoggingT message m a -> LoggingT message m a
forall message (m :: * -> *).
Alternative m =>
Applicative (LoggingT message m)
forall message (m :: * -> *) a.
Alternative m =>
LoggingT message m a
forall message (m :: * -> *) a.
Alternative m =>
LoggingT message m a -> LoggingT message m [a]
forall message (m :: * -> *) a.
Alternative m =>
LoggingT message m a
-> LoggingT message m a -> LoggingT message 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 message (m :: * -> *) a.
Alternative m =>
LoggingT message m a
empty :: forall a. LoggingT message m a
$c<|> :: forall message (m :: * -> *) a.
Alternative m =>
LoggingT message m a
-> LoggingT message m a -> LoggingT message m a
<|> :: forall a.
LoggingT message m a
-> LoggingT message m a -> LoggingT message m a
$csome :: forall message (m :: * -> *) a.
Alternative m =>
LoggingT message m a -> LoggingT message m [a]
some :: forall a. LoggingT message m a -> LoggingT message m [a]
$cmany :: forall message (m :: * -> *) a.
Alternative m =>
LoggingT message m a -> LoggingT message m [a]
many :: forall a. LoggingT message m a -> LoggingT message m [a]
Alternative,Monad (LoggingT message m)
Alternative (LoggingT message m)
(Alternative (LoggingT message m), Monad (LoggingT message m)) =>
(forall a. LoggingT message m a)
-> (forall a.
    LoggingT message m a
    -> LoggingT message m a -> LoggingT message m a)
-> MonadPlus (LoggingT message m)
forall a. LoggingT message m a
forall a.
LoggingT message m a
-> LoggingT message m a -> LoggingT message m a
forall message (m :: * -> *).
MonadPlus m =>
Monad (LoggingT message m)
forall message (m :: * -> *).
MonadPlus m =>
Alternative (LoggingT message m)
forall message (m :: * -> *) a. MonadPlus m => LoggingT message m a
forall message (m :: * -> *) a.
MonadPlus m =>
LoggingT message m a
-> LoggingT message m a -> LoggingT message m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall message (m :: * -> *) a. MonadPlus m => LoggingT message m a
mzero :: forall a. LoggingT message m a
$cmplus :: forall message (m :: * -> *) a.
MonadPlus m =>
LoggingT message m a
-> LoggingT message m a -> LoggingT message m a
mplus :: forall a.
LoggingT message m a
-> LoggingT message m a -> LoggingT message m a
MonadPlus,Monad (LoggingT message m)
Monad (LoggingT message m) =>
(forall a. IO a -> LoggingT message m a)
-> MonadIO (LoggingT message m)
forall a. IO a -> LoggingT message m a
forall message (m :: * -> *).
MonadIO m =>
Monad (LoggingT message m)
forall message (m :: * -> *) a.
MonadIO m =>
IO a -> LoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall message (m :: * -> *) a.
MonadIO m =>
IO a -> LoggingT message m a
liftIO :: forall a. IO a -> LoggingT message m a
MonadIO,MonadIO (LoggingT message m)
MonadIO (LoggingT message m) =>
(forall b.
 ((forall a. LoggingT message m a -> IO a) -> IO b)
 -> LoggingT message m b)
-> MonadUnliftIO (LoggingT message m)
forall b.
((forall a. LoggingT message m a -> IO a) -> IO b)
-> LoggingT message m b
forall message (m :: * -> *).
MonadUnliftIO m =>
MonadIO (LoggingT message m)
forall message (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. LoggingT message m a -> IO a) -> IO b)
-> LoggingT message m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall message (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. LoggingT message m a -> IO a) -> IO b)
-> LoggingT message m b
withRunInIO :: forall b.
((forall a. LoggingT message m a -> IO a) -> IO b)
-> LoggingT message m b
MonadUnliftIO,MonadWriter w,Monad (LoggingT message m)
Monad (LoggingT message m) =>
(forall a b.
 ((a -> LoggingT message m b) -> LoggingT message m a)
 -> LoggingT message m a)
-> MonadCont (LoggingT message m)
forall a b.
((a -> LoggingT message m b) -> LoggingT message m a)
-> LoggingT message m a
forall message (m :: * -> *).
MonadCont m =>
Monad (LoggingT message m)
forall message (m :: * -> *) a b.
MonadCont m =>
((a -> LoggingT message m b) -> LoggingT message m a)
-> LoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
$ccallCC :: forall message (m :: * -> *) a b.
MonadCont m =>
((a -> LoggingT message m b) -> LoggingT message m a)
-> LoggingT message m a
callCC :: forall a b.
((a -> LoggingT message m b) -> LoggingT message m a)
-> LoggingT message m a
MonadCont,MonadError e,MonadCatch (LoggingT message m)
MonadCatch (LoggingT message m) =>
(forall b.
 HasCallStack =>
 ((forall a. LoggingT message m a -> LoggingT message m a)
  -> LoggingT message m b)
 -> LoggingT message m b)
-> (forall b.
    HasCallStack =>
    ((forall a. LoggingT message m a -> LoggingT message m a)
     -> LoggingT message m b)
    -> LoggingT message m b)
-> (forall a b c.
    HasCallStack =>
    LoggingT message m a
    -> (a -> ExitCase b -> LoggingT message m c)
    -> (a -> LoggingT message m b)
    -> LoggingT message m (b, c))
-> MonadMask (LoggingT message m)
forall b.
HasCallStack =>
((forall a. LoggingT message m a -> LoggingT message m a)
 -> LoggingT message m b)
-> LoggingT message m b
forall a b c.
HasCallStack =>
LoggingT message m a
-> (a -> ExitCase b -> LoggingT message m c)
-> (a -> LoggingT message m b)
-> LoggingT message m (b, c)
forall message (m :: * -> *).
MonadMask m =>
MonadCatch (LoggingT message m)
forall message (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. LoggingT message m a -> LoggingT message m a)
 -> LoggingT message m b)
-> LoggingT message m b
forall message (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
LoggingT message m a
-> (a -> ExitCase b -> LoggingT message m c)
-> (a -> LoggingT message m b)
-> LoggingT message m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall message (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. LoggingT message m a -> LoggingT message m a)
 -> LoggingT message m b)
-> LoggingT message m b
mask :: forall b.
HasCallStack =>
((forall a. LoggingT message m a -> LoggingT message m a)
 -> LoggingT message m b)
-> LoggingT message m b
$cuninterruptibleMask :: forall message (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. LoggingT message m a -> LoggingT message m a)
 -> LoggingT message m b)
-> LoggingT message m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. LoggingT message m a -> LoggingT message m a)
 -> LoggingT message m b)
-> LoggingT message m b
$cgeneralBracket :: forall message (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
LoggingT message m a
-> (a -> ExitCase b -> LoggingT message m c)
-> (a -> LoggingT message m b)
-> LoggingT message m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
LoggingT message m a
-> (a -> ExitCase b -> LoggingT message m c)
-> (a -> LoggingT message m b)
-> LoggingT message m (b, c)
MonadMask,MonadThrow (LoggingT message m)
MonadThrow (LoggingT message m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 LoggingT message m a
 -> (e -> LoggingT message m a) -> LoggingT message m a)
-> MonadCatch (LoggingT message m)
forall e a.
(HasCallStack, Exception e) =>
LoggingT message m a
-> (e -> LoggingT message m a) -> LoggingT message m a
forall message (m :: * -> *).
MonadCatch m =>
MonadThrow (LoggingT message m)
forall message (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
LoggingT message m a
-> (e -> LoggingT message m a) -> LoggingT message m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall message (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
LoggingT message m a
-> (e -> LoggingT message m a) -> LoggingT message m a
catch :: forall e a.
(HasCallStack, Exception e) =>
LoggingT message m a
-> (e -> LoggingT message m a) -> LoggingT message m a
MonadCatch,Monad (LoggingT message m)
Monad (LoggingT message m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> LoggingT message m a)
-> MonadThrow (LoggingT message m)
forall e a.
(HasCallStack, Exception e) =>
e -> LoggingT message m a
forall message (m :: * -> *).
MonadThrow m =>
Monad (LoggingT message m)
forall message (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> LoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall message (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> LoggingT message m a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> LoggingT message m a
MonadThrow,MonadState s, Monad (LoggingT message m)
Monad (LoggingT message m) =>
(forall a. String -> LoggingT message m a)
-> MonadFail (LoggingT message m)
forall a. String -> LoggingT message m a
forall message (m :: * -> *).
MonadFail m =>
Monad (LoggingT message m)
forall message (m :: * -> *) a.
MonadFail m =>
String -> LoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall message (m :: * -> *) a.
MonadFail m =>
String -> LoggingT message m a
fail :: forall a. String -> LoggingT message m a
Fail.MonadFail)

instance MonadBase b m => MonadBase b (LoggingT message m) where
  liftBase :: forall α. b α -> LoggingT message m α
liftBase = m α -> LoggingT message m α
forall (m :: * -> *) a. Monad m => m a -> LoggingT message m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> LoggingT message m α)
-> (b α -> m α) -> b α -> LoggingT message m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall α. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadBaseControl b m => MonadBaseControl b (LoggingT message m) where
  type StM (LoggingT message m) a = StM m a
  liftBaseWith :: forall a.
(RunInBase (LoggingT message m) b -> b a) -> LoggingT message m a
liftBaseWith RunInBase (LoggingT message m) b -> b a
runInBase =
    ReaderT (Handler m message) m a -> LoggingT message m a
forall message (m :: * -> *) a.
ReaderT (Handler m message) m a -> LoggingT message m a
LoggingT ((Handler m message -> m a) -> ReaderT (Handler m message) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\Handler m message
handler ->
                         (RunInBase m b -> b a) -> m a
forall a. (RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith
                           (\RunInBase m b
runInReader ->
                              RunInBase (LoggingT message m) b -> b a
runInBase (\(LoggingT (ReaderT Handler m message -> m a
m)) ->
                                           m a -> b (StM m a)
RunInBase m b
runInReader (Handler m message -> m a
m Handler m message
handler)))))
  restoreM :: forall a. StM (LoggingT message m) a -> LoggingT message m a
restoreM StM (LoggingT message m) a
st = ReaderT (Handler m message) m a -> LoggingT message m a
forall message (m :: * -> *) a.
ReaderT (Handler m message) m a -> LoggingT message m a
LoggingT ((Handler m message -> m a) -> ReaderT (Handler m message) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\Handler m message
_ -> StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LoggingT message m) a
st))

-- | Given a 'Handler' for a given @message@, interleave this 'Handler' into the
-- underlying @m@ computation whenever 'logMessage' is called.
runLoggingT
  :: LoggingT message m a -> Handler m message -> m a
runLoggingT :: forall message (m :: * -> *) a.
LoggingT message m a -> Handler m message -> m a
runLoggingT (LoggingT (ReaderT Handler m message -> m a
m)) Handler m message
handler = Handler m message -> m a
m Handler m message
handler
{-# INLINEABLE runLoggingT #-}

instance MonadTrans (LoggingT message) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> LoggingT message m a
lift = ReaderT (Handler m message) m a -> LoggingT message m a
forall message (m :: * -> *) a.
ReaderT (Handler m message) m a -> LoggingT message m a
LoggingT (ReaderT (Handler m message) m a -> LoggingT message m a)
-> (m a -> ReaderT (Handler m message) m a)
-> m a
-> LoggingT message m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handler m message -> m a) -> ReaderT (Handler m message) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Handler m message -> m a) -> ReaderT (Handler m message) m a)
-> (m a -> Handler m message -> m a)
-> m a
-> ReaderT (Handler m message) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Handler m message -> m a
forall a b. a -> b -> a
const
  {-# INLINEABLE lift #-}

instance MonadReader r m => MonadReader r (LoggingT message m) where
  ask :: LoggingT message m r
ask = m r -> LoggingT message m r
forall (m :: * -> *) a. Monad m => m a -> LoggingT message m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  {-# INLINEABLE ask #-}
  local :: forall a. (r -> r) -> LoggingT message m a -> LoggingT message m a
local r -> r
f (LoggingT (ReaderT Handler m message -> m a
m)) = ReaderT (Handler m message) m a -> LoggingT message m a
forall message (m :: * -> *) a.
ReaderT (Handler m message) m a -> LoggingT message m a
LoggingT ((Handler m message -> m a) -> ReaderT (Handler m message) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m a -> m a)
-> (Handler m message -> m a) -> Handler m message -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler m message -> m a
m))
  {-# INLINEABLE local #-}
  reader :: forall a. (r -> a) -> LoggingT message m a
reader r -> a
f = m a -> LoggingT message m a
forall (m :: * -> *) a. Monad m => m a -> LoggingT message m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((r -> a) -> m a
forall a. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader r -> a
f)
  {-# INLINEABLE reader #-}

newtype Ap m = Ap { forall (m :: * -> *). Ap m -> m ()
runAp :: m () }

instance Applicative m => Semigroup (Ap m) where
  Ap m ()
l <> :: Ap m -> Ap m -> Ap m
<> Ap m ()
r = m () -> Ap m
forall (m :: * -> *). m () -> Ap m
Ap (m ()
l m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
r)
  {-# INLINEABLE (<>) #-}

instance Applicative m => Monoid (Ap m) where
  mempty :: Ap m
mempty = m () -> Ap m
forall (m :: * -> *). m () -> Ap m
Ap (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINEABLE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
  Ap l `mappend` Ap r = Ap (l *> r)
  {-# INLINEABLE mappend #-}
#endif

-- | The main instance of 'MonadLog', which replaces calls to 'logMessage' with calls to a 'Handler'.
instance Monad m => MonadLog message (LoggingT message m) where
  logMessageFree :: (forall n. Monoid n => (message -> n) -> n)
-> LoggingT message m ()
logMessageFree forall n. Monoid n => (message -> n) -> n
foldMap = ReaderT (Handler m message) m () -> LoggingT message m ()
forall message (m :: * -> *) a.
ReaderT (Handler m message) m a -> LoggingT message m a
LoggingT ((Handler m message -> m ()) -> ReaderT (Handler m message) m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\Handler m message
handler -> Ap m -> m ()
forall (m :: * -> *). Ap m -> m ()
runAp ((message -> Ap m) -> Ap m
forall n. Monoid n => (message -> n) -> n
foldMap (m () -> Ap m
forall (m :: * -> *). m () -> Ap m
Ap (m () -> Ap m) -> Handler m message -> message -> Ap m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler m message
handler))))
  {-# INLINEABLE logMessageFree #-}

instance MonadRWS r w s m => MonadRWS r w s (LoggingT message m)

instance (Functor f,MonadFree f m) => MonadFree f (LoggingT message m)

-- | 'LoggingT' unfortunately does admit an instance of the @MFunctor@ type
-- class, which provides the @hoist@ method to change the monad underneath
-- a monad transformer. However, it is possible to do this with 'LoggingT'
-- provided that you have a way to re-interpret a log handler in the
-- original monad.
mapLoggingT :: (forall x. (Handler m message -> m x) -> (Handler n message' -> n x))
            -> LoggingT message m a
            -> LoggingT message' n a
mapLoggingT :: forall (m :: * -> *) message (n :: * -> *) message' a.
(forall x. (Handler m message -> m x) -> Handler n message' -> n x)
-> LoggingT message m a -> LoggingT message' n a
mapLoggingT forall x. (Handler m message -> m x) -> Handler n message' -> n x
eta (LoggingT (ReaderT Handler m message -> m a
f)) = ReaderT (Handler n message') n a -> LoggingT message' n a
forall message (m :: * -> *) a.
ReaderT (Handler m message) m a -> LoggingT message m a
LoggingT ((Handler n message' -> n a) -> ReaderT (Handler n message') n a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Handler m message -> m a) -> Handler n message' -> n a
forall x. (Handler m message -> m x) -> Handler n message' -> n x
eta Handler m message -> m a
f))
{-# INLINEABLE mapLoggingT #-}

--------------------------------------------------------------------------------
-- | Handlers are mechanisms to interpret the meaning of logging as an action
-- in the underlying monad. They are simply functions from log messages to
-- @m@-actions.
type Handler m message = message -> m ()

-- | Options that be used to configure 'withBatchingHandler'.
data BatchingOptions =
  BatchingOptions {BatchingOptions -> Int
flushMaxDelay :: Int -- ^ The maximum amount of time to wait between flushes
                  ,BatchingOptions -> Int
flushMaxQueueSize :: Int -- ^ The maximum amount of messages to hold in memory between flushes}
                  ,BatchingOptions -> Bool
blockWhenFull :: Bool -- ^ If the 'Handler' becomes full, 'logMessage' will block until the queue is flushed if 'blockWhenFull' is 'True', otherwise it will drop that message and continue.
                  }
  deriving (BatchingOptions -> BatchingOptions -> Bool
(BatchingOptions -> BatchingOptions -> Bool)
-> (BatchingOptions -> BatchingOptions -> Bool)
-> Eq BatchingOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BatchingOptions -> BatchingOptions -> Bool
== :: BatchingOptions -> BatchingOptions -> Bool
$c/= :: BatchingOptions -> BatchingOptions -> Bool
/= :: BatchingOptions -> BatchingOptions -> Bool
Eq,Eq BatchingOptions
Eq BatchingOptions =>
(BatchingOptions -> BatchingOptions -> Ordering)
-> (BatchingOptions -> BatchingOptions -> Bool)
-> (BatchingOptions -> BatchingOptions -> Bool)
-> (BatchingOptions -> BatchingOptions -> Bool)
-> (BatchingOptions -> BatchingOptions -> Bool)
-> (BatchingOptions -> BatchingOptions -> BatchingOptions)
-> (BatchingOptions -> BatchingOptions -> BatchingOptions)
-> Ord BatchingOptions
BatchingOptions -> BatchingOptions -> Bool
BatchingOptions -> BatchingOptions -> Ordering
BatchingOptions -> BatchingOptions -> BatchingOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BatchingOptions -> BatchingOptions -> Ordering
compare :: BatchingOptions -> BatchingOptions -> Ordering
$c< :: BatchingOptions -> BatchingOptions -> Bool
< :: BatchingOptions -> BatchingOptions -> Bool
$c<= :: BatchingOptions -> BatchingOptions -> Bool
<= :: BatchingOptions -> BatchingOptions -> Bool
$c> :: BatchingOptions -> BatchingOptions -> Bool
> :: BatchingOptions -> BatchingOptions -> Bool
$c>= :: BatchingOptions -> BatchingOptions -> Bool
>= :: BatchingOptions -> BatchingOptions -> Bool
$cmax :: BatchingOptions -> BatchingOptions -> BatchingOptions
max :: BatchingOptions -> BatchingOptions -> BatchingOptions
$cmin :: BatchingOptions -> BatchingOptions -> BatchingOptions
min :: BatchingOptions -> BatchingOptions -> BatchingOptions
Ord,ReadPrec [BatchingOptions]
ReadPrec BatchingOptions
Int -> ReadS BatchingOptions
ReadS [BatchingOptions]
(Int -> ReadS BatchingOptions)
-> ReadS [BatchingOptions]
-> ReadPrec BatchingOptions
-> ReadPrec [BatchingOptions]
-> Read BatchingOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BatchingOptions
readsPrec :: Int -> ReadS BatchingOptions
$creadList :: ReadS [BatchingOptions]
readList :: ReadS [BatchingOptions]
$creadPrec :: ReadPrec BatchingOptions
readPrec :: ReadPrec BatchingOptions
$creadListPrec :: ReadPrec [BatchingOptions]
readListPrec :: ReadPrec [BatchingOptions]
Read,Int -> BatchingOptions -> ShowS
[BatchingOptions] -> ShowS
BatchingOptions -> String
(Int -> BatchingOptions -> ShowS)
-> (BatchingOptions -> String)
-> ([BatchingOptions] -> ShowS)
-> Show BatchingOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatchingOptions -> ShowS
showsPrec :: Int -> BatchingOptions -> ShowS
$cshow :: BatchingOptions -> String
show :: BatchingOptions -> String
$cshowList :: [BatchingOptions] -> ShowS
showList :: [BatchingOptions] -> ShowS
Show)

-- | Defaults for 'BatchingOptions'
--
-- @
-- 'defaultBatchingOptions' = 'BatchingOptions' {'flushMaxDelay' = 1000000
--                                          ,'flushMaxQueueSize' = 100
--                                          ,'blockWhenFull' = 'True'}
-- @
defaultBatchingOptions :: BatchingOptions
defaultBatchingOptions :: BatchingOptions
defaultBatchingOptions = Int -> Int -> Bool -> BatchingOptions
BatchingOptions Int
1000000 Int
100 Bool
True

-- | Create a new batched handler. Batched handlers take batches of messages to
-- log at once, which can be more performant than logging each individual
-- message.
--
-- A batched handler flushes under three criteria:
--
--   1. The flush interval has elapsed and the queue is not empty.
--   2. The queue has become full and needs to be flushed.
--   3. The scope of 'withBatchedHandler' is exited.
--
-- Batched handlers queue size and flush period can be configured via
-- 'BatchingOptions'.
withBatchedHandler :: (MonadIO io,MonadMask io)
                   => BatchingOptions
                   -> (NEL.NonEmpty message -> IO ())
                   -> (Handler io message -> io a)
                   -> io a
withBatchedHandler :: forall (io :: * -> *) message a.
(MonadIO io, MonadMask io) =>
BatchingOptions
-> (NonEmpty message -> IO ())
-> (Handler io message -> io a)
-> io a
withBatchedHandler BatchingOptions{Bool
Int
flushMaxDelay :: BatchingOptions -> Int
flushMaxQueueSize :: BatchingOptions -> Int
blockWhenFull :: BatchingOptions -> Bool
flushMaxDelay :: Int
flushMaxQueueSize :: Int
blockWhenFull :: Bool
..} NonEmpty message -> IO ()
flush Handler io message -> io a
k =
  do closed <- IO (TVar Bool) -> io (TVar Bool)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
False)
     channel <- liftIO (newTBQueueIO (fromIntegral flushMaxQueueSize))
     bracket (liftIO (async (repeatWhileTrue (publish closed channel))))
             (\Async ()
publisher ->
                do IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do STM () -> IO ()
forall a. STM a -> IO a
atomically (TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
closed Bool
True)
                              Async () -> IO ()
forall a. Async a -> IO a
wait Async ()
publisher))
             (\Async ()
_ ->
                Handler io message -> io a
k (\message
msg ->
                     IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (STM () -> IO ()
forall a. STM a -> IO a
atomically
                               (TBQueue message -> message -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue message
channel message
msg STM () -> STM () -> STM ()
forall a. STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                Bool -> STM ()
check (Bool -> Bool
not Bool
blockWhenFull)))))
  where repeatWhileTrue :: m Bool -> m ()
repeatWhileTrue m Bool
m =
          do again <- m Bool
m
             if again
                then repeatWhileTrue m
                else return ()
        publish :: TVar Bool -> TBQueue message -> IO Bool
publish TVar Bool
closed TBQueue message
channel =
          do flushAlarm <- Int -> IO Delay
newDelay Int
flushMaxDelay
             (messages,stillOpen) <-
               atomically
                 (do messages <-
                       flushAfter flushAlarm <|> flushFull <|> flushOnClose
                     stillOpen <- fmap not (readTVar closed)
                     return (messages,stillOpen))
             mapM_ flush (NEL.nonEmpty messages)
             pure stillOpen
          where flushAfter :: Delay -> STM [message]
flushAfter Delay
flushAlarm =
                  do Delay -> STM ()
waitDelay Delay
flushAlarm
                     TBQueue message -> STM Bool
forall a. TBQueue a -> STM Bool
isEmptyTBQueue TBQueue message
channel STM Bool -> (Bool -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> STM ()) -> (Bool -> Bool) -> Bool -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
                     TBQueue message -> STM [message]
forall {a}. TBQueue a -> STM [a]
emptyTBQueue TBQueue message
channel
                flushFull :: STM [message]
flushFull =
                  do TBQueue message -> STM Bool
forall a. TBQueue a -> STM Bool
isFullTBQueue TBQueue message
channel STM Bool -> (Bool -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
                     TBQueue message -> STM [message]
forall {a}. TBQueue a -> STM [a]
emptyTBQueue TBQueue message
channel
                flushOnClose :: STM [message]
flushOnClose =
                  do TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed STM Bool -> (Bool -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
                     TBQueue message -> STM [message]
forall {a}. TBQueue a -> STM [a]
emptyTBQueue TBQueue message
channel
        emptyTBQueue :: TBQueue a -> STM [a]
emptyTBQueue TBQueue a
q =
          do mx <- TBQueue a -> STM (Maybe a)
forall a. TBQueue a -> STM (Maybe a)
tryReadTBQueue TBQueue a
q
             case mx of
               Maybe a
Nothing -> [a] -> STM [a]
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return []
               Just a
x -> ([a] -> [a]) -> STM [a] -> STM [a]
forall a b. (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (TBQueue a -> STM [a]
emptyTBQueue TBQueue a
q)

-- | 'withFDHandler' creates a new 'Handler' that will append a given file
-- descriptor (or 'Handle', as it is known in the "base" library). Note that
-- this 'Handler' requires log messages to be of type 'PP.Doc'. This abstractly
-- specifies a pretty-printing for log lines. The two arguments two
-- 'withFDHandler' determine how this pretty-printing should be realised
-- when outputting log lines.
--
-- These 'Handler's asynchronously log messages to the given file descriptor,
-- rather than blocking.
withFDHandler
  :: (MonadIO io,MonadMask io)
  => BatchingOptions
  -> Handle -- ^ The 'Handle' to write log messages to.
  -> Double -- ^ The @ribbonFrac@ parameter to 'PP.renderPretty'
  -> Int -- ^ The amount of characters per line. Lines longer than this will be pretty-printed across multiple lines if possible.
  -> (Handler io (PP.Doc ann) -> io a)
  -> io a
withFDHandler :: forall (io :: * -> *) ann a.
(MonadIO io, MonadMask io) =>
BatchingOptions
-> Handle
-> Double
-> Int
-> (Handler io (Doc ann) -> io a)
-> io a
withFDHandler BatchingOptions
options Handle
fd Double
ribbonFrac Int
width = BatchingOptions
-> (NonEmpty (Doc ann) -> IO ())
-> (Handler io (Doc ann) -> io a)
-> io a
forall (io :: * -> *) message a.
(MonadIO io, MonadMask io) =>
BatchingOptions
-> (NonEmpty message -> IO ())
-> (Handler io message -> io a)
-> io a
withBatchedHandler BatchingOptions
options NonEmpty (Doc ann) -> IO ()
flush
  where
    flush :: NonEmpty (Doc ann) -> IO ()
flush NonEmpty (Doc ann)
messages = do
      Handle -> SimpleDocStream ann -> IO ()
forall ann. Handle -> SimpleDocStream ann -> IO ()
PP.renderIO
        Handle
fd
        (LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
PP.layoutPretty
           (PageWidth -> LayoutOptions
PP.LayoutOptions (Int -> Double -> PageWidth
PP.AvailablePerLine Int
width Double
ribbonFrac))
           ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
PP.vsep (NonEmpty (Doc ann) -> [Doc ann]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty (Doc ann)
messages) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
PP.line'))
      Handle -> IO ()
hFlush Handle
fd

--------------------------------------------------------------------------------
-- | A 'MonadLog' handler optimised for pure usage. Log messages are accumulated
-- strictly, given that messages form a 'Monoid'.
newtype PureLoggingT log m a = MkPureLoggingT (StateT log m a)
  deriving ((forall a b.
 (a -> b) -> PureLoggingT log m a -> PureLoggingT log m b)
-> (forall a b. a -> PureLoggingT log m b -> PureLoggingT log m a)
-> Functor (PureLoggingT log m)
forall a b. a -> PureLoggingT log m b -> PureLoggingT log m a
forall a b.
(a -> b) -> PureLoggingT log m a -> PureLoggingT log m b
forall log (m :: * -> *) a b.
Functor m =>
a -> PureLoggingT log m b -> PureLoggingT log m a
forall log (m :: * -> *) a b.
Functor m =>
(a -> b) -> PureLoggingT log m a -> PureLoggingT log 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 log (m :: * -> *) a b.
Functor m =>
(a -> b) -> PureLoggingT log m a -> PureLoggingT log m b
fmap :: forall a b.
(a -> b) -> PureLoggingT log m a -> PureLoggingT log m b
$c<$ :: forall log (m :: * -> *) a b.
Functor m =>
a -> PureLoggingT log m b -> PureLoggingT log m a
<$ :: forall a b. a -> PureLoggingT log m b -> PureLoggingT log m a
Functor,Functor (PureLoggingT log m)
Functor (PureLoggingT log m) =>
(forall a. a -> PureLoggingT log m a)
-> (forall a b.
    PureLoggingT log m (a -> b)
    -> PureLoggingT log m a -> PureLoggingT log m b)
-> (forall a b c.
    (a -> b -> c)
    -> PureLoggingT log m a
    -> PureLoggingT log m b
    -> PureLoggingT log m c)
-> (forall a b.
    PureLoggingT log m a
    -> PureLoggingT log m b -> PureLoggingT log m b)
-> (forall a b.
    PureLoggingT log m a
    -> PureLoggingT log m b -> PureLoggingT log m a)
-> Applicative (PureLoggingT log m)
forall a. a -> PureLoggingT log m a
forall a b.
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m a
forall a b.
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
forall a b.
PureLoggingT log m (a -> b)
-> PureLoggingT log m a -> PureLoggingT log m b
forall a b c.
(a -> b -> c)
-> PureLoggingT log m a
-> PureLoggingT log m b
-> PureLoggingT log m c
forall log (m :: * -> *). Monad m => Functor (PureLoggingT log m)
forall log (m :: * -> *) a. Monad m => a -> PureLoggingT log m a
forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m a
forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m (a -> b)
-> PureLoggingT log m a -> PureLoggingT log m b
forall log (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> PureLoggingT log m a
-> PureLoggingT log m b
-> PureLoggingT log 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 log (m :: * -> *) a. Monad m => a -> PureLoggingT log m a
pure :: forall a. a -> PureLoggingT log m a
$c<*> :: forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m (a -> b)
-> PureLoggingT log m a -> PureLoggingT log m b
<*> :: forall a b.
PureLoggingT log m (a -> b)
-> PureLoggingT log m a -> PureLoggingT log m b
$cliftA2 :: forall log (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> PureLoggingT log m a
-> PureLoggingT log m b
-> PureLoggingT log m c
liftA2 :: forall a b c.
(a -> b -> c)
-> PureLoggingT log m a
-> PureLoggingT log m b
-> PureLoggingT log m c
$c*> :: forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
*> :: forall a b.
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
$c<* :: forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m a
<* :: forall a b.
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m a
Applicative,Applicative (PureLoggingT log m)
Applicative (PureLoggingT log m) =>
(forall a b.
 PureLoggingT log m a
 -> (a -> PureLoggingT log m b) -> PureLoggingT log m b)
-> (forall a b.
    PureLoggingT log m a
    -> PureLoggingT log m b -> PureLoggingT log m b)
-> (forall a. a -> PureLoggingT log m a)
-> Monad (PureLoggingT log m)
forall a. a -> PureLoggingT log m a
forall a b.
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
forall a b.
PureLoggingT log m a
-> (a -> PureLoggingT log m b) -> PureLoggingT log m b
forall log (m :: * -> *).
Monad m =>
Applicative (PureLoggingT log m)
forall log (m :: * -> *) a. Monad m => a -> PureLoggingT log m a
forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> (a -> PureLoggingT log m b) -> PureLoggingT log 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 log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> (a -> PureLoggingT log m b) -> PureLoggingT log m b
>>= :: forall a b.
PureLoggingT log m a
-> (a -> PureLoggingT log m b) -> PureLoggingT log m b
$c>> :: forall log (m :: * -> *) a b.
Monad m =>
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
>> :: forall a b.
PureLoggingT log m a
-> PureLoggingT log m b -> PureLoggingT log m b
$creturn :: forall log (m :: * -> *) a. Monad m => a -> PureLoggingT log m a
return :: forall a. a -> PureLoggingT log m a
Monad,Monad (PureLoggingT log m)
Monad (PureLoggingT log m) =>
(forall a. (a -> PureLoggingT log m a) -> PureLoggingT log m a)
-> MonadFix (PureLoggingT log m)
forall a. (a -> PureLoggingT log m a) -> PureLoggingT log m a
forall log (m :: * -> *). MonadFix m => Monad (PureLoggingT log m)
forall log (m :: * -> *) a.
MonadFix m =>
(a -> PureLoggingT log m a) -> PureLoggingT log m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall log (m :: * -> *) a.
MonadFix m =>
(a -> PureLoggingT log m a) -> PureLoggingT log m a
mfix :: forall a. (a -> PureLoggingT log m a) -> PureLoggingT log m a
MonadFix,MonadThrow (PureLoggingT log m)
MonadThrow (PureLoggingT log m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 PureLoggingT log m a
 -> (e -> PureLoggingT log m a) -> PureLoggingT log m a)
-> MonadCatch (PureLoggingT log m)
forall e a.
(HasCallStack, Exception e) =>
PureLoggingT log m a
-> (e -> PureLoggingT log m a) -> PureLoggingT log m a
forall log (m :: * -> *).
MonadCatch m =>
MonadThrow (PureLoggingT log m)
forall log (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
PureLoggingT log m a
-> (e -> PureLoggingT log m a) -> PureLoggingT log m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall log (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
PureLoggingT log m a
-> (e -> PureLoggingT log m a) -> PureLoggingT log m a
catch :: forall e a.
(HasCallStack, Exception e) =>
PureLoggingT log m a
-> (e -> PureLoggingT log m a) -> PureLoggingT log m a
MonadCatch,Monad (PureLoggingT log m)
Monad (PureLoggingT log m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> PureLoggingT log m a)
-> MonadThrow (PureLoggingT log m)
forall e a.
(HasCallStack, Exception e) =>
e -> PureLoggingT log m a
forall log (m :: * -> *).
MonadThrow m =>
Monad (PureLoggingT log m)
forall log (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> PureLoggingT log m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall log (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> PureLoggingT log m a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> PureLoggingT log m a
MonadThrow,Monad (PureLoggingT log m)
Monad (PureLoggingT log m) =>
(forall a. IO a -> PureLoggingT log m a)
-> MonadIO (PureLoggingT log m)
forall a. IO a -> PureLoggingT log m a
forall log (m :: * -> *). MonadIO m => Monad (PureLoggingT log m)
forall log (m :: * -> *) a.
MonadIO m =>
IO a -> PureLoggingT log m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall log (m :: * -> *) a.
MonadIO m =>
IO a -> PureLoggingT log m a
liftIO :: forall a. IO a -> PureLoggingT log m a
MonadIO,MonadCatch (PureLoggingT log m)
MonadCatch (PureLoggingT log m) =>
(forall b.
 HasCallStack =>
 ((forall a. PureLoggingT log m a -> PureLoggingT log m a)
  -> PureLoggingT log m b)
 -> PureLoggingT log m b)
-> (forall b.
    HasCallStack =>
    ((forall a. PureLoggingT log m a -> PureLoggingT log m a)
     -> PureLoggingT log m b)
    -> PureLoggingT log m b)
-> (forall a b c.
    HasCallStack =>
    PureLoggingT log m a
    -> (a -> ExitCase b -> PureLoggingT log m c)
    -> (a -> PureLoggingT log m b)
    -> PureLoggingT log m (b, c))
-> MonadMask (PureLoggingT log m)
forall b.
HasCallStack =>
((forall a. PureLoggingT log m a -> PureLoggingT log m a)
 -> PureLoggingT log m b)
-> PureLoggingT log m b
forall a b c.
HasCallStack =>
PureLoggingT log m a
-> (a -> ExitCase b -> PureLoggingT log m c)
-> (a -> PureLoggingT log m b)
-> PureLoggingT log m (b, c)
forall log (m :: * -> *).
MonadMask m =>
MonadCatch (PureLoggingT log m)
forall log (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. PureLoggingT log m a -> PureLoggingT log m a)
 -> PureLoggingT log m b)
-> PureLoggingT log m b
forall log (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
PureLoggingT log m a
-> (a -> ExitCase b -> PureLoggingT log m c)
-> (a -> PureLoggingT log m b)
-> PureLoggingT log m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall log (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. PureLoggingT log m a -> PureLoggingT log m a)
 -> PureLoggingT log m b)
-> PureLoggingT log m b
mask :: forall b.
HasCallStack =>
((forall a. PureLoggingT log m a -> PureLoggingT log m a)
 -> PureLoggingT log m b)
-> PureLoggingT log m b
$cuninterruptibleMask :: forall log (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. PureLoggingT log m a -> PureLoggingT log m a)
 -> PureLoggingT log m b)
-> PureLoggingT log m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. PureLoggingT log m a -> PureLoggingT log m a)
 -> PureLoggingT log m b)
-> PureLoggingT log m b
$cgeneralBracket :: forall log (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
PureLoggingT log m a
-> (a -> ExitCase b -> PureLoggingT log m c)
-> (a -> PureLoggingT log m b)
-> PureLoggingT log m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
PureLoggingT log m a
-> (a -> ExitCase b -> PureLoggingT log m c)
-> (a -> PureLoggingT log m b)
-> PureLoggingT log m (b, c)
MonadMask,MonadReader r,MonadWriter w,Monad (PureLoggingT log m)
Monad (PureLoggingT log m) =>
(forall a b.
 ((a -> PureLoggingT log m b) -> PureLoggingT log m a)
 -> PureLoggingT log m a)
-> MonadCont (PureLoggingT log m)
forall a b.
((a -> PureLoggingT log m b) -> PureLoggingT log m a)
-> PureLoggingT log m a
forall log (m :: * -> *). MonadCont m => Monad (PureLoggingT log m)
forall log (m :: * -> *) a b.
MonadCont m =>
((a -> PureLoggingT log m b) -> PureLoggingT log m a)
-> PureLoggingT log m a
forall (m :: * -> *).
Monad m =>
(forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
$ccallCC :: forall log (m :: * -> *) a b.
MonadCont m =>
((a -> PureLoggingT log m b) -> PureLoggingT log m a)
-> PureLoggingT log m a
callCC :: forall a b.
((a -> PureLoggingT log m b) -> PureLoggingT log m a)
-> PureLoggingT log m a
MonadCont,MonadError e,Applicative (PureLoggingT log m)
Applicative (PureLoggingT log m) =>
(forall a. PureLoggingT log m a)
-> (forall a.
    PureLoggingT log m a
    -> PureLoggingT log m a -> PureLoggingT log m a)
-> (forall a. PureLoggingT log m a -> PureLoggingT log m [a])
-> (forall a. PureLoggingT log m a -> PureLoggingT log m [a])
-> Alternative (PureLoggingT log m)
forall a. PureLoggingT log m a
forall a. PureLoggingT log m a -> PureLoggingT log m [a]
forall a.
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log m a
forall log (m :: * -> *).
MonadPlus m =>
Applicative (PureLoggingT log m)
forall log (m :: * -> *) a. MonadPlus m => PureLoggingT log m a
forall log (m :: * -> *) a.
MonadPlus m =>
PureLoggingT log m a -> PureLoggingT log m [a]
forall log (m :: * -> *) a.
MonadPlus m =>
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log 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 log (m :: * -> *) a. MonadPlus m => PureLoggingT log m a
empty :: forall a. PureLoggingT log m a
$c<|> :: forall log (m :: * -> *) a.
MonadPlus m =>
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log m a
<|> :: forall a.
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log m a
$csome :: forall log (m :: * -> *) a.
MonadPlus m =>
PureLoggingT log m a -> PureLoggingT log m [a]
some :: forall a. PureLoggingT log m a -> PureLoggingT log m [a]
$cmany :: forall log (m :: * -> *) a.
MonadPlus m =>
PureLoggingT log m a -> PureLoggingT log m [a]
many :: forall a. PureLoggingT log m a -> PureLoggingT log m [a]
Alternative,Monad (PureLoggingT log m)
Alternative (PureLoggingT log m)
(Alternative (PureLoggingT log m), Monad (PureLoggingT log m)) =>
(forall a. PureLoggingT log m a)
-> (forall a.
    PureLoggingT log m a
    -> PureLoggingT log m a -> PureLoggingT log m a)
-> MonadPlus (PureLoggingT log m)
forall a. PureLoggingT log m a
forall a.
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log m a
forall log (m :: * -> *). MonadPlus m => Monad (PureLoggingT log m)
forall log (m :: * -> *).
MonadPlus m =>
Alternative (PureLoggingT log m)
forall log (m :: * -> *) a. MonadPlus m => PureLoggingT log m a
forall log (m :: * -> *) a.
MonadPlus m =>
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall log (m :: * -> *) a. MonadPlus m => PureLoggingT log m a
mzero :: forall a. PureLoggingT log m a
$cmplus :: forall log (m :: * -> *) a.
MonadPlus m =>
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log m a
mplus :: forall a.
PureLoggingT log m a
-> PureLoggingT log m a -> PureLoggingT log m a
MonadPlus,Monad (PureLoggingT log m)
Monad (PureLoggingT log m) =>
(forall a. String -> PureLoggingT log m a)
-> MonadFail (PureLoggingT log m)
forall a. String -> PureLoggingT log m a
forall log (m :: * -> *). MonadFail m => Monad (PureLoggingT log m)
forall log (m :: * -> *) a.
MonadFail m =>
String -> PureLoggingT log m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall log (m :: * -> *) a.
MonadFail m =>
String -> PureLoggingT log m a
fail :: forall a. String -> PureLoggingT log m a
Fail.MonadFail)

instance MonadBase b m => MonadBase b (PureLoggingT message m) where
  liftBase :: forall α. b α -> PureLoggingT message m α
liftBase = m α -> PureLoggingT message m α
forall (m :: * -> *) a. Monad m => m a -> PureLoggingT message m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> PureLoggingT message m α)
-> (b α -> m α) -> b α -> PureLoggingT message m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall α. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadTransControl (PureLoggingT message) where
    type StT (PureLoggingT message) a = StT (StateT message) a
    liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (PureLoggingT message) -> m a) -> PureLoggingT message m a
liftWith = (forall b. StateT message m b -> PureLoggingT message m b)
-> (forall (o :: * -> *) b.
    PureLoggingT message o b -> StateT message o b)
-> (RunDefault (PureLoggingT message) (StateT message) -> m a)
-> PureLoggingT message m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith StateT message m b -> PureLoggingT message m b
forall b. StateT message m b -> PureLoggingT message m b
forall log (m :: * -> *) a. StateT log m a -> PureLoggingT log m a
MkPureLoggingT (\(MkPureLoggingT StateT message o b
m) -> StateT message o b
m)
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (PureLoggingT message) a) -> PureLoggingT message m a
restoreT = (StateT message m a -> PureLoggingT message m a)
-> m (StT (StateT message) a) -> PureLoggingT message m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT StateT message m a -> PureLoggingT message m a
forall log (m :: * -> *) a. StateT log m a -> PureLoggingT log m a
MkPureLoggingT

instance MonadBaseControl b m => MonadBaseControl b (PureLoggingT message m) where
  type StM (PureLoggingT message m) a = ComposeSt (PureLoggingT message) m a
  liftBaseWith :: forall a.
(RunInBase (PureLoggingT message m) b -> b a)
-> PureLoggingT message m a
liftBaseWith     = (RunInBaseDefault (PureLoggingT message) m b -> b a)
-> PureLoggingT message m a
(RunInBase (PureLoggingT message m) b -> b a)
-> PureLoggingT message 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 (PureLoggingT message m) a -> PureLoggingT message m a
restoreM         = ComposeSt (PureLoggingT message) m a -> PureLoggingT message m a
StM (PureLoggingT message m) a -> PureLoggingT message m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

-- | Run a computation with access to logging by accumulating a log under its
-- 'Monoid' instance.
runPureLoggingT
  :: Monoid log
  => PureLoggingT log m a -> m (a,log)
runPureLoggingT :: forall log (m :: * -> *) a.
Monoid log =>
PureLoggingT log m a -> m (a, log)
runPureLoggingT (MkPureLoggingT (StateT log -> m (a, log)
m)) = log -> m (a, log)
m log
forall a. Monoid a => a
mempty
{-# INLINEABLE runPureLoggingT #-}

mkPureLoggingT
  :: (Monad m,Monoid log)
  => m (a,log) -> PureLoggingT log m a
mkPureLoggingT :: forall (m :: * -> *) log a.
(Monad m, Monoid log) =>
m (a, log) -> PureLoggingT log m a
mkPureLoggingT m (a, log)
m =
  StateT log m a -> PureLoggingT log m a
forall log (m :: * -> *) a. StateT log m a -> PureLoggingT log m a
MkPureLoggingT
    ((log -> m (a, log)) -> StateT log m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\log
s ->
               do (a,l) <- m (a, log)
m
                  return (a,mappend s l)))
{-# INLINEABLE mkPureLoggingT #-}

instance MonadTrans (PureLoggingT log) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> PureLoggingT log m a
lift = StateT log m a -> PureLoggingT log m a
forall log (m :: * -> *) a. StateT log m a -> PureLoggingT log m a
MkPureLoggingT (StateT log m a -> PureLoggingT log m a)
-> (m a -> StateT log m a) -> m a -> PureLoggingT log m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT log m a
forall (m :: * -> *) a. Monad m => m a -> StateT log m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
  {-# INLINEABLE lift #-}

instance (Functor f, MonadFree f m) => MonadFree f (PureLoggingT log m)

-- | A pure handler of 'MonadLog' that accumulates log messages under the structure of their 'Monoid' instance.
instance (Monad m, Monoid log) => MonadLog log (PureLoggingT log m) where
  logMessageFree :: (forall n. Monoid n => (log -> n) -> n) -> PureLoggingT log m ()
logMessageFree forall n. Monoid n => (log -> n) -> n
foldMap = m ((), log) -> PureLoggingT log m ()
forall (m :: * -> *) log a.
(Monad m, Monoid log) =>
m (a, log) -> PureLoggingT log m a
mkPureLoggingT (((), log) -> m ((), log)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), (log -> log) -> log
forall n. Monoid n => (log -> n) -> n
foldMap log -> log
forall a. a -> a
id))
  {-# INLINEABLE logMessageFree #-}

instance MonadRWS r w s m => MonadRWS r w s (PureLoggingT message m)

instance MonadState s m => MonadState s (PureLoggingT log m) where
  state :: forall a. (s -> (a, s)) -> PureLoggingT log m a
state s -> (a, s)
f = m a -> PureLoggingT log m a
forall (m :: * -> *) a. Monad m => m a -> PureLoggingT log m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f)
  {-# INLINEABLE state #-}
  get :: PureLoggingT log m s
get = m s -> PureLoggingT log m s
forall (m :: * -> *) a. Monad m => m a -> PureLoggingT log 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
get
  {-# INLINEABLE get #-}
  put :: s -> PureLoggingT log m ()
put = m () -> PureLoggingT log m ()
forall (m :: * -> *) a. Monad m => m a -> PureLoggingT log m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> PureLoggingT log m ())
-> (s -> m ()) -> s -> PureLoggingT log m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  {-# INLINEABLE put #-}

--------------------------------------------------------------------------------
-- | A 'MonadLog' handler that throws messages away.
--
-- The documentation may appear a bit confusing, but note that the full type of
-- 'discardLogging' is:
--
-- @
-- 'discardLogging' :: 'DiscardLoggingT' message m a -> m a
-- @
newtype DiscardLoggingT message m a =
  DiscardLoggingT {forall message (m :: * -> *) a. DiscardLoggingT message m a -> m a
discardLogging :: m a -- ^ Run a 'MonadLog' computation by throwing away all log requests.
                  }
  deriving ((forall a b.
 (a -> b)
 -> DiscardLoggingT message m a -> DiscardLoggingT message m b)
-> (forall a b.
    a -> DiscardLoggingT message m b -> DiscardLoggingT message m a)
-> Functor (DiscardLoggingT message m)
forall a b.
a -> DiscardLoggingT message m b -> DiscardLoggingT message m a
forall a b.
(a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message m b
forall message (m :: * -> *) a b.
Functor m =>
a -> DiscardLoggingT message m b -> DiscardLoggingT message m a
forall message (m :: * -> *) a b.
Functor m =>
(a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message 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 message (m :: * -> *) a b.
Functor m =>
(a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message m b
fmap :: forall a b.
(a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message m b
$c<$ :: forall message (m :: * -> *) a b.
Functor m =>
a -> DiscardLoggingT message m b -> DiscardLoggingT message m a
<$ :: forall a b.
a -> DiscardLoggingT message m b -> DiscardLoggingT message m a
Functor,Functor (DiscardLoggingT message m)
Functor (DiscardLoggingT message m) =>
(forall a. a -> DiscardLoggingT message m a)
-> (forall a b.
    DiscardLoggingT message m (a -> b)
    -> DiscardLoggingT message m a -> DiscardLoggingT message m b)
-> (forall a b c.
    (a -> b -> c)
    -> DiscardLoggingT message m a
    -> DiscardLoggingT message m b
    -> DiscardLoggingT message m c)
-> (forall a b.
    DiscardLoggingT message m a
    -> DiscardLoggingT message m b -> DiscardLoggingT message m b)
-> (forall a b.
    DiscardLoggingT message m a
    -> DiscardLoggingT message m b -> DiscardLoggingT message m a)
-> Applicative (DiscardLoggingT message m)
forall a. a -> DiscardLoggingT message m a
forall a b.
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m a
forall a b.
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
forall a b.
DiscardLoggingT message m (a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message m b
forall a b c.
(a -> b -> c)
-> DiscardLoggingT message m a
-> DiscardLoggingT message m b
-> DiscardLoggingT message m c
forall message (m :: * -> *).
Applicative m =>
Functor (DiscardLoggingT message m)
forall message (m :: * -> *) a.
Applicative m =>
a -> DiscardLoggingT message m a
forall message (m :: * -> *) a b.
Applicative m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m a
forall message (m :: * -> *) a b.
Applicative m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
forall message (m :: * -> *) a b.
Applicative m =>
DiscardLoggingT message m (a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message m b
forall message (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> DiscardLoggingT message m a
-> DiscardLoggingT message m b
-> DiscardLoggingT message 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 message (m :: * -> *) a.
Applicative m =>
a -> DiscardLoggingT message m a
pure :: forall a. a -> DiscardLoggingT message m a
$c<*> :: forall message (m :: * -> *) a b.
Applicative m =>
DiscardLoggingT message m (a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message m b
<*> :: forall a b.
DiscardLoggingT message m (a -> b)
-> DiscardLoggingT message m a -> DiscardLoggingT message m b
$cliftA2 :: forall message (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> DiscardLoggingT message m a
-> DiscardLoggingT message m b
-> DiscardLoggingT message m c
liftA2 :: forall a b c.
(a -> b -> c)
-> DiscardLoggingT message m a
-> DiscardLoggingT message m b
-> DiscardLoggingT message m c
$c*> :: forall message (m :: * -> *) a b.
Applicative m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
*> :: forall a b.
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
$c<* :: forall message (m :: * -> *) a b.
Applicative m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m a
<* :: forall a b.
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m a
Applicative,Applicative (DiscardLoggingT message m)
Applicative (DiscardLoggingT message m) =>
(forall a b.
 DiscardLoggingT message m a
 -> (a -> DiscardLoggingT message m b)
 -> DiscardLoggingT message m b)
-> (forall a b.
    DiscardLoggingT message m a
    -> DiscardLoggingT message m b -> DiscardLoggingT message m b)
-> (forall a. a -> DiscardLoggingT message m a)
-> Monad (DiscardLoggingT message m)
forall a. a -> DiscardLoggingT message m a
forall a b.
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
forall a b.
DiscardLoggingT message m a
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
forall message (m :: * -> *).
Monad m =>
Applicative (DiscardLoggingT message m)
forall message (m :: * -> *) a.
Monad m =>
a -> DiscardLoggingT message m a
forall message (m :: * -> *) a b.
Monad m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
forall message (m :: * -> *) a b.
Monad m =>
DiscardLoggingT message m a
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message 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 message (m :: * -> *) a b.
Monad m =>
DiscardLoggingT message m a
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
>>= :: forall a b.
DiscardLoggingT message m a
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
$c>> :: forall message (m :: * -> *) a b.
Monad m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
>> :: forall a b.
DiscardLoggingT message m a
-> DiscardLoggingT message m b -> DiscardLoggingT message m b
$creturn :: forall message (m :: * -> *) a.
Monad m =>
a -> DiscardLoggingT message m a
return :: forall a. a -> DiscardLoggingT message m a
Monad,Monad (DiscardLoggingT message m)
Monad (DiscardLoggingT message m) =>
(forall a.
 (a -> DiscardLoggingT message m a) -> DiscardLoggingT message m a)
-> MonadFix (DiscardLoggingT message m)
forall a.
(a -> DiscardLoggingT message m a) -> DiscardLoggingT message m a
forall message (m :: * -> *).
MonadFix m =>
Monad (DiscardLoggingT message m)
forall message (m :: * -> *) a.
MonadFix m =>
(a -> DiscardLoggingT message m a) -> DiscardLoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall message (m :: * -> *) a.
MonadFix m =>
(a -> DiscardLoggingT message m a) -> DiscardLoggingT message m a
mfix :: forall a.
(a -> DiscardLoggingT message m a) -> DiscardLoggingT message m a
MonadFix,MonadThrow (DiscardLoggingT message m)
MonadThrow (DiscardLoggingT message m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 DiscardLoggingT message m a
 -> (e -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m a)
-> MonadCatch (DiscardLoggingT message m)
forall e a.
(HasCallStack, Exception e) =>
DiscardLoggingT message m a
-> (e -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
forall message (m :: * -> *).
MonadCatch m =>
MonadThrow (DiscardLoggingT message m)
forall message (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
DiscardLoggingT message m a
-> (e -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall message (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
DiscardLoggingT message m a
-> (e -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
catch :: forall e a.
(HasCallStack, Exception e) =>
DiscardLoggingT message m a
-> (e -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
MonadCatch,Monad (DiscardLoggingT message m)
Monad (DiscardLoggingT message m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> DiscardLoggingT message m a)
-> MonadThrow (DiscardLoggingT message m)
forall e a.
(HasCallStack, Exception e) =>
e -> DiscardLoggingT message m a
forall message (m :: * -> *).
MonadThrow m =>
Monad (DiscardLoggingT message m)
forall message (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> DiscardLoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall message (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> DiscardLoggingT message m a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> DiscardLoggingT message m a
MonadThrow,Monad (DiscardLoggingT message m)
Monad (DiscardLoggingT message m) =>
(forall a. IO a -> DiscardLoggingT message m a)
-> MonadIO (DiscardLoggingT message m)
forall a. IO a -> DiscardLoggingT message m a
forall message (m :: * -> *).
MonadIO m =>
Monad (DiscardLoggingT message m)
forall message (m :: * -> *) a.
MonadIO m =>
IO a -> DiscardLoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall message (m :: * -> *) a.
MonadIO m =>
IO a -> DiscardLoggingT message m a
liftIO :: forall a. IO a -> DiscardLoggingT message m a
MonadIO,MonadIO (DiscardLoggingT message m)
MonadIO (DiscardLoggingT message m) =>
(forall b.
 ((forall a. DiscardLoggingT message m a -> IO a) -> IO b)
 -> DiscardLoggingT message m b)
-> MonadUnliftIO (DiscardLoggingT message m)
forall b.
((forall a. DiscardLoggingT message m a -> IO a) -> IO b)
-> DiscardLoggingT message m b
forall message (m :: * -> *).
MonadUnliftIO m =>
MonadIO (DiscardLoggingT message m)
forall message (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. DiscardLoggingT message m a -> IO a) -> IO b)
-> DiscardLoggingT message m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall message (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. DiscardLoggingT message m a -> IO a) -> IO b)
-> DiscardLoggingT message m b
withRunInIO :: forall b.
((forall a. DiscardLoggingT message m a -> IO a) -> IO b)
-> DiscardLoggingT message m b
MonadUnliftIO,MonadCatch (DiscardLoggingT message m)
MonadCatch (DiscardLoggingT message m) =>
(forall b.
 HasCallStack =>
 ((forall a.
   DiscardLoggingT message m a -> DiscardLoggingT message m a)
  -> DiscardLoggingT message m b)
 -> DiscardLoggingT message m b)
-> (forall b.
    HasCallStack =>
    ((forall a.
      DiscardLoggingT message m a -> DiscardLoggingT message m a)
     -> DiscardLoggingT message m b)
    -> DiscardLoggingT message m b)
-> (forall a b c.
    HasCallStack =>
    DiscardLoggingT message m a
    -> (a -> ExitCase b -> DiscardLoggingT message m c)
    -> (a -> DiscardLoggingT message m b)
    -> DiscardLoggingT message m (b, c))
-> MonadMask (DiscardLoggingT message m)
forall b.
HasCallStack =>
((forall a.
  DiscardLoggingT message m a -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
forall a b c.
HasCallStack =>
DiscardLoggingT message m a
-> (a -> ExitCase b -> DiscardLoggingT message m c)
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message m (b, c)
forall message (m :: * -> *).
MonadMask m =>
MonadCatch (DiscardLoggingT message m)
forall message (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a.
  DiscardLoggingT message m a -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
forall message (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
DiscardLoggingT message m a
-> (a -> ExitCase b -> DiscardLoggingT message m c)
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall message (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a.
  DiscardLoggingT message m a -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
mask :: forall b.
HasCallStack =>
((forall a.
  DiscardLoggingT message m a -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
$cuninterruptibleMask :: forall message (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a.
  DiscardLoggingT message m a -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a.
  DiscardLoggingT message m a -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m b)
-> DiscardLoggingT message m b
$cgeneralBracket :: forall message (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
DiscardLoggingT message m a
-> (a -> ExitCase b -> DiscardLoggingT message m c)
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
DiscardLoggingT message m a
-> (a -> ExitCase b -> DiscardLoggingT message m c)
-> (a -> DiscardLoggingT message m b)
-> DiscardLoggingT message m (b, c)
MonadMask,MonadReader r,MonadWriter w,Monad (DiscardLoggingT message m)
Monad (DiscardLoggingT message m) =>
(forall a b.
 ((a -> DiscardLoggingT message m b) -> DiscardLoggingT message m a)
 -> DiscardLoggingT message m a)
-> MonadCont (DiscardLoggingT message m)
forall a b.
((a -> DiscardLoggingT message m b) -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
forall message (m :: * -> *).
MonadCont m =>
Monad (DiscardLoggingT message m)
forall message (m :: * -> *) a b.
MonadCont m =>
((a -> DiscardLoggingT message m b) -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
$ccallCC :: forall message (m :: * -> *) a b.
MonadCont m =>
((a -> DiscardLoggingT message m b) -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
callCC :: forall a b.
((a -> DiscardLoggingT message m b) -> DiscardLoggingT message m a)
-> DiscardLoggingT message m a
MonadCont,MonadError e,Applicative (DiscardLoggingT message m)
Applicative (DiscardLoggingT message m) =>
(forall a. DiscardLoggingT message m a)
-> (forall a.
    DiscardLoggingT message m a
    -> DiscardLoggingT message m a -> DiscardLoggingT message m a)
-> (forall a.
    DiscardLoggingT message m a -> DiscardLoggingT message m [a])
-> (forall a.
    DiscardLoggingT message m a -> DiscardLoggingT message m [a])
-> Alternative (DiscardLoggingT message m)
forall a. DiscardLoggingT message m a
forall a.
DiscardLoggingT message m a -> DiscardLoggingT message m [a]
forall a.
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message m a
forall message (m :: * -> *).
Alternative m =>
Applicative (DiscardLoggingT message m)
forall message (m :: * -> *) a.
Alternative m =>
DiscardLoggingT message m a
forall message (m :: * -> *) a.
Alternative m =>
DiscardLoggingT message m a -> DiscardLoggingT message m [a]
forall message (m :: * -> *) a.
Alternative m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message 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 message (m :: * -> *) a.
Alternative m =>
DiscardLoggingT message m a
empty :: forall a. DiscardLoggingT message m a
$c<|> :: forall message (m :: * -> *) a.
Alternative m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message m a
<|> :: forall a.
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message m a
$csome :: forall message (m :: * -> *) a.
Alternative m =>
DiscardLoggingT message m a -> DiscardLoggingT message m [a]
some :: forall a.
DiscardLoggingT message m a -> DiscardLoggingT message m [a]
$cmany :: forall message (m :: * -> *) a.
Alternative m =>
DiscardLoggingT message m a -> DiscardLoggingT message m [a]
many :: forall a.
DiscardLoggingT message m a -> DiscardLoggingT message m [a]
Alternative,Monad (DiscardLoggingT message m)
Alternative (DiscardLoggingT message m)
(Alternative (DiscardLoggingT message m),
 Monad (DiscardLoggingT message m)) =>
(forall a. DiscardLoggingT message m a)
-> (forall a.
    DiscardLoggingT message m a
    -> DiscardLoggingT message m a -> DiscardLoggingT message m a)
-> MonadPlus (DiscardLoggingT message m)
forall a. DiscardLoggingT message m a
forall a.
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message m a
forall message (m :: * -> *).
MonadPlus m =>
Monad (DiscardLoggingT message m)
forall message (m :: * -> *).
MonadPlus m =>
Alternative (DiscardLoggingT message m)
forall message (m :: * -> *) a.
MonadPlus m =>
DiscardLoggingT message m a
forall message (m :: * -> *) a.
MonadPlus m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall message (m :: * -> *) a.
MonadPlus m =>
DiscardLoggingT message m a
mzero :: forall a. DiscardLoggingT message m a
$cmplus :: forall message (m :: * -> *) a.
MonadPlus m =>
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message m a
mplus :: forall a.
DiscardLoggingT message m a
-> DiscardLoggingT message m a -> DiscardLoggingT message m a
MonadPlus,MonadState s,MonadRWS r w s,MonadBase b,Monad (DiscardLoggingT message m)
Monad (DiscardLoggingT message m) =>
(forall a. String -> DiscardLoggingT message m a)
-> MonadFail (DiscardLoggingT message m)
forall a. String -> DiscardLoggingT message m a
forall message (m :: * -> *).
MonadFail m =>
Monad (DiscardLoggingT message m)
forall message (m :: * -> *) a.
MonadFail m =>
String -> DiscardLoggingT message m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall message (m :: * -> *) a.
MonadFail m =>
String -> DiscardLoggingT message m a
fail :: forall a. String -> DiscardLoggingT message m a
Fail.MonadFail)

instance MonadBaseControl b m => MonadBaseControl b (DiscardLoggingT message m) where
  type StM (DiscardLoggingT message m) a = StM m a
  liftBaseWith :: forall a.
(RunInBase (DiscardLoggingT message m) b -> b a)
-> DiscardLoggingT message m a
liftBaseWith RunInBase (DiscardLoggingT message m) b -> b a
runInBase = m a -> DiscardLoggingT message m a
forall (m :: * -> *) a.
Monad m =>
m a -> DiscardLoggingT message m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((RunInBase m b -> b a) -> m a
forall a. (RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m b
runInOrig -> RunInBase (DiscardLoggingT message m) b -> b a
runInBase (m a -> b (StM m a)
RunInBase m b
runInOrig (m a -> b (StM m a))
-> (DiscardLoggingT message m a -> m a)
-> DiscardLoggingT message m a
-> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscardLoggingT message m a -> m a
forall message (m :: * -> *) a. DiscardLoggingT message m a -> m a
discardLogging)))
  restoreM :: forall a.
StM (DiscardLoggingT message m) a -> DiscardLoggingT message m a
restoreM = m a -> DiscardLoggingT message m a
forall (m :: * -> *) a.
Monad m =>
m a -> DiscardLoggingT message m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> DiscardLoggingT message m a)
-> (StM m a -> m a) -> StM m a -> DiscardLoggingT message m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

instance MonadTrans (DiscardLoggingT message) where
  lift :: forall (m :: * -> *) a.
Monad m =>
m a -> DiscardLoggingT message m a
lift = m a -> DiscardLoggingT message m a
forall message (m :: * -> *) a. m a -> DiscardLoggingT message m a
DiscardLoggingT
  {-# INLINEABLE lift #-}

instance (Functor f,MonadFree f m) => MonadFree f (DiscardLoggingT message m)

-- | The trivial instance of 'MonadLog' that simply discards all messages logged.
instance Monad m => MonadLog message (DiscardLoggingT message m) where
  logMessageFree :: (forall n. Monoid n => (message -> n) -> n)
-> DiscardLoggingT message m ()
logMessageFree forall n. Monoid n => (message -> n) -> n
_ = () -> DiscardLoggingT message m ()
forall a. a -> DiscardLoggingT message m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  {-# INLINEABLE logMessageFree #-}

{- $intro

@logging-effect@ provides a toolkit for general logging in Haskell programs
and libraries. The library consists of the type class 'MonadLog' to add log
output to computations, and this library comes with a set of instances to help
you decide how this logging should be performed. There are predefined handlers
to write to file handles, to accumulate logs purely, or to discard logging
entirely.

Unlike other logging libraries available on Hackage, 'MonadLog' does /not/
assume that you will be logging text information. Instead, the choice of logging
data is up to you. This leads to a highly compositional form of logging, with
the ability to reinterpret logs into different formats, and avoid throwing
information away if your final output is structured (such as logging to a
relational database).

-}

{- $tutorialIntro

@logging-effect@ is designed to be used via the 'MonadLog' type class and
encourages an "mtl" style approach to programming. If you're not familiar with
the @mtl@, this approach uses type classes to keep the choice of monad
polymorphic as you program, and you later choose a specific monad transformer
stack when you execute your program. For more information, see
<#tutorialMtl Aside: An mtl refresher>.

-}

{- $tutorialMtl #tutorialMtl#

If you are already familiar with the @mtl@ you can skip this section. This is not
designed to be an exhaustive introduction to the @mtl@ library, but hopefully
via a short example you'll have a basic familarity with the approach.

In this example, we'll write a program with access to state and general 'IO'
actions. One way to do this would be to work with monad transformers, stacking
'StateT' on top of 'IO':

@
import "Control.Monad.Trans.State.Strict" ('StateT', 'get', 'put')
import "Control.Monad.Trans.Class" ('lift')

transformersProgram :: 'StateT' 'Int' 'IO' ()
transformersProgram = do
  stateNow <- 'get'
  'lift' launchMissles
  'put' (stateNow + 42)
@

This is OK, but it's not very flexible. For example, the transformers library
actually provides us with two implementations of state monads - strict and a
lazy variant. In the above approach we have forced the user into a choice (we
chose the strict variant), but this can be undesirable. We could imagine that
in the future there may be even more implementations of state monads (for
example, a state monad that persists state entirely on a remote machine) - if
requirements change we are unable to reuse this program without changing its
type.

With the @mtl@, we instead program to an /abstract specification/ of the effects
we require, and we postpone the choice of handler until the point when the
computation is ran.

Rewriting the @transformersProgram@ using the @mtl@, we have the following:

@
import "Control.Monad.State.Class" ('MonadState'('get', 'put'))
import "Control.Monad.IO.Class" ('MonadIO'('liftIO'))

mtlProgram :: ('MonadState' 'Int' m, 'MonadIO' m) => m ()
mtlProgram = do
  stateNow <- 'get'
  'liftIO' launchMissles
  'put' (stateNow + 42)
@

Notice that @mtlProgram@ doesn't specify a concrete choice of state monad. The
"transformers" library gives us two choices - strict or lazy state monads. We
make the choice of a specific monad stack when we run our program:

@
import "Control.Monad.Trans.State.Strict" ('execStateT')

main :: 'IO' ()
main = 'execStateT' mtlProgram 99
@

Here we chose the strict variant via 'execStateT'. Using 'execStateT'
/eliminates/ the 'MonadState' type class from @mtlProgram@, so now we only have
to fulfill the 'MonadIO' obligation. There is only one way to handle this, and
that's by working in the 'IO' monad. Fortunately we're inside the @main@
function, which is in the 'IO' monad, so we're all good.

-}

{- $tutorial-monadlog

To add logging to your applications, you will need to make two changes.

First, use the 'MonadLog' type class to indicate that a computation has
access to logging. 'MonadLog' is parameterized on the type of messages
that you intend to log. In this example, we will log a 'PP.Doc' that is
wrapped in 'WithSeverity'.

@
testApp :: 'MonadLog' ('WithSeverity' ('PP.Doc' ann)) m => m ()
testApp = do
  logMessage ('WithSeverity' 'Informational' "Don't mind me")
  logMessage ('WithSeverity' 'Error' "But do mind me!")
@

Note that this does /not/ specify where the logs "go", we'll address that when
we run the program.

-}

{- $tutorial-loggingt

Next, we need to run this computation under a 'MonadLog' effect handler. The
most flexible handler is 'LoggingT'. 'LoggingT' runs a 'MonadLog' computation
by providing it with a 'Handler', which is a computation that can be in the
underlying monad.

For example, we can easily fulfill the 'MonadLog' type class by just using
'print' as our 'Handler':

>>> runLoggingT testApp print
WithSeverity {msgSeverity = Informational, discardSeverity = "Don't mind me"}
WithSeverity {msgSeverity = Error, discardSeverity = "But do mind me!"}

The log messages are printed according to their 'Show' instances, and - while
this works - it is not particularly user friendly. As 'Handler's are just functions
from log messages to monadic actions, we can easily reformat log messages.
@logging-effect@ comes with a few "log message transformers" (such as
'WithSeverity'), and each of these message transformers has a canonical way to
render in a human-readable format:

>>> runLoggingT testApp (print . renderWithSeverity id)
[Informational] Don't mind me
[Error] But do mind me!

That's looking much more usable - and in fact this approach is probably fine for
command line applications.

However, for longer running high performance applications there is a slight
problem. Remember that 'runLoggingT' simply interleaves the given 'Handler'
whenever 'logMessage' is called. By providing 'print' as a 'Handler', our
application will actually block until the log is complete. This is undesirable
for high performance applications, where it's much better to log asynchronously.

@logging-effect@ comes with "batched handlers" for this problem. Batched handlers
are handlers that log asynchronously, are flushed periodically, and have maximum
memory impact. Batched handlers are created with 'withBatchedHandler', though
if you are just logging to file descriptors you can also use 'withFDHandler'.
We'll use this next to log to @STDOUT@:

@
main :: 'IO' ()
main =
  'withFDHandler' 'defaultBatchingOptions' 'stdout' 0.4 80 $ \\logToStdout ->
  'runLoggingT' testApp ('logToStdout' . 'renderWithSeverity' 'id')
@

Finally, as 'Handler's are just functions (we can't stress this enough!) you
are free to slice-and-dice your log messages however you want. As our log
messages are structured, we can pattern match on the messages and dispatch them
to multiple handlers. In this final example of using 'LoggingT' we'll split
our log messages between @STDOUT@ and @STDERR@, and change the formatting of
error messages:

@
main :: IO ()
main = do
  'withFDHandler' 'defaultBatchingOptions' 'stderr' 0.4 80 $ \\stderrHandler ->
  'withFDHandler' 'defaultBatchingOptions' 'stdout' 0.4 80 $ \\stdoutHandler ->
  'runLoggingT' testApp
              (\\message ->
                 case 'msgSeverity' message of
                   'Error' -> stderrHandler ('discardSeverity' message)
                   _     -> stdoutHandler ('renderWithSeverity' id message))
@

>>> main
[Informational] Don't mind me!
BUT DO MIND ME!

-}

{- $tutorial-composing

So far we've considered very small applications where all log messages fit nicely
into a single type. However, as applications grow and begin to reuse components,
it's unlikely that this approach will scale. @logging-effect@ comes with a
mapping function - 'mapLogMessage' - which allows us to map log messages from one
type to another (just like how we can use 'map' to change elements of a list).

For example, we've already seen the basic @testApp@ computation above that used
'WithSeverity' to add severity information to log messages. Elsewhere we might
have some older code that doesn't yet have any severity information:

@
legacyCode :: 'MonadLog' ('PP.Doc' ann) m => m ()
legacyCode = 'logMessage' "Does anyone even remember writing this function?"
@

Here @legacyCode@ is only logging 'PP.Doc', while our @testApp@ is logging
'WithSeverity' 'PP.Doc'. What happens if we compose these programs?

>>> :t runLoggingT (testApp >> legacyCode) (const (pure ()))
  Couldn't match type ‘WithSeverity (Doc ann1)’ with '(Doc ann0)'

Whoops! 'MonadLog' has /functional dependencies/ on the type class which means
that there can only be a single way to log per monad. One solution might be
to 'lift' one set of logs into the other:

>>> :t runLoggingT (testApp >> lift legacyCode) (const (pure ()))
  :: MonadLog (Doc ann) m => m ()

And indeed, this is /a/ solution, but it's not a particularly nice one.

Instead, we can map both of these computations into a common log format:

>>> :t mapLogMessage Left testApp >> mapLogMessage Right (logMessage "Hello")
  :: (MonadLog (Either (WithSeverity (Doc ann)) (Doc ann)) m) => m ()

This is a trivial way of combining two different types of log message. In larger
applications you will probably want to define a new sum-type that combines all of
your log messages, and generally sticking with a single log message type per
application.

-}

{- $convenience

While @logging-effect@ tries to be as general as possible, there is a fairly
common case of logging, namely basic messages with an indication of severity.
These combinators assume that you will be using 'WithSeverity' at the outer-most
level of your log message stack, though no make no assumptions at what is inside
your log messages. There is a @logX@ combinator for each level in 'Severity'.

-}