{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Aeson.Match.QQ.Internal.Match where

import           Control.Applicative (liftA2)
import           Control.Monad (unless)
import           Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as Aeson (toHashMapText)
import           Data.Either.Validation (Validation, eitherToValidation)
import           Data.Foldable (for_)
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           Data.List.NonEmpty (NonEmpty)
import           Data.String (IsString(..))
import           Data.Text (Text)
import           Data.Vector (Vector)
import qualified Data.Vector as Vector
import           Prelude hiding (any, null)

import           Aeson.Match.QQ.Internal.Value (Value(..), Box(..), TypeSig(..), Type(..), Nullable(..))


match :: Value Aeson.Value -> Aeson.Value -> Validation (NonEmpty VE) (HashMap Text Aeson.Value)
match :: Value Value
-> Value -> Validation (NonEmpty VE) (HashMap Text Value)
match =
  [PathElem]
-> Value Value
-> Value
-> Validation (NonEmpty VE) (HashMap Text Value)
go []
 where
  go :: [PathElem]
-> Value Value
-> Value
-> Validation (NonEmpty VE) (HashMap Text Value)
go [PathElem]
path Value Value
matcher Value
given = do
    let mismatched :: Validation (NonEmpty VE) a
mismatched = [PathElem] -> Value Value -> Value -> Validation (NonEmpty VE) a
forall a.
[PathElem] -> Value Value -> Value -> Validation (NonEmpty VE) a
mismatch ([PathElem] -> [PathElem]
forall a. [a] -> [a]
reverse [PathElem]
path) Value Value
matcher Value
given
    case (Value Value
matcher, Value
given) of
      (Any Maybe TypeSig
holeTypeO Maybe Text
nameO, Value
val) -> do
        Maybe TypeSig
-> (TypeSig -> Validation (NonEmpty VE) ())
-> Validation (NonEmpty VE) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TypeSig
holeTypeO ((TypeSig -> Validation (NonEmpty VE) ())
 -> Validation (NonEmpty VE) ())
-> (TypeSig -> Validation (NonEmpty VE) ())
-> Validation (NonEmpty VE) ()
forall a b. (a -> b) -> a -> b
$ \TypeSig
holeType ->
          Bool -> Validation (NonEmpty VE) () -> Validation (NonEmpty VE) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TypeSig -> Value -> Bool
holeTypeMatch TypeSig
holeType Value
val)
            Validation (NonEmpty VE) ()
forall a. Validation (NonEmpty VE) a
mismatched
        pure (HashMap Text Value
-> (Text -> HashMap Text Value) -> Maybe Text -> HashMap Text Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap Text Value
forall a. Monoid a => a
mempty (\Text
name -> Text -> Value -> HashMap Text Value
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
name Value
val) Maybe Text
nameO)
      (Value Value
Null, Value
Aeson.Null) ->
        HashMap Text Value -> Validation (NonEmpty VE) (HashMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Value Value
Null, Value
_) -> do
        Validation (NonEmpty VE) Any
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Bool Bool
b, Aeson.Bool Bool
b') -> do
        Bool -> Validation (NonEmpty VE) () -> Validation (NonEmpty VE) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b') Validation (NonEmpty VE) ()
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Bool Bool
_, Value
_) -> do
        Validation (NonEmpty VE) Any
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Number Scientific
n, Aeson.Number Scientific
n') -> do
        Bool -> Validation (NonEmpty VE) () -> Validation (NonEmpty VE) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Scientific
n Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
n') Validation (NonEmpty VE) ()
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Number Scientific
_, Value
_) -> do
        Validation (NonEmpty VE) Any
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (String Text
str, Aeson.String Text
str') -> do
        Bool -> Validation (NonEmpty VE) () -> Validation (NonEmpty VE) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
str Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
str') Validation (NonEmpty VE) ()
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (String Text
_, Value
_) -> do
        Validation (NonEmpty VE) Any
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Array Box {Vector (Value Value)
knownValues :: forall a. Box a -> a
knownValues :: Vector (Value Value)
knownValues, Bool
extendable :: forall a. Box a -> Bool
extendable :: Bool
extendable}, Aeson.Array Array
arr) ->
        let fold :: (Int -> t -> f (HashMap k v)) -> Vector t -> f (HashMap k v)
