@@ -3,45 +3,47 @@ module Katip.Scribes.Handle where
33-------------------------------------------------------------------------------
44import Control.Applicative as A
55import Control.Concurrent
6−import Control.Exception (bracket_, finally)
7−import Data.ByteString.Lazy as BL (hPutStr)
8−import Data.ByteString.Builder as B
6+import Control.Exception (finally)
97import Data.Aeson
10−import Data.Text as T (pack)
11−import Data.Text.Encoding as T
12−import Data.Text.Lazy as TL (toStrict)
13−import Data.Text.Lazy.Encoding as TL (decodeUtf8)
14−import qualified Data.HashMap.Strict as HM
8+import Data.Aeson.Text
9+import Data.ByteString.Builder as B
10+import Data.ByteString.Lazy as BL (hPutStr)
1511import Data.Monoid as M
1612import Data.Scientific as S
1713import Data.Text (Text)
14+import Data.Text.Lazy.Builder as TL
15+import Data.Text.Lazy.Encoding (encodeUtf8)
1816import System.IO
17+import qualified Data.HashMap.Strict as HM
18+
1919-------------------------------------------------------------------------------
2020import Katip.Core
2121import Katip.Format.Time (formatAsLogTime)
2222-------------------------------------------------------------------------------
2323
2424
25+-------------------------------------------------------------------------------
26+brackets :: TL.Builder -> TL.Builder
27+brackets m = fromText "[" M.<> m <> fromText "]"
2528
26−fromText :: Text -> Builder
27−fromText = B.byteString . T.encodeUtf8
29+textBuilderToBS :: TL.Builder -> B.Builder
30+textBuilderToBS = B.lazyByteString . encodeUtf8 . toLazyText
2831
29−-------------------------------------------------------------------------------
30−brackets :: Builder -> Builder
31−brackets m = fromText "[" <> m <> fromText "]"
32+appendNL :: TL.Builder -> TL.Builder
33+appendNL b = b <> TL.singleton '\n'
3234
3335-------------------------------------------------------------------------------
34−getKeys :: LogItem s => Verbosity -> s -> [Builder]
35−getKeys verb a = HM.toList (payloadObject verb a) >>= renderPair
36+getKeys :: LogItem s => Verbosity -> s -> [TL.Builder]
37+getKeys verb a = concat (renderPair A.<$> HM.toList (payloadObject verb a))
3638 where
37− renderPair :: (Text, Value) -> [Builder]
39+ renderPair :: (Text, Value) -> [TL.Builder]
3840 renderPair (k,v) =
3941 case v of
4042 Object o -> concat [renderPair (k <> "." <> k', v') | (k', v') <- HM.toList o]
41− String t -> [fromText k <> string7 ":" <> fromText t]
42− Number n -> [fromText k <> string7 ":" <> string7 (formatNumber n)]
43− Bool b -> [fromText k <> string7 ":" <> string7 (show b)]
44− Null -> [fromText k <> string7 ":null"]
43+ String t -> [fromText (k <> ":" <> t)]
44+ Number n -> [fromText (k <> ":") <> fromString (formatNumber n)]
45+ Bool b -> [fromText (k <> ":") <> fromString (show b)]
46+ Null -> [fromText (k <> ":null")]
4547 _ -> mempty -- Can't think of a sensible way to handle arrays
4648 formatNumber :: Scientific -> String
4749 formatNumber n =
@@ -107,7 +109,8 @@ mkFileScribe f permitF verb = do
107109-------------------------------------------------------------------------------
108110-- | A custom ItemFormatter for logging `Item`s. Takes a `Bool` indicating
109111-- whether to colorize the output, `Verbosity` of output, and an `Item` to
110−-- format.
112+-- format. Note that formatter is responsible for appending the newline at the
113+-- end of the string if required
111114--
112115-- See `bracketFormat` and `jsonFormat` for examples.
113116type ItemFormatter a = Bool -> Verbosity -> Item a -> B.Builder
@@ -124,21 +127,21 @@ formatItem = bracketFormat
124127-- > [2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][PID 1724][ThreadId 1154][confrab_factor:42.0][main:Helpers.Logging Helpers/Logging.hs:41:9] Confrabulating widgets, with extra namespace and context
125128-- > [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal
126129bracketFormat :: LogItem a => ItemFormatter a
127−bracketFormat withColor verb Item{..} =
130+bracketFormat withColor verb Item{..} = textBuilderToBS $ appendNL $
128131 brackets nowStr <>
129132 brackets (mconcat $ map fromText $ intercalateNs _itemNamespace) <>
130− brackets (fromText (renderSeverity' _itemSeverity)) <>
131− brackets (fromText (T.pack _itemHost)) <>
132− brackets ("PID " <> fromText (T.pack $ show _itemProcess)) <>
133+ brackets (renderSeverity' _itemSeverity) <>
134+ brackets (fromString _itemHost) <>
135+ brackets ("PID " <> fromString (show _itemProcess)) <>
133136 brackets ("ThreadId " <> fromText (getThreadIdText _itemThread)) <>
134137 mconcat ks <>
135− maybe mempty (brackets . fromText . T.pack . locationToString) _itemLoc <>
138+ maybe mempty (brackets . fromString . locationToString) _itemLoc <>
136139 fromText " " <> (unLogStr _itemMessage)
137140 where
138141 nowStr = fromText (formatAsLogTime _itemTime)
139142 ks = map brackets $ getKeys verb _itemPayload
140143 renderSeverity' severity =
141− colorBySeverity withColor severity (renderSeverity severity)
144+ colorBySeverity withColor severity (fromText $ renderSeverity severity)
142145
143146-- | Logs items as JSON. This can be useful in circumstances where you already
144147-- have infrastructure that is expecting JSON to be logged to a standard stream
@@ -148,15 +151,15 @@ bracketFormat withColor verb Item{..} =
148151-- > {"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp","confrabulation"],"data":{"confrab_factor":42},"app":["MyApp"],"msg":"Confrabulating widgets, with extra namespace and context","pid":"10456","loc":{"loc_col":11,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":53},"host":"myhost.example.com","sev":"Debug","thread":"ThreadId 139"}
149152-- > {"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp"],"data":{},"app":["MyApp"],"msg":"Namespace and context are back to normal","pid":"10456","loc":{"loc_col":9,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":55},"host":"myhost.example.com","sev":"Info","thread":"ThreadId 139"}
150153jsonFormat :: LogItem a => ItemFormatter a
151−jsonFormat withColor verb i =
152− fromText $
154+jsonFormat withColor verb i = textBuilderToBS $
155+ appendNL $
153156 colorBySeverity withColor (_itemSeverity i) $
154− toStrict $ TL.decodeUtf8 $ encode $ itemJson verb i
157+ encodeToTextBuilder $ itemJson verb i
155158
156159-- | Color a text message based on `Severity`. `ErrorS` and more severe errors
157160-- are colored red, `WarningS` is colored yellow, and all other messages are
158161-- rendered in the default color.
159−colorBySeverity :: Bool -> Severity -> Text -> Text
162+colorBySeverity :: Bool -> Severity -> TL.Builder -> TL.Builder
160163colorBySeverity withColor severity msg = case severity of
161164 EmergencyS -> red msg
162165 AlertS -> red msg