@@ -27,6 +27,7 @@ import Control.Monad.Trans.Writer
2727import Data.Aeson (ToJSON (..))
2828import qualified Data.Aeson as A
2929import Data.Aeson.Lens
30+import Data.Foldable (foldMap)
3031import qualified Data.HashMap.Strict as HM
3132import Data.List
3233import qualified Data.Map.Strict as M
@@ -87,7 +88,7 @@ data Severity
8788-- - 'V3' implies the maximum amount of payload information.
8889-- - Anything in between is left to the discretion of the developer.
8990data Verbosity = V0 | V1 | V2 | V3
90− deriving (Eq, Ord, Show, Read, Generic)
91+ deriving (Eq, Ord, Show, Read, Generic, Enum)
9192
9293
9394-------------------------------------------------------------------------------
@@ -191,8 +192,19 @@ data PayloadSelection
191192 = AllKeys
192193 | SomeKeys [Text]
193194
195+instance Monoid PayloadSelection where
196+ mempty = SomeKeys []
197+ mappend AllKeys _ = AllKeys
198+ mappend _ AllKeys = AllKeys
199+ mappend (SomeKeys as) (SomeKeys bs) = SomeKeys (as++bs)
200+
194201-------------------------------------------------------------------------------
195202-- | Payload objects need instances of this class.
203+--
204+-- When defining 'payloadKeys', don't redundantly declare the same
205+-- keys for higher levels of verbosity. Each level of verbosity
206+-- automatically and recursively contains all keys from the level
207+-- before it.
196208class ToJSON a => LogContext a where
197209
198210 -- | List of keys in the JSON object that should be included in message.
@@ -203,9 +215,10 @@ instance LogContext () where payloadKeys _ _ = SomeKeys []
203215
204216
205217-------------------------------------------------------------------------------
206−-- | Constrain payload based on verbosity. To be used by backends.
218+-- | Constrain payload based on verbosity. Backends should use this to
219+-- automatically bubble higher verbosity levels to lower ones.
207220payloadJson :: LogContext a => Verbosity -> a -> A.Value
208−payloadJson verb a = case payloadKeys verb a of
221+payloadJson verb a = case foldMap (flip payloadKeys a) [(V0)..verb] of
209222 AllKeys -> toJSON a
210223 SomeKeys ks -> toJSON a
211224 & _Object %~ HM.filterWithKey (\ k _ -> k `elem` ks)