-- | Expectations on JSON 'Value's -- -- Semantics: -- -- +--------------------------+-------------------+-------------------+ -- | Assertion that fails on: | extra Object keys | wrong Array order + -- +==========================+===================+===================+ -- | 'shouldBeJson' | Yes | Yes | -- +--------------------------+-------------------+-------------------+ -- | 'shouldBeUnorderedJson' | Yes | No | -- +--------------------------+-------------------+-------------------+ -- | 'shouldMatchJson' | No | No | -- +--------------------------+-------------------+-------------------+ -- | 'shouldMatchOrderedJson' | No | Yes | -- +--------------------------+-------------------+-------------------+ -- module Test.Hspec.Expectations.Json ( shouldBeJson , shouldBeUnorderedJson , shouldMatchJson , shouldMatchOrderedJson -- * As predicates -- | These are only created when a specific need arises , matchesJson ) where import Prelude import Data.Aeson import Data.Aeson.Encode.Pretty (encodePretty) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Encoding (decodeUtf8) import GHC.Stack import Test.Hspec.Expectations.Json.Internal -- $setup -- >>> :set -XQuasiQuotes -- >>> import Data.Aeson.QQ (aesonQQ) -- >>> import Test.HUnit.Lang (HUnitFailure(..), formatFailureReason) -- >>> import Control.Exception (handle) -- >>> let printFailure (HUnitFailure _ r) = putStr $ formatFailureReason r -- >>> let catchFailure f = handle printFailure $ f >> putStrLn "<passed>" -- | Compare two JSON values, with a useful diff -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": true, "b": false } |] `shouldBeJson` -- [aesonQQ| { "a": true, "b": false } |] -- :} -- <passed> -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": true, "b": false } |] `shouldBeJson` -- [aesonQQ| { "a": true, "b": true } |] -- :} -- { -- "a": true, -- --- "b": true -- +++ "b": false -- } -- shouldBeJson :: HasCallStack => Value -> Value -> IO () shouldBeJson :: Value -> Value -> IO () shouldBeJson Value a Value b = HasCallStack => Bool -> Text -> Text -> IO () Bool -> Text -> Text -> IO () assertBoolWithDiff (Value a Value -> Value -> Bool forall a. Eq a => a -> a -> Bool == Value b) (Value -> Text toText Value b) (Value -> Text toText Value a) where toText :: Value -> Text toText = Text -> Text toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Text decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> ByteString forall a. ToJSON a => a -> ByteString encodePretty (Value -> ByteString) -> (Value -> Value) -> Value -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Value normalizeScientific infix 1 `shouldBeJson` -- | 'shouldBeJson', ignoring Array ordering -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": [true, false], "b": false } |] `shouldBeUnorderedJson` -- [aesonQQ| { "a": [false, true], "b": false } |] -- :} -- <passed> -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": [true, false], "b": false, "c": true } |] `shouldBeUnorderedJson` -- [aesonQQ| { "a": [false, true], "b": true } |] -- :} -- { -- "a": [ -- false, -- true -- ], -- --- "b": true -- +++ "b": false, -- +++ "c": true -- } -- shouldBeUnorderedJson :: HasCallStack => Value -> Value -> IO () shouldBeUnorderedJson :: Value -> Value -> IO () shouldBeUnorderedJson Value a Value b = Value -> Value sortJsonArrays Value a HasCallStack => Value -> Value -> IO () Value -> Value -> IO () `shouldBeJson` Value -> Value sortJsonArrays Value b infix 1 `shouldBeUnorderedJson` -- | 'shouldBeJson', ignoring extra Object keys or Array ordering -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": [true, false], "b": false, "c": true } |] `shouldMatchJson` -- [aesonQQ| { "a": [false, true], "b": false } |] -- :} -- <passed> -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": [true, false], "b": false, "c": true } |] `shouldMatchJson` -- [aesonQQ| { "a": [false, true], "b": true } |] -- :} -- { -- "a": [ -- false, -- true -- ], -- --- "b": true -- +++ "b": false -- } -- shouldMatchJson :: HasCallStack => Value -> Value -> IO () shouldMatchJson :: Value -> Value -> IO () shouldMatchJson Value sup Value sub = Value -> Value sortJsonArrays (Superset -> Subset -> Value pruneJson (Value -> Superset Superset Value sup) (Value -> Subset Subset Value sub)) HasCallStack => Value -> Value -> IO () Value -> Value -> IO () `shouldBeJson` Value -> Value sortJsonArrays Value sub infix 1 `shouldMatchJson` -- | Compare JSON values with the same semantics as 'shouldMatchJson' matchesJson :: Value -> Value -> Bool matchesJson :: Value -> Value -> Bool matchesJson Value sup Value sub = Value -> Value sortJsonArrays (Superset -> Subset -> Value pruneJson (Value -> Superset Superset Value sup) (Value -> Subset Subset Value sub)) Value -> Value -> Bool forall a. Eq a => a -> a -> Bool == Value -> Value sortJsonArrays Value sub -- | 'shouldBeJson', ignoring extra Object keys -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": [true, false], "b": false, "c": true } |] `shouldMatchOrderedJson` -- [aesonQQ| { "a": [true, false], "b": false } |] -- :} -- <passed> -- -- >>> :{ -- catchFailure $ -- [aesonQQ| { "a": [true, false], "b": false, "c": true } |] `shouldMatchOrderedJson` -- [aesonQQ| { "a": [false, true], "b": true } |] -- :} -- { -- "a": [ -- --- false, -- --- true -- +++ true, -- +++ false -- ], -- --- "b": true -- +++ "b": false -- } -- shouldMatchOrderedJson :: HasCallStack => Value -> Value -> IO () shouldMatchOrderedJson :: Value -> Value -> IO () shouldMatchOrderedJson Value sup Value sub = Superset -> Subset -> Value pruneJson (Value -> Superset Superset Value sup) (Value -> Subset Subset Value sub) HasCallStack => Value -> Value -> IO () Value -> Value -> IO () `shouldBeJson` Value sub infix 1 `shouldMatchOrderedJson`