@@ -39,13 +39,13 @@ import Control.Monad.Trans.Either
3939import Control.Monad.Trans.Except
4040import Control.Monad.Trans.Maybe
4141import Control.Monad.Trans.Reader
42−import Control.Monad.Trans.Resource (ResourceT)
43−import Control.Monad.Trans.State.Lazy (StateT)
44−import qualified Control.Monad.Trans.State.Strict as Strict (StateT)
45−import Control.Monad.Trans.Writer.Lazy (WriterT)
46−import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)
47−import Control.Monad.Trans.RWS.Lazy (RWST)
48−import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST)
42+import Control.Monad.Trans.Resource (ResourceT, transResourceT)
43+import Control.Monad.Trans.State.Lazy (StateT, mapStateT)
44+import qualified Control.Monad.Trans.State.Strict as Strict (StateT, mapStateT)
45+import Control.Monad.Trans.Writer.Lazy (WriterT, mapWriterT)
46+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT, mapWriterT)
47+import Control.Monad.Trans.RWS.Lazy (RWST, mapRWST)
48+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST)
4949import Data.Aeson (FromJSON (..), ToJSON (..),
5050 object)
5151import qualified Data.Aeson as A
@@ -705,43 +705,69 @@ closeScribes le = do
705705-- which keeps a namespace and merged context. You can write simple
706706-- functions that add additional namespacing and merges additional
707707-- context on the fly.
708+--
709+-- 'localLogEnv' was added to allow for lexically-scoped modifications
710+-- of the log env that are reverted when the supplied monad
711+-- completes. 'katipNoLogging', for example, uses this to temporarily
712+-- pause log outputs.
708713class MonadIO m => Katip m where
709714 getLogEnv :: m LogEnv
715+ localLogEnv :: (LogEnv -> LogEnv) -> m a -> m a
710716
711717
712718instance Katip m => Katip (ReaderT s m) where
713719 getLogEnv = lift getLogEnv
720+ localLogEnv = mapReaderT . localLogEnv
714721
715722
716723instance Katip m => Katip (EitherT s m) where
717724 getLogEnv = lift getLogEnv
725+ localLogEnv = mapEitherT . localLogEnv
726+
718727
719728instance Katip m => Katip (ExceptT s m) where
720729 getLogEnv = lift getLogEnv
730+ localLogEnv = mapExceptT . localLogEnv
731+
721732
722733instance Katip m => Katip (MaybeT m) where
723734 getLogEnv = lift getLogEnv
735+ localLogEnv = mapMaybeT . localLogEnv
736+
724737
725738instance Katip m => Katip (StateT s m) where
726739 getLogEnv = lift getLogEnv
740+ localLogEnv = mapStateT . localLogEnv
741+
727742
728743instance (Katip m, Monoid w) => Katip (RWST r w s m) where
729744 getLogEnv = lift getLogEnv
745+ localLogEnv = mapRWST . localLogEnv
746+
730747
731748instance (Katip m, Monoid w) => Katip (Strict.RWST r w s m) where
732749 getLogEnv = lift getLogEnv
750+ localLogEnv = Strict.mapRWST . localLogEnv
751+
733752
734753instance Katip m => Katip (Strict.StateT s m) where
735754 getLogEnv = lift getLogEnv
755+ localLogEnv = Strict.mapStateT . localLogEnv
756+
736757
737758instance (Katip m, Monoid s) => Katip (WriterT s m) where
738759 getLogEnv = lift getLogEnv
760+ localLogEnv = mapWriterT . localLogEnv
761+
739762
740763instance (Katip m, Monoid s) => Katip (Strict.WriterT s m) where
741764 getLogEnv = lift getLogEnv
765+ localLogEnv = Strict.mapWriterT . localLogEnv
766+
742767
743768instance (Katip m) => Katip (ResourceT m) where
744769 getLogEnv = lift getLogEnv
770+ localLogEnv = transResourceT . localLogEnv
745771
746772
747773-------------------------------------------------------------------------------
@@ -753,6 +779,7 @@ newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
753779
754780instance MonadIO m => Katip (KatipT m) where
755781 getLogEnv = KatipT ask
782+ localLogEnv f (KatipT m) = KatipT $ local f m
756783
757784
758785instance MonadTransControl KatipT where
@@ -775,6 +802,17 @@ runKatipT :: LogEnv -> KatipT m a -> m a
775802runKatipT le (KatipT f) = runReaderT f le
776803
777804
805+-------------------------------------------------------------------------------
806+-- | Disable all scribes for the given monadic action, then restore
807+-- them afterwards. Works in any Katip monad.
808+katipNoLogging
809+ :: ( Katip m
810+ )
811+ => m a
812+ -> m a
813+katipNoLogging = localLogEnv (\le -> set logEnvScribes mempty le)
814+
815+
778816-------------------------------------------------------------------------------
779817-- | Log with everything, including a source code location. This is
780818-- very low level and you typically can use 'logT' in its place.