@@ -26,7 +26,6 @@ import Control.Monad.Trans.State
2626import Control.Monad.Trans.Writer
2727import Data.Aeson (ToJSON (..))
2828import qualified Data.Aeson as A
29−import Data.Aeson.Lens
3029import Data.Foldable (foldMap)
3130import qualified Data.HashMap.Strict as HM
3231import Data.List
@@ -198,6 +197,26 @@ instance Monoid PayloadSelection where
198197 mappend _ AllKeys = AllKeys
199198 mappend (SomeKeys as) (SomeKeys bs) = SomeKeys (as++bs)
200199
200+
201+-------------------------------------------------------------------------------
202+-- | Katip requires JSON objects to be logged as context. This
203+-- typeclass provides a default instance which uses ToJSON and
204+-- produces an empty object if 'toJSON' results in any type other than
205+-- object. If you have a type you want to log that produces an Array
206+-- or Number for example, you'll want to write an explicit instance
207+-- here. You can trivially add a ToObject instance for something with
208+-- a ToJSON instance like:
209+--
210+-- > instance ToObject Foo
211+class ToJSON a => ToObject a where
212+ toObject :: a -> A.Object
213+ toObject v = case toJSON v of
214+ A.Object o -> o
215+ _ -> mempty
216+
217+instance ToObject ()
218+instance ToObject A.Object
219+
201220-------------------------------------------------------------------------------
202221-- | Payload objects need instances of this class.
203222--
@@ -205,7 +224,7 @@ instance Monoid PayloadSelection where
205224-- keys for higher levels of verbosity. Each level of verbosity
206225-- automatically and recursively contains all keys from the level
207226-- before it.
208−class ToJSON a => LogContext a where
227+class ToObject a => LogContext a where
209228
210229 -- | List of keys in the JSON object that should be included in message.
211230 payloadKeys :: Verbosity -> a -> PayloadSelection
@@ -217,11 +236,10 @@ instance LogContext () where payloadKeys _ _ = SomeKeys []
217236-------------------------------------------------------------------------------
218237-- | Constrain payload based on verbosity. Backends should use this to
219238-- automatically bubble higher verbosity levels to lower ones.
220−payloadJson :: LogContext a => Verbosity -> a -> A.Value
221−payloadJson verb a = case foldMap (flip payloadKeys a) [(V0)..verb] of
222− AllKeys -> toJSON a
223− SomeKeys ks -> toJSON a
224− & _Object %~ HM.filterWithKey (\ k _ -> k `elem` ks)
239+payloadObject :: LogContext a => Verbosity -> a -> A.Object
240+payloadObject verb a = case foldMap (flip payloadKeys a) [(V0)..verb] of
241+ AllKeys -> toObject a
242+ SomeKeys ks -> HM.filterWithKey (\ k _ -> k `elem` ks) $ toObject a
225243
226244
227245-------------------------------------------------------------------------------
@@ -229,7 +247,7 @@ payloadJson verb a = case foldMap (flip payloadKeys a) [(V0)..verb] of
229247-- payload based on the desired verbosity. Backends that push JSON
230248-- messages should use this to obtain their payload.
231249itemJson :: LogContext a => Verbosity -> Item a -> A.Value
232−itemJson verb a = toJSON $ a & itemPayload %~ payloadJson verb
250+itemJson verb a = toJSON $ a & itemPayload %~ payloadObject verb
233251
234252
235253-------------------------------------------------------------------------------