fold Int -> t -> f (HashMap k v)
f =
              (Int -> t -> f (HashMap k v) -> f (HashMap k v))
-> f (HashMap k v) -> Vector t -> f (HashMap k v)
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
Vector.ifoldr (\Int
i t
v f (HashMap k v)
a -> (HashMap k v -> HashMap k v -> HashMap k v)
-> f (HashMap k v) -> f (HashMap k v) -> f (HashMap k v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 HashMap k v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union f (HashMap k v)
a (Int -> t -> f (HashMap k v)
f Int
i t
v)) (HashMap k v -> f (HashMap k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v
forall a. Monoid a => a
mempty)
            extraValues :: Array
extraValues =
              Int -> Array -> Array
forall a. Int -> Vector a -> Vector a
Vector.drop (Vector (Value Value) -> Int
forall a. Vector a -> Int
Vector.length Vector (Value Value)
knownValues) Array
arr
        in
          Bool -> Validation (NonEmpty VE) () -> Validation (NonEmpty VE) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
            (Bool
extendable Bool -> Bool -> Bool
|| Array -> Bool
forall a. Vector a -> Bool
Vector.null Array
extraValues)
            ([PathElem] -> Array -> Validation (NonEmpty VE) ()
forall a. [PathElem] -> Array -> Validation (NonEmpty VE) a
extraArrayValues ([PathElem] -> [PathElem]
forall a. [a] -> [a]
reverse [PathElem]
path) Array
extraValues) Validation (NonEmpty VE) ()
-> Validation (NonEmpty VE) (HashMap Text Value)
-> Validation (NonEmpty VE) (HashMap Text Value)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
          (Int
 -> Value Value -> Validation (NonEmpty VE) (HashMap Text Value))
-> Vector (Value Value)
-> Validation (NonEmpty VE) (HashMap Text Value)
forall (f :: * -> *) k t v.
(Applicative f, Eq k, Hashable k) =>
(Int -> t -> f (HashMap k v)) -> Vector t -> f (HashMap k v)
fold
            (\Int
i Value Value
v -> Validation (NonEmpty VE) (HashMap Text Value)
-> (Value -> Validation (NonEmpty VE) (HashMap Text Value))
-> Maybe Value
-> Validation (NonEmpty VE) (HashMap Text Value)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([PathElem]
-> PathElem -> Validation (NonEmpty VE) (HashMap Text Value)
forall a. [PathElem] -> PathElem -> Validation (NonEmpty VE) a
missingPathElem ([PathElem] -> [PathElem]
forall a. [a] -> [a]
reverse [PathElem]
path) (Int -> PathElem
Idx Int
i)) ([PathElem]
-> Value Value
-> Value
-> Validation (NonEmpty VE) (HashMap Text Value)
go (Int -> PathElem
Idx Int
i PathElem -> [PathElem] -> [PathElem]
forall a. a -> [a] -> [a]
: [PathElem]
path) Value Value
v) (Array
arr Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
i))
            Vector (Value Value)
knownValues
      (Array Box (Vector (Value Value))
_, Value
_) -> do
        Validation (NonEmpty VE) Any
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Object Box {HashMap Text (Value Value)
knownValues :: HashMap Text (Value Value)
knownValues :: forall a. Box a -> a
knownValues, Bool
extendable :: Bool
extendable :: forall a. Box a -> Bool
extendable}, Aeson.Object (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
Aeson.toHashMapText -> HashMap Text Value
o)) ->
        let fold :: (t -> t -> f (HashMap k v)) -> HashMap t t -> f (HashMap k v)
fold t -> t -> f (HashMap k v)
f =
              (t -> t -> f (HashMap k v) -> f (HashMap k v))
-> f (HashMap k v) -> HashMap t t -> f (HashMap k v)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey (\t
k t
v f (HashMap k v)
a -> (HashMap k v -> HashMap k v -> HashMap k v)
-> f (HashMap k v) -> f (HashMap k v) -> f (HashMap k v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 HashMap k v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union f (HashMap k v)
a (t -> t -> f (HashMap k v)
f t
k t
v)) (HashMap k v -> f (HashMap k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v
forall a. Monoid a => a
mempty)
            extraValues :: HashMap Text Value
extraValues =
              HashMap Text Value
-> HashMap Text (Value Value) -> HashMap Text Value
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference HashMap Text Value
o HashMap Text (Value Value)
knownValues
        in
          Bool -> Validation (NonEmpty VE) () -> Validation (NonEmpty VE) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
            (Bool
extendable Bool -> Bool -> Bool
|| HashMap Text Value -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Text Value
extraValues)
            ([PathElem] -> HashMap Text Value -> Validation (NonEmpty VE) ()
forall a.
[PathElem] -> HashMap Text Value -> Validation (NonEmpty VE) a
extraObjectValues ([PathElem] -> [PathElem]
forall a. [a] -> [a]
reverse [PathElem]
path) HashMap Text Value
extraValues) Validation (NonEmpty VE) ()
-> Validation (NonEmpty VE) (HashMap Text Value)
-> Validation (NonEmpty VE) (HashMap Text Value)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
          (Text
 -> Value Value -> Validation (NonEmpty VE) (HashMap Text Value))
-> HashMap Text (Value Value)
-> Validation (NonEmpty VE) (HashMap Text Value)
forall (f :: * -> *) k t t v.
(Applicative f, Eq k, Hashable k) =>
(t -> t -> f (HashMap k v)) -> HashMap t t -> f (HashMap k v)
fold
            (\Text
k Value Value
v -> Validation (NonEmpty VE) (HashMap Text Value)
-> (Value -> Validation (NonEmpty VE) (HashMap Text Value))
-> Maybe Value
-> Validation (NonEmpty VE) (HashMap Text Value)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([PathElem]
-> PathElem -> Validation (NonEmpty VE) (HashMap Text Value)
forall a. [PathElem] -> PathElem -> Validation (NonEmpty VE) a
missingPathElem ([PathElem] -> [PathElem]
forall a. [a] -> [a]
reverse [PathElem]
path) (Text -> PathElem
Key Text
k)) ([PathElem]
-> Value Value
-> Value
-> Validation (NonEmpty VE) (HashMap Text Value)
go (Text -> PathElem
Key Text
k PathElem -> [PathElem] -> [PathElem]
forall a. a -> [a] -> [a]
: [PathElem]
path) Value Value
v) (Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
k HashMap Text Value
o))
            HashMap Text (Value Value)
knownValues
      (Object Box (HashMap Text (Value Value))
_, Value
_) -> do
        Validation (NonEmpty VE) Any
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty
      (Ext Value
val, Value
val') -> do
        Bool -> Validation (NonEmpty VE) () -> Validation (NonEmpty VE) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
val') Validation (NonEmpty VE) ()
forall a. Validation (NonEmpty VE) a
mismatched
        pure HashMap Text Value
forall a. Monoid a => a
mempty

holeTypeMatch :: TypeSig -> Aeson.Value -> Bool
holeTypeMatch :: TypeSig -> Value -> Bool
holeTypeMatch TypeSig
type_ Value
val =
  case (TypeSig
type_, Value
val) of
    (TypeSig {nullable :: TypeSig -> Nullable
nullable = Nullable
Nullable}, Value
Aeson.Null) -> Bool
True
    (TypeSig {type_ :: TypeSig -> Type
type_ = Type
BoolT} , Aeson.Bool {}) -> Bool
True
    (TypeSig {type_ :: TypeSig -> Type
type_ = Type
NumberT} , Aeson.Number {}) -> Bool
True
    (TypeSig {type_ :: TypeSig -> Type
type_ = Type
StringT} , Aeson.String {}) -> Bool
True
    (TypeSig {type_ :: TypeSig -> Type
type_ = Type
ArrayT} , Aeson.Array {}) -> Bool
True
    (TypeSig {type_ :: TypeSig -> Type
type_ = Type
ObjectT} , Aeson.Object {}) -> Bool
True
    (TypeSig
_, Value
_) -> Bool
False

mismatch :: Path -> Value Aeson.Value -> Aeson.Value -> Validation (NonEmpty VE) a
mismatch :: [PathElem] -> Value Value -> Value -> Validation (NonEmpty VE) a
mismatch [PathElem]
path Value Value
matcher Value
given =
  VE -> Validation (NonEmpty VE) a
forall e a. e -> Validation (NonEmpty e) a
throwE (Mismatch -> VE
Mismatch MkMismatch :: [PathElem] -> Value Value -> Value -> Mismatch
MkMismatch {[PathElem]
Value
Value Value
$sel:given:MkMismatch :: Value
$sel:matcher:MkMismatch :: Value Value
$sel:path:MkMismatch :: [PathElem]
given :: Value
matcher :: Value Value
path :: [PathElem]
..})

missingPathElem :: Path -> PathElem -> Validation (NonEmpty VE) a
missingPathElem :: [PathElem] -> PathElem -> Validation (NonEmpty VE) a
missingPathElem [PathElem]
path PathElem
missing =
  VE -> Validation (NonEmpty VE) a
forall e a. e -> Validation (NonEmpty e) a
throwE (MissingPathElem -> VE
MissingPathElem MkMissingPathElem :: [PathElem] -> PathElem -> MissingPathElem
MkMissingPathElem {[PathElem]
PathElem
$sel:missing:MkMissingPathElem :: PathElem
$sel:path:MkMissingPathElem :: [PathElem]
missing :: PathElem
path :: [PathElem]
..})

extraArrayValues :: Path -> Vector Aeson.Value -> Validation (NonEmpty VE) a
extraArrayValues :: [PathElem] -> Array -> Validation (NonEmpty VE) a
extraArrayValues [PathElem]
path Array
values =
  VE -> Validation (NonEmpty VE) a
forall e a. e -> Validation (NonEmpty e) a
throwE (ExtraArrayValues -> VE
ExtraArrayValues MkExtraArrayValues :: [PathElem] -> Array -> ExtraArrayValues
MkExtraArrayValues {[PathElem]
Array
$sel:values:MkExtraArrayValues :: Array
$sel:path:MkExtraArrayValues :: [PathElem]
values :: Array
path :: [PathElem]
..})

extraObjectValues :: Path -> HashMap Text Aeson.Value -> Validation (NonEmpty VE) a
extraObjectValues :: [PathElem] -> HashMap Text Value -> Validation (NonEmpty VE) a
extraObjectValues [PathElem]
path HashMap Text Value
values =
  VE -> Validation (NonEmpty VE) a
forall e a. e -> Validation (NonEmpty e) a
throwE (ExtraObjectValues -> VE
ExtraObjectValues MkExtraObjectValues :: [PathElem] -> HashMap Text Value -> ExtraObjectValues
MkExtraObjectValues {[PathElem]
HashMap Text Value
$sel:values:MkExtraObjectValues :: HashMap Text Value
$sel:path:MkExtraObjectValues :: [PathElem]
values :: HashMap Text Value
path :: [PathElem]
..})

throwE :: e -> Validation (NonEmpty e) a
throwE :: e -> Validation (NonEmpty e) a
throwE =
  Either (NonEmpty e) a -> Validation (NonEmpty e) a
forall e a. Either e a -> Validation e a
eitherToValidation (Either (NonEmpty e) a -> Validation (NonEmpty e) a)
-> (e -> Either (NonEmpty e) a) -> e -> Validation (NonEmpty e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty e -> Either (NonEmpty e) a
forall a b. a -> Either a b
Left (NonEmpty e -> Either (NonEmpty e) a)
-> (e -> NonEmpty e) -> e -> Either (NonEmpty e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> NonEmpty e
forall (f :: * -> *) a. Applicative f => a -> f a
pure

data VE
  = Mismatch Mismatch
  | MissingPathElem MissingPathElem
  | ExtraArrayValues ExtraArrayValues
  | ExtraObjectValues ExtraObjectValues
    deriving (Int -> VE -> ShowS
[VE] -> ShowS
VE -> String
(Int -> VE -> ShowS)
-> (VE -> String) -> ([VE] -> ShowS) -> Show VE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VE] -> ShowS
$cshowList :: [VE] -> ShowS
show :: VE -> String
$cshow :: VE -> String
showsPrec :: Int -> VE -> ShowS
$cshowsPrec :: Int -> VE -> ShowS
Show, VE -> VE -> Bool
(VE -> VE -> Bool) -> (VE -> VE -> Bool) -> Eq VE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VE -> VE -> Bool
$c/= :: VE -> VE -> Bool
== :: VE -> VE -> Bool
$c== :: VE -> VE -> Bool
Eq)

instance Aeson.ToJSON VE where
  toJSON :: VE -> Value
toJSON =
    [Pair] -> Value
Aeson.object ([Pair] -> Value) -> (VE -> [Pair]) -> VE -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Mismatch Mismatch
v ->
        [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"mismatch" :: Text)
        , Key
"value" Key -> Mismatch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Mismatch
v
        ]
      MissingPathElem MissingPathElem
v ->
        [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"missing-path-elem" :: Text)
        , Key
"value" Key -> MissingPathElem -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MissingPathElem
v
        ]
      ExtraArrayValues ExtraArrayValues
v ->
        [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"extra-array-values" :: Text)
        , Key
"value" Key -> ExtraArrayValues -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExtraArrayValues
v
        ]
      ExtraObjectValues ExtraObjectValues
v ->
        [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"extra-object-values" :: Text)
        , Key
"value" Key -> ExtraObjectValues -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExtraObjectValues
v
        ]

data MissingPathElem = MkMissingPathElem
  { MissingPathElem -> [PathElem]
path :: Path
  , MissingPathElem -> PathElem
missing :: PathElem
  } deriving (Int -> MissingPathElem -> ShowS
[MissingPathElem] -> ShowS
MissingPathElem -> String
(Int -> MissingPathElem -> ShowS)
-> (MissingPathElem -> String)
-> ([MissingPathElem] -> ShowS)
-> Show MissingPathElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MissingPathElem] -> ShowS
$cshowList :: [MissingPathElem] -> ShowS
show :: MissingPathElem -> String
$cshow :: MissingPathElem -> String
showsPrec :: Int -> MissingPathElem -> ShowS
$cshowsPrec :: Int -> MissingPathElem -> ShowS
Show, MissingPathElem -> MissingPathElem -> Bool
(MissingPathElem -> MissingPathElem -> Bool)
-> (MissingPathElem -> MissingPathElem -> Bool)
-> Eq MissingPathElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MissingPathElem -> MissingPathElem -> Bool
$c/= :: MissingPathElem -> MissingPathElem -> Bool
== :: MissingPathElem -> MissingPathElem -> Bool
$c== :: MissingPathElem -> MissingPathElem -> Bool
Eq)

