@@ -1,4 +1,5 @@
11{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE ExistentialQuantification #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE FlexibleInstances #-}
45{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -25,7 +26,7 @@ import Control.Monad.Trans.Reader
2526import Control.Monad.Trans.Resource
2627import Control.Monad.Trans.State
2728import Control.Monad.Trans.Writer
28−import Data.Aeson (ToJSON (..))
29+import Data.Aeson (ToJSON (..), object)
2930import qualified Data.Aeson as A
3031import Data.Foldable (foldMap)
3132import qualified Data.HashMap.Strict as HM
@@ -234,6 +235,40 @@ class ToObject a => LogItem a where
234235instance LogItem () where payloadKeys _ _ = SomeKeys []
235236
236237
238+data AnyLogPayload = forall a. ToJSON a => AnyLogPayload a
239+
240+newtype SimpleLogPayload = SimpleLogPayload {
241+ unSimpleLogPayload :: [(Text, AnyLogPayload)]
242+ }
243+
244+-------------------------------------------------------------------------------
245+-- | A built-in convenience log payload that won't log anything on 'V0',
246+-- but will log everything in any other level of verbosity. Intended
247+-- for easy in-line usage without having to define new log types.
248+--
249+-- Construct using 'sl' and combine multiple tuples using '<>' from
250+-- 'Monoid'.
251+instance ToJSON SimpleLogPayload where
252+ toJSON (SimpleLogPayload as) = object $ map go as
253+ where go (k, AnyLogPayload v) = k A..= v
254+
255+instance ToObject SimpleLogPayload
256+
257+instance LogItem SimpleLogPayload where
258+ payloadKeys V0 _ = SomeKeys []
259+ payloadKeys _ _ = AllKeys
260+
261+instance Monoid SimpleLogPayload where
262+ mempty = SimpleLogPayload []
263+ SimpleLogPayload a `mappend` SimpleLogPayload b = SimpleLogPayload (a `mappend` b)
264+
265+
266+-------------------------------------------------------------------------------
267+-- | Construct a simple log from any JSON item.
268+sl :: ToJSON a => Text -> a -> SimpleLogPayload
269+sl a b = SimpleLogPayload [(a, AnyLogPayload b)]
270+
271+
237272-------------------------------------------------------------------------------
238273-- | Constrain payload based on verbosity. Backends should use this to
239274-- automatically bubble higher verbosity levels to lower ones.