git.iko.soy/typeable/katip
on master help sign in
Lensify Item, combinator for verbosity restriction
ffc2428Ozgun Ataman
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+2−1
compare with master
unifiedsplit
@@ -21,7 +21,8 @@ mkEsScribe
21 -> IO Scribe
21 -> IO Scribe
22mkEsScribe server ix mapping sev verb = return $ Scribe $ \ i -> do
22mkEsScribe server ix mapping sev verb = return $ Scribe $ \ i -> do
23 did <- mkDocId
23 did <- mkDocId
24+ when (_itemSeverity i >= sev) $
24− void $ indexDocument server ix mapping i did
25+ void $ indexDocument server ix mapping (itemJson verb i) did
25
26
26
27
27-------------------------------------------------------------------------------
28-------------------------------------------------------------------------------
katip/src/Katip/Core.hs+31−23
@@ -143,34 +143,34 @@ showLS = ls . show
143-------------------------------------------------------------------------------
143-------------------------------------------------------------------------------
144-- | This has everything each log message will contain.
144-- | This has everything each log message will contain.
145data Item a = Item {
145data Item a = Item {
146− itemApp :: Namespace
146+ _itemApp :: Namespace
147− , itemEnv :: Environment
147+ , _itemEnv :: Environment
148− , itemSeverity :: Severity
148+ , _itemSeverity :: Severity
149− , itemThread :: ThreadId
149+ , _itemThread :: ThreadId
150− , itemHost :: HostName
150+ , _itemHost :: HostName
151− , itemProcess :: ProcessID
151+ , _itemProcess :: ProcessID
152− , itemPayload :: a
152+ , _itemPayload :: a
153− , itemMessage :: LogStr
153+ , _itemMessage :: LogStr
154− , itemTime :: UTCTime
154+ , _itemTime :: UTCTime
155− , itemNamespace :: Namespace
155+ , _itemNamespace :: Namespace
156− , itemLoc :: Maybe Loc
156+ , _itemLoc :: Maybe Loc
157 } deriving (Generic)
157 } deriving (Generic)
158−
158+makeLenses ''Item
159
159
160
160
161instance ToJSON a => ToJSON (Item a) where
161instance ToJSON a => ToJSON (Item a) where
162 toJSON Item{..} = A.object
162 toJSON Item{..} = A.object
163− [ "app" A..= itemApp
163+ [ "app" A..= _itemApp
164− , "env" A..= itemEnv
164+ , "env" A..= _itemEnv
165− , "sev" A..= itemSeverity
165+ , "sev" A..= _itemSeverity
166− , "thread" A..= show itemThread
166+ , "thread" A..= show _itemThread
167− , "host" A..= itemHost
167+ , "host" A..= _itemHost
168− , "pid" A..= A.String (toS (show itemProcess))
168+ , "pid" A..= A.String (toS (show _itemProcess))
169− , "data" A..= itemPayload
169+ , "data" A..= _itemPayload
170− , "msg" A..= (B.toLazyText $ unLogStr itemMessage)
170+ , "msg" A..= (B.toLazyText $ unLogStr _itemMessage)
171− , "at" A..= itemTime
171+ , "at" A..= _itemTime
172− , "ns" A..= itemNamespace
172+ , "ns" A..= _itemNamespace
173− , "loc" A..= fmap LocJs itemLoc
173+ , "loc" A..= fmap LocJs _itemLoc
174 ]
174 ]
175
175
176newtype LocJs = LocJs { getLocJs :: Loc }
176newtype LocJs = LocJs { getLocJs :: Loc }
@@ -224,6 +224,14 @@ payloadJson verb a = case foldMap (flip payloadKeys a) [(V0)..verb] of
224 & _Object %~ HM.filterWithKey (\ k _ -> k `elem` ks)
224 & _Object %~ HM.filterWithKey (\ k _ -> k `elem` ks)
225
225
226
226
227+-------------------------------------------------------------------------------
228+-- | Convert log item to its JSON representation while trimming its
229+-- payload based on the desired verbosity. Backends that push JSON
230+-- messages should use this to obtain their payload.
231+itemJson :: LogContext a => Verbosity -> Item a -> A.Value
232+itemJson verb a = toJSON $ a & itemPayload %~ payloadJson verb
233+
234+
227-------------------------------------------------------------------------------
235-------------------------------------------------------------------------------
228-- | Scribes are handlers of incoming items. Each registered scribe
236-- | Scribes are handlers of incoming items. Each registered scribe
229-- knows how to push a log item somewhere.
237-- knows how to push a log item somewhere.
katip/src/Katip/Scribes/Handle.hs+11−11
@@ -26,7 +26,7 @@ brackets m = fromText "[" <> m <> fromText "]"
26
26
27-------------------------------------------------------------------------------
27-------------------------------------------------------------------------------
28getKeys :: LogContext s => Verbosity -> s -> [Builder]
28getKeys :: LogContext s => Verbosity -> s -> [Builder]
29−getKeys verb a = payloadJson verb a ^..
29+getKeys verb a = payloadJson verb a ^..
30 _Object . to HM.toList . traverse . to rendPair
30 _Object . to HM.toList . traverse . to rendPair
31 where
31 where
32 rendPair (k,v) = fromText k <> fromText ":" <> (v ^. _Primitive . to renderPrim)
32 rendPair (k,v) = fromText k <> fromText ":" <> (v ^. _Primitive . to renderPrim)
@@ -56,7 +56,7 @@ mkHandleScribe cs h sev verb = do
56 ColorIfTerminal -> hIsTerminalDevice h
56 ColorIfTerminal -> hIsTerminalDevice h
57 ColorLog b -> return b
57 ColorLog b -> return b
58 return $ Scribe $ \ i@Item{..} -> do
58 return $ Scribe $ \ i@Item{..} -> do
59− when (itemSeverity >= sev) $
59+ when (_itemSeverity >= sev) $
60 T.hPutStrLn h $ toLazyText $ formatItem colorize verb i
60 T.hPutStrLn h $ toLazyText $ formatItem colorize verb i
61
61
62
62
@@ -64,17 +64,17 @@ mkHandleScribe cs h sev verb = do
64formatItem :: LogContext a => Bool -> Verbosity -> Item a -> Builder
64formatItem :: LogContext a => Bool -> Verbosity -> Item a -> Builder
65formatItem withColor verb Item{..} =
65formatItem withColor verb Item{..} =
66 brackets nowStr <>
66 brackets nowStr <>
67− brackets (mconcat $ map fromText $ intercalateNs itemNamespace) <>
67+ brackets (mconcat $ map fromText $ intercalateNs _itemNamespace) <>
68− brackets (fromText (renderSeverity' itemSeverity)) <>
68+ brackets (fromText (renderSeverity' _itemSeverity)) <>
69− brackets (fromString itemHost) <>
69+ brackets (fromString _itemHost) <>
70− brackets (fromString (show itemProcess)) <>
70+ brackets (fromString (show _itemProcess)) <>
71− brackets (fromString (show itemThread)) <>
71+ brackets (fromString (show _itemThread)) <>
72 mconcat ks <>
72 mconcat ks <>
73− maybe mempty (brackets . fromString . locationToString) itemLoc <>
73+ maybe mempty (brackets . fromString . locationToString) _itemLoc <>
74− fromText " " <> (unLogStr itemMessage)
74+ fromText " " <> (unLogStr _itemMessage)
75 where
75 where
76− nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
76+ nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" _itemTime
77− ks = map brackets $ getKeys verb itemPayload
77+ ks = map brackets $ getKeys verb _itemPayload
78 renderSeverity' s = case s of
78 renderSeverity' s = case s of
79 EmergencyS -> red $ renderSeverity s
79 EmergencyS -> red $ renderSeverity s
80 AlertS -> red $ renderSeverity s
80 AlertS -> red $ renderSeverity s