instance Aeson.ToJSON MissingPathElem where
  toJSON :: MissingPathElem -> Value
toJSON MkMissingPathElem {[PathElem]
PathElem
missing :: PathElem
path :: [PathElem]
$sel:missing:MkMissingPathElem :: MissingPathElem -> PathElem
$sel:path:MkMissingPathElem :: MissingPathElem -> [PathElem]
..} =
    [Pair] -> Value
Aeson.object
      [ Key
"path" Key -> [PathElem] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PathElem]
path
      , Key
"missing" Key -> PathElem -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PathElem
missing
      ]

data Mismatch = MkMismatch
  { Mismatch -> [PathElem]
path :: Path
  , Mismatch -> Value Value
matcher :: Value Aeson.Value
  , Mismatch -> Value
given :: Aeson.Value
  } deriving (Int -> Mismatch -> ShowS
[Mismatch] -> ShowS
Mismatch -> String
(Int -> Mismatch -> ShowS)
-> (Mismatch -> String) -> ([Mismatch] -> ShowS) -> Show Mismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mismatch] -> ShowS
$cshowList :: [Mismatch] -> ShowS
show :: Mismatch -> String
$cshow :: Mismatch -> String
showsPrec :: Int -> Mismatch -> ShowS
$cshowsPrec :: Int -> Mismatch -> ShowS
Show, Mismatch -> Mismatch -> Bool
(Mismatch -> Mismatch -> Bool)
-> (Mismatch -> Mismatch -> Bool) -> Eq Mismatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mismatch -> Mismatch -> Bool
$c/= :: Mismatch -> Mismatch -> Bool
== :: Mismatch -> Mismatch -> Bool
$c== :: Mismatch -> Mismatch -> Bool
Eq)

