{-# LANGUAGE CPP #-}
module Test.Hspec.Expectations.Json.Internal
(
assertBoolWithDiff
, Superset(..)
, Subset(..)
, pruneJson
, Sortable(..)
, sortJsonArrays
, vectorSortOn
, normalizeScientific
)
where
import Prelude
import Data.Aeson
#if MIN_VERSION_Diff(0,4,0)
import Data.Algorithm.Diff (PolyDiff(..), getDiff)
#else
import Data.Algorithm.Diff (Diff(..), getDiff)
#endif
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
#else
import qualified Data.HashMap.Strict as KeyMap
#endif
import Data.List (sortOn)
import qualified Data.Scientific as Scientific
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import GHC.Stack (HasCallStack)
import qualified Test.HUnit as HUnit
import Test.Hspec.Expectations.Json.Color
{-# ANN module ("HLint: ignore Avoid restricted qualification" :: String) #-}
assertBoolWithDiff :: HasCallStack => Bool -> Text -> Text -> IO ()
assertBoolWithDiff :: Bool -> Text -> Text -> IO ()
assertBoolWithDiff Bool
asserting Text
expected Text
got = do
Color -> String -> String
colorize <- IO (Color -> String -> String)
forall (m :: * -> *). MonadIO m => m (Color -> String -> String)
getColorize
(String -> Bool -> IO ()) -> Bool -> String -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
HUnit.assertBool Bool
asserting (String -> IO ())
-> ([PolyDiff String String] -> String)
-> [PolyDiff String String]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([PolyDiff String String] -> [String])
-> [PolyDiff String String]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PolyDiff String String -> String)
-> [PolyDiff String String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Color -> String -> String) -> PolyDiff String String -> String
forall p. (Color -> String -> p) -> PolyDiff String String -> p
addSign Color -> String -> String
colorize) ([PolyDiff String String] -> IO ())
-> [PolyDiff String String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [PolyDiff String String]
forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff
(String -> [String]
lines (Text -> String
T.unpack Text
expected))
(String -> [String]
lines (Text -> String
T.unpack Text
got))
where
addSign :: (Color -> String -> p) -> PolyDiff String String -> p
addSign Color -> String -> p
colorize = \case
Both String
_ String
s -> Color -> String -> p
colorize Color
Reset (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
First String
s -> Color -> String -> p
colorize Color
Red (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"---" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
Second String
s -> Color -> String -> p
colorize Color
Green (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"+++" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
newtype Superset = Superset Value
newtype Subset = Subset Value
pruneJson :: Superset -> Subset -> Value
pruneJson :: Superset -> Subset -> Value
pruneJson (Superset Value
sup) (Subset Value
sub) = case (Value
sup, Value
sub) of
(Object Object
a, Object Object
b) -> Object -> Value
Object
(Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value -> Value) -> Object -> Object -> Object
forall a b c. (a -> b -> c) -> KeyMap a -> KeyMap b -> KeyMap c
KeyMap.intersectionWith (\Value
x Value
y -> Superset -> Subset -> Value
pruneJson (Value -> Superset
Superset Value
x) (Value -> Subset
Subset Value
y)) Object
a Object
b
(Array Array
a, Array Array
b) -> Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ case Array
b Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
V.!? Int
0 of
Maybe Value
Nothing -> Array
a
Just Value
y -> (\Value
x -> Superset -> Subset -> Value
pruneJson (Value -> Superset
Superset Value
x) (Value -> Subset
Subset Value
y)) (Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array
a
(Value
x, Value
_) -> Value
x
newtype Sortable = Sortable Value
deriving newtype Sortable -> Sortable -> Bool
(Sortable -> Sortable -> Bool)
-> (Sortable -> Sortable -> Bool) -> Eq Sortable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sortable -> Sortable -> Bool
$c/= :: Sortable -> Sortable -> Bool
== :: Sortable -> Sortable -> Bool
$c== :: Sortable -> Sortable -> Bool
Eq
instance Ord Sortable where
Sortable Value
a compare :: Sortable -> Sortable -> Ordering
`compare` Sortable Value
b = case (Value
a, Value
b) of
(String Text
x, String Text
y) -> Text
x Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text
y
(Number Scientific
x, Number Scientific
y) -> Scientific
x Scientific -> Scientific -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Scientific
y
(Bool Bool
x, Bool Bool
y) -> Bool
x Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Bool
y
(Value
Null, Value
Null) -> Ordering
EQ
(Array Array
x, Array Array
y) -> (Value -> Sortable) -> Array -> Vector Sortable
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Sortable
Sortable Array
x Vector Sortable -> Vector Sortable -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Value -> Sortable) -> Array -> Vector Sortable
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Sortable
Sortable Array
y
(Object Object
x, Object Object
y) ->
(Value -> Sortable
Sortable (Value -> Sortable) -> Object -> KeyMap Sortable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x) KeyMap Sortable -> KeyMap Sortable -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Value -> Sortable
Sortable (Value -> Sortable) -> Object -> KeyMap Sortable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
y)
(Value
x, Value
y) -> Value -> Int
arbitraryRank Value
x Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Value -> Int
arbitraryRank Value
y
where
arbitraryRank :: Value -> Int
arbitraryRank :: Value -> Int
arbitraryRank = \case
Object{} -> Int
5
Array{} -> Int
4
String{} -> Int
3
Number{} -> Int
2
Bool{} -> Int
1
Value
Null -> Int
0
sortJsonArrays :: Value -> Value
sortJsonArrays :: Value -> Value
sortJsonArrays = \case
Array Array
v -> Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Sortable) -> Array -> Array
forall b a. Ord b => (a -> b) -> Vector a -> Vector a
vectorSortOn Value -> Sortable
Sortable (Array -> Array) -> Array -> Array
forall a b. (a -> b) -> a -> b
$ Value -> Value
sortJsonArrays (Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array
v
Object Object
hm -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
sortJsonArrays (Value -> Value) -> Object -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
hm
x :: Value
x@String{} -> Value
x
x :: Value
x@Number{} -> Value
x
x :: Value
x@Bool{} -> Value
x
x :: Value
x@Null{} -> Value
x
vectorSortOn :: Ord b => (a -> b) -> Vector a -> Vector a
vectorSortOn :: (a -> b) -> Vector a -> Vector a
vectorSortOn a -> b
f Vector a
v = Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
sorted
where sorted :: [a]
sorted = (a -> b) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn a -> b
f ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
v
normalizeScientific :: Value -> Value
normalizeScientific :: Value -> Value
normalizeScientific = \case
Object Object
hm -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
normalizeScientific (Value -> Value) -> Object -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
hm
Array Array
vs -> Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
normalizeScientific (Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array
vs
x :: Value
x@String{} -> Value
x
Number Scientific
sci ->
Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ RealFloat Double => Double -> Scientific
forall a. RealFloat a => a -> Scientific
Scientific.fromFloatDigits @Double (Double -> Scientific) -> Double -> Scientific
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
sci
x :: Value
x@Bool{} -> Value
x
x :: Value
x@Value
Null -> Value
x