diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -84,3 +84,4 @@ * [Leonid Onokhov](https://github.com/sopvop) * [Alexander Vershilov](https://github.com/qnikst) * [Chris Martin](https://github.com/chris-martin) +* [Domen Kožar](https://github.com/domenkozar) diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,11 @@ +0.6.2.0 +======= +* Add `mkHandleScribeWithFormatter`. This allows control over the + format of log items going to a handle. Credit to [Domen + Kožar](https://github.com/domenkozar) for the implementation. +* Add `jsonFormat` handle formatter. +* Deprecate `formatItem` which is now replaced by `bracketFormat`. + 0.6.1.0 ======= * Loosen deps diff --git a/katip.cabal b/katip.cabal --- a/katip.cabal +++ b/katip.cabal @@ -1,5 +1,5 @@ name: katip -version: 0.6.1.0 +version: 0.6.2.0 synopsis: A structured logging framework. description: Katip is a structured logging framework. See README.md for more details. diff --git a/src/Katip.hs b/src/Katip.hs --- a/src/Katip.hs +++ b/src/Katip.hs @@ -177,8 +177,12 @@ -- * Included Scribes , mkHandleScribe + , mkHandleScribeWithFormatter , mkFileScribe , ColorStrategy (..) + , ItemFormatter + , bracketFormat + , jsonFormat -- * Tools for implementing Scribes , permitItem diff --git a/src/Katip/Monadic.hs b/src/Katip/Monadic.hs --- a/src/Katip/Monadic.hs +++ b/src/Katip/Monadic.hs @@ -272,16 +272,14 @@ ------------------------------------------------------------------------------- --- | 'Loc'-tagged logging when using template-haskell. Automatically --- supplies payload and namespace. +-- | 'Loc'-tagged logging when using . +-- Automatically supplies payload and namespace. -- -- Same consideration as `logLoc` applies. -- --- This function does not require template-haskell as it --- automatically uses --- when the code is compiled using GHC > 7.8. Using an older version of the --- compiler will result in the emission of a log line without any location information, --- so be aware of it. Users using GHC <= 7.8 may want to use the template-haskell function +-- This function does not require template-haskell. Using GHC <= 7.8 will result +-- in the emission of a log line without any location information. +-- Users using GHC <= 7.8 may want to use the template-haskell function -- `logTM` for maximum compatibility. -- -- @logLocM InfoS "Hello world"@ diff --git a/src/Katip/Scribes/Handle.hs b/src/Katip/Scribes/Handle.hs --- a/src/Katip/Scribes/Handle.hs +++ b/src/Katip/Scribes/Handle.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - module Katip.Scribes.Handle where ------------------------------------------------------------------------------- @@ -8,6 +6,8 @@ import Control.Exception (bracket_, finally) import Control.Monad import Data.Aeson +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Encoding (decodeUtf8) import qualified Data.HashMap.Strict as HM import Data.Monoid as M import Data.Scientific as S @@ -64,7 +64,15 @@ -- Returns the newly-created `Scribe`. The finalizer flushes the -- handle. Handle mode is set to 'LineBuffering' automatically. mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe -mkHandleScribe cs h sev verb = do +mkHandleScribe = mkHandleScribeWithFormatter bracketFormat + +-- | Logs to a file handle such as stdout, stderr, or a file. Takes a custom +-- `ItemFormatter` that can be used to format `Item` as needed. +-- +-- Returns the newly-created `Scribe`. The finalizer flushes the +-- handle. Handle mode is set to 'LineBuffering' automatically. +mkHandleScribeWithFormatter :: (forall a . LogItem a => ItemFormatter a) -> ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe +mkHandleScribeWithFormatter itemFormatter cs h sev verb = do hSetBuffering h LineBuffering colorize <- case cs of ColorIfTerminal -> hIsTerminalDevice h @@ -72,7 +80,7 @@ lock <- newMVar () let logger i@Item{..} = do when (permitItem sev i) $ bracket_ (takeMVar lock) (putMVar lock ()) $ - T.hPutStrLn h $ toLazyText $ formatItem colorize verb i + T.hPutStrLn h $ toLazyText $ itemFormatter colorize verb i return $ Scribe logger (hFlush h) @@ -90,8 +98,26 @@ ------------------------------------------------------------------------------- -formatItem :: LogItem a => Bool -> Verbosity -> Item a -> Builder -formatItem withColor verb Item{..} = +-- | A custom ItemFormatter for logging `Item`s. Takes a `Bool` indicating +-- whether to colorize the output, `Verbosity` of output, and an `Item` to +-- format. +-- +-- See `bracketFormat` and `jsonFormat` for examples. +type ItemFormatter a = Bool -> Verbosity -> Item a -> Builder + + +formatItem :: LogItem a => ItemFormatter a +formatItem = bracketFormat +{-# DEPRECATED formatItem "Use bracketFormat instead" #-} + +-- | A traditional 'bracketed' log format. Contexts and other information will +-- be flattened out into bracketed fields. For example: +-- +-- > [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 +bracketFormat :: LogItem a => ItemFormatter a +bracketFormat withColor verb Item{..} = brackets nowStr <> brackets (mconcat $ map fromText $ intercalateNs _itemNamespace) <> brackets (fromText (renderSeverity' _itemSeverity)) <> @@ -104,13 +130,34 @@ where nowStr = fromText (formatAsLogTime _itemTime) ks = map brackets $ getKeys verb _itemPayload - renderSeverity' s = case s of - EmergencyS -> red $ renderSeverity s - AlertS -> red $ renderSeverity s - CriticalS -> red $ renderSeverity s - ErrorS -> red $ renderSeverity s - WarningS -> yellow $ renderSeverity s - _ -> renderSeverity s + renderSeverity' severity = + colorBySeverity withColor severity (renderSeverity severity) + +-- | Logs items as JSON. This can be useful in circumstances where you already +-- have infrastructure that is expecting JSON to be logged to a standard stream +-- or file. For example: +-- +-- > {"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp"],"data":{},"app":["MyApp"],"msg":"Started","pid":"10456","loc":{"loc_col":9,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":44},"host":"myhost.example.com","sev":"Info","thread":"ThreadId 139"} +-- > {"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp","confrabulation"],"data":{"confrab_factor":42},"app":["MyApp"],"msg":"Confrabulating widgets, with extra namespace and context","pid":"10456","loc":{"loc_col":11,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":53},"host":"myhost.example.com","sev":"Debug","thread":"ThreadId 139"} +-- > {"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp"],"data":{},"app":["MyApp"],"msg":"Namespace and context are back to normal","pid":"10456","loc":{"loc_col":9,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":55},"host":"myhost.example.com","sev":"Info","thread":"ThreadId 139"} +jsonFormat :: LogItem a => ItemFormatter a +jsonFormat withColor verb i = + fromText $ + colorBySeverity withColor (_itemSeverity i) $ + toStrict $ decodeUtf8 $ encode $ itemJson verb i + +-- | Color a text message based on `Severity`. `ErrorS` and more severe errors +-- are colored red, `WarningS` is colored yellow, and all other messages are +-- rendered in the default color. +colorBySeverity :: Bool -> Severity -> Text -> Text +colorBySeverity withColor severity msg = case severity of + EmergencyS -> red msg + AlertS -> red msg + CriticalS -> red msg + ErrorS -> red msg + WarningS -> yellow msg + _ -> msg + where red = colorize "31" yellow = colorize "33" colorize c s diff --git a/test/Katip/Tests/Scribes/Handle.hs b/test/Katip/Tests/Scribes/Handle.hs --- a/test/Katip/Tests/Scribes/Handle.hs +++ b/test/Katip/Tests/Scribes/Handle.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} module Katip.Tests.Scribes.Handle ( tests ) where @@ -25,7 +26,6 @@ import Text.Regex.TDFA ------------------------------------------------------------------------------- import Katip -import Katip.Scribes.Handle ------------------------------------------------------------------------------- @@ -55,6 +55,10 @@ goldenVsString "Text-golden" "test/Katip/Tests/Scribes/Handle-text.golden" (setupFn >>= writeTextLog) + , withResource setupTempFile teardownTempFile $ \setupFn -> + goldenVsString "Json-golden" + "test/Katip/Tests/Scribes/Handle-json.golden" + (setupFn >>= writeJsonLog) ] @@ -234,14 +238,20 @@ ------------------------------------------------------------------------------- writeTextLog :: (FilePath, Handle) -> IO (BL.ByteString) -writeTextLog (path, h) = do +writeTextLog = writeFormattedLog bracketFormat + +writeJsonLog :: (FilePath, Handle) -> IO (BL.ByteString) +writeJsonLog = writeFormattedLog jsonFormat + +writeFormattedLog :: (forall a . LogItem a => ItemFormatter a) -> (FilePath, Handle) -> IO (BL.ByteString) +writeFormattedLog format (path, h) = do mapM_ (put . formatOne) genItems mapM_ (put . formatOne) genTypedItems hClose h BL.readFile path where formatOne :: LogItem a => Item a -> Text - formatOne = LT.toStrict . LT.toLazyText . formatItem False V3 + formatOne = LT.toStrict . LT.toLazyText . format False V3 put = B.hPutStrLn h . T.encodeUtf8 setupTempFile :: IO (FilePath, Handle)