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

import qualified Colog
import Colog (LogAction, convertToLogAction, defCapacity, forkBackgroundLogger, killBackgroundLogger)
import Colog.Concurrent.Internal (Capacity)
import qualified Colog.Polysemy as Colog
import Colog.Polysemy (runLogAction)

import Polysemy.Log.Data.LogEntry (LogEntry)
import Polysemy.Log.Data.LogMessage (LogMessage)
import Polysemy.Log.Format (formatLogEntry)

-- |Interpret 'Colog.Log' using /co-log/'s concurrent logger with the provided 'LogAction'.
interpretCologConcNativeWith ::
  ∀ msg r .
  Members [Resource, Embed IO] r =>
  Capacity ->
  LogAction IO msg ->
  InterpreterFor (Colog.Log msg) r
interpretCologConcNativeWith :: forall msg (r :: EffectRow).
Members '[Resource, Embed IO] r =>
Capacity -> LogAction IO msg -> InterpreterFor (Log msg) r
interpretCologConcNativeWith Capacity
capacity LogAction IO msg
action Sem (Log msg : r) a
sem = do
  Sem r (BackgroundWorker msg)
-> (BackgroundWorker msg -> Sem r ())
-> (BackgroundWorker msg -> Sem r a)
-> Sem r a
forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket (IO (BackgroundWorker msg) -> Sem r (BackgroundWorker msg)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Capacity -> LogAction IO msg -> IO (BackgroundWorker msg)
forall msg.
Capacity -> LogAction IO msg -> IO (BackgroundWorker msg)
forkBackgroundLogger Capacity
capacity LogAction IO msg
action)) (IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ())
-> (BackgroundWorker msg -> IO ())
-> BackgroundWorker msg
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackgroundWorker msg -> IO ()
forall msg. BackgroundWorker msg -> IO ()
killBackgroundLogger) BackgroundWorker msg -> Sem r a
use
  where
    use :: BackgroundWorker msg -> Sem r a
use BackgroundWorker msg
worker =
      LogAction IO 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 (forall (m :: * -> *) msg.
MonadIO m =>
BackgroundWorker msg -> LogAction m msg
convertToLogAction @IO BackgroundWorker msg
worker) Sem (Log msg : r) a
sem
{-# inline interpretCologConcNativeWith #-}

-- |Interpret 'Colog.Log' using /co-log/'s concurrent logger with the default message and formatting.
interpretCologConcNative ::
  Members [Resource, Embed IO] r =>
  InterpreterFor (Colog.Log (LogEntry LogMessage)) r
interpretCologConcNative :: forall (r :: EffectRow).
Members '[Resource, Embed IO] r =>
InterpreterFor (Log (LogEntry LogMessage)) r
interpretCologConcNative =
  Capacity
-> LogAction IO (LogEntry LogMessage)
-> InterpreterFor (Log (LogEntry LogMessage)) r
forall msg (r :: EffectRow).
Members '[Resource, Embed IO] r =>
Capacity -> LogAction IO msg -> InterpreterFor (Log msg) r
interpretCologConcNativeWith Capacity
defCapacity ((LogEntry LogMessage -> Text)
-> LogAction IO Text -> LogAction IO (LogEntry LogMessage)
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap LogEntry LogMessage -> Text
formatLogEntry LogAction IO Text
forall (m :: * -> *). MonadIO m => LogAction m Text
Colog.logTextStdout)
{-# inline interpretCologConcNative #-}