katip 0.3.1.4 → 0.3.1.5

raw patch · 9 files changed

+75/−34 lines, 9 filesdep +unagi-chandep ~asyncPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unagi-chan

Dependency ranges changed: async

API changes (from Hackage documentation)

Files

• bench/Main.hs +10/−5
• changelog.md +4/−0
• examples/example.hs +2/−2
• examples/example_lens.hs +2/−1
• katip.cabal +3/−1
• src/Katip/Core.hs +5/−1
• src/Katip/Monadic.hs +4/−4
• src/Katip/Scribes/Handle.hs +38/−14
• test/Katip/Tests/Scribes/Handle.hs +7/−6

@@ -31,14 +31,14 @@ ------------------------------------------------------------------------------- handleScribeBench :: Benchmark handleScribeBench = bgroup "Katip.Scribes.Handle" [-      env setupHandleEnv $ \ ~(Scribe push, tid) ->+      env setupHandleEnv $ \ ~((Scribe push, _), tid) ->       bench "Bytestring Builder" $-        whnfIO $ push $ exItem tid+        whnfIO $ (push (exItem tid))     ]   --------------------------------------------------------------------------------setupHandleEnv :: IO (Scribe, ThreadIdText)+setupHandleEnv :: IO ((Scribe, Finaliser), ThreadIdText) setupHandleEnv = do       scribe <- setup       tid <- myThreadId@@ -83,15 +83,20 @@   --------------------------------------------------------------------------------setup :: IO Scribe+setup :: IO (Scribe, Finaliser) setup = do   h <- openFile "/dev/null" WriteMode-  mkHandleScribe ColorIfTerminal h DebugS V0+  (s, f) <- mkHandleScribe ColorIfTerminal h DebugS V0+  return (s, F f)   ------------------------------------------------------------------------------- deriving instance NFData ThreadIdText +newtype Finaliser = F (IO ())  instance NFData Scribe where   rnf (Scribe _) = ()++instance NFData Finaliser where+  rnf (F _) = ()

@@ -1,3 +1,7 @@+0.3.1.5+=======+* Add Semigroup instance for LogStr.+ 0.3.1.4 ======= * Loosen deps on aeson to allow 1.1.0.0

@@ -34,7 +34,7 @@   -- messages entirely. Note that katip provides facilities like   -- 'unregisterScribe' and 'registerScribe' to make it possible to   -- hot-swap scribes at runtime if you need to.-  handleScribe <- mkHandleScribe ColorIfTerminal stdout InfoS V2+  (handleScribe, finaliser) <- mkHandleScribe ColorIfTerminal stdout InfoS V2   let le' = registerScribe "stdout" handleScribe le   let s = MyState M.mempty mempty le'   runStack s $ do@@ -52,7 +52,7 @@     $(logTM) InfoS "Namespace and context are back to normal"     noLogging $       $(logTM) DebugS "You'll never see this log message!"-+  finaliser  ------------------------------------------------------------------------------- newtype ConfrabLogCTX = ConfrabLogCTX Int

@@ -50,7 +50,7 @@   -- messages entirely. Note that katip provides facilities like   -- 'unregisterScribe' and 'registerScribe' to make it possible to   -- hot-swap scribes at runtime if you need to.-  handleScribe <- mkHandleScribe ColorIfTerminal stdout InfoS V2+  (handleScribe, finaliser) <- mkHandleScribe ColorIfTerminal stdout InfoS V2   let le' = registerScribe "stdout" handleScribe le   let s = MyState M.mempty mempty le'   runStack s $ do@@ -68,6 +68,7 @@     $(logTM) InfoS "Namespace and context are back to normal"     noLogging $       $(logTM) DebugS "You'll never see this log message!"+  finaliser   -------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ name:                katip-version:             0.3.1.4+version:             0.3.1.5 synopsis:            A structured logging framework. description:   Katip is a structured logging framework. See README.md for more details.@@ -55,6 +55,7 @@    build-depends: base >=4.5 && <5                , aeson >=0.6 && <1.2+               , async < 3.0.0.0                , auto-update >= 0.1 && < 0.2                , bytestring >= 0.9 && < 0.11                , containers >=0.4 && <0.6@@ -76,6 +77,7 @@                , microlens >= 0.2.0.0 && < 0.5                , microlens-th >= 0.1.0.0 && < 0.5                , semigroups+               , unagi-chan < 0.5.0.0    hs-source-dirs:      src   default-language:    Haskell2010

