-- |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.Resource (Resource, bracket)

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 :: 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 :: [Effect]) a c b.
MemberWithError 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 :: [Effect]) 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 :: [Effect]) 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
run
  where
    run :: BackgroundWorker msg -> Sem r a
run BackgroundWorker msg
worker =
      LogAction IO msg -> Sem (Log msg : r) a -> Sem r a
forall (m :: * -> *) msg (r :: [Effect]) a.
Member (Embed m) r =>
LogAction m msg -> Sem (Log msg : r) a -> Sem r a
runLogAction (BackgroundWorker msg -> LogAction IO msg
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 :: InterpreterFor (Log (LogEntry LogMessage)) r
interpretCologConcNative =
  Capacity
-> LogAction IO (LogEntry LogMessage)
-> InterpreterFor (Log (LogEntry LogMessage)) r
forall msg (r :: [Effect]).
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 b. Contravariant f => (a -> b) -> f b -> f a
contramap LogEntry LogMessage -> Text
formatLogEntry LogAction IO Text
forall (m :: * -> *). MonadIO m => LogAction m Text
Colog.logTextStdout)
{-# INLINE interpretCologConcNative #-}