mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-23 07:22:53 +03:00
61 lines
2.2 KiB
Haskell
61 lines
2.2 KiB
Haskell
|
-- | This module contains functions that help express expectations about json
|
||
|
|
-- values.
|
||
|
|
module Test.Aeson.Expectation
|
||
|
|
( shouldBeSubsetOf,
|
||
|
|
jsonSubsetOf,
|
||
|
|
)
|
||
|
|
where
|
||
|
|
|
||
|
|
import Data.Aeson qualified as A
|
||
|
|
import Data.Aeson.Encode.Pretty qualified as AP
|
||
|
|
import Data.Aeson.KeyMap qualified as A
|
||
|
|
import Data.ByteString.Lazy.Char8 qualified as LBS
|
||
|
|
import Data.Text qualified as T
|
||
|
|
import Data.Text.Encoding (decodeUtf8)
|
||
|
|
import Data.These
|
||
|
|
import Data.Vector qualified as V
|
||
|
|
import Hasura.Backends.Postgres.Instances.Schema ()
|
||
|
|
import Hasura.Prelude
|
||
|
|
import Test.Hspec
|
||
|
|
|
||
|
|
-- | Assert that one json value should be a subset of another, in the sense of 'jsonSubsetOf'.
|
||
|
|
shouldBeSubsetOf :: A.Value -> A.Value -> IO ()
|
||
|
|
shouldBeSubsetOf subset superset | subset `jsonSubsetOf` superset = return ()
|
||
|
|
shouldBeSubsetOf subset superset =
|
||
|
|
expectationFailure $
|
||
|
|
T.unpack $
|
||
|
|
decodeUtf8 $
|
||
|
|
LBS.toStrict $
|
||
|
|
AP.encodePretty subset <> " is not a subset of " <> AP.encodePretty superset
|
||
|
|
|
||
|
|
-- | Compute whether one json value 'sub' is a subset of another value 'sup', in the sense that:
|
||
|
|
--
|
||
|
|
-- * For arrays, there is a contiguous segment in 'sup' in which all elements are subset-related with 'sub' in order
|
||
|
|
-- * For objects, the keys of 'sub' are a subset of those of 'sup', and all their associated values are also subset-related
|
||
|
|
-- * Leaf values are identical
|
||
|
|
jsonSubsetOf :: A.Value -> A.Value -> Bool
|
||
|
|
jsonSubsetOf (A.Array sub) (A.Array sup) = sub `subarrayOf` sup
|
||
|
|
jsonSubsetOf (A.Object sub) (A.Object sup) = sub `subobjectOf` sup
|
||
|
|
jsonSubsetOf (A.String sub) (A.String sup) = sub == sup
|
||
|
|
jsonSubsetOf (A.Number sub) (A.Number sup) = sub == sup
|
||
|
|
jsonSubsetOf (A.Bool sub) (A.Bool sup) = sub == sup
|
||
|
|
jsonSubsetOf A.Null A.Null = True
|
||
|
|
jsonSubsetOf _sub _sup = False
|
||
|
|
|
||
|
|
subobjectOf :: A.KeyMap A.Value -> A.KeyMap A.Value -> Bool
|
||
|
|
subobjectOf sub sup =
|
||
|
|
A.foldr (&&) True $
|
||
|
|
A.alignWith
|
||
|
|
( \case
|
||
|
|
This _ -> False -- key is only in the sub
|
||
|
|
That _ -> True -- key is only in sup
|
||
|
|
These l r -> l `jsonSubsetOf` r
|
||
|
|
)
|
||
|
|
sub
|
||
|
|
sup
|
||
|
|
|
||
|
|
subarrayOf :: V.Vector A.Value -> V.Vector A.Value -> Bool
|
||
|
|
subarrayOf sub sup | V.length sub > V.length sup = False
|
||
|
|
subarrayOf sub sup | V.and $ V.zipWith jsonSubsetOf sub sup = True
|
||
|
|
subarrayOf sub sup = subarrayOf sub (V.tail sup)
|