module Polysemy.Log.Colog.Colog where
import qualified Colog (Message, Msg(Msg), Severity(..), logTextStdout, richMessageAction)
import qualified Colog.Polysemy as Colog
import Colog.Polysemy (runLogAction)
import Polysemy.Internal (InterpretersFor)
import Polysemy.Time (GhcTime, interpretTimeGhc)
import Polysemy.Log.Data.DataLog (DataLog(DataLog))
import Polysemy.Log.Data.Log (Log)
import Polysemy.Log.Data.LogEntry (LogEntry (LogEntry))
import Polysemy.Log.Data.LogMessage (LogMessage(..))
import qualified Polysemy.Log.Data.Severity as Severity
import Polysemy.Log.Data.Severity (Severity)
import Polysemy.Log.Format (formatLogEntry)
import Polysemy.Log.Log (interpretLogDataLog)
severityToColog ::
Severity ->
Colog.Severity
severityToColog :: Severity -> Severity
severityToColog = \case
Severity
Severity.Trace -> Severity
Colog.Debug
Severity
Severity.Debug -> Severity
Colog.Debug
Severity
Severity.Info -> Severity
Colog.Info
Severity
Severity.Warn -> Severity
Colog.Warning
Severity
Severity.Error -> Severity
Colog.Error
Severity
Severity.Crit -> Severity
Colog.Error
{-# INLINE severityToColog #-}
toColog :: LogEntry LogMessage -> Colog.Message
toColog :: LogEntry LogMessage -> Message
toColog (LogEntry LogMessage {Text
Severity
$sel:severity:LogMessage :: LogMessage -> Severity
$sel:message:LogMessage :: LogMessage -> Text
message :: Text
severity :: Severity
..} UTCTime
_ CallStack
source) =
Severity -> CallStack -> Text -> Message
forall sev. sev -> CallStack -> Text -> Msg sev
Colog.Msg (Severity -> Severity
severityToColog Severity
severity) CallStack
source Text
message
{-# INLINE toColog #-}
interpretDataLogColog ::
∀ a r .
Member (Colog.Log a) r =>
InterpreterFor (DataLog a) r
interpretDataLogColog :: InterpreterFor (DataLog a) r
interpretDataLogColog =
(forall x (rInitial :: EffectRow).
DataLog a (Sem rInitial) x -> Sem r x)
-> Sem (DataLog a : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
DataLog msg -> a -> Sem r ()
forall msg (r :: EffectRow). Member (Log msg) r => msg -> Sem r ()
Colog.log a
msg
{-# INLINE interpretDataLogColog #-}
interpretDataLogNative ::
Member (Colog.Log Colog.Message) r =>
InterpreterFor (DataLog (LogEntry LogMessage)) r
interpretDataLogNative :: InterpreterFor (DataLog (LogEntry LogMessage)) r
interpretDataLogNative =
(forall x (rInitial :: EffectRow).
DataLog (LogEntry LogMessage) (Sem rInitial) x -> Sem r x)
-> Sem (DataLog (LogEntry LogMessage) : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
DataLog msg -> Message -> Sem r ()
forall msg (r :: EffectRow). Member (Log msg) r => msg -> Sem r ()
Colog.log (LogEntry LogMessage -> Message
toColog LogEntry LogMessage
msg)
{-# INLINE interpretDataLogNative #-}
interpretLogColog ::
Members [Colog.Log (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogColog :: InterpreterFor Log r
interpretLogColog =
forall (r :: EffectRow).
Member (Log (LogEntry LogMessage)) r =>
InterpreterFor (DataLog (LogEntry LogMessage)) r
forall a (r :: EffectRow).
Member (Log a) r =>
InterpreterFor (DataLog a) r
interpretDataLogColog @(LogEntry LogMessage) (Sem (DataLog (LogEntry LogMessage) : r) a -> Sem r a)
-> (Sem (Log : r) a -> Sem (DataLog (LogEntry LogMessage) : r) a)
-> Sem (Log : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : DataLog (LogEntry LogMessage) : r) a
-> Sem (DataLog (LogEntry LogMessage) : r) a
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogDataLog (Sem (Log : DataLog (LogEntry LogMessage) : r) a
-> Sem (DataLog (LogEntry LogMessage) : r) a)
-> (Sem (Log : r) a
-> Sem (Log : DataLog (LogEntry LogMessage) : r) a)
-> Sem (Log : r) a
-> Sem (DataLog (LogEntry LogMessage) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : r) a -> Sem (Log : DataLog (LogEntry LogMessage) : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
{-# INLINE interpretLogColog #-}
interpretLogColog' ::
Members [Colog.Log (LogEntry LogMessage), Embed IO] r =>
InterpretersFor [Log, GhcTime] r
interpretLogColog' :: InterpretersFor '[Log, GhcTime] r
interpretLogColog' =
Sem (GhcTime : r) a -> Sem r a
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : r) a -> Sem r a)
-> (Sem (Log : GhcTime : r) a -> Sem (GhcTime : r) a)
-> Sem (Log : GhcTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Log : GhcTime : r) a -> Sem (GhcTime : r) a
forall (r :: EffectRow).
Members '[Log (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogColog
{-# INLINE interpretLogColog' #-}
interpretCologStdoutFormat ::
∀ msg m r .
MonadIO m =>
Member (Embed m) r =>
(msg -> Text) ->
InterpreterFor (Colog.Log msg) r
interpretCologStdoutFormat :: (msg -> Text) -> InterpreterFor (Log msg) r
interpretCologStdoutFormat msg -> Text
format =
LogAction m msg -> Sem (Log msg : r) a -> Sem r a
forall (m :: * -> *) msg (r :: EffectRow) a.
Member (Embed m) r =>
LogAction m msg -> Sem (Log msg : r) a -> Sem r a
runLogAction @m ((msg -> Text) -> LogAction m Text -> LogAction m msg
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap msg -> Text
format LogAction m Text
forall (m :: * -> *). MonadIO m => LogAction m Text
Colog.logTextStdout)
{-# INLINE interpretCologStdoutFormat #-}
interpretCologStdout ::
∀ m r .
MonadIO m =>
Member (Embed m) r =>
InterpreterFor (Colog.Log (LogEntry LogMessage)) r
interpretCologStdout :: InterpreterFor (Log (LogEntry LogMessage)) r
interpretCologStdout =
(LogEntry LogMessage -> Text)
-> InterpreterFor (Log (LogEntry LogMessage)) r
forall msg (m :: * -> *) (r :: EffectRow).
(MonadIO m, Member (Embed m) r) =>
(msg -> Text) -> InterpreterFor (Log msg) r
interpretCologStdoutFormat @_ @m LogEntry LogMessage -> Text
formatLogEntry
{-# INLINE interpretCologStdout #-}
interpretLogStdout ::
Member (Embed IO) r =>
InterpreterFor Log r
interpretLogStdout :: InterpreterFor Log r
interpretLogStdout =
forall (r :: EffectRow).
(MonadIO IO, Member (Embed IO) r) =>
InterpreterFor (Log (LogEntry LogMessage)) r
forall (m :: * -> *) (r :: EffectRow).
(MonadIO m, Member (Embed m) r) =>
InterpreterFor (Log (LogEntry LogMessage)) r
interpretCologStdout @IO (Sem (Log (LogEntry LogMessage) : r) a -> Sem r a)
-> (Sem (Log : r) a -> Sem (Log (LogEntry LogMessage) : r) a)
-> Sem (Log : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (GhcTime : Log (LogEntry LogMessage) : r) a
-> Sem (Log (LogEntry LogMessage) : r) a
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : Log (LogEntry LogMessage) : r) a
-> Sem (Log (LogEntry LogMessage) : r) a)
-> (Sem (Log : r) a
-> Sem (GhcTime : Log (LogEntry LogMessage) : r) a)
-> Sem (Log : r) a
-> Sem (Log (LogEntry LogMessage) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Log (LogEntry LogMessage)) r =>
InterpreterFor (DataLog (LogEntry LogMessage)) r
forall a (r :: EffectRow).
Member (Log a) r =>
InterpreterFor (DataLog a) r
interpretDataLogColog @(LogEntry LogMessage) (Sem
(DataLog (LogEntry LogMessage)
: GhcTime : Log (LogEntry LogMessage) : r)
a
-> Sem (GhcTime : Log (LogEntry LogMessage) : r) a)
-> (Sem (Log : r) a
-> Sem
(DataLog (LogEntry LogMessage)
: GhcTime : Log (LogEntry LogMessage) : r)
a)
-> Sem (Log : r) a
-> Sem (GhcTime : Log (LogEntry LogMessage) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(Log
: DataLog (LogEntry LogMessage) : GhcTime
: Log (LogEntry LogMessage) : r)
a
-> Sem
(DataLog (LogEntry LogMessage)
: GhcTime : Log (LogEntry LogMessage) : r)
a
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogDataLog (Sem
(Log
: DataLog (LogEntry LogMessage) : GhcTime
: Log (LogEntry LogMessage) : r)
a
-> Sem
(DataLog (LogEntry LogMessage)
: GhcTime : Log (LogEntry LogMessage) : r)
a)
-> (Sem (Log : r) a
-> Sem
(Log
: DataLog (LogEntry LogMessage) : GhcTime
: Log (LogEntry LogMessage) : r)
a)
-> Sem (Log : r) a
-> Sem
(DataLog (LogEntry LogMessage)
: GhcTime : Log (LogEntry LogMessage) : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : r) a
-> Sem
(Log
: DataLog (LogEntry LogMessage) : GhcTime
: Log (LogEntry LogMessage) : r)
a
forall (e2 :: Effect) (e3 :: Effect) (e4 :: Effect) (e1 :: Effect)
(r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raiseUnder3
{-# INLINE interpretLogStdout #-}
interpretCologStdoutNative ::
∀ m r .
MonadIO m =>
Member (Embed m) r =>
InterpreterFor (Colog.Log Colog.Message) r
interpretCologStdoutNative :: InterpreterFor (Log Message) r
interpretCologStdoutNative =
LogAction m Message -> Sem (Log Message : r) a -> Sem r a
forall (m :: * -> *) msg (r :: EffectRow) a.
Member (Embed m) r =>
LogAction m msg -> Sem (Log msg : r) a -> Sem r a
runLogAction @m LogAction m Message
forall (m :: * -> *). MonadIO m => LogAction m Message
Colog.richMessageAction
{-# INLINE interpretCologStdoutNative #-}
interpretLogCologAsNative ::
Members [Colog.Log Colog.Message, GhcTime] r =>
InterpreterFor Log r
interpretLogCologAsNative :: InterpreterFor Log r
interpretLogCologAsNative =
Sem (DataLog (LogEntry LogMessage) : r) a -> Sem r a
forall (r :: EffectRow).
Member (Log Message) r =>
InterpreterFor (DataLog (LogEntry LogMessage)) r
interpretDataLogNative (Sem (DataLog (LogEntry LogMessage) : r) a -> Sem r a)
-> (Sem (Log : r) a -> Sem (DataLog (LogEntry LogMessage) : r) a)
-> Sem (Log : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : DataLog (LogEntry LogMessage) : r) a
-> Sem (DataLog (LogEntry LogMessage) : r) a
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogDataLog (Sem (Log : DataLog (LogEntry LogMessage) : r) a
-> Sem (DataLog (LogEntry LogMessage) : r) a)
-> (Sem (Log : r) a
-> Sem (Log : DataLog (LogEntry LogMessage) : r) a)
-> Sem (Log : r) a
-> Sem (DataLog (LogEntry LogMessage) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : r) a -> Sem (Log : DataLog (LogEntry LogMessage) : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
{-# INLINE interpretLogCologAsNative #-}
interpretLogStdoutAsNative ::
Member (Embed IO) r =>
InterpretersFor [Log, Colog.Log Colog.Message] r
interpretLogStdoutAsNative :: InterpretersFor '[Log, Log Message] r
interpretLogStdoutAsNative =
forall (r :: EffectRow).
(MonadIO IO, Member (Embed IO) r) =>
InterpreterFor (Log Message) r
forall (m :: * -> *) (r :: EffectRow).
(MonadIO m, Member (Embed m) r) =>
InterpreterFor (Log Message) r
interpretCologStdoutNative @IO (Sem (Log Message : r) a -> Sem r a)
-> (Sem (Log : Log Message : r) a -> Sem (Log Message : r) a)
-> Sem (Log : Log Message : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (GhcTime : Log Message : r) a -> Sem (Log Message : r) a
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : Log Message : r) a -> Sem (Log Message : r) a)
-> (Sem (Log : Log Message : r) a
-> Sem (GhcTime : Log Message : r) a)
-> Sem (Log : Log Message : r) a
-> Sem (Log Message : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : GhcTime : Log Message : r) a
-> Sem (GhcTime : Log Message : r) a
forall (r :: EffectRow).
Members '[Log Message, GhcTime] r =>
InterpreterFor Log r
interpretLogCologAsNative (Sem (Log : GhcTime : Log Message : r) a
-> Sem (GhcTime : Log Message : r) a)
-> (Sem (Log : Log Message : r) a
-> Sem (Log : GhcTime : Log Message : r) a)
-> Sem (Log : Log Message : r) a
-> Sem (GhcTime : Log Message : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : Log Message : r) a
-> Sem (Log : GhcTime : Log Message : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
{-# INLINE interpretLogStdoutAsNative #-}