git.iko.soy/typeable/control-logger
on master help sign in
Drop the custom katip (#3)
2ab9c6eYuras
.gitignore+2
compare with master
unifiedsplit
@@ -1 +1,3 @@
1.stack-work
1.stack-work
2+*~
3+*.swp
src/Control/Logger/Katip.hs+2−21
@@ -5,7 +5,7 @@ module Control.Logger.Katip
5 ( logSeverityToKSeverity
5 ( logSeverityToKSeverity
6 , KatipContextTState(..)
6 , KatipContextTState(..)
7 , getKatipLogger
7 , getKatipLogger
8− , ourFormatter
8+ , ourItemJson
9 , katipIndexNameString
9 , katipIndexNameString
10 ) where
10 ) where
11
11
@@ -14,12 +14,11 @@ import Control.Has.Katip ()
14import Control.Lens hiding ((.=))
14import Control.Lens hiding ((.=))
15import Control.Logger.Internal
15import Control.Logger.Internal
16import Data.Aeson hiding (Error)
16import Data.Aeson hiding (Error)
17−import qualified Data.HashMap.Strict as HM
18import Data.Text (Text)
17import Data.Text (Text)
19import qualified Data.Text as T
18import qualified Data.Text as T
20import qualified Data.Text.Lazy.Builder as T.Builder
19import qualified Data.Text.Lazy.Builder as T.Builder
21import Katip as K hiding (logMsg)
20import Katip as K hiding (logMsg)
22−import Katip.Core (ItemFunc(..), LocJs(..), ProcessIDJs(..))
21+import Katip.Core (LocJs(..), ProcessIDJs(..))
23import Katip.Monadic (KatipContextTState(..))
22import Katip.Monadic (KatipContextTState(..))
24
23
25
24
@@ -31,24 +30,6 @@ logSeverityToKSeverity = \case
31 Error -> ErrorS
30 Error -> ErrorS
32
31
33
32
34−-- | Adds the @rev-hash@ value to each record.
35−-- Early we copied `msg` to `msg-keyword` here but drop it
36−-- because purpose of this duplication is not clear.
37−ourFormatter
38− :: Text
39− -- ^ git revision string
40− -> Verbosity
41− -> ItemFunc Value
42−ourFormatter gitRev verb = ItemFunc $ \item -> go $ ourItemJson verb item
43− where
44− go :: Value -> Value
45− go = \case
46− Object h -> Object $ setRev h
47− x -> x -- drop exception here?
48− where
49− setRev :: HM.HashMap Text Value -> HM.HashMap Text Value
50− setRev = HM.insert "rev-hash" (toJSON gitRev)
51−
52katipIndexNameString :: Text
33katipIndexNameString :: Text
53katipIndexNameString = "antorica-b2b-logs"
34katipIndexNameString = "antorica-b2b-logs"
54
35
src/Control/Logger/Katip/Utils.hs+34−12
@@ -1,4 +1,5 @@
1{-# LANGUAGE ImplicitParams #-}
1{-# LANGUAGE ImplicitParams #-}
2+{-# LANGUAGE CPP #-}
2
3
3module Control.Logger.Katip.Utils
4module Control.Logger.Katip.Utils
4 ( katipIndexNameString
5 ( katipIndexNameString
@@ -6,7 +7,6 @@ module Control.Logger.Katip.Utils
6 , LogFormat(..)
7 , LogFormat(..)
7 , registerFileScribe
8 , registerFileScribe
8 , setLoggingCtx
9 , setLoggingCtx
9− , ourFormatter
10 , getKatipLogger
10 , getKatipLogger
11 , logSeverityToKSeverity
11 , logSeverityToKSeverity
12 ) where
12 ) where
@@ -20,18 +20,36 @@ import Control.Logger.Internal as L
20import Control.Logger.Katip as L
20import Control.Logger.Katip as L
21import Data.Aeson hiding (Error)
21import Data.Aeson hiding (Error)
22import Data.Aeson.Text
22import Data.Aeson.Text
23+#if MIN_VERSION_aeson(2,0,0)
23−import qualified Data.ByteString.Builder as B.Builder
24+import qualified Data.Aeson.KeyMap as HM
25+import qualified Data.Aeson.Key as HM
26+#else
24import qualified Data.HashMap.Strict as HM
27import qualified Data.HashMap.Strict as HM
28+#endif
25import Data.Text (Text)
29import Data.Text (Text)
30+import qualified Data.Text.Lazy as T
26import qualified Data.Text.Lazy.Builder as T.Builder
31import qualified Data.Text.Lazy.Builder as T.Builder
27−import qualified Data.Text.Lazy.Encoding as T.Lazy
28import Katip as K hiding (logMsg)
32import Katip as K hiding (logMsg)
29−import Katip.Core (ItemFunc(..))
30import Katip.Monadic (KatipContextTState(..))
33import Katip.Monadic (KatipContextTState(..))
31import qualified Katip.Scribes.Handle as K
34import qualified Katip.Scribes.Handle as K
32import System.IO
35import System.IO
33
36
34
37
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+
35-- | How to format logs
53-- | How to format logs
36data LogFormat
54data LogFormat
37 = LogBracket -- ^ use `bracketFormat`
55 = LogBracket -- ^ use `bracketFormat`
@@ -55,38 +73,42 @@ registerFileScribe gitRev verbosity format filePath permitF additions logenv =
55 formatter = case format of
73 formatter = case format of
56 LogBracket -> customBracketFormat additions'
74 LogBracket -> customBracketFormat additions'
57 LogJson -> customJsonFormat gitRev additions'
75 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
59
80
60-- | JSON formatter that adds the specified fields to the output
81-- | JSON formatter that adds the specified fields to the output
61customJsonFormat
82customJsonFormat
62− :: forall a. LogItem a => Text -> HM.HashMap Text Value -> ItemFormatter a
83+ :: forall a. LogItem a => Text -> KeyMap Value -> ItemFormatter a
63customJsonFormat gitRev additions withColor verb i = (mappend "\n") $
84customJsonFormat gitRev additions withColor verb i = (mappend "\n") $
64 -- Here we reimplement the standard formater because we want the
85 -- Here we reimplement the standard formater because we want the
65 -- additional key/value pairs to be added at the top level.
86 -- additional key/value pairs to be added at the top level.
66 -- So we can't use the LogWithAdditions like we do for bracket format
87 -- 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 $
68 K.colorBySeverity withColor (_itemSeverity i) $
89 K.colorBySeverity withColor (_itemSeverity i) $
69− encodeToTextBuilder (extend $ applyItemFunc (ourFormatter gitRev verb) i)
90+ (T.toStrict . encodeToLazyText) (extend $ ourItemJson verb i)
70 where
91 where
71− extend (Object o) = Object $ HM.union additions o
92+ extend (Object o) = Object $ HM.union additions' o
72 extend v = v
93 extend v = v
94+ additions' = HM.insert "rev-hash" (toJSON gitRev) additions
73
95
74-- | Bracket formatter that adds the specified fields to the output
96-- | Bracket formatter that adds the specified fields to the output
75customBracketFormat
97customBracketFormat
76− :: forall a. LogItem a => HM.HashMap Text Value -> ItemFormatter a
98+ :: forall a. LogItem a => KeyMap Value -> ItemFormatter a
77customBracketFormat additions withColor verb i =
99customBracketFormat additions withColor verb i =
78 bracketFormat withColor verb (LogWithAdditions additions <$> i)
100 bracketFormat withColor verb (LogWithAdditions additions <$> i)
79
101
80-- | Log item payload that adds the specified additional key/value pairs
102-- | Log item payload that adds the specified additional key/value pairs
81-- to the output on at verbosity levels
103-- 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
83 deriving (Show)
105 deriving (Show)
84
106
85instance LogItem a => LogItem (LogWithAdditions a) where
107instance LogItem a => LogItem (LogWithAdditions a) where
86 payloadKeys v (LogWithAdditions additions a) =
108 payloadKeys v (LogWithAdditions additions a) =
87 case payloadKeys v a of
109 case payloadKeys v a of
88 AllKeys -> AllKeys
110 AllKeys -> AllKeys
89− SomeKeys keys -> SomeKeys (HM.keys additions ++ keys)
111+ SomeKeys keys -> SomeKeys (map keyToText (HM.keys additions) ++ keys)
90
112
91instance ToObject a => ToObject (LogWithAdditions a) where
113instance ToObject a => ToObject (LogWithAdditions a) where
92 toObject (LogWithAdditions additions a) =
114 toObject (LogWithAdditions additions a) =