module Test.Hspec.Expectations.Json
( shouldMatchJson
, shouldBeJson
, shouldBeJsonNormalized
, Normalizer
, defaultNormalizer
, treatNullsAsMissing
, ignoreArrayOrdering
, subsetActualToExpected
, expandHeterogenousArrays
, shouldBeUnorderedJson
, shouldMatchOrderedJson
, matchesJson
) where
import Prelude
import Control.Monad (unless)
import Data.Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Bifunctor
import Data.Semigroup (Endo (..))
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Encoding (decodeUtf8)
import GHC.Stack
import Test.Hspec.Expectations.Json.Internal
( Subset (..)
, Superset (..)
, assertBoolWithDiff
, filterNullFields
, normalizeScientific
, pruneJson
, sortJsonArrays
)
import qualified Test.Hspec.Expectations.Json.Internal as Internal
newtype Actual a = Actual a
deriving (forall a b. a -> Actual b -> Actual a
forall a b. (a -> b) -> Actual a -> Actual b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Actual b -> Actual a
$c<$ :: forall a b. a -> Actual b -> Actual a
fmap :: forall a b. (a -> b) -> Actual a -> Actual b
$cfmap :: forall a b. (a -> b) -> Actual a -> Actual b
Functor)
newtype Expected a = Expected a
deriving (forall a b. a -> Expected b -> Expected a
forall a b. (a -> b) -> Expected a -> Expected b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Expected b -> Expected a
$c<$ :: forall a b. a -> Expected b -> Expected a
fmap :: forall a b. (a -> b) -> Expected a -> Expected b
$cfmap :: forall a b. (a -> b) -> Expected a -> Expected b
Functor)
newtype Normalizer = Normalizer
{ Normalizer -> Endo (Actual Value, Expected Value)
normalize :: Endo (Actual Value, Expected Value)
}
deriving newtype (NonEmpty Normalizer -> Normalizer
Normalizer -> Normalizer -> Normalizer
forall b. Integral b => b -> Normalizer -> Normalizer
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Normalizer -> Normalizer
$cstimes :: forall b. Integral b => b -> Normalizer -> Normalizer
sconcat :: NonEmpty Normalizer -> Normalizer
$csconcat :: NonEmpty Normalizer -> Normalizer
<> :: Normalizer -> Normalizer -> Normalizer
$c<> :: Normalizer -> Normalizer -> Normalizer
Semigroup, Semigroup Normalizer
Normalizer
[Normalizer] -> Normalizer
Normalizer -> Normalizer -> Normalizer
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Normalizer] -> Normalizer
$cmconcat :: [Normalizer] -> Normalizer
mappend :: Normalizer -> Normalizer -> Normalizer
$cmappend :: Normalizer -> Normalizer -> Normalizer
mempty :: Normalizer
$cmempty :: Normalizer
Monoid)
normalizeBoth :: (Value -> Value) -> Normalizer
normalizeBoth :: (Value -> Value) -> Normalizer
normalizeBoth Value -> Value
f = Endo (Actual Value, Expected Value) -> Normalizer
Normalizer forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
f) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
f)
treatNullsAsMissing :: Normalizer
treatNullsAsMissing :: Normalizer
treatNullsAsMissing = (Value -> Value) -> Normalizer
normalizeBoth Value -> Value
filterNullFields
ignoreArrayOrdering :: Normalizer
ignoreArrayOrdering :: Normalizer
ignoreArrayOrdering = (Value -> Value) -> Normalizer
normalizeBoth Value -> Value
sortJsonArrays
expandHeterogenousArrays :: Normalizer
expandHeterogenousArrays :: Normalizer
expandHeterogenousArrays = (Value -> Value) -> Normalizer
normalizeBoth Value -> Value
Internal.expandHeterogenousArrays
subsetActualToExpected :: Normalizer
subsetActualToExpected :: Normalizer
subsetActualToExpected = Endo (Actual Value, Expected Value) -> Normalizer
Normalizer forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo (Actual Value, Expected Value) -> (Actual Value, Expected Value)
go
where
go :: (Actual Value, Expected Value) -> (Actual Value, Expected Value)
go (Actual Value
a, Expected Value
b) =
let a' :: Value
a' = Superset -> Subset -> Value
pruneJson (Value -> Superset
Superset Value
a) (Value -> Subset
Subset Value
b)
in (forall a. a -> Actual a
Actual Value
a', forall a. a -> Expected a
Expected Value
b)
defaultNormalizer :: Normalizer
defaultNormalizer :: Normalizer
defaultNormalizer =
Normalizer
ignoreArrayOrdering forall a. Semigroup a => a -> a -> a
<> Normalizer
subsetActualToExpected
shouldBeJsonNormalized :: HasCallStack => Normalizer -> Value -> Value -> IO ()
shouldBeJsonNormalized :: HasCallStack => Normalizer -> Value -> Value -> IO ()
shouldBeJsonNormalized Normalizer
normalizer Value
a Value
b =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value
a forall a. Eq a => a -> a -> Bool
== Value
b) forall a b. (a -> b) -> a -> b
$
HasCallStack => Bool -> Text -> Text -> IO ()
assertBoolWithDiff (Value
a' 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encodePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
normalizeScientific
(Actual Value
a', Expected Value
b') = forall a. Endo a -> a -> a
appEndo (Normalizer -> Endo (Actual Value, Expected Value)
normalize Normalizer
normalizer) (forall a. a -> Actual a
Actual Value
a, forall a. a -> Expected a
Expected Value
b)
shouldBeJson :: HasCallStack => Value -> Value -> IO ()
shouldBeJson :: HasCallStack => Value -> Value -> IO ()
shouldBeJson = HasCallStack => Normalizer -> Value -> Value -> IO ()
shouldBeJsonNormalized forall a. Monoid a => a
mempty
infix 1 `shouldBeJson`
shouldBeUnorderedJson :: HasCallStack => Value -> Value -> IO ()
shouldBeUnorderedJson :: HasCallStack => Value -> Value -> IO ()
shouldBeUnorderedJson = HasCallStack => Normalizer -> Value -> Value -> IO ()
shouldBeJsonNormalized Normalizer
ignoreArrayOrdering
infix 1 `shouldBeUnorderedJson`
shouldMatchJson :: HasCallStack => Value -> Value -> IO ()
shouldMatchJson :: HasCallStack => Value -> Value -> IO ()
shouldMatchJson = HasCallStack => Normalizer -> Value -> Value -> IO ()
shouldBeJsonNormalized Normalizer
defaultNormalizer
infix 1 `shouldMatchJson`
matchesJson :: Value -> Value -> Bool
matchesJson :: Value -> Value -> Bool
matchesJson Value
sup Value
sub = Value
sup forall a. Eq a => a -> a -> Bool
== Value
sub Bool -> Bool -> Bool
|| Value
sup' forall a. Eq a => a -> a -> Bool
== Value
sub'
where
(Actual Value
sup', Expected Value
sub') = forall a. Endo a -> a -> a
appEndo (Normalizer -> Endo (Actual Value, Expected Value)
normalize Normalizer
defaultNormalizer) (forall a. a -> Actual a
Actual Value
sup, forall a. a -> Expected a
Expected Value
sub)
shouldMatchOrderedJson :: HasCallStack => Value -> Value -> IO ()
shouldMatchOrderedJson :: HasCallStack => Value -> Value -> IO ()
shouldMatchOrderedJson = HasCallStack => Normalizer -> Value -> Value -> IO ()
shouldBeJsonNormalized Normalizer
subsetActualToExpected
infix 1 `shouldMatchOrderedJson`