instance Aeson.ToJSON Mismatch where
  toJSON :: Mismatch -> Value
toJSON MkMismatch {[PathElem]
Value
Value Value
given :: Value
matcher :: Value Value
path :: [PathElem]
$sel:given:MkMismatch :: Mismatch -> Value
$sel:matcher:MkMismatch :: Mismatch -> Value Value
$sel:path:MkMismatch :: Mismatch -> [PathElem]
..} =
    [Pair] -> Value
Aeson.object
      [ Key
"path" Key -> [PathElem] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PathElem]
path
      , Key
"matcher" Key -> Value Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value Value
matcher
      , Key
"given" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
given
      ]

data ExtraArrayValues = MkExtraArrayValues
  { ExtraArrayValues -> [PathElem]
path :: Path
  , ExtraArrayValues -> Array
values :: Vector Aeson.Value
  } deriving (Int -> ExtraArrayValues -> ShowS
[ExtraArrayValues] -> ShowS
ExtraArrayValues -> String
(Int -> ExtraArrayValues -> ShowS)
-> (ExtraArrayValues -> String)
-> ([ExtraArrayValues] -> ShowS)
-> Show ExtraArrayValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtraArrayValues] -> ShowS
$cshowList :: [ExtraArrayValues] -> ShowS
show :: ExtraArrayValues -> String
$cshow :: ExtraArrayValues -> String
showsPrec :: Int -> ExtraArrayValues -> ShowS
$cshowsPrec :: Int -> ExtraArrayValues -> ShowS
Show, ExtraArrayValues -> ExtraArrayValues -> Bool
(ExtraArrayValues -> ExtraArrayValues -> Bool)
-> (ExtraArrayValues -> ExtraArrayValues -> Bool)
-> Eq ExtraArrayValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtraArrayValues -> ExtraArrayValues -> Bool
$c/= :: ExtraArrayValues -> ExtraArrayValues -> Bool
== :: ExtraArrayValues -> ExtraArrayValues -> Bool
$c== :: ExtraArrayValues -> ExtraArrayValues -> Bool
Eq)

