{-# LANGUAGE RecordWildCards #-}
module Wire.Sem.Logger.TinyLog
( loggerToTinyLog,
loggerToTinyLogReqId,
stringLoggerToTinyLog,
discardTinyLogs,
module Wire.Sem.Logger.Level,
LogRecorder (..),
newLogRecorder,
recordLogs,
)
where
import Data.Id
import Imports
import Polysemy
import Polysemy.TinyLog (TinyLog)
import qualified System.Logger as Log
import Wire.Sem.Logger
import Wire.Sem.Logger.Level
loggerToTinyLog ::
(Member (Embed IO) r) =>
Log.Logger ->
Sem (Logger (Log.Msg -> Log.Msg) ': r) a ->
Sem r a
loggerToTinyLog :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
Logger -> Sem (Logger (Msg -> Msg) : r) a -> Sem r a
loggerToTinyLog Logger
tinylog = (forall (rInitial :: EffectRow) x.
Logger (Msg -> Msg) (Sem rInitial) x -> Sem r x)
-> Sem (Logger (Msg -> Msg) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (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 ((forall (rInitial :: EffectRow) x.
Logger (Msg -> Msg) (Sem rInitial) x -> Sem r x)
-> Sem (Logger (Msg -> Msg) : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
Logger (Msg -> Msg) (Sem rInitial) x -> Sem r x)
-> Sem (Logger (Msg -> Msg) : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
Log Level
lvl Msg -> Msg
msg ->
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed @IO (IO x -> Sem r x) -> IO x -> Sem r x
forall a b. (a -> b) -> a -> b
$ Logger -> Level -> (Msg -> Msg) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
Log.log Logger
tinylog (Level -> Level
toLevel Level
lvl) Msg -> Msg
msg
loggerToTinyLogReqId ::
(Member (Embed IO) r) =>
RequestId ->
Log.Logger ->
Sem (TinyLog ': r) a ->
Sem r a
loggerToTinyLogReqId :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
RequestId -> Logger -> Sem (Logger (Msg -> Msg) : r) a -> Sem r a
loggerToTinyLogReqId RequestId
r Logger
tinylog =
Logger -> Sem (Logger (Msg -> Msg) : r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Logger -> Sem (Logger (Msg -> Msg) : r) a -> Sem r a
loggerToTinyLog Logger
tinylog
(Sem (Logger (Msg -> Msg) : r) a -> Sem r a)
-> (Sem (Logger (Msg -> Msg) : r) a
-> Sem (Logger (Msg -> Msg) : r) a)
-> Sem (Logger (Msg -> Msg) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Msg -> Msg) -> Msg -> Msg)
-> Sem (Logger (Msg -> Msg) : Logger (Msg -> Msg) : r) a
-> Sem (Logger (Msg -> Msg) : r) a
forall msg msg' (r :: EffectRow) a.
Member (Logger msg') r =>
(msg -> msg') -> Sem (Logger msg : r) a -> Sem r a
mapLogger (ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"request" (RequestId -> ByteString
unRequestId RequestId
r) (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
(Sem (Logger (Msg -> Msg) : Logger (Msg -> Msg) : r) a
-> Sem (Logger (Msg -> Msg) : r) a)
-> (Sem (Logger (Msg -> Msg) : r) a
-> Sem (Logger (Msg -> Msg) : Logger (Msg -> Msg) : r) a)
-> Sem (Logger (Msg -> Msg) : r) a
-> Sem (Logger (Msg -> Msg) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder @TinyLog
stringLoggerToTinyLog :: (Member (Logger (Log.Msg -> Log.Msg)) r) => Sem (Logger String ': r) a -> Sem r a
stringLoggerToTinyLog :: forall (r :: EffectRow) a.
Member (Logger (Msg -> Msg)) r =>
Sem (Logger String : r) a -> Sem r a
stringLoggerToTinyLog = forall msg msg' (r :: EffectRow) a.
Member (Logger msg') r =>
(msg -> msg') -> Sem (Logger msg : r) a -> Sem r a
mapLogger @String String -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Log.msg
discardTinyLogs :: Sem (Logger (Log.Msg -> Log.Msg) ': r) a -> Sem r a
discardTinyLogs :: forall (r :: EffectRow) a.
Sem (Logger (Msg -> Msg) : r) a -> Sem r a
discardTinyLogs = Sem (Logger (Msg -> Msg) : r) a -> Sem r a
forall msg (r :: EffectRow) a. Sem (Logger msg : r) a -> Sem r a
discardLogs
newtype LogRecorder = LogRecorder {LogRecorder -> IORef [(Level, LByteString)]
recordedLogs :: IORef [(Level, LByteString)]}
newLogRecorder :: IO LogRecorder
newLogRecorder :: IO LogRecorder
newLogRecorder = IORef [(Level, LByteString)] -> LogRecorder
LogRecorder (IORef [(Level, LByteString)] -> LogRecorder)
-> IO (IORef [(Level, LByteString)]) -> IO LogRecorder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Level, LByteString)] -> IO (IORef [(Level, LByteString)])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
recordLogs :: (Member (Embed IO) r) => LogRecorder -> Sem (TinyLog ': r) a -> Sem r a
recordLogs :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
LogRecorder -> Sem (Logger (Msg -> Msg) : r) a -> Sem r a
recordLogs LogRecorder {IORef [(Level, LByteString)]
$sel:recordedLogs:LogRecorder :: LogRecorder -> IORef [(Level, LByteString)]
recordedLogs :: IORef [(Level, LByteString)]
..} = (forall (rInitial :: EffectRow) x.
Logger (Msg -> Msg) (Sem rInitial) x -> Sem r x)
-> Sem (Logger (Msg -> Msg) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (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 ((forall (rInitial :: EffectRow) x.
Logger (Msg -> Msg) (Sem rInitial) x -> Sem r x)
-> Sem (Logger (Msg -> Msg) : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
Logger (Msg -> Msg) (Sem rInitial) x -> Sem r x)
-> Sem (Logger (Msg -> Msg) : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \(Log Level
lvl Msg -> Msg
msg) ->
IORef [(Level, LByteString)]
-> ([(Level, LByteString)] -> [(Level, LByteString)]) -> Sem r ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef [(Level, LByteString)]
recordedLogs ([(Level, LByteString)]
-> [(Level, LByteString)] -> [(Level, LByteString)]
forall a. [a] -> [a] -> [a]
++ [(Level
lvl, ([Element] -> Builder) -> (Msg -> Msg) -> LByteString
Log.render (ByteString -> [Element] -> Builder
Log.renderDefault ByteString
", ") Msg -> Msg
msg)])