git.iko.soy/typeable/katip
on master help sign in
SimpleLogPayload for inline context convenience
034ccb4Ozgun Ataman
katip/src/Katip.hs+1
compare with master
unifiedsplit
@@ -16,6 +16,7 @@ module Katip
16 , KatipContext(..)
16 , KatipContext(..)
17 , AnyLogContext
17 , AnyLogContext
18 , LogContexts, liftPayload
18 , LogContexts, liftPayload
19+ , SimpleLogPayload, sl
19
20
20 -- * A Built-in Monad For Logging
21 -- * A Built-in Monad For Logging
21 , KatipT (..)
22 , KatipT (..)
katip/src/Katip/Core.hs+36−1
@@ -1,4 +1,5 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE ExistentialQuantification #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -25,7 +26,7 @@ import Control.Monad.Trans.Reader
25import Control.Monad.Trans.Resource
26import Control.Monad.Trans.Resource
26import Control.Monad.Trans.State
27import Control.Monad.Trans.State
27import Control.Monad.Trans.Writer
28import Control.Monad.Trans.Writer
28−import Data.Aeson (ToJSON (..))
29+import Data.Aeson (ToJSON (..), object)
29import qualified Data.Aeson as A
30import qualified Data.Aeson as A
30import Data.Foldable (foldMap)
31import Data.Foldable (foldMap)
31import qualified Data.HashMap.Strict as HM
32import qualified Data.HashMap.Strict as HM
@@ -234,6 +235,40 @@ class ToObject a => LogItem a where
234instance LogItem () where payloadKeys _ _ = SomeKeys []
235instance LogItem () where payloadKeys _ _ = SomeKeys []
235
236
236
237
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+
237-------------------------------------------------------------------------------
272-------------------------------------------------------------------------------
238-- | Constrain payload based on verbosity. Backends should use this to
273-- | Constrain payload based on verbosity. Backends should use this to
239-- automatically bubble higher verbosity levels to lower ones.
274-- automatically bubble higher verbosity levels to lower ones.