instance Aeson.ToJSON ExtraArrayValues where
  toJSON :: ExtraArrayValues -> Value
toJSON MkExtraArrayValues {[PathElem]
Array
values :: Array
path :: [PathElem]
$sel:values:MkExtraArrayValues :: ExtraArrayValues -> Array
$sel:path:MkExtraArrayValues :: ExtraArrayValues -> [PathElem]
..} =
    [Pair] -> Value
Aeson.object
      [ Key
"path" Key -> [PathElem] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PathElem]
path
      , Key
"values" Key -> Array -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Array
values
      ]

data ExtraObjectValues = MkExtraObjectValues
  { ExtraObjectValues -> [PathElem]
path :: Path
  , ExtraObjectValues -> HashMap Text Value
values :: HashMap Text Aeson.Value
  } deriving (Int -> ExtraObjectValues -> ShowS
[ExtraObjectValues] -> ShowS
ExtraObjectValues -> String
(Int -> ExtraObjectValues -> ShowS)
-> (ExtraObjectValues -> String)
-> ([ExtraObjectValues] -> ShowS)
-> Show ExtraObjectValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtraObjectValues] -> ShowS
$cshowList :: [ExtraObjectValues] -> ShowS
show :: ExtraObjectValues -> String
$cshow :: ExtraObjectValues -> String
showsPrec :: Int -> ExtraObjectValues -> ShowS
$cshowsPrec :: Int -> ExtraObjectValues -> ShowS
Show, ExtraObjectValues -> ExtraObjectValues -> Bool
(ExtraObjectValues -> ExtraObjectValues -> Bool)
-> (ExtraObjectValues -> ExtraObjectValues -> Bool)
-> Eq ExtraObjectValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtraObjectValues -> ExtraObjectValues -> Bool
$c/= :: ExtraObjectValues -> ExtraObjectValues -> Bool
== :: ExtraObjectValues -> ExtraObjectValues -> Bool
$c== :: ExtraObjectValues -> ExtraObjectValues -> Bool
Eq)

