added unit test for null value suppression

Author: kostmo

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

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

test/data/suppress-nulls/input.json

@@ -0,0 +1 @@
+{"bar": null, "foo": "blah"}

test/data/suppress-nulls/null-values-allowed.json

@@ -0,0 +1,4 @@
+{
+    "bar": null,
+    "foo": "blah"
+}

test/data/suppress-nulls/null-values-suppressed.json

@@ -0,0 +1,3 @@
+{
+    "foo": "blah"
+}

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