From 01f9d3bf3b94f375f9c4b1603aed58f570ca136b Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sun, 22 May 2016 03:03:14 -0700 Subject: [PATCH 1/2] Optionally suppress keys with null values Closes #16. --- Data/Aeson/Encode/Pretty.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/Data/Aeson/Encode/Pretty.hs b/Data/Aeson/Encode/Pretty.hs index c996f24..7f0c104 100644 --- a/Data/Aeson/Encode/Pretty.hs +++ b/Data/Aeson/Encode/Pretty.hs @@ -70,6 +70,7 @@ import qualified Data.Vector as V (toList) data PState = PState { pstIndent :: Int , pstLevel :: Int , pstSort :: [(Text, Value)] -> [(Text, Value)] + , pstNullValues :: Bool } data Config = Config @@ -77,6 +78,8 @@ data Config = Config -- ^ Indentation spaces per level of nesting , confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects + , confNullValues :: Bool + -- ^ Set to 'False' to suppress object pairs with null values. Compare to } -- |Sort keys by their order of appearance in the argument list. @@ -94,7 +97,7 @@ keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks) -- -- > defConfig = Config { confIndent = 4, confCompare = mempty } defConfig :: Config -defConfig = Config { confIndent = 4, confCompare = mempty } +defConfig = Config { confIndent = 4, confCompare = mempty, confNullValues = True } -- |A drop-in replacement for aeson's 'Aeson.encode' function, producing -- JSON-ByteStrings for human readers. @@ -120,7 +123,7 @@ encodePrettyToTextBuilder = encodePrettyToTextBuilder' defConfig encodePrettyToTextBuilder' :: ToJSON a => Config -> a -> Builder encodePrettyToTextBuilder' Config{..} = fromValue st . toJSON where - st = PState confIndent 0 condSort + st = PState confIndent 0 condSort confNullValues condSort = sortBy (confCompare `on` fst) @@ -128,7 +131,11 @@ fromValue :: PState -> Value -> Builder fromValue st@PState{..} = go where go (Array v) = fromCompound st ("[","]") fromValue (V.toList v) - go (Object m) = fromCompound st ("{","}") fromPair (pstSort (H.toList m)) + go (Object m) = fromCompound st ("{","}") fromPair (pstSort filtered_pairs) + where original_pairs = H.toList m + filtered_pairs = if pstNullValues + then original_pairs + else filter (\(_, v) -> v /= Null) original_pairs go v = Aeson.encodeToTextBuilder v fromCompound :: PState From 33eb8e39a6375dec840159587742940a07d6faaf Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sun, 22 May 2016 03:03:45 -0700 Subject: [PATCH 2/2] added unit test for null value suppression --- Data/Aeson/Encode/Pretty.hs | 10 ++-- aeson-pretty.cabal | 21 ++++++++ test/data/suppress-nulls/input.json | 1 + .../suppress-nulls/null-values-allowed.json | 4 ++ .../null-values-suppressed.json | 3 ++ test/src/RunTest.hs | 48 +++++++++++++++++++ 6 files changed, 82 insertions(+), 5 deletions(-) create mode 100644 test/data/suppress-nulls/input.json create mode 100644 test/data/suppress-nulls/null-values-allowed.json create mode 100644 test/data/suppress-nulls/null-values-suppressed.json create mode 100644 test/src/RunTest.hs diff --git a/Data/Aeson/Encode/Pretty.hs b/Data/Aeson/Encode/Pretty.hs index 7f0c104..7ee301c 100644 --- a/Data/Aeson/Encode/Pretty.hs +++ b/Data/Aeson/Encode/Pretty.hs @@ -48,7 +48,7 @@ module Data.Aeson.Encode.Pretty ( -- |Serves as an order-preserving (non-)sort function. Re-exported from -- "Data.Monoid". compare, - -- |Sort keys in their natural order, i.e. by comparing character codes. + -- |Sort keys in standard "ASCIIbetical" order, i.e. by comparing character codes. -- Re-exported from the Prelude and "Data.Ord" keyOrder ) where @@ -70,7 +70,7 @@ import qualified Data.Vector as V (toList) data PState = PState { pstIndent :: Int , pstLevel :: Int , pstSort :: [(Text, Value)] -> [(Text, Value)] - , pstNullValues :: Bool + , pstNullValues :: Bool -- ^ allow keys with null values in the output } data Config = Config @@ -93,9 +93,9 @@ keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks) -- |The default configuration: indent by four spaces per level of nesting, do --- not sort objects by key. +-- not sort objects by key, and preserve keys with null values. -- --- > defConfig = Config { confIndent = 4, confCompare = mempty } +-- > defConfig = Config { confIndent = 4, confCompare = mempty, confNullValues = True } defConfig :: Config defConfig = Config { confIndent = 4, confCompare = mempty, confNullValues = True } @@ -135,7 +135,7 @@ fromValue st@PState{..} = go where original_pairs = H.toList m filtered_pairs = if pstNullValues then original_pairs - else filter (\(_, v) -> v /= Null) original_pairs + else filter (\p -> (snd p) /= Null) original_pairs go v = Aeson.encodeToTextBuilder v fromCompound :: PState diff --git a/aeson-pretty.cabal b/aeson-pretty.cabal index 2b69fc2..b33212c 100644 --- a/aeson-pretty.cabal +++ b/aeson-pretty.cabal @@ -67,6 +67,27 @@ executable aeson-pretty ghc-options: -Wall ghc-prof-options: -auto-all +test-suite aeson-pretty-tests + hs-source-dirs: test/src + main-is: RunTest.hs + + type: exitcode-stdio-1.0 + build-depends: + aeson >= 0.6, + aeson-pretty, + base == 4.*, + bytestring >= 0.9, + containers, + filepath, + HUnit, + MissingH, + test-framework, + test-framework-hunit, + utf8-string + + ghc-options: -Wall + ghc-prof-options: -auto-all + source-repository head type: git location: http://github.com/informatikr/aeson-pretty diff --git a/test/data/suppress-nulls/input.json b/test/data/suppress-nulls/input.json new file mode 100644 index 0000000..fbe8631 --- /dev/null +++ b/test/data/suppress-nulls/input.json @@ -0,0 +1 @@ +{"bar": null, "foo": "blah"} diff --git a/test/data/suppress-nulls/null-values-allowed.json b/test/data/suppress-nulls/null-values-allowed.json new file mode 100644 index 0000000..b0336f4 --- /dev/null +++ b/test/data/suppress-nulls/null-values-allowed.json @@ -0,0 +1,4 @@ +{ + "bar": null, + "foo": "blah" +} diff --git a/test/data/suppress-nulls/null-values-suppressed.json b/test/data/suppress-nulls/null-values-suppressed.json new file mode 100644 index 0000000..fc90464 --- /dev/null +++ b/test/data/suppress-nulls/null-values-suppressed.json @@ -0,0 +1,3 @@ +{ + "foo": "blah" +} diff --git a/test/src/RunTest.hs b/test/src/RunTest.hs new file mode 100644 index 0000000..8857026 --- /dev/null +++ b/test/src/RunTest.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Test.Framework +import Test.Framework.Providers.HUnit + +import Data.Aeson +import Data.Aeson.Encode.Pretty +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.UTF8 as U (toString) +import Data.Map (Map) +import Test.HUnit (assertEqual) +import System.FilePath.Posix +import Data.String.Utils (rstrip) + +testDataDir :: FilePath +testDataDir = "test/data/suppress-nulls" + +eitherDecodeMap :: IO (Map String (Maybe String)) +eitherDecodeMap = do + d <- eitherDecode <$> B.readFile (testDataDir "input.json") + case d of + Left err -> error $ "ERROR: " ++ err + Right val -> return val + + +prettifyMap :: Bool -> Map String (Maybe String) -> String +prettifyMap s m = U.toString $ encodePretty' (Config 4 compare s) m + + +testEquality :: Bool -> FilePath -> IO () +testEquality suppress data_filename = do + vals <- eitherDecodeMap + let pretty_output_computed = prettifyMap suppress vals + reference_output_file_content <- readFile $ testDataDir data_filename + let pretty_output_expected = rstrip $ reference_output_file_content + + assertEqual "Checking equality..." pretty_output_expected pretty_output_computed + + +tests = [ + testGroup "Null value suppression" [ + testCase "nulls-allowed" $ testEquality True "null-values-allowed.json" + , testCase "nulls-suppressed" $ testEquality False "null-values-suppressed.json" + ] + ] + + +main = defaultMain tests