instance Aeson.ToJSON ExtraObjectValues where
  toJSON :: ExtraObjectValues -> Value
toJSON MkExtraObjectValues {[PathElem]
HashMap Text Value
values :: HashMap Text Value
path :: [PathElem]
$sel:values:MkExtraObjectValues :: ExtraObjectValues -> HashMap Text Value
$sel:path:MkExtraObjectValues :: ExtraObjectValues -> [PathElem]
..} =
    [Pair] -> Value
Aeson.object
      [ Key
"path" Key -> [PathElem] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PathElem]
path
      , Key
"values" Key -> HashMap Text Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HashMap Text Value
values
      ]

type Path = [PathElem]

data PathElem
  = Key Text
  | Idx Int
    deriving (Int -> PathElem -> ShowS
[PathElem] -> ShowS
PathElem -> String
(Int -> PathElem -> ShowS)
-> (PathElem -> String) -> ([PathElem] -> ShowS) -> Show PathElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathElem] -> ShowS
$cshowList :: [PathElem] -> ShowS
show :: PathElem -> String
$cshow :: PathElem -> String
showsPrec :: Int -> PathElem -> ShowS
$cshowsPrec :: Int -> PathElem -> ShowS
Show, PathElem -> PathElem -> Bool
(PathElem -> PathElem -> Bool)
-> (PathElem -> PathElem -> Bool) -> Eq PathElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathElem -> PathElem -> Bool
$c/= :: PathElem -> PathElem -> Bool
== :: PathElem -> PathElem -> Bool
$c== :: PathElem -> PathElem -> Bool
Eq)

instance Aeson.ToJSON PathElem where
  toJSON :: PathElem -> Value
toJSON = \case
    Key Text
k ->
      Text -> Value
Aeson.String Text
k
    Idx Int
i ->
      Scientific -> Value
Aeson.Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

instance IsString PathElem where
  fromString :: String -> PathElem
fromString =
    Text -> PathElem
Key (Text -> PathElem) -> (String -> Text) -> String -> PathElem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString