Changing name and adding new log runner.

Add a log runner where a syncronizition primitiv can come from the outside.
This commit is contained in:
Stefan Risberg 2023-04-20 09:22:15 +02:00
parent aa7ce69eb8
commit 62c41d1d36
3 changed files with 17 additions and 7 deletions

View File

@ -1,5 +1,5 @@
name: ris-utils
version: 0.0.2
version: 0.0.3
homepage: "https://git.fiskhamn.se/steffenomak/ris-utils#readme"
license: BSD3
author: "Stefan Risberg"

View File

@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: ris-utils
version: 0.0.2
version: 0.0.3
description: Please see the README at <https://git.fiskhamn.se/steffenomak/ris-utils#readme>
homepage: https://git.fiskhamn.se/steffenomak/ris-utils#readme
author: Stefan Risberg

View File

@ -2,7 +2,8 @@
module Effects.Log (
Severity (..),
runLogEff,
runLog,
runLogWithQsem,
stderrLogger,
fmtMessage,
addTime,
@ -50,25 +51,34 @@ data Log :: Effect where
makeEffect ''Log
runLogEff ::
runLog ::
(Time :> es, Concurrent :> es, IOE :> es) =>
LogAction IO T.Builder ->
Eff (Log : es) a ->
Eff es a
runLogEff logger e = do
runLog logger e = do
lock <- newQSem 1
runLogWithQsem lock logger e
runLogWithQsem ::
(Time :> es, Concurrent :> es, IOE :> es) =>
QSem ->
LogAction IO T.Builder ->
Eff (Log : es) a ->
Eff es a
runLogWithQsem lock logger e = do
reinterpret
(runReader lock)
( \_ -> \case
Log sev msg -> do
l <- ask
bracket_ (waitQSem l) (signalQSem l) $ do
lock' <- ask
bracket_ (waitQSem lock') (signalQSem lock') $ do
t <- currentTimeB
liftIO $ cmap (addTime t . fmtMessage) logger <& msg `WithSeverity` sev
)
e
stderrLogger ::
(MonadIO m) =>
LogAction m T.Builder