@@ -493,7 +493,7 @@ -- Handle scribe does. -- -- 2. Return a finalizing function that tells the scribe to shut--- down. @katip-elasticsearch@'s @mkEsScribe@ returns a @IO (Scribe,+-- down. @katip-elasticsearch@'s @mkEsScribe@ returns an @IO (Scribe, -- IO ())@. The finalizer will flush any queued log messages and shut -- down gracefully before returning. This can be hooked into your -- application's shutdown routine to ensure you never miss any log@@ -826,7 +826,11 @@ -- `logT` for maximum compatibility. -- -- @logLoc obj mempty InfoS "Hello world"@+#if MIN_VERSION_base(4, 8, 0)+logLoc :: (Applicative m, LogItem a, Katip m, ?loc :: CallStack)+#else logLoc :: (Applicative m, LogItem a, Katip m)+#endif        => a        -> Namespace        -> Severity

@@ -57,11 +57,11 @@ import qualified Control.Monad.Trans.RWS.Strict    as Strict (RWST) import qualified Control.Monad.Trans.State.Strict  as Strict (StateT) import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)-import           Control.Monad.Writer+import           Control.Monad.Writer              hiding ((<>)) import           Data.Aeson import qualified Data.Foldable                     as FT import qualified Data.HashMap.Strict               as HM-import           Data.Monoid                       as M+import           Data.Semigroup                    as Semi import           Data.Sequence                     as Seq import           Data.Text                         (Text) import           Language.Haskell.TH@@ -92,7 +92,7 @@ -- Additional note: you should not mappend LogContexts in any sort of -- infinite loop, as it retains all data, so that would be a memory -- leak.-newtype LogContexts = LogContexts (Seq AnyLogContext) deriving (Monoid)+newtype LogContexts = LogContexts (Seq AnyLogContext) deriving (Monoid, Semigroup)  instance ToJSON LogContexts where     toJSON (LogContexts cs) =@@ -230,7 +230,7 @@ logExceptionM action sev = action `catchAll` \e -> f e >> throwM e   where     f e = logFM sev (msg e)-    msg e = ls ("An exception has occured: " :: Text) M.<> showLS e+    msg e = ls ("An exception has occured: " :: Text) Semi.<> showLS e   -------------------------------------------------------------------------------

