{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE UndecidableInstances #-}
{-| Simple logging
-}
module Convex.MonadLog(
  MonadLog(..),
  logInfo,
  logInfoS,
  logWarn,
  logWarnS,
  logDebug,
  logDebugS,
  MonadLogIgnoreT(..),

  -- ** Logging with Katip
  MonadLogKatipT(..),
  runMonadLogKatip,
  KatipConfig,
  withKatipLogging,
  -- * Etc.
  logUnless
) where

import           Control.Monad              (unless)
import           Control.Monad.Catch        (MonadCatch, MonadMask, MonadThrow,
                                             bracket)
import           Control.Monad.Except       (MonadError)
import           Control.Monad.IO.Class     (MonadIO (..))
import           Control.Monad.Reader       (ReaderT (..))
import           Control.Monad.State        (StateT (..))
import qualified Control.Monad.State.Strict as State.Strict
import           Control.Monad.Trans.Class  (MonadTrans (..))
import           Control.Monad.Trans.Except (ExceptT (..))
import           Control.Monad.Trans.Maybe  (MaybeT (..))
import           Data.String                (IsString (..))
import           Data.Void                  (Void)
import           Katip                      (Environment, KatipContextT,
                                             LogContexts, LogEnv, Namespace,
                                             Severity (..))
import qualified Katip
import           Prettyprinter              (Doc, Pretty (..),
                                             defaultLayoutOptions, layoutPretty)
import qualified Prettyprinter.Render.Text  as Render
import           System.IO                  (stdout)

class Monad m => MonadLog m where
  logInfo'  :: Doc Void -> m ()
  logWarn'  :: Doc Void -> m ()
  logDebug' :: Doc Void -> m ()

instance MonadLog m => MonadLog (ReaderT e m) where
  logInfo' :: Doc Void -> ReaderT e m ()
logInfo' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo'
  logWarn' :: Doc Void -> ReaderT e m ()
logWarn' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn'
  logDebug' :: Doc Void -> ReaderT e m ()
logDebug' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug'

instance MonadLog m => MonadLog (StateT s m) where
  logInfo' :: Doc Void -> StateT s m ()
logInfo' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo'
  logWarn' :: Doc Void -> StateT s m ()
logWarn' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn'
  logDebug' :: Doc Void -> StateT s m ()
logDebug' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug'

instance MonadLog m => MonadLog (MaybeT m) where
  logInfo' :: Doc Void -> MaybeT m ()
logInfo' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo'
  logWarn' :: Doc Void -> MaybeT m ()
logWarn' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn'
  logDebug' :: Doc Void -> MaybeT m ()
logDebug' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug'

instance MonadLog m => MonadLog (State.Strict.StateT s m) where
  logInfo' :: Doc Void -> StateT s m ()
logInfo' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo'
  logWarn' :: Doc Void -> StateT s m ()
logWarn' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn'
  logDebug' :: Doc Void -> StateT s m ()
logDebug' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug'

instance MonadLog m => MonadLog (ExceptT e m) where
  logInfo' :: Doc Void -> ExceptT e m ()
logInfo' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo'
  logWarn' :: Doc Void -> ExceptT e m ()
logWarn' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn'
  logDebug' :: Doc Void -> ExceptT e m ()
logDebug' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug'

logInfo :: forall a m. (Pretty a, MonadLog m) => a -> m ()
logInfo :: forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logInfo = forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

logInfoS :: forall  m. (MonadLog m) => String -> m ()
logInfoS :: forall (m :: * -> *). MonadLog m => String -> m ()
logInfoS = forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logInfo' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

logWarn :: forall a m. (Pretty a, MonadLog m) => a -> m ()
logWarn :: forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logWarn = forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

logWarnS :: forall m. MonadLog m => String -> m ()
logWarnS :: forall (m :: * -> *). MonadLog m => String -> m ()
logWarnS = forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logWarn' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

logDebug :: forall a m. (Pretty a, MonadLog m) => a -> m ()
logDebug :: forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logDebug = forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

logDebugS :: forall m. MonadLog m => String -> m ()
logDebugS :: forall (m :: * -> *). MonadLog m => String -> m ()
logDebugS = forall (m :: * -> *). MonadLog m => Doc Void -> m ()
logDebug' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

newtype MonadLogIgnoreT m a = MonadLogIgnoreT { forall (m :: * -> *) a. MonadLogIgnoreT m a -> m a
runMonadLogIgnoreT :: m a }
  deriving newtype (forall a b. a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
forall a b. (a -> b) -> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
fmap :: forall a b. (a -> b) -> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
Functor, forall a. a -> MonadLogIgnoreT m a
forall a b.
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
forall a b.
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
forall a b.
MonadLogIgnoreT m (a -> b)
-> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
forall a b c.
(a -> b -> c)
-> MonadLogIgnoreT m a
-> MonadLogIgnoreT m b
-> MonadLogIgnoreT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (MonadLogIgnoreT m)
forall (m :: * -> *) a. Applicative m => a -> MonadLogIgnoreT m a
forall (m :: * -> *) a b.
Applicative m =>
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
forall (m :: * -> *) a b.
Applicative m =>
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
forall (m :: * -> *) a b.
Applicative m =>
MonadLogIgnoreT m (a -> b)
-> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> MonadLogIgnoreT m a
-> MonadLogIgnoreT m b
-> MonadLogIgnoreT m c
<* :: forall a b.
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m a
*> :: forall a b.
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> MonadLogIgnoreT m a
-> MonadLogIgnoreT m b
-> MonadLogIgnoreT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> MonadLogIgnoreT m a
-> MonadLogIgnoreT m b
-> MonadLogIgnoreT m c
<*> :: forall a b.
MonadLogIgnoreT m (a -> b)
-> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MonadLogIgnoreT m (a -> b)
-> MonadLogIgnoreT m a -> MonadLogIgnoreT m b
pure :: forall a. a -> MonadLogIgnoreT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MonadLogIgnoreT m a
Applicative, forall a. a -> MonadLogIgnoreT m a
forall a b.
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
forall a b.
MonadLogIgnoreT m a
-> (a -> MonadLogIgnoreT m b) -> MonadLogIgnoreT m b
forall {m :: * -> *}. Monad m => Applicative (MonadLogIgnoreT m)
forall (m :: * -> *) a. Monad m => a -> MonadLogIgnoreT m a
forall (m :: * -> *) a b.
Monad m =>
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
forall (m :: * -> *) a b.
Monad m =>
MonadLogIgnoreT m a
-> (a -> MonadLogIgnoreT m b) -> MonadLogIgnoreT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> MonadLogIgnoreT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MonadLogIgnoreT m a
>> :: forall a b.
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MonadLogIgnoreT m a -> MonadLogIgnoreT m b -> MonadLogIgnoreT m b
>>= :: forall a b.
MonadLogIgnoreT m a
-> (a -> MonadLogIgnoreT m b) -> MonadLogIgnoreT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MonadLogIgnoreT m a
-> (a -> MonadLogIgnoreT m b) -> MonadLogIgnoreT m b
Monad, forall a. IO a -> MonadLogIgnoreT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (MonadLogIgnoreT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MonadLogIgnoreT m a
liftIO :: forall a. IO a -> MonadLogIgnoreT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MonadLogIgnoreT m a
MonadIO, forall e a.
Exception e =>
MonadLogIgnoreT m a
-> (e -> MonadLogIgnoreT m a) -> MonadLogIgnoreT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}.
MonadCatch m =>
MonadThrow (MonadLogIgnoreT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MonadLogIgnoreT m a
-> (e -> MonadLogIgnoreT m a) -> MonadLogIgnoreT m a
catch :: forall e a.
Exception e =>
MonadLogIgnoreT m a
-> (e -> MonadLogIgnoreT m a) -> MonadLogIgnoreT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MonadLogIgnoreT m a
-> (e -> MonadLogIgnoreT m a) -> MonadLogIgnoreT m a
MonadCatch, forall e a. Exception e => e -> MonadLogIgnoreT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (MonadLogIgnoreT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MonadLogIgnoreT m a
throwM :: forall e a. Exception e => e -> MonadLogIgnoreT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MonadLogIgnoreT m a
MonadThrow, forall b.
((forall a. MonadLogIgnoreT m a -> MonadLogIgnoreT m a)
 -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m b
forall a b c.
MonadLogIgnoreT m a
-> (a -> ExitCase b -> MonadLogIgnoreT m c)
-> (a -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall {m :: * -> *}. MonadMask m => MonadCatch (MonadLogIgnoreT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. MonadLogIgnoreT m a -> MonadLogIgnoreT m a)
 -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m b
forall (m :: * -> *) a b c.
MonadMask m =>
MonadLogIgnoreT m a
-> (a -> ExitCase b -> MonadLogIgnoreT m c)
-> (a -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m (b, c)
generalBracket :: forall a b c.
MonadLogIgnoreT m a
-> (a -> ExitCase b -> MonadLogIgnoreT m c)
-> (a -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
MonadLogIgnoreT m a
-> (a -> ExitCase b -> MonadLogIgnoreT m c)
-> (a -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m (b, c)
uninterruptibleMask :: forall b.
((forall a. MonadLogIgnoreT m a -> MonadLogIgnoreT m a)
 -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. MonadLogIgnoreT m a -> MonadLogIgnoreT m a)
 -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m b
mask :: forall b.
((forall a. MonadLogIgnoreT m a -> MonadLogIgnoreT m a)
 -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. MonadLogIgnoreT m a -> MonadLogIgnoreT m a)
 -> MonadLogIgnoreT m b)
-> MonadLogIgnoreT m b
MonadMask, forall a. String -> MonadLogIgnoreT m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall {m :: * -> *}. MonadFail m => Monad (MonadLogIgnoreT m)
forall (m :: * -> *) a.
MonadFail m =>
String -> MonadLogIgnoreT m a
fail :: forall a. String -> MonadLogIgnoreT m a
$cfail :: forall (m :: * -> *) a.
MonadFail m =>
String -> MonadLogIgnoreT m a
MonadFail)

deriving newtype instance MonadError e m => MonadError e (MonadLogIgnoreT m)

instance MonadTrans MonadLogIgnoreT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> MonadLogIgnoreT m a
lift = forall (m :: * -> *) a. m a -> MonadLogIgnoreT m a
MonadLogIgnoreT

instance Monad m => MonadLog (MonadLogIgnoreT m) where
  logInfo' :: Doc Void -> MonadLogIgnoreT m ()
logInfo' Doc Void
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  logWarn' :: Doc Void -> MonadLogIgnoreT m ()
logWarn' Doc Void
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  logDebug' :: Doc Void -> MonadLogIgnoreT m ()
logDebug' Doc Void
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

newtype MonadLogKatipT m a = MonadLogKatipT { forall (m :: * -> *) a. MonadLogKatipT m a -> KatipContextT m a
runMonadLogKatipT :: KatipContextT m a }
  deriving newtype (forall a b. a -> MonadLogKatipT m b -> MonadLogKatipT m a
forall a b. (a -> b) -> MonadLogKatipT m a -> MonadLogKatipT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MonadLogKatipT m b -> MonadLogKatipT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonadLogKatipT m a -> MonadLogKatipT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MonadLogKatipT m b -> MonadLogKatipT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MonadLogKatipT m b -> MonadLogKatipT m a
fmap :: forall a b. (a -> b) -> MonadLogKatipT m a -> MonadLogKatipT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonadLogKatipT m a -> MonadLogKatipT m b
Functor, forall a. a -> MonadLogKatipT m a
forall a b.
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m a
forall a b.
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
forall a b.
MonadLogKatipT m (a -> b)
-> MonadLogKatipT m a -> MonadLogKatipT m b
forall a b c.
(a -> b -> c)
-> MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (MonadLogKatipT m)
forall (m :: * -> *) a. Applicative m => a -> MonadLogKatipT m a
forall (m :: * -> *) a b.
Applicative m =>
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m a
forall (m :: * -> *) a b.
Applicative m =>
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
forall (m :: * -> *) a b.
Applicative m =>
MonadLogKatipT m (a -> b)
-> MonadLogKatipT m a -> MonadLogKatipT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m c
<* :: forall a b.
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m a
*> :: forall a b.
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m c
<*> :: forall a b.
MonadLogKatipT m (a -> b)
-> MonadLogKatipT m a -> MonadLogKatipT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MonadLogKatipT m (a -> b)
-> MonadLogKatipT m a -> MonadLogKatipT m b
pure :: forall a. a -> MonadLogKatipT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MonadLogKatipT m a
Applicative, forall a. a -> MonadLogKatipT m a
forall a b.
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
forall a b.
MonadLogKatipT m a
-> (a -> MonadLogKatipT m b) -> MonadLogKatipT m b
forall {m :: * -> *}. Monad m => Applicative (MonadLogKatipT m)
forall (m :: * -> *) a. Monad m => a -> MonadLogKatipT m a
forall (m :: * -> *) a b.
Monad m =>
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
forall (m :: * -> *) a b.
Monad m =>
MonadLogKatipT m a
-> (a -> MonadLogKatipT m b) -> MonadLogKatipT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> MonadLogKatipT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MonadLogKatipT m a
>> :: forall a b.
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MonadLogKatipT m a -> MonadLogKatipT m b -> MonadLogKatipT m b
>>= :: forall a b.
MonadLogKatipT m a
-> (a -> MonadLogKatipT m b) -> MonadLogKatipT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MonadLogKatipT m a
-> (a -> MonadLogKatipT m b) -> MonadLogKatipT m b
Monad, forall a. IO a -> MonadLogKatipT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (MonadLogKatipT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MonadLogKatipT m a
liftIO :: forall a. IO a -> MonadLogKatipT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MonadLogKatipT m a
MonadIO, forall e a.
Exception e =>
MonadLogKatipT m a
-> (e -> MonadLogKatipT m a) -> MonadLogKatipT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (MonadLogKatipT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MonadLogKatipT m a
-> (e -> MonadLogKatipT m a) -> MonadLogKatipT m a
catch :: forall e a.
Exception e =>
MonadLogKatipT m a
-> (e -> MonadLogKatipT m a) -> MonadLogKatipT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MonadLogKatipT m a
-> (e -> MonadLogKatipT m a) -> MonadLogKatipT m a
MonadCatch, forall e a. Exception e => e -> MonadLogKatipT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (MonadLogKatipT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MonadLogKatipT m a
throwM :: forall e a. Exception e => e -> MonadLogKatipT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MonadLogKatipT m a
MonadThrow, forall b.
((forall a. MonadLogKatipT m a -> MonadLogKatipT m a)
 -> MonadLogKatipT m b)
-> MonadLogKatipT m b
forall a b c.
MonadLogKatipT m a
-> (a -> ExitCase b -> MonadLogKatipT m c)
-> (a -> MonadLogKatipT m b)
-> MonadLogKatipT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall {m :: * -> *}. MonadMask m => MonadCatch (MonadLogKatipT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. MonadLogKatipT m a -> MonadLogKatipT m a)
 -> MonadLogKatipT m b)
-> MonadLogKatipT m b
forall (m :: * -> *) a b c.
MonadMask m =>
MonadLogKatipT m a
-> (a -> ExitCase b -> MonadLogKatipT m c)
-> (a -> MonadLogKatipT m b)
-> MonadLogKatipT m (b, c)
generalBracket :: forall a b c.
MonadLogKatipT m a
-> (a -> ExitCase b -> MonadLogKatipT m c)
-> (a -> MonadLogKatipT m b)
-> MonadLogKatipT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
MonadLogKatipT m a
-> (a -> ExitCase b -> MonadLogKatipT m c)
-> (a -> MonadLogKatipT m b)
-> MonadLogKatipT m (b, c)
uninterruptibleMask :: forall b.
((forall a. MonadLogKatipT m a -> MonadLogKatipT m a)
 -> MonadLogKatipT m b)
-> MonadLogKatipT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. MonadLogKatipT m a -> MonadLogKatipT m a)
 -> MonadLogKatipT m b)
-> MonadLogKatipT m b
mask :: forall b.
((forall a. MonadLogKatipT m a -> MonadLogKatipT m a)
 -> MonadLogKatipT m b)
-> MonadLogKatipT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. MonadLogKatipT m a -> MonadLogKatipT m a)
 -> MonadLogKatipT m b)
-> MonadLogKatipT m b
MonadMask, forall a. String -> MonadLogKatipT m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall {m :: * -> *}. MonadFail m => Monad (MonadLogKatipT m)
forall (m :: * -> *) a. MonadFail m => String -> MonadLogKatipT m a
fail :: forall a. String -> MonadLogKatipT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> MonadLogKatipT m a
MonadFail)

runMonadLogKatip :: KatipConfig -> MonadLogKatipT m a -> m a
runMonadLogKatip :: forall (m :: * -> *) a. KatipConfig -> MonadLogKatipT m a -> m a
runMonadLogKatip (LogEnv
env, LogContexts
context, Namespace
ns) (MonadLogKatipT KatipContextT m a
action) =
  forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
Katip.runKatipContextT LogEnv
env LogContexts
context Namespace
ns KatipContextT m a
action

deriving newtype instance MonadError e m => MonadError e (MonadLogKatipT m)

instance MonadTrans MonadLogKatipT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> MonadLogKatipT m a
lift = forall (m :: * -> *) a. KatipContextT m a -> MonadLogKatipT m a
MonadLogKatipT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadIO m => MonadLog (MonadLogKatipT m) where
    logInfo' :: Doc Void -> MonadLogKatipT m ()
logInfo' Doc Void
s =
        let mkStr :: Doc ann -> LogStr
mkStr = forall a. StringConv a Text => a -> LogStr
Katip.logStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. SimpleDocStream ann -> Text
Render.renderLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions
        in forall (m :: * -> *) a. KatipContextT m a -> MonadLogKatipT m a
MonadLogKatipT (forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
Katip.logFM Severity
InfoS (forall {ann}. Doc ann -> LogStr
mkStr Doc Void
s))
    logWarn' :: Doc Void -> MonadLogKatipT m ()
logWarn' Doc Void
s =
        let mkStr :: Doc ann -> LogStr
mkStr = forall a. StringConv a Text => a -> LogStr
Katip.logStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. SimpleDocStream ann -> Text
Render.renderLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions
        in forall (m :: * -> *) a. KatipContextT m a -> MonadLogKatipT m a
MonadLogKatipT (forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
Katip.logFM Severity
WarningS (forall {ann}. Doc ann -> LogStr
mkStr Doc Void
s))
    logDebug' :: Doc Void -> MonadLogKatipT m ()
logDebug' Doc Void
s =
        let mkStr :: Doc ann -> LogStr
mkStr = forall a. StringConv a Text => a -> LogStr
Katip.logStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. SimpleDocStream ann -> Text
Render.renderLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions
        in forall (m :: * -> *) a. KatipContextT m a -> MonadLogKatipT m a
MonadLogKatipT (forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
Katip.logFM Severity
DebugS (forall {ann}. Doc ann -> LogStr
mkStr Doc Void
s))

logUnless :: MonadLog m => Bool -> String -> m ()
logUnless :: forall (m :: * -> *). MonadLog m => Bool -> String -> m ()
logUnless Bool
w String
m = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
w (forall (m :: * -> *). MonadLog m => String -> m ()
logInfoS String
m)

type KatipConfig = (LogEnv, LogContexts, Namespace)

{-| Set up a 'KatipConfig' with a single scribe that writes to stdout
at the given severity
-}
withKatipLogging :: Severity -> Environment -> Namespace -> (KatipConfig -> IO ()) -> IO ()
withKatipLogging :: Severity
-> Environment -> Namespace -> (KatipConfig -> IO ()) -> IO ()
withKatipLogging Severity
severity Environment
environment Namespace
initialNamespace KatipConfig -> IO ()
action = do
  Scribe
handleScribe <- ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
Katip.mkHandleScribe ColorStrategy
Katip.ColorIfTerminal Handle
stdout (forall (m :: * -> *) a. Monad m => Severity -> Item a -> m Bool
Katip.permitItem Severity
severity) Verbosity
Katip.V2
  let makeLogEnv :: IO LogEnv
makeLogEnv = Text -> Scribe -> ScribeSettings -> LogEnv -> IO LogEnv
Katip.registerScribe (forall a. IsString a => String -> a
fromString String
"stdout") Scribe
handleScribe ScribeSettings
Katip.defaultScribeSettings forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Namespace -> Environment -> IO LogEnv
Katip.initLogEnv Namespace
initialNamespace Environment
environment
  -- closeScribes will stop accepting new logs, flush existing ones and clean up resources
  forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket IO LogEnv
makeLogEnv LogEnv -> IO LogEnv
Katip.closeScribes forall a b. (a -> b) -> a -> b
$ \LogEnv
le -> do
    let initialContext :: LogContexts
initialContext = forall a. Monoid a => a
mempty -- this context will be attached to every log in your app and merged w/ subsequent contexts
    KatipConfig -> IO ()
action (LogEnv
le, LogContexts
initialContext, Namespace
initialNamespace)