packages feed

katip 0.7.0.0 → 0.8.0.0

raw patch · 11 files changed

+234/−156 lines, 11 filesdep ~asyncdep ~auto-updatedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: async, auto-update, bytestring, containers, either, hostname, microlens, microlens-th, monad-control, old-locale, resourcet, stm, string-conv, template-haskell, time, time-locale-compat, transformers, transformers-base, unordered-containers

API changes (from Hackage documentation)

+ Katip: [scribePermitItem] :: Scribe -> PermitFunc
+ Katip: permitAND :: PermitFunc -> PermitFunc -> PermitFunc
+ Katip: permitOR :: PermitFunc -> PermitFunc -> PermitFunc
+ Katip: type PermitFunc = forall a. Item a -> IO Bool
+ Katip.Core: [scribePermitItem] :: Scribe -> PermitFunc
+ Katip.Core: instance GHC.Enum.Bounded Katip.Core.Verbosity
+ Katip.Core: permitAND :: PermitFunc -> PermitFunc -> PermitFunc
+ Katip.Core: permitOR :: PermitFunc -> PermitFunc -> PermitFunc
+ Katip.Core: type PermitFunc = forall a. Item a -> IO Bool
+ Katip.Core: whenM :: Monad m => m Bool -> m () -> m ()
- Katip: Scribe :: (forall a. LogItem a => Item a -> IO ()) -> IO () -> Scribe
+ Katip: Scribe :: (forall a. LogItem a => Item a -> IO ()) -> IO () -> PermitFunc -> Scribe
- Katip: itemApp :: forall a_aeDe. Lens' (Item a_aeDe) Namespace
+ Katip: itemApp :: forall a_aeLw. Lens' (Item a_aeLw) Namespace
- Katip: itemEnv :: forall a_aeDe. Lens' (Item a_aeDe) Environment
+ Katip: itemEnv :: forall a_aeLw. Lens' (Item a_aeLw) Environment
- Katip: itemHost :: forall a_aeDe. Lens' (Item a_aeDe) HostName
+ Katip: itemHost :: forall a_aeLw. Lens' (Item a_aeLw) HostName
- Katip: itemLoc :: forall a_aeDe. Lens' (Item a_aeDe) (Maybe Loc)
+ Katip: itemLoc :: forall a_aeLw. Lens' (Item a_aeLw) (Maybe Loc)
- Katip: itemMessage :: forall a_aeDe. Lens' (Item a_aeDe) LogStr
+ Katip: itemMessage :: forall a_aeLw. Lens' (Item a_aeLw) LogStr
- Katip: itemNamespace :: forall a_aeDe. Lens' (Item a_aeDe) Namespace
+ Katip: itemNamespace :: forall a_aeLw. Lens' (Item a_aeLw) Namespace
- Katip: itemPayload :: forall a_aeDe a_akYR. Lens (Item a_aeDe) (Item a_akYR) a_aeDe a_akYR
+ Katip: itemPayload :: forall a_aeLw a_al9l. Lens (Item a_aeLw) (Item a_al9l) a_aeLw a_al9l
- Katip: itemProcess :: forall a_aeDe. Lens' (Item a_aeDe) ProcessID
+ Katip: itemProcess :: forall a_aeLw. Lens' (Item a_aeLw) ProcessID
- Katip: itemSeverity :: forall a_aeDe. Lens' (Item a_aeDe) Severity
+ Katip: itemSeverity :: forall a_aeLw. Lens' (Item a_aeLw) Severity
- Katip: itemThread :: forall a_aeDe. Lens' (Item a_aeDe) ThreadIdText
+ Katip: itemThread :: forall a_aeLw. Lens' (Item a_aeLw) ThreadIdText
- Katip: itemTime :: forall a_aeDe. Lens' (Item a_aeDe) UTCTime
+ Katip: itemTime :: forall a_aeLw. Lens' (Item a_aeLw) UTCTime
- Katip: mkFileScribe :: FilePath -> Severity -> Verbosity -> IO Scribe
+ Katip: mkFileScribe :: FilePath -> PermitFunc -> Verbosity -> IO Scribe
- Katip: mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe
+ Katip: mkHandleScribe :: ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
- Katip: mkHandleScribeWithFormatter :: (forall a. LogItem a => ItemFormatter a) -> ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe
+ Katip: mkHandleScribeWithFormatter :: (forall a. LogItem a => ItemFormatter a) -> ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
- Katip: permitItem :: Severity -> Item a -> Bool
+ Katip: permitItem :: Monad m => Severity -> Item a -> m Bool
- Katip.Core: Scribe :: (forall a. LogItem a => Item a -> IO ()) -> IO () -> Scribe
+ Katip.Core: Scribe :: (forall a. LogItem a => Item a -> IO ()) -> IO () -> PermitFunc -> Scribe
- Katip.Core: itemApp :: forall a_aeDe. Lens' (Item a_aeDe) Namespace
+ Katip.Core: itemApp :: forall a_aeLw. Lens' (Item a_aeLw) Namespace
- Katip.Core: itemEnv :: forall a_aeDe. Lens' (Item a_aeDe) Environment
+ Katip.Core: itemEnv :: forall a_aeLw. Lens' (Item a_aeLw) Environment
- Katip.Core: itemHost :: forall a_aeDe. Lens' (Item a_aeDe) HostName
+ Katip.Core: itemHost :: forall a_aeLw. Lens' (Item a_aeLw) HostName
- Katip.Core: itemLoc :: forall a_aeDe. Lens' (Item a_aeDe) (Maybe Loc)
+ Katip.Core: itemLoc :: forall a_aeLw. Lens' (Item a_aeLw) (Maybe Loc)
- Katip.Core: itemMessage :: forall a_aeDe. Lens' (Item a_aeDe) LogStr
+ Katip.Core: itemMessage :: forall a_aeLw. Lens' (Item a_aeLw) LogStr
- Katip.Core: itemNamespace :: forall a_aeDe. Lens' (Item a_aeDe) Namespace
+ Katip.Core: itemNamespace :: forall a_aeLw. Lens' (Item a_aeLw) Namespace
- Katip.Core: itemPayload :: forall a_aeDe a_akYR. Lens (Item a_aeDe) (Item a_akYR) a_aeDe a_akYR
+ Katip.Core: itemPayload :: forall a_aeLw a_al9l. Lens (Item a_aeLw) (Item a_al9l) a_aeLw a_al9l
- Katip.Core: itemProcess :: forall a_aeDe. Lens' (Item a_aeDe) ProcessID
+ Katip.Core: itemProcess :: forall a_aeLw. Lens' (Item a_aeLw) ProcessID
- Katip.Core: itemSeverity :: forall a_aeDe. Lens' (Item a_aeDe) Severity
+ Katip.Core: itemSeverity :: forall a_aeLw. Lens' (Item a_aeLw) Severity
- Katip.Core: itemThread :: forall a_aeDe. Lens' (Item a_aeDe) ThreadIdText
+ Katip.Core: itemThread :: forall a_aeLw. Lens' (Item a_aeLw) ThreadIdText
- Katip.Core: itemTime :: forall a_aeDe. Lens' (Item a_aeDe) UTCTime
+ Katip.Core: itemTime :: forall a_aeLw. Lens' (Item a_aeLw) UTCTime
- Katip.Core: permitItem :: Severity -> Item a -> Bool
+ Katip.Core: permitItem :: Monad m => Severity -> Item a -> m Bool
- Katip.Scribes.Handle: ioLogEnv :: Severity -> Verbosity -> IO LogEnv
+ Katip.Scribes.Handle: ioLogEnv :: PermitFunc -> Verbosity -> IO LogEnv
- Katip.Scribes.Handle: mkFileScribe :: FilePath -> Severity -> Verbosity -> IO Scribe
+ Katip.Scribes.Handle: mkFileScribe :: FilePath -> PermitFunc -> Verbosity -> IO Scribe
- Katip.Scribes.Handle: mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe
+ Katip.Scribes.Handle: mkHandleScribe :: ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
- Katip.Scribes.Handle: mkHandleScribeWithFormatter :: (forall a. LogItem a => ItemFormatter a) -> ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe
+ Katip.Scribes.Handle: mkHandleScribeWithFormatter :: (forall a. LogItem a => ItemFormatter a) -> ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe

Files

bench/Main.hs view
@@ -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` ()
changelog.md view
@@ -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)
examples/example.hs view
@@ -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
examples/example_lens.hs view
@@ -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
katip.cabal view
@@ -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
src/Katip.hs view
@@ -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
src/Katip/Core.hs view
@@ -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.
src/Katip/Scribes/Handle.hs view
@@ -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
test/Katip/Tests.hs view
@@ -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)   -------------------------------------------------------------------------------
test/Katip/Tests/Scribes/Handle-text.golden view
@@ -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
test/Katip/Tests/Scribes/Handle.hs view
@@ -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')