module Polysemy.Log.Log where
import Polysemy (interpretH, runT)
import Polysemy.Async (Async)
import Polysemy.Conc (Race)
import Polysemy.Internal (InterpretersFor)
import Polysemy.Internal.Tactics (liftT)
import Polysemy.Resource (Resource)
import Polysemy.Time (GhcTime, interpretTimeGhc)
import Polysemy.Log.Conc (interceptDataLogConc)
import Polysemy.Log.Data.DataLog (DataLog (DataLog, Local), dataLog)
import Polysemy.Log.Data.Log (Log (Log))
import Polysemy.Log.Data.LogEntry (LogEntry, annotate)
import Polysemy.Log.Data.LogMessage (LogMessage)
import Polysemy.Log.Data.LogMetadata (LogMetadata (Annotated), annotated)
interpretLogLogMetadata ::
Members [LogMetadata LogMessage, GhcTime] r =>
InterpreterFor Log r
interpretLogLogMetadata :: InterpreterFor Log r
interpretLogLogMetadata =
(forall x (rInitial :: EffectRow). Log (Sem rInitial) x -> Sem r x)
-> Sem (Log : 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
Log msg -> LogMessage -> Sem r ()
forall msg (r :: EffectRow).
(HasCallStack, Member (LogMetadata msg) r) =>
msg -> Sem r ()
annotated LogMessage
msg
{-# INLINE interpretLogLogMetadata #-}
interpretLogMetadataDataLog ::
∀ a r .
Members [DataLog (LogEntry a), GhcTime] r =>
InterpreterFor (LogMetadata a) r
interpretLogMetadataDataLog :: InterpreterFor (LogMetadata a) r
interpretLogMetadataDataLog =
(forall x (rInitial :: EffectRow).
LogMetadata a (Sem rInitial) x -> Sem r x)
-> Sem (LogMetadata 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
Annotated msg -> LogEntry a -> Sem r ()
forall a (r :: EffectRow).
MemberWithError (DataLog a) r =>
a -> Sem r ()
dataLog (LogEntry a -> Sem r ()) -> Sem r (LogEntry a) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> Sem r (LogEntry a)
forall (r :: EffectRow) a.
(HasCallStack, Member GhcTime r) =>
a -> Sem r (LogEntry a)
annotate a
msg
{-# INLINE interpretLogMetadataDataLog #-}
interpretLogMetadataDataLog' ::
Members [DataLog (LogEntry a), Embed IO] r =>
InterpretersFor [LogMetadata a, GhcTime] r
interpretLogMetadataDataLog' :: InterpretersFor '[LogMetadata a, GhcTime] r
interpretLogMetadataDataLog' =
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 (LogMetadata a : GhcTime : r) a -> Sem (GhcTime : r) a)
-> Sem (LogMetadata a : GhcTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (LogMetadata a : GhcTime : r) a -> Sem (GhcTime : r) a
forall a (r :: EffectRow).
Members '[DataLog (LogEntry a), GhcTime] r =>
InterpreterFor (LogMetadata a) r
interpretLogMetadataDataLog
{-# INLINE interpretLogMetadataDataLog' #-}
interpretLogDataLog ::
Members [DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogDataLog :: InterpreterFor Log r
interpretLogDataLog =
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor (LogMetadata LogMessage) r
forall a (r :: EffectRow).
Members '[DataLog (LogEntry a), GhcTime] r =>
InterpreterFor (LogMetadata a) r
interpretLogMetadataDataLog @LogMessage (Sem (LogMetadata LogMessage : r) a -> Sem r a)
-> (Sem (Log : r) a -> Sem (LogMetadata LogMessage : r) a)
-> Sem (Log : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Log : LogMetadata LogMessage : r) a
-> Sem (LogMetadata LogMessage : r) a
forall (r :: EffectRow).
Members '[LogMetadata LogMessage, GhcTime] r =>
InterpreterFor Log r
interpretLogLogMetadata (Sem (Log : LogMetadata LogMessage : r) a
-> Sem (LogMetadata LogMessage : r) a)
-> (Sem (Log : r) a -> Sem (Log : LogMetadata LogMessage : r) a)
-> Sem (Log : r) a
-> Sem (LogMetadata LogMessage : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Log : r) a -> Sem (Log : LogMetadata LogMessage : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
{-# INLINE interpretLogDataLog #-}
interpretLogDataLog' ::
Members [DataLog (LogEntry LogMessage), Embed IO] r =>
InterpretersFor [Log, LogMetadata LogMessage, GhcTime] r
interpretLogDataLog' :: InterpretersFor '[Log, LogMetadata LogMessage, GhcTime] r
interpretLogDataLog' =
Sem (LogMetadata LogMessage : GhcTime : r) a -> Sem r a
forall a (r :: EffectRow).
Members '[DataLog (LogEntry a), Embed IO] r =>
InterpretersFor '[LogMetadata a, GhcTime] r
interpretLogMetadataDataLog' (Sem (LogMetadata LogMessage : GhcTime : r) a -> Sem r a)
-> (Sem (Log : LogMetadata LogMessage : GhcTime : r) a
-> Sem (LogMetadata LogMessage : GhcTime : r) a)
-> Sem (Log : LogMetadata LogMessage : GhcTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Log : LogMetadata LogMessage : GhcTime : r) a
-> Sem (LogMetadata LogMessage : GhcTime : r) a
forall (r :: EffectRow).
Members '[LogMetadata LogMessage, GhcTime] r =>
InterpreterFor Log r
interpretLogLogMetadata
{-# INLINE interpretLogDataLog' #-}
interpretLogDataLogConc ::
Members [DataLog (LogEntry LogMessage), Resource, Async, Race, Embed IO] r =>
Int ->
InterpreterFor Log r
interpretLogDataLogConc :: Int -> InterpreterFor Log r
interpretLogDataLogConc Int
maxQueued =
Int -> Sem r a -> Sem r a
forall msg (r :: EffectRow) a.
Members '[DataLog msg, Resource, Async, Race, Embed IO] r =>
Int -> Sem r a -> Sem r a
interceptDataLogConc @(LogEntry LogMessage) Int
maxQueued (Sem r a -> Sem r a)
-> (Sem (Log : r) a -> Sem r a) -> Sem (Log : r) a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 : r) a -> Sem (GhcTime : r) a)
-> Sem (Log : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor (LogMetadata LogMessage) r
forall a (r :: EffectRow).
Members '[DataLog (LogEntry a), GhcTime] r =>
InterpreterFor (LogMetadata a) r
interpretLogMetadataDataLog @LogMessage (Sem (LogMetadata LogMessage : GhcTime : r) a
-> Sem (GhcTime : r) a)
-> (Sem (Log : r) a
-> Sem (LogMetadata LogMessage : GhcTime : r) a)
-> Sem (Log : r) a
-> Sem (GhcTime : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : LogMetadata LogMessage : GhcTime : r) a
-> Sem (LogMetadata LogMessage : GhcTime : r) a
forall (r :: EffectRow).
Members '[LogMetadata LogMessage, GhcTime] r =>
InterpreterFor Log r
interpretLogLogMetadata (Sem (Log : LogMetadata LogMessage : GhcTime : r) a
-> Sem (LogMetadata LogMessage : GhcTime : r) a)
-> (Sem (Log : r) a
-> Sem (Log : LogMetadata LogMessage : GhcTime : r) a)
-> Sem (Log : r) a
-> Sem (LogMetadata LogMessage : GhcTime : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Log : r) a
-> Sem (Log : LogMetadata LogMessage : GhcTime : r) a
forall (e2 :: Effect) (e3 :: Effect) (e1 :: Effect)
(r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2
{-# INLINE interpretLogDataLogConc #-}
interpretDataLogLocal ::
∀ a r .
(a -> a) ->
(a -> Sem r ()) ->
InterpreterFor (DataLog a) r
interpretDataLogLocal :: (a -> a) -> (a -> Sem r ()) -> InterpreterFor (DataLog a) r
interpretDataLogLocal a -> a
context a -> Sem r ()
log =
(forall x (rInitial :: EffectRow).
DataLog a (Sem rInitial) x
-> Tactical (DataLog a) (Sem rInitial) r x)
-> Sem (DataLog a : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
(forall x (rInitial :: EffectRow).
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
DataLog msg ->
Sem r () -> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f ())
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow) (e :: Effect)
a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (a -> Sem r ()
log (a -> a
context a
msg))
Local f ma ->
Sem r (f x)
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x)
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise (Sem r (f x)
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x))
-> (Sem (DataLog a : r) (f x) -> Sem r (f x))
-> Sem (DataLog a : r) (f x)
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> (a -> Sem r ()) -> InterpreterFor (DataLog a) r
forall a (r :: EffectRow).
(a -> a) -> (a -> Sem r ()) -> InterpreterFor (DataLog a) r
interpretDataLogLocal (a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
context) a -> Sem r ()
log (Sem (DataLog a : r) (f x)
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x))
-> Sem
(WithTactics (DataLog a) f (Sem rInitial) r)
(Sem (DataLog a : r) (f x))
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem rInitial x
-> Sem
(WithTactics (DataLog a) f (Sem rInitial) r)
(Sem (DataLog a : r) (f x))
forall (m :: * -> *) a (e :: Effect) (f :: * -> *)
(r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial x
ma
{-# INLINE interpretDataLogLocal #-}
interpretDataLog ::
∀ a r .
(a -> Sem r ()) ->
InterpreterFor (DataLog a) r
interpretDataLog :: (a -> Sem r ()) -> InterpreterFor (DataLog a) r
interpretDataLog =
(a -> a) -> (a -> Sem r ()) -> InterpreterFor (DataLog a) r
forall a (r :: EffectRow).
(a -> a) -> (a -> Sem r ()) -> InterpreterFor (DataLog a) r
interpretDataLogLocal a -> a
forall a. a -> a
id