@@ -1,4 +1,5 @@
11{-# LANGUAGE ImplicitParams #-}
2+{-# LANGUAGE CPP #-}
23
34module Control.Logger.Katip.Utils
45 ( katipIndexNameString
@@ -6,7 +7,6 @@ module Control.Logger.Katip.Utils
67 , LogFormat(..)
78 , registerFileScribe
89 , setLoggingCtx
9− , ourFormatter
1010 , getKatipLogger
1111 , logSeverityToKSeverity
1212 ) where
@@ -20,18 +20,36 @@ import Control.Logger.Internal as L
2020import Control.Logger.Katip as L
2121import Data.Aeson hiding (Error)
2222import Data.Aeson.Text
23−import qualified Data.ByteString.Builder as B.Builder
23+#if MIN_VERSION_aeson(2,0,0)
24+import qualified Data.Aeson.KeyMap as HM
25+import qualified Data.Aeson.Key as HM
26+#else
2427import qualified Data.HashMap.Strict as HM
28+#endif
2529import Data.Text (Text)
30+import qualified Data.Text.Lazy as T
2631import qualified Data.Text.Lazy.Builder as T.Builder
27−import qualified Data.Text.Lazy.Encoding as T.Lazy
2832import Katip as K hiding (logMsg)
29−import Katip.Core (ItemFunc(..))
3033import Katip.Monadic (KatipContextTState(..))
3134import qualified Katip.Scribes.Handle as K
3235import System.IO
3336
3437
38+#if MIN_VERSION_aeson(2,0,0)
39+type KeyMap v = HM.KeyMap v
40+textToKey :: Text -> Key
41+textToKey = HM.fromText
42+keyToText :: Key -> Text
43+keyToText = HM.toText
44+#else
45+type KeyMap v = HM.HashMap Text v
46+type Key = Text
47+textToKey :: Text -> Key
48+textToKey = id
49+keyToText :: Key -> Text
50+keyToText = id
51+#endif
52+
3553-- | How to format logs
3654data LogFormat
3755 = LogBracket -- ^ use `bracketFormat`
@@ -55,38 +73,42 @@ registerFileScribe gitRev verbosity format filePath permitF additions logenv =
5573 formatter = case format of
5674 LogBracket -> customBracketFormat additions'
5775 LogJson -> customJsonFormat gitRev additions'
58− additions' = HM.fromList . map (fmap String) $ additions
76+ additions'
77+ = HM.fromList
78+ . map (\(k, v) -> (textToKey k, String v))
79+ $ additions
5980
6081-- | JSON formatter that adds the specified fields to the output
6182customJsonFormat
62− :: forall a. LogItem a => Text -> HM.HashMap Text Value -> ItemFormatter a
83+ :: forall a. LogItem a => Text -> KeyMap Value -> ItemFormatter a
6384customJsonFormat gitRev additions withColor verb i = (mappend "\n") $
6485 -- Here we reimplement the standard formater because we want the
6586 -- additional key/value pairs to be added at the top level.
6687 -- So we can't use the LogWithAdditions like we do for bracket format
67− B.Builder.lazyByteString . T.Lazy.encodeUtf8 . T.Builder.toLazyText $
88+ T.Builder.fromText $
6889 K.colorBySeverity withColor (_itemSeverity i) $
69− encodeToTextBuilder (extend $ applyItemFunc (ourFormatter gitRev verb) i)
90+ (T.toStrict . encodeToLazyText) (extend $ ourItemJson verb i)
7091 where
71− extend (Object o) = Object $ HM.union additions o
92+ extend (Object o) = Object $ HM.union additions' o
7293 extend v = v
94+ additions' = HM.insert "rev-hash" (toJSON gitRev) additions
7395
7496-- | Bracket formatter that adds the specified fields to the output
7597customBracketFormat
76− :: forall a. LogItem a => HM.HashMap Text Value -> ItemFormatter a
98+ :: forall a. LogItem a => KeyMap Value -> ItemFormatter a
7799customBracketFormat additions withColor verb i =
78100 bracketFormat withColor verb (LogWithAdditions additions <$> i)
79101
80102-- | Log item payload that adds the specified additional key/value pairs
81103-- to the output on at verbosity levels
82−data LogWithAdditions a = LogWithAdditions (HM.HashMap Text Value) a
104+data LogWithAdditions a = LogWithAdditions (KeyMap Value) a
83105 deriving (Show)
84106
85107instance LogItem a => LogItem (LogWithAdditions a) where
86108 payloadKeys v (LogWithAdditions additions a) =
87109 case payloadKeys v a of
88110 AllKeys -> AllKeys
89− SomeKeys keys -> SomeKeys (HM.keys additions ++ keys)
111+ SomeKeys keys -> SomeKeys (map keyToText (HM.keys additions) ++ keys)
90112
91113instance ToObject a => ToObject (LogWithAdditions a) where
92114 toObject (LogWithAdditions additions a) =