polysemy-log 0.2.0.0 → 0.2.0.1

raw patch · 5 files changed

+57/−39 lines, 5 filesdep +polysemy-concdep ~polysemyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: polysemy-conc

Dependency ranges changed: polysemy

API changes (from Hackage documentation)

Files

• lib/Polysemy/Log/Conc.hs +22/−35
• lib/Polysemy/Log/Log.hs +2/−1
• polysemy-log.cabal +5/−3
• readme.md +26/−0
• test/Polysemy/Log/Test/ConcTest.hs +2/−0

@@ -1,11 +1,13 @@ -- |Description: Internal module Polysemy.Log.Conc where -import Control.Concurrent.STM.TBMQueue (TBMQueue, closeTBMQueue, newTBMQueueIO, readTBMQueue, writeTBMQueue) import Polysemy (interceptH, runT, subsume) import Polysemy.Async (Async, async)+import Polysemy.Conc (Queue, Race, interpretQueueTBM)+import qualified Polysemy.Conc.Data.Queue as Queue+import Polysemy.Conc.Queue.Result (resultToMaybe) import Polysemy.Internal.Tactics (liftT)-import Polysemy.Resource (Resource, bracket)+import Polysemy.Resource (Resource)  import qualified Polysemy.Log.Data.DataLog as DataLog import Polysemy.Log.Data.DataLog (DataLog(DataLog, Local))@@ -15,28 +17,26 @@ -- 'Local' has to be handled here, otherwise this will not be called for actions in higher-order thunks. interceptDataLogConcWithLocal ::   ∀ msg r a .-  Members [DataLog msg, Embed IO] r =>+  Members [Queue msg, DataLog msg] r =>   (msg -> msg) ->-  TBMQueue msg ->   Sem r a ->   Sem r a-interceptDataLogConcWithLocal context queue =+interceptDataLogConcWithLocal context =   interceptH \case     DataLog msg ->-      liftT (atomically (writeTBMQueue queue (context msg)))+      liftT (Queue.write (context msg))     Local f ma ->-      raise . interceptDataLogConcWithLocal (f . context) queue . subsume =<< runT ma+      raise . interceptDataLogConcWithLocal (f . context) . subsume =<< runT ma {-# INLINE interceptDataLogConcWithLocal #-}  -- |Intercept 'DataLog' for concurrent processing. interceptDataLogConcWith ::   ∀ msg r a .-  Members [DataLog msg, Embed IO] r =>-  TBMQueue msg ->+  Members [Queue msg, DataLog msg] r =>   Sem r a ->   Sem r a interceptDataLogConcWith =-  interceptDataLogConcWithLocal id+  interceptDataLogConcWithLocal @msg id {-# INLINE interceptDataLogConcWith #-}  -- |Part of 'interceptDataLogConc'.@@ -44,30 +44,16 @@ -- forcing the logging implementation to work in this thread. loggerThread ::   ∀ msg r .-  Members [DataLog msg, Embed IO] r =>-  TBMQueue msg ->+  Members [Queue msg, DataLog msg] r =>   Sem r ()-loggerThread queue = do+loggerThread = do   spin   where-    spin =-      atomically (readTBMQueue queue) >>= \case-        Nothing -> pure ()-        Just msg -> do-          DataLog.dataLog @msg msg-          spin---- |Part of 'interceptDataLogConc'.--- Create a queue and start a thread that reads messages from it, calling the logging implementation.-acquireQueue ::-  ∀ msg r .-  Members [DataLog msg, Async, Embed IO] r =>-  Int ->-  Sem r (TBMQueue msg)-acquireQueue maxQueued = do-  queue <- embed (newTBMQueueIO maxQueued)-  !_ <- async (loggerThread queue)-  pure queue+    spin = do+      next <- Queue.read+      for_ (resultToMaybe next) \ msg -> do+        DataLog.dataLog @msg msg+        spin  -- |Intercept 'DataLog' for concurrent processing. -- Creates a queue and starts a worker thread.@@ -77,16 +63,17 @@ -- Since this is an interceptor, it will not remove the effect from the stack, but relay it to another interpreter: -- -- @--- interpretDataLogAtomic (interceptDataLogConc (DataLog.dataLog "message"))+-- interpretDataLogAtomic (interceptDataLogConc 64 (DataLog.dataLog "message")) -- @ interceptDataLogConc ::   ∀ msg r a .-  Members [DataLog msg, Resource, Async, Embed IO] r =>+  Members [DataLog msg, Resource, Async, Race, Embed IO] r =>   -- |Queue size. When the queue fills up, the interceptor will block.   Int ->   Sem r a ->   Sem r a interceptDataLogConc maxQueued sem = do-  bracket (acquireQueue maxQueued) (atomically . closeTBMQueue) \ queue ->-    interceptDataLogConcWith @msg queue sem+  interpretQueueTBM @msg maxQueued do+    !_ <- async (loggerThread @msg)+    interceptDataLogConcWith @msg (raise sem) {-# INLINE interceptDataLogConc #-}

@@ -2,6 +2,7 @@ module Polysemy.Log.Log where  import Polysemy.Async (Async)+import Polysemy.Conc (Race) import Polysemy.Internal (InterpretersFor) import Polysemy.Resource (Resource) import Polysemy.Time (GhcTime, interpretTimeGhc)@@ -64,7 +65,7 @@  -- |Interpret 'Log' into 'DataLog' concurrently, adding metadata information and wrapping with 'LogEntry'. interpretLogDataLogConc ::-  Members [DataLog (LogEntry LogMessage), Resource, Async, Embed IO] r =>+  Members [DataLog (LogEntry LogMessage), Resource, Async, Race, Embed IO] r =>   Int ->   InterpreterFor Log r interpretLogDataLogConc maxQueued =

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-log-version:        0.2.0.0+version:        0.2.0.1 synopsis:       Polysemy effects for logging description:    See <https://hackage.haskell.org/package/polysemy-log/docs/Polysemy-Log.html> category:       Logging@@ -110,7 +110,8 @@       ansi-terminal >=0.10.0 && <0.11     , async     , base ==4.*-    , polysemy >=1.3 && <1.5+    , polysemy >=1.3 && <1.6+    , polysemy-conc >=0.1.0.0 && <0.2     , polysemy-time >=0.1.1.0 && <0.2     , relude >=0.5 && <0.8     , stm@@ -199,7 +200,8 @@     , async     , base ==4.*     , hedgehog-    , polysemy >=1.3 && <1.5+    , polysemy >=1.3 && <1.6+    , polysemy-conc >=0.1.0.0 && <0.2     , polysemy-log     , polysemy-test     , polysemy-time >=0.1.1.0 && <0.2

@@ -23,3 +23,29 @@ * [polysemy-log](https://hackage.haskell.org/package/polysemy-log) * [polysemy-log-co](https://hackage.haskell.org/package/polysemy-log-co) * [polysemy-log-di](https://hackage.haskell.org/package/polysemy-log-di)++# Building the Project++The build is defined in [nix], supporting `flake` and legacy `nix-build`.++With `nix-build`:++```bash+nix-build -A defaultPackage+nix-build -A packages.x86_64-linux.polysemy-log-co+```++With `nix flake`:++```+nix build+nix build '.#polysemy-log-co'+```++To run all tests:++```bash+nix flake check+```++[nix]: https://nixos.org/manual/nix/unstable

@@ -2,6 +2,7 @@  import Data.Time (Day, UTCTime) import Polysemy.Async (asyncToIOFinal)+import Polysemy.Conc (interpretRace) import Polysemy.Test (UnitTest, assertEq, runTestAuto) import qualified Polysemy.Time as Time import Polysemy.Time (GhcTime, MilliSeconds(MilliSeconds), interpretTimeGhc)@@ -42,6 +43,7 @@   runTestAuto do     msgs <-       asyncToIOFinal $+      interpretRace $       interpretTimeGhc $       interpretDataLogAtomic @Context $       interceptDataLogConc @Context 1 $