@@ -3,21 +3,22 @@ module Katip.Scribes.Handle where  --------------------------------------------------------------------------------import           Control.Applicative     as A-import           Control.Concurrent-import           Control.Exception       (bracket_)+import           Control.Applicative as A import           Control.Monad+import           Control.Exception (onException) import           Data.Aeson-import qualified Data.HashMap.Strict     as HM+import qualified Data.HashMap.Strict as HM import           Data.Monoid-import           Data.Text               (Text)+import           Data.Text (Text) import           Data.Text.Lazy.Builder-import           Data.Text.Lazy.IO       as T+import           Data.Text.Lazy.IO as T import           System.IO-import           System.IO.Unsafe        (unsafePerformIO)+import           System.IO.Unsafe (unsafePerformIO)+import qualified Control.Concurrent.Chan.Unagi.Bounded as U+import           Control.Concurrent.Async ------------------------------------------------------------------------------- import           Katip.Core-import           Katip.Format.Time       (formatAsLogTime)+import           Katip.Format.Time (formatAsLogTime) -------------------------------------------------------------------------------  @@ -48,6 +49,10 @@     | ColorIfTerminal     -- ^ Color if output is a terminal +-------------------------------------------------------------------------------+data WorkerCmd =+    NewItem Builder+  | PoisonPill  ------------------------------------------------------------------------------- -- | Logs to a file handle such as stdout, stderr, or a file. Contexts@@ -57,18 +62,36 @@ -- > [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:32:7] Started -- > [2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][1724][ThreadId 1154][confrab_factor:42.0][main:Helpers.Logging Helpers/Logging.hs:41:9] Confrabulating widgets, with extra namespace and context -- > [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal-mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe+--+-- Returns the newly-created `Scribe` together with a finaliser the user needs to run to perform resource cleanup.+mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO (Scribe, IO ()) mkHandleScribe cs h sev verb = do+  (inChan, outChan) <- U.newChan 4096+  worker <- async $ workerLoop outChan+  flip onException (stopWorker worker inChan) $ do     hSetBuffering h LineBuffering     colorize <- case cs of       ColorIfTerminal -> hIsTerminalDevice h       ColorLog b -> return b-    lock <- newMVar ()-    return $ Scribe $ \ i@Item{..} -> do-      when (permitItem sev i) $ bracket_ (takeMVar lock) (putMVar lock ()) $-        T.hPutStrLn h $ toLazyText $ formatItem colorize verb i+    let scribe = Scribe $ \i ->+          when (permitItem sev i) $ void (U.tryWriteChan inChan (NewItem (formatItem colorize verb i)))+    return (scribe, stopWorker worker inChan) +  where+    stopWorker :: Async () -> U.InChan WorkerCmd -> IO ()+    stopWorker worker inChan = do+      U.writeChan inChan PoisonPill+      void $ waitCatch worker +    workerLoop :: U.OutChan WorkerCmd -> IO ()+    workerLoop outChan = do+      newCmd <- U.readChan outChan+      case newCmd of+        NewItem b  -> do+          T.hPutStrLn h $ toLazyText b+          workerLoop outChan+        PoisonPill -> return ()+ ------------------------------------------------------------------------------- formatItem :: LogItem a => Bool -> Verbosity -> Item a -> Builder formatItem withColor verb Item{..} =@@ -100,10 +123,11 @@  ------------------------------------------------------------------------------- -- | An implicit environment to enable logging directly ouf of the IO monad.+-- Be careful as this LogEnv won't perform any resource cleanup for you. _ioLogEnv :: LogEnv _ioLogEnv = unsafePerformIO $ do     le <- initLogEnv "io" "io"-    lh <- mkHandleScribe ColorIfTerminal stdout DebugS V3+    (lh, _) <- mkHandleScribe ColorIfTerminal stdout DebugS V3     return $ registerScribe "stdout" lh le {-# NOINLINE _ioLogEnv #-} 

@@ -33,8 +33,9 @@ tests = testGroup "Katip.Scribes.Handle"   [     withResource setup teardown $ \setupScribe -> testCase "logs the correct data" $ do-       (path, h, le) <- setupScribe+       (path, h, fin, le) <- setupScribe        runKatipT le $ logItem dummyLogItem "test" Nothing InfoS "test message"+       fin        hClose h        res <- readFile path        let pat = "\\[[[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2} [[:digit:]]{2}:[[:digit:]]{2}:[[:digit:]]{2}\\]\\[katip-test.test\\]\\[Info\\]\\[.+\\]\\[[[:digit:]]+\\]\\[ThreadId [[:digit:]]+\\]\\[note.deep:some note\\] test message" :: String@@ -73,18 +74,18 @@   --------------------------------------------------------------------------------setup :: IO (FilePath, Handle, LogEnv)+setup :: IO (FilePath, Handle, IO (), LogEnv) setup = do   tempDir <- getTemporaryDirectory   (fp, h) <- openTempFile tempDir "katip.log"-  s <- mkHandleScribe (ColorLog False) h DebugS V3+  (s, finaliser) <- mkHandleScribe (ColorLog False) h DebugS V3   le <- initLogEnv "katip-test" "test"-  return (fp, h, registerScribe "handle" s le)+  return (fp, h, finaliser, registerScribe "handle" s le)   --------------------------------------------------------------------------------teardown :: (FilePath, Handle, LogEnv) -> IO ()-teardown (_, h, _) = do+teardown :: (FilePath, Handle, IO (), LogEnv) -> IO ()+teardown (_, h, _, _) = do   chk <- hIsOpen h   when chk $ hClose h