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:
parent
aa7ce69eb8
commit
62c41d1d36
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user