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

import qualified DiPolysemy as Di
import Polysemy.Conc (Race)
import Polysemy.Internal.Tactics (liftT)
import Polysemy.Time (GhcTime)

import Polysemy.Log.Effect.DataLog (DataLog (DataLog, Local))
import Polysemy.Log.Effect.Log (Log)
import qualified Polysemy.Log.Data.LogEntry as LogEntry
import Polysemy.Log.Data.LogEntry (LogEntry)
import qualified Polysemy.Log.Data.LogMessage as LogMessage
import Polysemy.Log.Data.LogMessage (LogMessage)
import Polysemy.Log.Data.Severity (Severity)
import Polysemy.Log.Log (interpretLogDataLog, interpretLogDataLog', interpretLogDataLogConc)

-- |Reinterpret 'DataLog' as 'Di.Di', using the provided function to extract the log level from the message.
-- Maintains a context function as state that is applied to each logged message, allowing the context of a block to be
-- modified.
interpretDataLogDiLocal ::
  ∀ level path msg r .
  Member (Di.Di level path msg) r =>
  (msg -> level) ->
  (msg -> msg) ->
  InterpreterFor (DataLog msg) r
interpretDataLogDiLocal :: forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
(msg -> level) -> (msg -> msg) -> InterpreterFor (DataLog msg) r
interpretDataLogDiLocal msg -> level
extractLevel msg -> msg
context =
  (forall (rInitial :: EffectRow) x.
 DataLog msg (Sem rInitial) x
 -> Tactical (DataLog msg) (Sem rInitial) r x)
-> Sem (DataLog msg : 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
msg ->
      Sem r ()
-> Sem (WithTactics (DataLog msg) 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 (forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
level -> msg -> Sem r ()
Di.log @_ @path (msg -> level
extractLevel msg
msg) (msg -> msg
context msg
msg))
    Local msg -> msg
f Sem rInitial x
ma ->
      Sem r (f x)
-> Sem (WithTactics (DataLog msg) 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 msg) f (Sem rInitial) r) (f x))
-> (Sem (DataLog msg : r) (f x) -> Sem r (f x))
-> Sem (DataLog msg : r) (f x)
-> Sem (WithTactics (DataLog msg) f (Sem rInitial) r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
(msg -> level) -> (msg -> msg) -> InterpreterFor (DataLog msg) r
interpretDataLogDiLocal @_ @path msg -> level
extractLevel (msg -> msg
f (msg -> msg) -> (msg -> msg) -> msg -> msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> msg
context) (Sem (DataLog msg : r) (f x)
 -> Sem (WithTactics (DataLog msg) f (Sem rInitial) r) (f x))
-> Sem
     (WithTactics (DataLog msg) f (Sem rInitial) r)
     (Sem (DataLog msg : r) (f x))
-> Sem (WithTactics (DataLog msg) 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 msg) f (Sem rInitial) r)
     (Sem (DataLog msg : 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 interpretDataLogDiLocal #-}

-- |Reinterpret 'DataLog' as 'Di.Di', using the provided function to extract the log level from the message.
interpretDataLogDi ::
  ∀ level path msg r .
  Member (Di.Di level path msg) r =>
  (msg -> level) ->
  InterpreterFor (DataLog msg) r
interpretDataLogDi :: forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
(msg -> level) -> InterpreterFor (DataLog msg) r
interpretDataLogDi msg -> level
extractLevel =
  forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
(msg -> level) -> (msg -> msg) -> InterpreterFor (DataLog msg) r
interpretDataLogDiLocal @_ @path msg -> level
extractLevel msg -> msg
forall a. a -> a
id
{-# inline interpretDataLogDi #-}

-- |Reinterpret 'Log' as 'Di.Di', using the /polysemy-log/ default message.
--
-- Since this adds a timestamp, it has a dependency on 'GhcTime'.
-- Use 'interpretLogDi'' for a variant that interprets 'GhcTime' in-place.
interpretLogDi ::
  ∀ path r .
  Members [Di.Di Severity path (LogEntry LogMessage), GhcTime] r =>
  InterpreterFor Log r
interpretLogDi :: forall path (r :: EffectRow).
Members '[Di Severity path (LogEntry LogMessage), GhcTime] r =>
InterpreterFor Log r
interpretLogDi =
  forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
(msg -> level) -> InterpreterFor (DataLog msg) r
interpretDataLogDi @_ @path (LogMessage -> Severity
LogMessage.severity (LogMessage -> Severity)
-> (LogEntry LogMessage -> LogMessage)
-> LogEntry LogMessage
-> Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogEntry LogMessage -> LogMessage
forall a. LogEntry a -> a
LogEntry.message) (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 interpretLogDi #-}

-- |Reinterpret 'Log' as 'Di.Di', also interpreting 'GhcTime'.
interpretLogDi' ::
  ∀ path r .
  Members [Di.Di Severity path (LogEntry LogMessage), Embed IO] r =>
  InterpretersFor [Log, GhcTime] r
interpretLogDi' :: forall path (r :: EffectRow).
Members '[Di Severity path (LogEntry LogMessage), Embed IO] r =>
InterpretersFor '[Log, GhcTime] r
interpretLogDi' =
  forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
(msg -> level) -> InterpreterFor (DataLog msg) r
interpretDataLogDi @_ @path (LogMessage -> Severity
LogMessage.severity (LogMessage -> Severity)
-> (LogEntry LogMessage -> LogMessage)
-> LogEntry LogMessage
-> Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogEntry LogMessage -> LogMessage
forall a. LogEntry a -> a
LogEntry.message) (Sem (DataLog (LogEntry LogMessage) : r) a -> Sem r a)
-> (Sem (Log : GhcTime : r) a
    -> Sem (DataLog (LogEntry LogMessage) : r) a)
-> Sem (Log : GhcTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (Log
     : LogMetadata LogMessage : GhcTime : DataLog (LogEntry LogMessage)
     : r)
  a
-> Sem (DataLog (LogEntry LogMessage) : r) a
forall (r :: EffectRow).
Members '[DataLog (LogEntry LogMessage), Embed IO] r =>
InterpretersFor '[Log, LogMetadata LogMessage, GhcTime] r
interpretLogDataLog' (Sem
   (Log
      : LogMetadata LogMessage : GhcTime : DataLog (LogEntry LogMessage)
      : r)
   a
 -> Sem (DataLog (LogEntry LogMessage) : r) a)
-> (Sem (Log : GhcTime : r) a
    -> Sem
         (Log
            : LogMetadata LogMessage : GhcTime : DataLog (LogEntry LogMessage)
            : r)
         a)
-> Sem (Log : GhcTime : 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
     (Log
        : LogMetadata LogMessage : GhcTime : DataLog (LogEntry LogMessage)
        : r)
     a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Log : GhcTime : DataLog (LogEntry LogMessage) : r) a
 -> Sem
      (Log
         : LogMetadata LogMessage : GhcTime : DataLog (LogEntry LogMessage)
         : r)
      a)
-> (Sem (Log : GhcTime : r) a
    -> Sem (Log : GhcTime : DataLog (LogEntry LogMessage) : r) a)
-> Sem (Log : GhcTime : r) a
-> Sem
     (Log
        : LogMetadata LogMessage : GhcTime : DataLog (LogEntry LogMessage)
        : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Log : GhcTime : r) a
-> Sem (Log : GhcTime : DataLog (LogEntry LogMessage) : r) a
forall (e3 :: Effect) (e1 :: Effect) (e2 :: Effect)
       (r :: EffectRow) a.
Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under
{-# inline interpretLogDi' #-}

-- |Reinterpret 'Log' as 'Di.Di' concurrently.
interpretLogDiConc ::
  ∀ path r .
  Members [Di.Di Severity path (LogEntry LogMessage), Resource, Async, Race, Embed IO] r =>
  Int ->
  InterpreterFor Log r
interpretLogDiConc :: forall path (r :: EffectRow).
Members
  '[Di Severity path (LogEntry LogMessage), Resource, Async, Race,
    Embed IO]
  r =>
Int -> InterpreterFor Log r
interpretLogDiConc Int
maxQueued =
  forall level path msg (r :: EffectRow).
Member (Di level path msg) r =>
(msg -> level) -> InterpreterFor (DataLog msg) r
interpretDataLogDi @_ @path (LogMessage -> Severity
LogMessage.severity (LogMessage -> Severity)
-> (LogEntry LogMessage -> LogMessage)
-> LogEntry LogMessage
-> Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogEntry LogMessage -> LogMessage
forall a. LogEntry a -> a
LogEntry.message) (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
.
  Int -> InterpreterFor Log (DataLog (LogEntry LogMessage) : r)
forall (r :: EffectRow).
Members
  '[DataLog (LogEntry LogMessage), Resource, Async, Race, Embed IO]
  r =>
Int -> InterpreterFor Log r
interpretLogDataLogConc Int
maxQueued (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 interpretLogDiConc #-}