log-warper 1.1.0 → 1.1.1

raw patch · 3 files changed

+12/−8 lines, 3 files

Files

• log-warper.cabal +1/−1
• src/System/Wlog/Formatter.hs +2/−1
• src/System/Wlog/Handler/Simple.hs +9/−6

@@ -1,5 +1,5 @@ name:                log-warper-version:             1.1.0+version:             1.1.1 synopsis:            Flexible, configurable, monadic and pretty logging homepage:            https://github.com/serokell/log-warper license:             MIT

@@ -184,7 +184,8 @@     simpleLogFormatter (fmt t) a r s   where     fmt time = mconcat $-        [ colorizer pr "[$loggername:$prio:$tid] ["+        [ colorizer pr "[$loggername:$prio:$tid]"+        , " ["         , formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z" time         , "] $msg"] 

@@ -23,7 +23,7 @@        , verboseStreamHandler        ) where -import           Control.Concurrent      (withMVar)+import           Control.Concurrent      (modifyMVar_, withMVar) import           Control.Exception       (SomeException) import qualified Data.Text.IO            as TIO import           Data.Typeable           (Typeable)@@ -45,7 +45,7 @@     , privData       :: !a     , writeFunc      :: !(a -> Text -> IO ())     , closeFunc      :: !(a -> IO ())-    , readBackBuffer :: !(MemoryQueue Text)+    , readBackBuffer :: !(MVar (MemoryQueue Text))     , ghTag          :: !LogHandlerTag     } deriving Typeable @@ -55,7 +55,7 @@     getLevel sh = severity sh     setFormatter sh f = sh{formatter = f}     getFormatter sh = formatter sh-    readBack sh i = pure $ take i . reverse $ MQ.toList $ readBackBuffer sh+    readBack sh i = withMVar (readBackBuffer sh) $ pure . take i . MQ.toList     emit sh (_,msg) _ = (writeFunc sh) (privData sh) msg     close sh = (closeFunc sh) (privData sh) @@ -66,8 +66,11 @@ streamHandler :: Handle -> Severity -> IO (GenericHandler Handle) streamHandler h sev = do     lock <- newMVar ()-    let mywritefunc hdl msg =-            withMVar lock (const $ writeToHandle hdl msg >> hFlush hdl)+    mq <- newMVar $ MQ.newMemoryQueue $ 2 * 1024 * 1024 -- 2 MB+    let mywritefunc hdl msg = withMVar lock $ const $ do+            writeToHandle hdl msg+            modifyMVar_ mq $ pure . pushFront msg+            hFlush hdl     return         GenericHandler         { severity = sev@@ -75,7 +78,7 @@         , privData = h         , writeFunc = mywritefunc         , closeFunc = const $ pure ()-        , readBackBuffer = MQ.newMemoryQueue $ 2 * 1024 * 1024 -- 2 MB+        , readBackBuffer = mq         , ghTag = HandlerOther "GenericHandler/StreamHandler"         }   where