content: {-# 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 (DiffNode xs) = intercalate "\n" (map showField xs)
      where
        showField (k, v) = k <> ":\n  " <> indent (show v)
    show (DiffLeaf x y) =
      "should be:"
        <> showLeaf x
        <> "but it is:"
        <> showLeaf y
  
  showLeaf :: (ToJSON a) => a -> [Char]
  showLeaf x = " " <> unpack (encode x) <> "\n"
  
  unescape :: String -> String
  unescape = concatMap f
    where
      f '\"' = ""
      f x = x : ""
  
  indent :: String -> String
  indent = concatMap f
    where
      f '\n' = "\n  "
      f x = x : ""
  
  diff :: (Value, Value) -> Maybe Diff
  diff (Object beforeFields, Object afterFields) = diffNode $ map toPair ks
    where
      ks = uniq (keys (beforeFields <> afterFields))
      toPair key = (unescape (show key), (getField key beforeFields, getField key afterFields))
      getField key = fromMaybe Null . lookup key
  diff (Array beforeElems, Array afterElems) = diffNode (zip ks vs)
    where
      ks = map show ([1 ..] :: [Int])
      vs = zipOptional (toList beforeElems) (toList afterElems)
  diff (v1, v2)
    | v1 == v2 =
        Nothing
    | otherwise = Just (DiffLeaf v1 v2)
  
  diffNode :: [(String, (Value, Value))] -> Maybe Diff
  diffNode values
    | null entries = Nothing
    | otherwise = Just (DiffNode entries)
    where
      entries = mapMaybe (\(key, value) -> (key,) <$> diff value) values
  
  uniq :: (Eq a) => [a] -> [a]
  uniq [] = []
  uniq (x : xs)
    | isJust (find (== x) xs) = uniq xs
    | otherwise = x : uniq xs
  
  jsonEQ :: (ToJSON a) => a -> a -> IO ()
  jsonEQ expected actual = case diff (toJSON expected, toJSON actual) of
    Just x -> assertFailure $ indent $ "\n" <> show x <> "\n"
    Nothing -> pure ()
  
  zipOptional :: [Value] -> [Value] -> [(Value, Value)]
  zipOptional [] [] = []
  zipOptional (x : xs) [] = (x, Null) : zipOptional xs []
  zipOptional [] (y : ys) = (Null, y) : zipOptional [] ys
  zipOptional (x : xs) (y : ys) = (x, y) : zipOptional xs ys
  