git.iko.soy/typeable/katip
on master help sign in
Probably better if payloads define their important keys
1f45580Ozgun Ataman
src/Katip/Core.hs+14−2
compare with master
unifiedsplit
@@ -93,11 +93,23 @@ instance ToJSON a => ToJSON (Item a) where
93 ]
93 ]
94
94
95
95
96+-------------------------------------------------------------------------------
97+-- | Payload objects need instances of this class.
98+class ToJSON a => LogContext a where
99+
100+ -- | List of keys in the JSON object that should be printed in
101+ -- summarizing human-readable output.
102+ importantKeys :: a -> [Text]
103+
104+
105+instance LogContext () where importantKeys _ = []
106+
107+
96-------------------------------------------------------------------------------
108-------------------------------------------------------------------------------
97-- | Scribes are handlers of incoming items. Each registered scribe
109-- | Scribes are handlers of incoming items. Each registered scribe
98-- knows how to push a log item somewhere.
110-- knows how to push a log item somewhere.
99data Scribe = Scribe {
111data Scribe = Scribe {
100− lhPush :: forall a. ToJSON a => Item a -> IO ()
112+ lhPush :: forall a. LogContext a => Item a -> IO ()
101 }
113 }
102
114
103
115
@@ -156,7 +168,7 @@ class Katip m where
156-------------------------------------------------------------------------------
168-------------------------------------------------------------------------------
157-- | The generic *full* logging function.
169-- | The generic *full* logging function.
158logF
170logF
159− :: (Applicative m, MonadIO m, ToJSON a, Katip m)
171+ :: (Applicative m, MonadIO m, LogContext a, Katip m)
160 => Severity
172 => Severity
161 -> a
173 -> a
162 -- ^ Contextual payload for the log
174 -- ^ Contextual payload for the log
src/Katip/Scribes/Handle.hs+6−6
@@ -29,8 +29,8 @@ brackets m = fromByteString "[" <> m <> fromByteString "]"
29
29
30
30
31-------------------------------------------------------------------------------
31-------------------------------------------------------------------------------
32−getKeys :: ToJSON s => s -> [Text] -> [Builder]
32+getKeys :: LogContext s => s -> [Builder]
33−getKeys a keys = flip mapMaybe keys $ \ k ->
33+getKeys a = flip mapMaybe (importantKeys a) $ \ k ->
34 a' ^? key k . _Primitive . to renderPrim
34 a' ^? key k . _Primitive . to renderPrim
35 where
35 where
36 a' = toJSON a
36 a' = toJSON a
@@ -44,12 +44,12 @@ renderPrim NullPrim = fromByteString "null"
44
44
45
45
46-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
47−mkHandleScribe :: Handle -> [Text] -> Severity -> IO Scribe
47+mkHandleScribe :: Handle -> Severity -> IO Scribe
48−mkHandleScribe h keys sev = do
48+mkHandleScribe h sev = do
49 hSetBuffering h LineBuffering
49 hSetBuffering h LineBuffering
50 return $ Scribe $ \ Item{..} -> do
50 return $ Scribe $ \ Item{..} -> do
51 let nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
51 let nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
52− ks = map brackets $ getKeys itemPayload keys
52+ ks = map brackets $ getKeys itemPayload
53 msg = brackets nowStr <>
53 msg = brackets nowStr <>
54 brackets (fromText (renderSeverity itemSeverity)) <>
54 brackets (fromText (renderSeverity itemSeverity)) <>
55 brackets (fromString itemHost) <>
55 brackets (fromString itemHost) <>
@@ -67,7 +67,7 @@ mkHandleScribe h keys sev = do
67_ioLogEnv :: LogEnv
67_ioLogEnv :: LogEnv
68_ioLogEnv = unsafePerformIO $ do
68_ioLogEnv = unsafePerformIO $ do
69 le <- initLogEnv "io" "io"
69 le <- initLogEnv "io" "io"
70− lh <- mkHandleScribe stdout [] Debug
70+ lh <- mkHandleScribe stdout Debug
71 return $ registerHandler "stdout" lh le
71 return $ registerHandler "stdout" lh le
72{-# NOINLINE _ioLogEnv #-}
72{-# NOINLINE _ioLogEnv #-}
73
73