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

import qualified DiPolysemy as Di
import Polysemy.Internal (InterpretersFor, raise2Under)
import Polysemy.Time (GhcTime)

import Polysemy.Log.Data.DataLog (DataLog(DataLog))
import Polysemy.Log.Data.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')

-- |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 :: (msg -> level) -> InterpreterFor (DataLog msg) r
interpretDataLogDi msg -> level
extractLevel =
  (forall x (rInitial :: EffectRow).
 DataLog msg (Sem rInitial) x -> Sem r x)
-> Sem (DataLog msg : 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 ->
      level -> msg -> Sem r ()
forall level path msg (r :: EffectRow).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
Di.log @_ @path (msg -> level
extractLevel msg
msg) msg
msg
{-# 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 :: InterpreterFor Log r
interpretLogDi =
  (LogEntry LogMessage -> Severity)
-> InterpreterFor (DataLog (LogEntry LogMessage)) r
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' :: InterpretersFor '[Log, GhcTime] r
interpretLogDi' =
  (LogEntry LogMessage -> Severity)
-> InterpreterFor (DataLog (LogEntry LogMessage)) r
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).
(Member (Embed IO) r, Member (DataLog (LogEntry LogMessage)) 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' #-}