katip 0.8.6.0 → 0.8.7.0
raw patch · 7 files changed
+123/−22 lines, 7 filesdep ~aeson
Dependency ranges changed: aeson
Files
- changelog.md +4/−0
- katip.cabal +1/−1
- src/Katip/Core.hs +27/−2
- src/Katip/Monadic.hs +18/−3
- src/Katip/Scribes/Handle.hs +33/−11
- test/Katip/Tests.hs +24/−3
- test/Katip/Tests/Scribes/Handle.hs +16/−2
changelog.md view
@@ -1,3 +1,7 @@+0.8.7.0+=======+* Aeson 2 compatibility [#131](https://github.com/Soostone/katip/pull/131)+ 0.8.6.0 ======= * GHC 8.10 compatibility
katip.cabal view
@@ -1,5 +1,5 @@ name: katip-version: 0.8.6.0+version: 0.8.7.0 synopsis: A structured logging framework. description: Katip is a structured logging framework. See README.md for more details.
src/Katip/Core.hs view
@@ -57,8 +57,15 @@ import Data.Aeson (FromJSON (..), ToJSON (..), object) import qualified Data.Aeson as A+#if MIN_VERSION_aeson(2, 0, 0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as KM+import Data.Bifunctor (Bifunctor (..))+#endif import Data.Foldable as FT+#if !MIN_VERSION_aeson(2, 0, 0) import qualified Data.HashMap.Strict as HM+#endif import Data.List import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe)@@ -489,10 +496,20 @@ -- Construct using 'sl' and combine multiple tuples using '<>' from -- 'Monoid'. instance ToJSON SimpleLogPayload where- toJSON (SimpleLogPayload as) = object $ map go as+ toJSON (SimpleLogPayload as) = object $ map go as' where go (k, AnyLogPayload v) = k A..= v+ as' = toKey <$> as +#if MIN_VERSION_aeson(2, 0, 0)+toKey :: (Text, c) -> (K.Key, c)+toKey = first K.fromText+#else+toKey :: a -> a+toKey = id+#endif++ instance ToObject SimpleLogPayload @@ -522,7 +539,15 @@ payloadObject :: LogItem a => Verbosity -> a -> A.Object payloadObject verb a = case FT.foldMap (flip payloadKeys a) [(V0)..verb] of AllKeys -> toObject a- SomeKeys ks -> HM.filterWithKey (\ k _ -> k `FT.elem` ks) $ toObject a+ SomeKeys ks -> filterElems ks $ toObject a++#if MIN_VERSION_aeson(2, 0, 0)+filterElems :: [Text] -> KM.KeyMap v -> KM.KeyMap v+filterElems ks = KM.filterWithKey (\ k _ -> K.toText k `FT.elem` ks)+#else+filterElems :: [Text] -> HM.HashMap Text v -> HM.HashMap Text v+filterElems ks = HM.filterWithKey (\ k _ -> k `FT.elem` ks)+#endif -------------------------------------------------------------------------------
src/Katip/Monadic.hs view
@@ -73,8 +73,14 @@ ) import Control.Monad.Writer hiding ((<>)) import Data.Aeson+#if MIN_VERSION_aeson(2, 0, 0)+import qualified Data.Aeson.KeyMap as KM+import qualified Data.Aeson.Key as K+#endif import qualified Data.Foldable as FT+#if !MIN_VERSION_aeson(2, 0, 0) import qualified Data.HashMap.Strict as HM+#endif import Data.Semigroup as Semi import Data.Sequence as Seq import Data.Text (Text)@@ -130,9 +136,17 @@ -- combined, we resolve AllKeys to its equivalent SomeKeys -- representation first. payloadKeys' (AnyLogContext v) = case payloadKeys verb v of- AllKeys -> SomeKeys $ HM.keys $ toObject v+ AllKeys -> SomeKeys $ toKeys $ toObject v x -> x +#if MIN_VERSION_aeson(2, 0, 0)+toKeys :: KM.KeyMap v -> [Text]+toKeys = fmap K.toText . KM.keys+#else+toKeys :: HM.HashMap k v -> [k]+toKeys = HM.keys+#endif+ ------------------------------------------------------------------------------- -- | Lift a log context into the generic wrapper so that it can@@ -287,8 +301,9 @@ -- -- Same consideration as `logLoc` applies. ----- Location will be logged from the module that invokes 'logLocM' so--- be aware that wrapping 'logLocM' will make location reporting useless.+-- By default, location will be logged from the module that invokes 'logLocM'.+-- If you want to use 'logLocM' in a helper, wrap the entire helper in+-- 'withFrozenCallStack' to retain the callsite of the helper in the logs. -- -- This function does not require template-haskell. Using GHC <= 7.8 will result -- in the emission of a log line without any location information.
src/Katip/Scribes/Handle.hs view
@@ -1,11 +1,18 @@+{-# LANGUAGE CPP #-}+ module Katip.Scribes.Handle where --------------------------------------------------------------------------------import Control.Applicative as A import Control.Concurrent import Control.Exception (bracket_, finally) import Data.Aeson+#if MIN_VERSION_aeson(2, 0, 0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as KM+import Data.Bifunctor (Bifunctor (..))+#else import qualified Data.HashMap.Strict as HM+#endif import Data.Monoid as M import Data.Scientific as S import Data.Text (Text)@@ -26,17 +33,32 @@ ------------------------------------------------------------------------------- getKeys :: LogItem s => Verbosity -> s -> [Builder]-getKeys verb a = concat (renderPair A.<$> HM.toList (payloadObject verb a))+getKeys verb a = concat (toBuilders (payloadObject verb a))++#if MIN_VERSION_aeson(2, 0, 0)+toBuilders :: KM.KeyMap Value -> [[Builder]]+toBuilders = fmap (renderPair . first K.toText) . KM.toList++toTxtKeyList :: KM.KeyMap v -> [(Text, v)]+toTxtKeyList mp = first K.toText <$> KM.toList mp+#else+toBuilders :: HM.HashMap Text Value -> [[Builder]]+toBuilders = fmap renderPair . HM.toList++toTxtKeyList :: HM.HashMap Text v -> [(Text, v)]+toTxtKeyList = HM.toList+#endif++renderPair :: (Text, Value) -> [Builder]+renderPair (k, v) =+ case v of+ Object o -> concat [renderPair (k <> "." <> k', v') | (k', v') <- toTxtKeyList o]+ String t -> [fromText (k <> ":" <> t)]+ Number n -> [fromText (k <> ":") <> fromString (formatNumber n)]+ Bool b -> [fromText (k <> ":") <> fromString (show b)]+ Null -> [fromText (k <> ":null")]+ _ -> mempty -- Can't think of a sensible way to handle arrays where- renderPair :: (Text, Value) -> [Builder]- renderPair (k, v) =- case v of- Object o -> concat [renderPair (k <> "." <> k', v') | (k', v') <- HM.toList o]- String t -> [fromText (k <> ":" <> t)]- Number n -> [fromText (k <> ":") <> fromString (formatNumber n)]- Bool b -> [fromText (k <> ":") <> fromString (show b)]- Null -> [fromText (k <> ":null")]- _ -> mempty -- Can't think of a sensible way to handle arrays formatNumber :: Scientific -> String formatNumber n = formatScientific Generic (if isFloating n then Nothing else Just 0) n
test/Katip/Tests.hs view
@@ -18,7 +18,12 @@ import Control.Concurrent.STM import Control.Exception.Safe import Data.Aeson+#if MIN_VERSION_aeson(2, 0, 0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as KM+#else import qualified Data.HashMap.Strict as HM+#endif import qualified Data.Map.Strict as M import Data.Monoid as Monoid import Data.Text (Text)@@ -69,7 +74,7 @@ l2 = liftPayload (SimpleLogPayload [("foo", AnyLogPayload ("b" :: Text))]) l3 = liftPayload (SimpleLogPayload [("foo", AnyLogPayload ("c" :: Text))]) both = l1 <> l2 <> l3- toObject both @?= HM.singleton "foo" (String "c"),+ toObject both @?= singletonMap "foo" (String "c"), testCase "respects payloadKeys for each constituent payload" $ do let everything = liftPayload (SimpleLogPayload [("foo", AnyLogPayload ("a" :: Text))]) conservative = liftPayload (ConservativePayload "always" "rarely")@@ -78,6 +83,14 @@ payloadKeys V1 both @?= SomeKeys ["often_shown", "foo"] ] +#if MIN_VERSION_aeson(2, 0, 0)+singletonMap :: K.Key -> v -> KM.KeyMap v+singletonMap = KM.singleton+#else+singletonMap :: Text -> v -> HM.HashMap Text v+singletonMap = HM.singleton+#endif+ ------------------------------------------------------------------------------- closeScribeTests :: TestTree closeScribeTests =@@ -123,12 +136,12 @@ $(logTM) InfoS "additional context" _ <- closeScribes le summary <- fmap summarizeItem <$> readTVarIO items- let baseCtx = HM.singleton "base_context" (Number 42)+ let baseCtx = singletonMap "base_context" (Number 42) let baseNS = "tests" <> "base_namespace" summary @?= [ (baseNS, baseCtx, "basic log"), (baseNS <> "added" <> "namespace", baseCtx, "with namespaces"),- (baseNS <> "added", HM.insert "additional" (Bool True) baseCtx, "additional context")+ (baseNS <> "added", insertMap "additional" (Bool True) baseCtx, "additional context") ], testCase "Katip.Monadic.logLocM" $ do (le, items) <- recordingEnv@@ -153,6 +166,14 @@ return (le2, items) summarizeItem :: Item Object -> (Namespace, Object, LogStr) summarizeItem Item {..} = (_itemNamespace, _itemPayload, _itemMessage)++#if MIN_VERSION_aeson(2, 0, 0)+insertMap :: K.Key -> v -> KM.KeyMap v -> KM.KeyMap v+insertMap = KM.insert+#else+insertMap :: Text -> v -> HM.HashMap Text v -> HM.HashMap Text v+insertMap = HM.insert+#endif ------------------------------------------------------------------------------- trivialScribe :: IO (Scribe, TVar Bool)
test/Katip/Tests/Scribes/Handle.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -57,14 +58,27 @@ withResource setupTempFile teardownTempFile $ \setupFn -> goldenVsString "Text-golden"- "test/Katip/Tests/Scribes/Handle-text.golden"+ goldenTextPath (setupFn >>= writeTextLog), withResource setupTempFile teardownTempFile $ \setupFn -> goldenVsString "Json-golden"- "test/Katip/Tests/Scribes/Handle-json.golden"+ goldenJsonPath (setupFn >>= writeJsonLog) ]++#if MIN_VERSION_aeson(2, 0, 0)+-- keys get reordered, hence different output+goldenTextPath :: FilePath+goldenTextPath = "test/Katip/Tests/Scribes/Handle-text-aeson2.golden"+goldenJsonPath :: FilePath+goldenJsonPath = "test/Katip/Tests/Scribes/Handle-json-aeson2.golden"+#else+goldenTextPath :: FilePath+goldenTextPath = "test/Katip/Tests/Scribes/Handle-text.golden"+goldenJsonPath :: FilePath+goldenJsonPath = "test/Katip/Tests/Scribes/Handle-json.golden"+#endif ------------------------------------------------------------------------------- data DummyLogItem = DummyLogItem