plow-log-async (empty) → 0.1.4.0

raw patch · 4 files changed

+144/−0 lines, 4 filesdep +basedep +conduitdep +plow-log

Dependencies added: base, conduit, plow-log, stm-conduit, text, time, unliftio

Files

• CHANGELOG.md +20/−0
• LICENSE +21/−0
• plow-log-async.cabal +35/−0
• src/Plow/Logging/Async.hs +68/−0

@@ -0,0 +1,20 @@+# Revision history for plow-log-async++## 0.1.4.0+* Prep for OSS release++## 0.1.3.0+* Upgraded to work with GHC 9++## 0.1.2.0 -- 2021-7-226++* Fixed adding timestamp on tracer call not when the message is printed from the queue+* Fixed withAsyncHandleTracer to wait for the log queue to be empty (after running `f`) before returning++## 0.1.1.0 -- 2021-6-2++* Print timestamp in log messages++## 0.1.0.0 -- 2021-5-4++* First version. Released on an unsuspecting world.

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Plow Technologies++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,35 @@+cabal-version:       >=1.10+name:                plow-log-async+version:             0.1.4.0+synopsis:            Async IO tracer for plow-log+description:         Async logging backend for plow-log +category:            Logging+homepage:            https://github.com/plow-technologies/plow-log-async.git#readme+bug-reports:         https://github.com/plow-technologies/plow-log-async.git/issues+copyright:           Plow-Technologies LLC+license:             MIT+license-file:        LICENSE+author:              Alberto Valverde+maintainer:          info@plowtech.net+build-type:          Simple+extra-source-files:  CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/plow-technologies/plow-log-async.git++library+  exposed-modules:+    Plow.Logging.Async+  hs-source-dirs:+      src+  ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+  build-depends:+      base >= 4.13 && < 4.18+    , plow-log >= 0.1.6 && < 0.2+    , conduit >= 1.3.4 && < 1.4+    , stm-conduit >= 4.0.1 && < 4.1+    , text >= 2.0.1 && < 2.1+    , unliftio >= 0.2.22 && < 0.3+    , time >= 1.9.3 && < 1.12+  default-language: Haskell2010

@@ -0,0 +1,68 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Plow.Logging.Async (withAsyncHandleTracer) where++import qualified Control.Monad.IO.Class+import Data.Conduit ((.|))+import qualified Data.Conduit as Conduit+import qualified Data.Conduit.TMChan as Conduit.TMChan+import Data.String (fromString)+import Data.Text (Text)+import qualified Data.Text.IO as T+import Data.Time (getCurrentTime)+import Plow.Logging (IOTracer (..), Tracer (..), traceWith)+import System.IO (Handle, hFlush)+import UnliftIO (MonadUnliftIO)+import UnliftIO.Async (link, withAsync)+import qualified UnliftIO.STM as STM++-- | Returns (in CPS) a 'IOTracer' that pushes messages to a thread-safe queue.+-- This 'IOTracer' won't block unless the queue is full (size is configurable with+-- queueSize)+--+-- An async thread that continuously consumes traces in queue by printing them to a+-- 'Handle' will be launched. Any exceptions thrown inside (or to) the thread will be+-- rethrown in the caller of this function+--+-- Example use+--+-- main =+--   withAsyncHandleTracer stdout 100 $ \tracer' -> do+--     -- We use contramap to convert the tracer to a tracer that accepts+--     -- domain-specic trace types and displays them as Text+--     let tracer = contramap displaySomeTrace tracer'+--     traceWith tracer (SomeTrace a b c)+--     ...+withAsyncHandleTracer :: MonadUnliftIO m => Handle -> Int -> (IOTracer Text -> m a) -> m a+withAsyncHandleTracer handle queueSize f = do+  chan <- STM.atomically $ Conduit.TMChan.newTBMChan queueSize+  withAsync (logConsumer chan) $ \logConsumerThread -> do+    let tracer = asyncTracer chan+    link logConsumerThread+    res <- f tracer+    traceWith tracer "exit" >> waitUntilEmpty chan >> return res+  where+    logConsumer chan =+      Conduit.runConduit $+        ( Conduit.TMChan.sourceTBMChan chan+            .| Conduit.awaitForever+              ( \(time, msg) ->+                  Control.Monad.IO.Class.liftIO $ do+                    T.hPutStrLn handle $ fromString (show time <> ": ") <> msg+                    hFlush handle+              )+        )++    asyncTracer chan = IOTracer $+      Tracer $ \msg -> do+        time <- Control.Monad.IO.Class.liftIO $ getCurrentTime+        Conduit.runConduit $+          Conduit.yield (time, msg)+            .| Conduit.TMChan.sinkTBMChan chan++    waitUntilEmpty chan =+      STM.atomically $+        Conduit.TMChan.isEmptyTBMChan chan >>= \case+          True -> return ()+          False -> STM.retrySTM