@@ -27,6 +27,7 @@ import Control.Monad.Trans.Writer
27import Data.Aeson (ToJSON (..))
27import Data.Aeson (ToJSON (..))
28import qualified Data.Aeson as A
28import qualified Data.Aeson as A
29import Data.Aeson.Lens
29import Data.Aeson.Lens
30+import Data.Foldable (foldMap)
30import qualified Data.HashMap.Strict as HM
31import qualified Data.HashMap.Strict as HM
31import Data.List
32import Data.List
32import qualified Data.Map.Strict as M
33import qualified Data.Map.Strict as M
@@ -87,7 +88,7 @@ data Severity
87-- - 'V3' implies the maximum amount of payload information.
88-- - 'V3' implies the maximum amount of payload information.
88-- - Anything in between is left to the discretion of the developer.
89-- - Anything in between is left to the discretion of the developer.
89data Verbosity = V0 | V1 | V2 | V3
90data Verbosity = V0 | V1 | V2 | V3
90− deriving (Eq, Ord, Show, Read, Generic)
91+ deriving (Eq, Ord, Show, Read, Generic, Enum)
93-------------------------------------------------------------------------------
94-------------------------------------------------------------------------------
@@ -191,8 +192,19 @@ data PayloadSelection
191 = AllKeys
192 = AllKeys
192 | SomeKeys [Text]
193 | SomeKeys [Text]
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)
194-------------------------------------------------------------------------------
201-------------------------------------------------------------------------------
195-- | Payload objects need instances of this class.
202-- | Payload objects need instances of this class.
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
196class ToJSON a => LogContext a where
208class ToJSON a => LogContext a where
198 -- | List of keys in the JSON object that should be included in message.
210 -- | List of keys in the JSON object that should be included in message.
@@ -203,9 +215,10 @@ instance LogContext () where payloadKeys _ _ = SomeKeys []
205-------------------------------------------------------------------------------
217-------------------------------------------------------------------------------
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.
207payloadJson :: LogContext a => Verbosity -> a -> A.Value
220payloadJson :: 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
209 AllKeys -> toJSON a
222 AllKeys -> toJSON a
210 SomeKeys ks -> toJSON a
223 SomeKeys ks -> toJSON a
211 & _Object %~ HM.filterWithKey (\ k _ -> k `elem` ks)
224 & _Object %~ HM.filterWithKey (\ k _ -> k `elem` ks)