{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Test.Morpheus.JSONDiff
  ( jsonEQ,
  )
where

import Data.Aeson (ToJSON (..), Value (..), encode)
import Data.ByteString.Lazy.Char8 (unpack)
import GHC.Show (Show (show))
import Relude hiding (ByteString, Show, show)
import Test.Tasty.HUnit (assertFailure)

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (keys, lookup)
# else
import Data.HashMap.Lazy (keys, lookup)
#endif

data Diff
  = DiffNode [(String, Diff)]
  | DiffLeaf Value Value

instance Show Diff where
  show :: Diff -> String
show (DiffNode [(String, Diff)]
xs) = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (String, a) -> String
showField [(String, Diff)]
xs)
    where
      showField :: (String, a) -> String
showField (String
k, a
v) = String
k forall a. Semigroup a => a -> a -> a
<> String
":\n  " forall a. Semigroup a => a -> a -> a
<> ShowS
indent (forall a. Show a => a -> String
show a
v)
  show (DiffLeaf Value
x Value
y) =
    String
"should be:"
      forall a. Semigroup a => a -> a -> a
<> forall a. ToJSON a => a -> String
showLeaf Value
x
      forall a. Semigroup a => a -> a -> a
<> String
"but it is:"
      forall a. Semigroup a => a -> a -> a
<> forall a. ToJSON a => a -> String
showLeaf Value
y

showLeaf :: ToJSON a => a -> [Char]
showLeaf :: forall a. ToJSON a => a -> String
showLeaf a
x = String
" " forall a. Semigroup a => a -> a -> a
<> ByteString -> String
unpack (forall a. ToJSON a => a -> ByteString
encode a
x) forall a. Semigroup a => a -> a -> a
<> String
"\n"

unescape :: String -> String
unescape :: ShowS
unescape = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f
  where
    f :: Char -> String
f Char
'\"' = String
""
    f Char
x = Char
x forall a. a -> [a] -> [a]
: String
""

indent :: String -> String
indent :: ShowS
indent = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f
  where
    f :: Char -> String
f Char
'\n' = String
"\n  "
    f Char
x = Char
x forall a. a -> [a] -> [a]
: String
""

diff :: (Value, Value) -> Maybe Diff
diff :: (Value, Value) -> Maybe Diff
diff (Object Object
beforeFields, Object Object
afterFields) = [(String, (Value, Value))] -> Maybe Diff
diffNode forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Key -> (String, (Value, Value))
toPair [Key]
ks
  where
    ks :: [Key]
ks = forall a. Eq a => [a] -> [a]
uniq (forall v. KeyMap v -> [Key]
keys (Object
beforeFields forall a. Semigroup a => a -> a -> a
<> Object
afterFields))
    toPair :: Key -> (String, (Value, Value))
toPair Key
key = (ShowS
unescape (forall a. Show a => a -> String
show Key
key), (Key -> Object -> Value
getField Key
key Object
beforeFields, Key -> Object -> Value
getField Key
key Object
afterFields))
    getField :: Key -> Object -> Value
getField Key
key = forall a. a -> Maybe a -> a
fromMaybe Value
Null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. Key -> KeyMap v -> Maybe v
lookup Key
key
diff (Array Array
beforeElems, Array Array
afterElems) = [(String, (Value, Value))] -> Maybe Diff
diffNode (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ks [(Value, Value)]
vs)
  where
    ks :: [String]
ks = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show ([Int
1 ..] :: [Int])
    vs :: [(Value, Value)]
vs = [Value] -> [Value] -> [(Value, Value)]
zipOptional (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
beforeElems) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
afterElems)
diff (Value
v1, Value
v2)
  | Value
v1 forall a. Eq a => a -> a -> Bool
== Value
v2 =
      forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (Value -> Value -> Diff
DiffLeaf Value
v1 Value
v2)

diffNode :: [(String, (Value, Value))] -> Maybe Diff
diffNode :: [(String, (Value, Value))] -> Maybe Diff
diffNode [(String, (Value, Value))]
values
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Diff)]
entries = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just ([(String, Diff)] -> Diff
DiffNode [(String, Diff)]
entries)
  where
    entries :: [(String, Diff)]
entries = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(String
key, (Value, Value)
value) -> (String
key,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value, Value) -> Maybe Diff
diff (Value, Value)
value) [(String, (Value, Value))]
values

uniq :: (Eq a) => [a] -> [a]
uniq :: forall a. Eq a => [a] -> [a]
uniq [] = []
uniq (a
x : [a]
xs)
  | forall a. Maybe a -> Bool
isJust (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs) = forall a. Eq a => [a] -> [a]
uniq [a]
xs
  | Bool
otherwise = a
x forall a. a -> [a] -> [a]
: forall a. Eq a => [a] -> [a]
uniq [a]
xs

jsonEQ :: ToJSON a => a -> a -> IO ()
jsonEQ :: forall a. ToJSON a => a -> a -> IO ()
jsonEQ a
expected a
actual = case (Value, Value) -> Maybe Diff
diff (forall a. ToJSON a => a -> Value
toJSON a
expected, forall a. ToJSON a => a -> Value
toJSON a
actual) of
  Just Diff
x -> forall a. HasCallStack => String -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ ShowS
indent forall a b. (a -> b) -> a -> b
$ String
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Diff
x forall a. Semigroup a => a -> a -> a
<> String
"\n"
  Maybe Diff
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

zipOptional :: [Value] -> [Value] -> [(Value, Value)]
zipOptional :: [Value] -> [Value] -> [(Value, Value)]
zipOptional [] [] = []
zipOptional (Value
x : [Value]
xs) [] = (Value
x, Value
Null) forall a. a -> [a] -> [a]
: [Value] -> [Value] -> [(Value, Value)]
zipOptional [Value]
xs []
zipOptional [] (Value
y : [Value]
ys) = (Value
Null, Value
y) forall a. a -> [a] -> [a]
: [Value] -> [Value] -> [(Value, Value)]
zipOptional [] [Value]
ys
zipOptional (Value
x : [Value]
xs) (Value
y : [Value]
ys) = (Value
x, Value
y) forall a. a -> [a] -> [a]
: [Value] -> [Value] -> [(Value, Value)]
zipOptional [Value]
xs [Value]
ys