@@ -29,7 +29,7 @@ import qualified Control.Concurrent.Async as Async
2929import Control.Concurrent.STM
3030import qualified Control.Concurrent.STM.TBQueue as BQ
3131import Control.Exception.Safe
32−import Control.Monad (unless, void)
32+import Control.Monad (unless, void, when)
3333import Control.Monad.Base
3434import Control.Monad.IO.Class
3535import Control.Monad.IO.Unlift
@@ -532,45 +532,86 @@ itemJson verb a = toJSON $ a & itemPayload %~ payloadObject verb
532532--
533533-- Scribes should always take a 'Severity' and 'Verbosity'.
534534--
535−-- Severity is used to *exclude log messages* that are < the provided
536−-- Severity. For instance, if the user passes InfoS, DebugS items
537−-- should be ignored. Katip provides the 'permitItem' utility for this.
535+-- Severity is used to __exclude log messages__ that are lower than
536+-- the provided Severity. For instance, if the user passes InfoS,
537+-- DebugS items should be ignored. Katip provides the 'permitItem'
538+-- utility for this. The user or the scribe may use 'permitAND' and
539+-- 'permitOR' to further customize this filtering, even dynamically if
540+-- they wish to.
538541--
539542-- Verbosity is used to select keys from the log item's payload. Each
540543-- 'LogItem' instance describes what keys should be retained for each
541544-- Verbosity level. Use the 'payloadObject' utility for extracting the keys
542−-- that should be permitted.
545+-- that should be written.
543546--
544−-- There is no built-in mechanism in katip for telling a scribe that
545−-- its time to shut down. 'unregisterScribe' merely drops it from the
546−-- 'LogEnv'. This means there are 2 ways to handle resources as a scribe:
547+-- Scribes provide a finalizer IO action ('scribeFinalizer') that is
548+-- meant to synchronously flush any remaining writes and clean up any
549+-- resources acquired when the scribe was created. Internally, katip
550+-- keeps a buffer for each scribe's writes. When 'closeScribe' or
551+-- 'closeScribes' is called, that buffer stops accepting new log
552+-- messages and after the last item in its buffer is sent to 'liPush',
553+-- calls the finalizer. Thus, when the finalizer returns, katip can
554+-- assume that all resources are cleaned up and all log messages are
555+-- durably written.
547556--
548−-- 1. Pass in the resource when the scribe is created. Handle
549−-- allocation and release of the resource elsewhere. This is what the
550−-- Handle scribe does.
551−--
552−-- 2. Return a finalizing function that tells the scribe to shut
553−-- down. @katip-elasticsearch@'s @mkEsScribe@ returns an @IO (Scribe,
554−-- IO ())@. The finalizer will flush any queued log messages and shut
555−-- down gracefully before returning. This can be hooked into your
556−-- application's shutdown routine to ensure you never miss any log
557−-- messages on shutdown.
557+-- While katip internally buffers messages per 'ScribeSettings', it
558+-- sends them one at a time to the scribe. Depending on the scribe
559+-- itself, it may make sense for that scribe to keep its own internal
560+-- buffer to batch-send logs if writing items one at a time is not
561+-- efficient. The scribe implementer must be sure that on
562+-- finalization, all writes are committed synchronously.
563+
564+-- | Signature of a function passed to `Scribe` constructor and
565+-- mkScribe* functions that decides which messages to be
566+-- logged. Typically filters based on 'Severity', but can be
567+-- combined with other, custom logic with 'permitAND' and 'permitOR'
568+type PermitFunc = forall a. Item a -> IO Bool
569+
570+
571+-- | AND together 2 permit functions
572+permitAND :: PermitFunc -> PermitFunc -> PermitFunc
573+permitAND f1 f2 = \a -> liftA2 (&&) (f1 a) (f2 a)
574+
575+-- | OR together 2 permit functions
576+permitOR :: PermitFunc -> PermitFunc -> PermitFunc
577+permitOR f1 f2 = \a -> liftA2 (||) (f1 a) (f2 a)
578+
579+
558580data Scribe = Scribe {
559581 liPush :: forall a. LogItem a => Item a -> IO ()
582+ -- ^ How do we write an item to the scribe's output?
560583 , scribeFinalizer :: IO ()
561− -- ^ Provide a *blocking* finalizer to call when your scribe is
562− -- removed. If this is not relevant to your scribe, return () is
563− -- fine.
584+ -- ^ Provide a __blocking__ finalizer to call when your scribe is
585+ -- removed. All pending writes should be flushed synchronously. If
586+ -- this is not relevant to your scribe, return () is fine.
587+ , scribePermitItem :: PermitFunc
588+ -- ^ Provide a filtering function to allow the item to be logged,
589+ -- or not. It can check Severity or some string in item's
590+ -- body. The initial value of this is usually created from
591+ -- 'permitItem'. Scribes and users can customize this by ANDing
592+ -- or ORing onto the default with 'permitAND' or 'permitOR'
564593 }
565594
566595
596+whenM :: Monad m => m Bool -> m () -> m ()
597+whenM mbool = (>>=) mbool . flip when
598+
599+
600+-- | Combine two scribes. Publishes to the left scribe if the left
601+-- would permit the item and to the right scribe if the right would
602+-- permit the item. Finalizers are called in sequence from left to
603+-- right.
567604instance Semigroup Scribe where
568− (Scribe pushA finA) <> (Scribe pushB finB) =
569− Scribe (\item -> pushA item >> pushB item) (finA `finally` finB)
605+ (Scribe pushA finA permitA) <> (Scribe pushB finB permitB) =
606+ Scribe (\item -> whenM (permitA item) (pushA item)
607+ >> whenM (permitB item) (pushB item)
608+ )
609+ (finA `finally` finB)
610+ (permitOR permitA permitB)
570611
571612
572613instance Monoid Scribe where
573− mempty = Scribe (const (return ())) (return ())
614+ mempty = Scribe (const (return ())) (return ()) (permitItem DebugS)
574615 mappend = (<>)
575616
576617
@@ -589,8 +630,9 @@ data WorkerMessage where
589630
590631-------------------------------------------------------------------------------
591632-- | Should this item be logged given the user's maximum severity?
592−permitItem :: Severity -> Item a -> Bool
593−permitItem sev i = _itemSeverity i >= sev
633+-- Most new scribes will use this as a base for their 'PermitFunc'
634+permitItem :: Monad m => Severity -> Item a -> m Bool
635+permitItem sev item = return (_itemSeverity item >= sev)
594636
595637
596638-------------------------------------------------------------------------------
@@ -636,7 +678,9 @@ initLogEnv an env = LogEnv
636678
637679-------------------------------------------------------------------------------
638680-- | Add a scribe to the list. All future log calls will go to this
639−-- scribe in addition to the others.
681+-- scribe in addition to the others. Writes will be buffered per the
682+-- ScribeSettings to prevent slow scribes from slowing down
683+-- logging. Writes will be dropped if the buffer fills.
640684registerScribe
641685 :: Text
642686 -- ^ Name the scribe
@@ -660,7 +704,7 @@ registerScribe nm scribe ScribeSettings {..} le = do
660704
661705-------------------------------------------------------------------------------
662706spawnScribeWorker :: Scribe -> BQ.TBQueue WorkerMessage -> IO (Async.Async ())
663−spawnScribeWorker (Scribe write _) queue = Async.async go
707+spawnScribeWorker (Scribe write _ _) queue = Async.async go
664708 where
665709 go = do
666710 newCmd <- atomically (BQ.readTBQueue queue)
@@ -689,7 +733,7 @@ defaultScribeSettings = ScribeSettings 4096
689733
690734
691735-------------------------------------------------------------------------------
692−-- | Remove a scribe from the environment. This does *not* finalize
736+-- | Remove a scribe from the environment. This does __not__ finalize
693737-- the scribe. This mainly only makes sense to use with something like
694738-- MonadReader's @local@ function to temporarily disavow a single
695739-- logger for a block of code.
@@ -702,7 +746,7 @@ unregisterScribe nm = logEnvScribes %~ M.delete nm
702746
703747
704748-------------------------------------------------------------------------------
705−-- | Unregister *all* scribes. Note that this is *not* for closing or
749+-- | Unregister __all__ scribes. Note that this is __not__ for closing or
706750-- finalizing scribes, use 'closeScribes' for that. This mainly only
707751-- makes sense to use with something like MonadReader's @local@
708752-- function to temporarily disavow any loggers for a block of code.
@@ -714,9 +758,10 @@ clearScribes = logEnvScribes .~ mempty
714758
715759-------------------------------------------------------------------------------
716760-- | Finalize a scribe. The scribe is removed from the environment,
717−-- its finalizer is called and it can never be written to again. Note
718−-- that this will throw any exceptions yoru finalizer will throw, and
719−-- that LogEnv is immutable, so it will not be removed in that case.
761+-- its finalizer is called so that it can never be written to again
762+-- and all pending writes are flushed. Note that this will throw any
763+-- exceptions yoru finalizer will throw, and that LogEnv is immutable,
764+-- so it will not be removed in that case.
720765closeScribe
721766 :: Text
722767 -- ^ Name of the scribe
@@ -896,8 +941,9 @@ logItem a ns loc sev msg = do
896941 <*> _logEnvTimer
897942 <*> pure (_logEnvApp <> ns)
898943 <*> pure loc
899− FT.forM_ (M.elems _logEnvScribes) $ \ ScribeHandle {..} -> atomically (tryWriteTBQueue shChan (NewItem item))
900−
944+ FT.forM_ (M.elems _logEnvScribes) $ \ ScribeHandle {..} -> do
945+ whenM (scribePermitItem shScribe item) $
946+ void $ atomically (tryWriteTBQueue shChan (NewItem item))
901947
902948-------------------------------------------------------------------------------
903949tryWriteTBQueue
@@ -910,6 +956,7 @@ tryWriteTBQueue q a = do
910956 unless full (writeTBQueue q a)
911957 return (not full)
912958
959+
913960-------------------------------------------------------------------------------
914961-- | Log with full context, but without any code location.
915962logF