diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -92,7 +92,7 @@ return (tmp "katip-bench.log") DevNull -> return ("/dev/null") h <- openFile outFile WriteMode - s <- mkHandleScribe ColorIfTerminal h DebugS V0 + s <- mkHandleScribe ColorIfTerminal h (permitItem DebugS) V0 let cleanupHandle = hClose h `finally` (when (dest == TempFile) (removeLink outFile)) return s { scribeFinalizer = scribeFinalizer s `finally` cleanupHandle} @@ -101,4 +101,7 @@ deriving instance NFData ThreadIdText instance NFData Scribe where - rnf (Scribe a b) = (a :: Item ExPayload -> IO ()) `seq` b `seq` () + rnf (Scribe a b p) = (a :: Item ExPayload -> IO ()) + `seq` b + `seq` (p :: Item ExPayload -> IO Bool) + `seq` () diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,19 @@ +0.8.0.0 +======= +* **Breaking change**: switch from severity based log level filtering to + user-definable `PermitFunc`. To upgrade, any time you initialize one + of the standard scribes, rather than providing a severity like + `InfoS`, instead pass in `(permitItem InfoS)`. Credit to + [vlatkoB](https://github.com/vlatkoB). +* Update some misformatted and outdated docs. +* Set lower bound of base to 4.9.0.0, the version shipped with GHC + 8.0.2. Support for GHC versions older than that is removed. +* Update default formatter of Handle scribe to format pid as `[PID + 1234]` instead of `[1234]` and `[ThreadId 1234]` instead of + `[1234]`. +* Add missing `Bounded` instance for `Verbosity`. This allows you to + easily enumerate all verbosities via `[minBound..maxBound]`. + 0.7.0.0 ======= * Exclusively use HasCallstack for location reporting in errors. Credit to [Domen Kožar](https://github.com/domenkozar) diff --git a/examples/example.hs b/examples/example.hs --- a/examples/example.hs +++ b/examples/example.hs @@ -36,7 +36,7 @@ -- hot-swap scribes at runtime if you need to. 'closeScribes' is -- blocking and flushes all messages out of a scribe and cleans up -- resources that were allocated at creation. - handleScribe <- mkHandleScribe ColorIfTerminal stdout InfoS V2 + handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem InfoS) V2 let mkLogEnv = registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv "MyApp" "production" bracket mkLogEnv closeScribes $ \le -> do let s = MyState M.mempty mempty le diff --git a/examples/example_lens.hs b/examples/example_lens.hs --- a/examples/example_lens.hs +++ b/examples/example_lens.hs @@ -51,7 +51,7 @@ -- hot-swap scribes at runtime if you need to. 'closeScribes' is -- blocking and flushes all messages out of a scribe and cleans up -- resources that were allocated at creation. - handleScribe <- mkHandleScribe ColorIfTerminal stdout InfoS V2 + handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem InfoS) V2 let mkLogEnv = registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv "MyApp" "production" bracket mkLogEnv closeScribes $ \le -> do let s = MyState M.mempty mempty le diff --git a/katip.cabal b/katip.cabal --- a/katip.cabal +++ b/katip.cabal @@ -1,5 +1,5 @@ name: katip -version: 0.7.0.0 +version: 0.8.0.0 synopsis: A structured logging framework. description: Katip is a structured logging framework. See README.md for more details. @@ -53,32 +53,32 @@ TemplateHaskell OverloadedStrings - build-depends: base >=4.5 && <5 + build-depends: base >=4.9.0.0 && <5 , aeson >=0.6 , async < 3.0.0.0 - , auto-update >= 0.1 && < 0.2 - , bytestring >= 0.9 && < 0.11 - , containers >=0.4 && <0.7 - , either >= 4 && < 5.1 + , auto-update >= 0.1 + , bytestring >= 0.9 + , containers >=0.4 + , either >= 4 , safe-exceptions >= 0.1.0.0 - , hostname >=1.0 && <1.1 - , old-locale >= 1.0 && < 1.1 - , string-conv >= 0.1 && < 0.2 - , template-haskell >= 2.8 && < 2.15 - , text >= 0.11 && <1.3 - , time >= 1 && < 1.9 - , transformers >= 0.3 && < 0.6 + , hostname >=1.0 + , old-locale >= 1.0 + , string-conv >= 0.1 + , template-haskell >= 2.8 + , text >= 0.11 + , time >= 1 + , transformers >= 0.3 , transformers-compat - , unordered-containers >= 0.2 && < 0.3 - , monad-control >= 1.0 && < 1.1 - , mtl >= 2.0 && < 2.3 - , transformers-base >= 0.3 && < 0.6 - , resourcet >= 1.1 && < 1.3 + , unordered-containers >= 0.2 + , monad-control >= 1.0 + , mtl >= 2.0 + , transformers-base >= 0.3 + , resourcet >= 1.1 , scientific >= 0.3.3.0 - , microlens >= 0.2.0.0 && < 0.5 - , microlens-th >= 0.1.0.0 && < 0.5 + , microlens >= 0.2.0.0 + , microlens-th >= 0.1.0.0 , semigroups - , unliftio-core >= 0.1 && < 0.2 + , unliftio-core >= 0.1 , stm >= 2.4 hs-source-dirs: src @@ -114,7 +114,7 @@ , template-haskell , text , time - , time-locale-compat >= 0.1.0.1 && < 0.2 + , time-locale-compat >= 0.1.0.1 , directory , regex-tdfa , unordered-containers diff --git a/src/Katip.hs b/src/Katip.hs --- a/src/Katip.hs +++ b/src/Katip.hs @@ -11,8 +11,8 @@ -- -- main :: IO () -- main = do --- handleScribe <- mkHandleScribe ColorIfTerminal stdout InfoS V2 --- let makeLogEnv = registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv "MyApp" "production" +-- handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem InfoS) V2 +-- let makeLogEnv = registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv \"MyApp\" \"production\" -- -- closeScribes will stop accepting new logs, flush existing ones and clean up resources -- bracket makeLogEnv closeScribes $ \le -> do -- let initialContext = () -- this context will be attached to every log in your app and merged w/ subsequent contexts @@ -153,7 +153,7 @@ , LogStr (..) , logStr, ls, showLS - -- ** 'Katip' LoggingFunctions + -- ** 'Katip' Logging Functions -- $katiplogging , Katip (..) , logF @@ -186,6 +186,9 @@ , jsonFormat -- * Tools for implementing Scribes + , PermitFunc + , permitAND + , permitOR , permitItem , payloadObject , itemJson diff --git a/src/Katip/Core.hs b/src/Katip/Core.hs --- a/src/Katip/Core.hs +++ b/src/Katip/Core.hs @@ -22,14 +22,14 @@ module Katip.Core where ------------------------------------------------------------------------------- -import Control.Applicative as A +import Control.Applicative as A import Control.AutoUpdate import Control.Concurrent -import qualified Control.Concurrent.Async as Async +import qualified Control.Concurrent.Async as Async import Control.Concurrent.STM -import qualified Control.Concurrent.STM.TBQueue as BQ +import qualified Control.Concurrent.STM.TBQueue as BQ import Control.Exception.Safe -import Control.Monad (unless, void) +import Control.Monad (unless, void, when) import Control.Monad.Base import Control.Monad.IO.Class import Control.Monad.IO.Unlift @@ -41,28 +41,30 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader -import Control.Monad.Trans.Resource (ResourceT, transResourceT) -import Control.Monad.Trans.State.Lazy (StateT, mapStateT) -import qualified Control.Monad.Trans.State.Strict as Strict (StateT, mapStateT) -import Control.Monad.Trans.Writer.Lazy (WriterT, mapWriterT) -import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT, mapWriterT) -import Control.Monad.Trans.RWS.Lazy (RWST, mapRWST) -import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST) -import Data.Aeson (FromJSON (..), ToJSON (..), - object) -import qualified Data.Aeson as A -import Data.Foldable as FT -import qualified Data.HashMap.Strict as HM +import Control.Monad.Trans.Resource (ResourceT, transResourceT) +import Control.Monad.Trans.RWS.Lazy (RWST, mapRWST) +import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST) +import Control.Monad.Trans.State.Lazy (StateT, mapStateT) +import qualified Control.Monad.Trans.State.Strict as Strict (StateT, mapStateT) +import Control.Monad.Trans.Writer.Lazy (WriterT, mapWriterT) +import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT, + mapWriterT) +import Data.Aeson (FromJSON (..), ToJSON (..), + object) +import qualified Data.Aeson as A +import Data.Foldable as FT +import qualified Data.HashMap.Strict as HM import Data.List -import qualified Data.Map.Strict as M -import Data.Semigroup as SG +import qualified Data.Map.Strict as M +import Data.Maybe (fromMaybe) +import Data.Semigroup as SG import Data.String import Data.String.Conv -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Lazy.Builder as B +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Lazy.Builder as B import Data.Time -import GHC.Generics hiding (to) +import GHC.Generics hiding (to) #if MIN_VERSION_base(4, 8, 0) #if !MIN_VERSION_base(4, 9, 0) import GHC.SrcLoc @@ -70,7 +72,7 @@ import GHC.Stack #endif import Language.Haskell.TH -import qualified Language.Haskell.TH.Syntax as TH +import qualified Language.Haskell.TH.Syntax as TH import Lens.Micro import Lens.Micro.TH import Network.HostName @@ -137,7 +139,7 @@ -- - 'V3' implies the maximum amount of payload information. -- - Anything in between is left to the discretion of the developer. data Verbosity = V0 | V1 | V2 | V3 - deriving (Eq, Ord, Show, Read, Generic, Enum) + deriving (Eq, Ord, Show, Read, Generic, Enum, Bounded) ------------------------------------------------------------------------------- @@ -244,7 +246,9 @@ mkThreadIdText :: ThreadId -> ThreadIdText -mkThreadIdText = ThreadIdText . T.pack . show +mkThreadIdText = ThreadIdText . stripPrefix' "ThreadId " . T.pack . show + where + stripPrefix' pfx t = fromMaybe t (T.stripPrefix pfx t) ------------------------------------------------------------------------------- @@ -532,52 +536,93 @@ -- -- Scribes should always take a 'Severity' and 'Verbosity'. -- --- Severity is used to *exclude log messages* that are < the provided --- Severity. For instance, if the user passes InfoS, DebugS items --- should be ignored. Katip provides the 'permitItem' utility for this. +-- Severity is used to __exclude log messages__ that are lower than +-- the provided Severity. For instance, if the user passes InfoS, +-- DebugS items should be ignored. Katip provides the 'permitItem' +-- utility for this. The user or the scribe may use 'permitAND' and +-- 'permitOR' to further customize this filtering, even dynamically if +-- they wish to. -- -- Verbosity is used to select keys from the log item's payload. Each -- 'LogItem' instance describes what keys should be retained for each -- Verbosity level. Use the 'payloadObject' utility for extracting the keys --- that should be permitted. --- --- There is no built-in mechanism in katip for telling a scribe that --- its time to shut down. 'unregisterScribe' merely drops it from the --- 'LogEnv'. This means there are 2 ways to handle resources as a scribe: +-- that should be written. -- --- 1. Pass in the resource when the scribe is created. Handle --- allocation and release of the resource elsewhere. This is what the --- Handle scribe does. +-- Scribes provide a finalizer IO action ('scribeFinalizer') that is +-- meant to synchronously flush any remaining writes and clean up any +-- resources acquired when the scribe was created. Internally, katip +-- keeps a buffer for each scribe's writes. When 'closeScribe' or +-- 'closeScribes' is called, that buffer stops accepting new log +-- messages and after the last item in its buffer is sent to 'liPush', +-- calls the finalizer. Thus, when the finalizer returns, katip can +-- assume that all resources are cleaned up and all log messages are +-- durably written. -- --- 2. Return a finalizing function that tells the scribe to shut --- 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 --- messages on shutdown. +-- While katip internally buffers messages per 'ScribeSettings', it +-- sends them one at a time to the scribe. Depending on the scribe +-- itself, it may make sense for that scribe to keep its own internal +-- buffer to batch-send logs if writing items one at a time is not +-- efficient. The scribe implementer must be sure that on +-- finalization, all writes are committed synchronously. + +-- | Signature of a function passed to `Scribe` constructor and +-- mkScribe* functions that decides which messages to be +-- logged. Typically filters based on 'Severity', but can be +-- combined with other, custom logic with 'permitAND' and 'permitOR' +type PermitFunc = forall a. Item a -> IO Bool + + +-- | AND together 2 permit functions +permitAND :: PermitFunc -> PermitFunc -> PermitFunc +permitAND f1 f2 = \a -> liftA2 (&&) (f1 a) (f2 a) + +-- | OR together 2 permit functions +permitOR :: PermitFunc -> PermitFunc -> PermitFunc +permitOR f1 f2 = \a -> liftA2 (||) (f1 a) (f2 a) + + data Scribe = Scribe { - liPush :: forall a. LogItem a => Item a -> IO () - , scribeFinalizer :: IO () - -- ^ Provide a *blocking* finalizer to call when your scribe is - -- removed. If this is not relevant to your scribe, return () is - -- fine. + liPush :: forall a. LogItem a => Item a -> IO () + -- ^ How do we write an item to the scribe's output? + , scribeFinalizer :: IO () + -- ^ Provide a __blocking__ finalizer to call when your scribe is + -- removed. All pending writes should be flushed synchronously. If + -- this is not relevant to your scribe, return () is fine. + , scribePermitItem :: PermitFunc + -- ^ Provide a filtering function to allow the item to be logged, + -- or not. It can check Severity or some string in item's + -- body. The initial value of this is usually created from + -- 'permitItem'. Scribes and users can customize this by ANDing + -- or ORing onto the default with 'permitAND' or 'permitOR' } +whenM :: Monad m => m Bool -> m () -> m () +whenM mbool = (>>=) mbool . flip when + + +-- | Combine two scribes. Publishes to the left scribe if the left +-- would permit the item and to the right scribe if the right would +-- permit the item. Finalizers are called in sequence from left to +-- right. instance Semigroup Scribe where - (Scribe pushA finA) <> (Scribe pushB finB) = - Scribe (\item -> pushA item >> pushB item) (finA `finally` finB) + (Scribe pushA finA permitA) <> (Scribe pushB finB permitB) = + Scribe (\item -> whenM (permitA item) (pushA item) + >> whenM (permitB item) (pushB item) + ) + (finA `finally` finB) + (permitOR permitA permitB) instance Monoid Scribe where - mempty = Scribe (const (return ())) (return ()) + mempty = Scribe (const (return ())) (return ()) (permitItem DebugS) mappend = (<>) ------------------------------------------------------------------------------- data ScribeHandle = ScribeHandle { shScribe :: Scribe - , shChan :: BQ.TBQueue WorkerMessage + , shChan :: BQ.TBQueue WorkerMessage } @@ -589,8 +634,9 @@ ------------------------------------------------------------------------------- -- | Should this item be logged given the user's maximum severity? -permitItem :: Severity -> Item a -> Bool -permitItem sev i = _itemSeverity i >= sev +-- Most new scribes will use this as a base for their 'PermitFunc' +permitItem :: Monad m => Severity -> Item a -> m Bool +permitItem sev item = return (_itemSeverity item >= sev) ------------------------------------------------------------------------------- @@ -636,7 +682,9 @@ ------------------------------------------------------------------------------- -- | Add a scribe to the list. All future log calls will go to this --- scribe in addition to the others. +-- scribe in addition to the others. Writes will be buffered per the +-- ScribeSettings to prevent slow scribes from slowing down +-- logging. Writes will be dropped if the buffer fills. registerScribe :: Text -- ^ Name the scribe @@ -660,7 +708,7 @@ ------------------------------------------------------------------------------- spawnScribeWorker :: Scribe -> BQ.TBQueue WorkerMessage -> IO (Async.Async ()) -spawnScribeWorker (Scribe write _) queue = Async.async go +spawnScribeWorker (Scribe write _ _) queue = Async.async go where go = do newCmd <- atomically (BQ.readTBQueue queue) @@ -689,7 +737,7 @@ ------------------------------------------------------------------------------- --- | Remove a scribe from the environment. This does *not* finalize +-- | Remove a scribe from the environment. This does __not__ finalize -- the scribe. This mainly only makes sense to use with something like -- MonadReader's @local@ function to temporarily disavow a single -- logger for a block of code. @@ -702,7 +750,7 @@ ------------------------------------------------------------------------------- --- | Unregister *all* scribes. Note that this is *not* for closing or +-- | Unregister __all__ scribes. Note that this is __not__ for closing or -- finalizing scribes, use 'closeScribes' for that. This mainly only -- makes sense to use with something like MonadReader's @local@ -- function to temporarily disavow any loggers for a block of code. @@ -714,9 +762,10 @@ ------------------------------------------------------------------------------- -- | Finalize a scribe. The scribe is removed from the environment, --- its finalizer is called and it can never be written to again. Note --- that this will throw any exceptions yoru finalizer will throw, and --- that LogEnv is immutable, so it will not be removed in that case. +-- its finalizer is called so that it can never be written to again +-- and all pending writes are flushed. Note that this will throw any +-- exceptions yoru finalizer will throw, and that LogEnv is immutable, +-- so it will not be removed in that case. closeScribe :: Text -- ^ Name of the scribe @@ -896,8 +945,9 @@ <*> _logEnvTimer <*> pure (_logEnvApp <> ns) <*> pure loc - FT.forM_ (M.elems _logEnvScribes) $ \ ScribeHandle {..} -> atomically (tryWriteTBQueue shChan (NewItem item)) - + FT.forM_ (M.elems _logEnvScribes) $ \ ScribeHandle {..} -> do + whenM (scribePermitItem shScribe item) $ + void $ atomically (tryWriteTBQueue shChan (NewItem item)) ------------------------------------------------------------------------------- tryWriteTBQueue @@ -909,6 +959,7 @@ full <- isFullTBQueue q unless full (writeTBQueue q a) return (not full) + ------------------------------------------------------------------------------- -- | Log with full context, but without any code location. 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 @@ -4,7 +4,6 @@ import Control.Applicative as A import Control.Concurrent import Control.Exception (bracket_, finally) -import Control.Monad import Data.Aeson import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Encoding (decodeUtf8) @@ -57,13 +56,13 @@ -- 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 +-- > [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:32:7] Started +-- > [2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][PID 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][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal -- -- 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 :: ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe mkHandleScribe = mkHandleScribeWithFormatter bracketFormat -- | Logs to a file handle such as stdout, stderr, or a file. Takes a custom @@ -71,17 +70,22 @@ -- -- 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 +mkHandleScribeWithFormatter :: (forall a . LogItem a => ItemFormatter a) + -> ColorStrategy + -> Handle + -> PermitFunc + -> Verbosity + -> IO Scribe +mkHandleScribeWithFormatter itemFormatter cs h permitF verb = do hSetBuffering h LineBuffering colorize <- case cs of ColorIfTerminal -> hIsTerminalDevice h ColorLog b -> return b lock <- newMVar () let logger i@Item{..} = do - when (permitItem sev i) $ bracket_ (takeMVar lock) (putMVar lock ()) $ + bracket_ (takeMVar lock) (putMVar lock ()) $ T.hPutStrLn h $ toLazyText $ itemFormatter colorize verb i - return $ Scribe logger (hFlush h) + return $ Scribe logger (hFlush h) permitF ------------------------------------------------------------------------------- @@ -90,11 +94,11 @@ -- 'AppendMode' and will close the file handle on -- 'closeScribe'/'closeScribes'. Does not do log coloring. Sets handle -- to 'LineBuffering' mode. -mkFileScribe :: FilePath -> Severity -> Verbosity -> IO Scribe -mkFileScribe f sev verb = do +mkFileScribe :: FilePath -> PermitFunc -> Verbosity -> IO Scribe +mkFileScribe f permitF verb = do h <- openFile f AppendMode - Scribe logger finalizer <- mkHandleScribe (ColorLog False) h sev verb - return (Scribe logger (finalizer `finally` hClose h)) + Scribe logger finalizer permit <- mkHandleScribe (ColorLog False) h permitF verb + return (Scribe logger (finalizer `finally` hClose h) permit) ------------------------------------------------------------------------------- @@ -113,17 +117,17 @@ -- | 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 +-- > [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:32:7] Started +-- > [2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][PID 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][PID 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)) <> brackets (fromString _itemHost) <> - brackets (fromString (show _itemProcess)) <> - brackets (fromText (getThreadIdText _itemThread)) <> + brackets ("PID " <> fromString (show _itemProcess)) <> + brackets ("ThreadId " <> fromText (getThreadIdText _itemThread)) <> mconcat ks <> maybe mempty (brackets . fromString . locationToString) _itemLoc <> fromText " " <> (unLogStr _itemMessage) @@ -169,8 +173,8 @@ -- stdout. This is a decent example of how to build a LogEnv and is -- best for scripts that just need a quick, reasonable set up to log -- to stdout. -ioLogEnv :: Severity -> Verbosity -> IO LogEnv -ioLogEnv sev verb = do +ioLogEnv :: PermitFunc -> Verbosity -> IO LogEnv +ioLogEnv permit verb = do le <- initLogEnv "io" "io" - lh <- mkHandleScribe ColorIfTerminal stdout sev verb + lh <- mkHandleScribe ColorIfTerminal stdout permit verb registerScribe "stdout" lh defaultScribeSettings le diff --git a/test/Katip/Tests.hs b/test/Katip/Tests.hs --- a/test/Katip/Tests.hs +++ b/test/Katip/Tests.hs @@ -141,6 +141,7 @@ let scribe = Scribe { liPush = \i -> atomically (modifyTVar' items (<> [toObject <$> i])) , scribeFinalizer = return () + , scribePermitItem = permitItem DebugS } le1 <- initLogEnv "tests" "test" le2 <- registerScribe "recorder" scribe defaultScribeSettings le1 @@ -154,7 +155,7 @@ trivialScribe = do finalizerCalled <- newTVarIO False let finalizer = atomically (writeTVar finalizerCalled True) - return (Scribe (const (return ())) finalizer, finalizerCalled) + return (Scribe (const (return ())) finalizer (permitItem DebugS), finalizerCalled) ------------------------------------------------------------------------------- @@ -164,7 +165,7 @@ let finalizer = do atomically (writeTVar finalizerCalled True) throw (ScribeBroken scribeNum) - return (Scribe (const (return ())) finalizer, finalizerCalled) + return (Scribe (const (return ())) finalizer (permitItem DebugS), finalizerCalled) ------------------------------------------------------------------------------- diff --git a/test/Katip/Tests/Scribes/Handle-text.golden b/test/Katip/Tests/Scribes/Handle-text.golden --- a/test/Katip/Tests/Scribes/Handle-text.golden +++ b/test/Katip/Tests/Scribes/Handle-text.golden @@ -1,40 +1,40 @@ -[2016-06-12 12:34:56][foo][Debug][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Notice][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Warning][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Error][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Critical][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Alert][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Emergency][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][0][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][2147483647][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][www.example.com][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][127.0.0.1][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][0][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][1][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][1337][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][2147483647][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Debug][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Notice][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Warning][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Error][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Critical][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Alert][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Emergency][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 0][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 2147483647][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][www.example.com][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][127.0.0.1][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 0][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 1][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 1337][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 2147483647][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message with newline -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] сообщение -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] 哈囉世界 -[2000-01-01 00:00:00][foo][Info][example][7331][1337][note.deep:some note] message -[2123-12-31 23:59:59][foo][Info][example][7331][1337][note.deep:some note] message -[2016-10-10 01:01:05][foo][Info][example][7331][1337][note.deep:some note] message -[2100-12-31 12:59:10][foo][Info][example][7331][1337][note.deep:some note] message -[1982-01-01 12:30:00][foo][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo.bar][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][фу.бар][Info][example][7331][1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message a really long message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] сообщение +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] 哈囉世界 +[2000-01-01 00:00:00][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2123-12-31 23:59:59][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-10-10 01:01:05][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2100-12-31 12:59:10][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[1982-01-01 12:30:00][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo.bar][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][фу.бар][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message [2016-06-12 12:34:56][with -newline][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note][main:Some.Module path/Some/Module.hs:30:1] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][note.deep:some note][main:Some.Module путь/Some/Module.hs:3000:9000] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][sub:null][text:][num:0][float:0] message -[2016-06-12 12:34:56][foo][Info][example][7331][1337][sub.note.deep:some note][text:note][num:10][float:5.5] message +newline][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note][main:Some.Module path/Some/Module.hs:30:1] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][note.deep:some note][main:Some.Module путь/Some/Module.hs:3000:9000] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][sub:null][text:][num:0][float:0] message +[2016-06-12 12:34:56][foo][Info][example][PID 7331][ThreadId 1337][sub.note.deep:some note][text:note][num:10][float:5.5] message 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 @@ -39,7 +39,7 @@ runKatipT le $ logItem dummyLogItem "test" Nothing InfoS "wont make it in" 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 + let pat = "\\[[[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2} [[:digit:]]{2}:[[:digit:]]{2}:[[:digit:]]{2}\\]\\[katip-test.test\\]\\[Info\\]\\[.+\\]\\[[PID [:digit:]]+\\]\\[ThreadId [[:digit:]]+\\]\\[note.deep:some note\\] test message" :: String let matches = res =~ pat assertBool (show res M.<> " did not match") matches , withResource setupFile (const (return ())) $ \setupScribe -> testCase "logs correct data to a file" $ do @@ -48,7 +48,7 @@ fin runKatipT le $ logItem dummyLogItem "test" Nothing InfoS "wont make it in" 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 + let pat = "\\[[[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2} [[:digit:]]{2}:[[:digit:]]{2}:[[:digit:]]{2}\\]\\[katip-test.test\\]\\[Info\\]\\[.+\\]\\[[PID [:digit:]]+\\]\\[ThreadId [[:digit:]]+\\]\\[note.deep:some note\\] test message" :: String let matches = res =~ pat assertBool (show res <> " did not match") matches , withResource setupTempFile teardownTempFile $ \setupFn -> @@ -92,7 +92,7 @@ setup = do tempDir <- getTemporaryDirectory (fp, h) <- openTempFile tempDir "katip.log" - s <- mkHandleScribe (ColorLog False) h DebugS V3 + s <- mkHandleScribe (ColorLog False) h (permitItem DebugS) V3 le <- initLogEnv "katip-test" "test" le' <- registerScribe "handle" s defaultScribeSettings le return (fp, h, void (closeScribes le'), le') @@ -111,7 +111,7 @@ tempDir <- getTemporaryDirectory (fp, h) <- openTempFile tempDir "katip.log" hClose h - s <- mkFileScribe fp DebugS V3 + s <- mkFileScribe fp (permitItem DebugS) V3 le <- initLogEnv "katip-test" "test" le' <- registerScribe "handle" s defaultScribeSettings le return (fp, void (closeScribes le'), le')