-- |Description: Internal
module Polysemy.Log.Log where

import qualified Data.Text.IO as Text
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)
import Polysemy.Log.Format (formatLogEntry)

-- |Interpret 'Log' into the intermediate internal effect 'LogMetadata'.
interpretLogLogMetadata ::
  Members [LogMetadata LogMessage, GhcTime] r =>
  InterpreterFor Log r
interpretLogLogMetadata :: InterpreterFor Log r
interpretLogLogMetadata =
  (forall (rInitial :: EffectRow) x. Log (Sem rInitial) x -> Sem r x)
-> Sem (Log : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. 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 #-}

-- |Interpret the intermediate internal effect 'LogMetadata' into 'DataLog'.
--
-- Since this adds a timestamp, it has a dependency on 'GhcTime'.
-- Use 'interpretLogMetadataDataLog'' for a variant that interprets 'GhcTime' in-place.
interpretLogMetadataDataLog ::
  ∀ a r .
  Members [DataLog (LogEntry a), GhcTime] r =>
  InterpreterFor (LogMetadata a) r
interpretLogMetadataDataLog :: InterpreterFor (LogMetadata a) r
interpretLogMetadataDataLog =
  (forall (rInitial :: EffectRow) x.
 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 (rInitial :: EffectRow) x. 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 #-}

-- |Interpret the intermediate internal effect 'LogMetadata' into 'DataLog'.
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' #-}

-- |Interpret 'Log' into 'DataLog', adding metadata information and wrapping with 'LogEntry'.
--
-- Since this adds a timestamp, it has a dependency on 'GhcTime'.
-- Use 'interpretLogDataLog'' for a variant that interprets 'GhcTime' in-place.
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 #-}

-- |Interpret 'Log' into 'DataLog', adding metadata information and wrapping with 'LogEntry'.
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' #-}

-- |Interpret 'Log' into 'DataLog' concurrently, adding metadata information and wrapping with 'LogEntry'.
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 #-}

-- |Helper for maintaining context function as state that is applied to each logged message, allowing the context of a
-- block to be modified.
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 (rInitial :: EffectRow) x.
 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 (rInitial :: EffectRow) x.
 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 #-}

-- |Combinator for building 'DataLog' interpreters that handles 'Local'.
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

-- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' with the supplied function.
interpretDataLogStderrWith ::
  Member (Embed IO) r =>
  (a -> Text) ->
  InterpreterFor (DataLog a) r
interpretDataLogStderrWith :: (a -> Text) -> InterpreterFor (DataLog a) r
interpretDataLogStderrWith a -> Text
fmt =
  (a -> Sem r ()) -> InterpreterFor (DataLog a) r
forall a (r :: EffectRow).
(a -> Sem r ()) -> InterpreterFor (DataLog a) r
interpretDataLog \ a
msg -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr (a -> Text
fmt a
msg))
{-# INLINE interpretDataLogStderrWith #-}

-- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' by using 'Show'.
interpretDataLogStderr ::
  Show a =>
  Member (Embed IO) r =>
  InterpreterFor (DataLog a) r
interpretDataLogStderr :: InterpreterFor (DataLog a) r
interpretDataLogStderr =
  (a -> Text) -> InterpreterFor (DataLog a) r
forall (r :: EffectRow) a.
Member (Embed IO) r =>
(a -> Text) -> InterpreterFor (DataLog a) r
interpretDataLogStderrWith a -> Text
forall b a. (Show a, IsString b) => a -> b
show
{-# INLINE interpretDataLogStderr #-}

-- |Interpret 'Log' by printing to stderr, converting messages to 'Text' with the supplied function.
interpretLogStderrWith ::
  Members [Embed IO, GhcTime] r =>
  (LogEntry LogMessage -> Text) ->
  InterpreterFor Log r
interpretLogStderrWith :: (LogEntry LogMessage -> Text) -> InterpreterFor Log r
interpretLogStderrWith LogEntry LogMessage -> Text
fmt =
  (LogEntry LogMessage -> Text)
-> InterpreterFor (DataLog (LogEntry LogMessage)) r
forall (r :: EffectRow) a.
Member (Embed IO) r =>
(a -> Text) -> InterpreterFor (DataLog a) r
interpretDataLogStderrWith LogEntry LogMessage -> Text
fmt (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 (GhcTime : DataLog (LogEntry LogMessage) : r) a
-> Sem (DataLog (LogEntry LogMessage) : r) a
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : DataLog (LogEntry LogMessage) : r) a
 -> Sem (DataLog (LogEntry LogMessage) : r) a)
-> (Sem (Log : r) a
    -> Sem (GhcTime : 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 : GhcTime : DataLog (LogEntry LogMessage) : r) a
-> Sem (GhcTime : DataLog (LogEntry LogMessage) : r) a
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogDataLog (Sem (Log : GhcTime : DataLog (LogEntry LogMessage) : r) a
 -> Sem (GhcTime : DataLog (LogEntry LogMessage) : r) a)
-> (Sem (Log : r) a
    -> Sem (Log : GhcTime : DataLog (LogEntry LogMessage) : r) a)
-> Sem (Log : r) a
-> Sem (GhcTime : DataLog (LogEntry LogMessage) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Log : r) a
-> Sem (Log : GhcTime : DataLog (LogEntry LogMessage) : r) a
forall (e2 :: Effect) (e3 :: Effect) (e1 :: Effect)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2
{-# INLINE interpretLogStderrWith #-}

-- |Interpret 'Log' by printing to stderr, using the default formatter.
--
-- Since this adds a timestamp, it has a dependency on 'GhcTime'.
-- Use 'interpretLogStderr'' for a variant that interprets 'GhcTime' in-place.
interpretLogStderr ::
  Members [Embed IO, GhcTime] r =>
  InterpreterFor Log r
interpretLogStderr :: InterpreterFor Log r
interpretLogStderr =
  (LogEntry LogMessage -> Text) -> InterpreterFor Log r
forall (r :: EffectRow).
Members '[Embed IO, GhcTime] r =>
(LogEntry LogMessage -> Text) -> InterpreterFor Log r
interpretLogStderrWith LogEntry LogMessage -> Text
formatLogEntry
{-# INLINE interpretLogStderr #-}

-- |Interpret 'Log' by printing to stderr, using the default formatter, then interpreting 'GhcTime'.
interpretLogStderr' ::
  Member (Embed IO) r =>
  InterpreterFor Log r
interpretLogStderr' :: InterpreterFor Log r
interpretLogStderr' =
  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
.
  Sem (Log : GhcTime : r) a -> Sem (GhcTime : r) a
forall (r :: EffectRow).
Members '[Embed IO, GhcTime] r =>
InterpreterFor Log r
interpretLogStderr (Sem (Log : GhcTime : r) a -> Sem (GhcTime : r) a)
-> (Sem (Log : r) a -> Sem (Log : GhcTime : r) a)
-> Sem (Log : r) a
-> Sem (GhcTime : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Log : r) a -> Sem (Log : GhcTime : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
{-# INLINE interpretLogStderr' #-}