diff --git a/package.yaml b/package.yaml index 394c08b..eb03de4 100644 --- a/package.yaml +++ b/package.yaml @@ -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" diff --git a/ris-utils.cabal b/ris-utils.cabal index f29b4d9..ee1b09d 100644 --- a/ris-utils.cabal +++ b/ris-utils.cabal @@ -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 homepage: https://git.fiskhamn.se/steffenomak/ris-utils#readme author: Stefan Risberg diff --git a/src/Effects/Log.hs b/src/Effects/Log.hs index 91ac9ff..37c68e7 100644 --- a/src/Effects/Log.hs +++ b/src/Effects/Log.hs @@ -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