{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use ++" #-}

-- |
-- Module:      JSONSchema.Validation
-- Copyright:   (c) DPella AB 2025
-- License:     LicenseRef-AllRightsReserved
-- Maintainer:  <matti@dpella.io>, <lobo@dpella.io>
--
-- JSON Schema validation according to JSON Schema 2020-12.
--
-- This module provides validation functions that check if a JSON value
-- conforms to a given JSON Schema. It supports the core 2020-12
-- semantics for validation and applicator keywords ("type", "properties", "patternProperties",
-- "additionalProperties", "items", "prefixItems", numeric and string
-- constraints, combinators, and conditionals). Local $ref resolution to JSON Pointers
-- within the same schema document (including paths under "$defs") is supported.
-- The "unevaluatedProperties" and "unevaluatedItems" keywords are implemented
-- with pragmatic semantics at the current instance location (covering properties/items
-- handled by properties/patternProperties/prefixItems/items/contains). The full
-- annotation-merging behavior across nested applicators is not implemented.
-- The Format-Assertion vocabulary is not implemented; the "format" and "content*"
-- keywords are treated as annotations only, per the 2020-12 specification.
--
-- = Usage
--
-- @
-- let schema = toJSONSchema (Proxy :: Proxy Person)
-- let value = object ["name" .= "Alice", "age" .= 30]
-- validateJSONSchema schema value  -- Returns True if valid
-- @
module JSONSchema.Validation (
  validateJSONSchema,
  ValidationError (..),
  validate,
  validateWithErrors,
) where

import Data.Aeson
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Char (isDigit)
import Data.List (nub)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Ratio (denominator)
import Data.Scientific (Scientific)
import Data.Scientific qualified as Sci
import Data.Text (Text)
import Data.Text qualified as T
import Data.Vector qualified as V
import Text.Regex.TDFA ((=~))
import Text.Regex.TDFA.Text ()

-- | Validation error with context about what failed
data ValidationError = ValidationError
  { ValidationError -> [Text]
error_path :: [Text]
  -- ^ Path to the failing value (e.g. ["users", "0", "name"])
  , ValidationError -> Text
error_message :: Text
  -- ^ Description of the validation failure
  }
  deriving (Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
(Int -> ValidationError -> ShowS)
-> (ValidationError -> String)
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationError -> ShowS
showsPrec :: Int -> ValidationError -> ShowS
$cshow :: ValidationError -> String
show :: ValidationError -> String
$cshowList :: [ValidationError] -> ShowS
showList :: [ValidationError] -> ShowS
Show, ValidationError -> ValidationError -> Bool
(ValidationError -> ValidationError -> Bool)
-> (ValidationError -> ValidationError -> Bool)
-> Eq ValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
/= :: ValidationError -> ValidationError -> Bool
Eq)

-- | Simple validation that returns True if the value matches the schema
validateJSONSchema :: Value -> Value -> Bool
validateJSONSchema :: Value -> Value -> Bool
validateJSONSchema Value
schema Value
value = [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ValidationError] -> Bool) -> [ValidationError] -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> Value -> [ValidationError]
validateWithErrors Value
schema Value
value

-- | Validate with error collection
validate :: Value -> Value -> Either [ValidationError] ()
validate :: Value -> Value -> Either [ValidationError] ()
validate Value
schema Value
value =
  case Value -> Value -> [ValidationError]
validateWithErrors Value
schema Value
value of
    [] -> () -> Either [ValidationError] ()
forall a b. b -> Either a b
Right ()
    [ValidationError]
errs -> [ValidationError] -> Either [ValidationError] ()
forall a b. a -> Either a b
Left [ValidationError]
errs

-- | Validate and return all errors found for an instance against a schema.
-- This walks the instance and applies the validation vocabulary for 2020-12,
-- returning every violation discovered (no short-circuit).
validateWithErrors :: Value -> Value -> [ValidationError]
validateWithErrors :: Value -> Value -> [ValidationError]
validateWithErrors Value
schema Value
value = [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [] Value
schema Value
schema Value
value Int
maxRefDepth

-- | Max recursion depth for $ref to avoid infinite loops
maxRefDepth :: Int
maxRefDepth :: Int
maxRefDepth = Int
256

-- | Internal validator with context.
--
-- Parameters:
--  - path: JSON Pointer-like path to the current instance location
--  - root: the root schema document (for resolving local $ref)
--  - schema: the current subschema to apply
--  - value: the current instance value
--  - fuel: remaining recursion depth for $ref resolution
validateValue :: [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue :: [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
schema Value
value Int
fuel =
  case Value
schema of
    Bool Bool
True -> [] -- true schema always validates
    Bool Bool
False -> [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Schema is false (always fails)"]
    Object Object
km ->
      -- \$ref short-circuit: if present, ignore other keywords (per spec)
      case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"$ref" of
        Just (String Text
ref_path) ->
          if Int
fuel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
            then [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Exceeded $ref resolution depth"]
            else case Value -> Text -> Maybe Value
resolveRef Value
root Text
ref_path of
              Just Value
ref_schema -> [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
ref_schema Value
value (Int
fuel Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              Maybe Value
Nothing -> [[Text] -> Text -> ValidationError
ValidationError [Text]
path (Text
"Unresolved $ref: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref_path)]
        Maybe Value
_ -> [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateObject [Text]
path Value
root Object
km Value
value Int
fuel
    Value
_ -> [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Invalid schema: must be a boolean or object"]

-- | Apply object schema keywords and dispatch to other validators.
--
-- Covers:
--  - type/const/enum
--  - Object keywords: properties, patternProperties, additionalProperties,
--    propertyNames, required, dependentSchemas, dependentRequired
--  - Array keywords present at this location: prefixItems, items (when instance is array)
--  - String/Number/Object count constraints
--  - Combinators: anyOf, oneOf, allOf, not
--  - Conditionals: if/then/else
--  - unevaluatedProperties / unevaluatedItems (local, pragmatic semantics)
validateObject :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateObject :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateObject [Text]
path Value
root Object
km Value
value Int
fuel =
  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text] -> Object -> Value -> [ValidationError]
validateType [Text]
path Object
km Value
value
    , [Text] -> Object -> Value -> [ValidationError]
validateConst [Text]
path Object
km Value
value
    , [Text] -> Object -> Value -> [ValidationError]
validateEnum [Text]
path Object
km Value
value
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateProperties [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateItems [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validatePrefixItems [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateArrayConstraints [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Object -> Value -> [ValidationError]
validateStringConstraints [Text]
path Object
km Value
value
    , [Text] -> Object -> Value -> [ValidationError]
validateNumberConstraints [Text]
path Object
km Value
value
    , [Text] -> Object -> Value -> [ValidationError]
validateObjectConstraints [Text]
path Object
km Value
value
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateCombinators [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateConditional [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateUnevaluatedProperties [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateUnevaluatedItems [Text]
path Value
root Object
km Value
value Int
fuel
    ]

-- | Validate the "type" keyword. Supports a single string or an array of types.
-- Recognized types: null, boolean, string, number, integer, array, object.
validateType :: [Text] -> KM.KeyMap Value -> Value -> [ValidationError]
validateType :: [Text] -> Object -> Value -> [ValidationError]
validateType [Text]
path Object
km Value
value =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"type" of
    Maybe Value
Nothing -> []
    Just (String Text
type_str) ->
      [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ Text
"Expected type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
type_str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
describeType Value
value
      | Bool -> Bool
not (Text -> Value -> Bool
checkType Text
type_str Value
value)
      ]
    Just (Array Array
types) ->
      let type_strs :: [Text]
type_strs = [Text
t | String Text
t <- Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
types]
      in  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ Text
"Expected one of types " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
type_strs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
describeType Value
value
          | Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Value -> Bool
`checkType` Value
value) [Text]
type_strs)
          ]
    Just Value
_ -> [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Invalid 'type' field in schema"]

-- | Check whether a JSON value is of the given JSON Schema type.
checkType :: Text -> Value -> Bool
checkType :: Text -> Value -> Bool
checkType Text
"null" Value
Null = Bool
True
checkType Text
"boolean" (Bool Bool
_) = Bool
True
checkType Text
"string" (String Text
_) = Bool
True
checkType Text
"number" (Number Scientific
_) = Bool
True
-- Per JSON Schema, "integer" means the instance is a number with an integral value,
-- not limited by machine-sized Int bounds.
checkType Text
"integer" (Number Scientific
n) = Scientific -> Bool
Sci.isInteger Scientific
n
checkType Text
"array" (Array Array
_) = Bool
True
checkType Text
"object" (Object Object
_) = Bool
True
checkType Text
_ Value
_ = Bool
False

-- | Derive the schema type name corresponding to a value (e.g., "integer").
describeType :: Value -> Text
describeType :: Value -> Text
describeType Value
Null = Text
"null"
describeType (Bool Bool
_) = Text
"boolean"
describeType (String Text
_) = Text
"string"
describeType (Number Scientific
n)
  | Scientific -> Bool
Sci.isInteger Scientific
n = Text
"integer"
  | Bool
otherwise = Text
"number"
describeType (Array Array
_) = Text
"array"
describeType (Object Object
_) = Text
"object"

-- | Validate the "const" keyword (instance must be exactly equal to the given value).
validateConst :: [Text] -> KM.KeyMap Value -> Value -> [ValidationError]
validateConst :: [Text] -> Object -> Value -> [ValidationError]
validateConst [Text]
path Object
km Value
value =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"const" of
    Maybe Value
Nothing -> []
    Just Value
const_val ->
      [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ Text
"Expected constant value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
showJSON Value
const_val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
showJSON Value
value
      | Value
value Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
const_val
      ]

-- | Validate the "enum" keyword (instance must be a member of the given array).
validateEnum :: [Text] -> KM.KeyMap Value -> Value -> [ValidationError]
validateEnum :: [Text] -> Object -> Value -> [ValidationError]
validateEnum [Text]
path Object
km Value
value =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"enum" of
    Maybe Value
Nothing -> []
    Just (Array Array
values) ->
      [[Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ Text
"Value not in enum: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
showJSON Value
value | Bool -> Bool
not (Value
value Value -> Array -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` Array
values)]
    Just Value
_ -> [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Invalid 'enum' field in schema"]

-- | Validate object-related keywords at this location.
--
-- Implements:
--  - properties: validate each defined property if present
--  - patternProperties: validate properties whose names match regex patterns
--  - additionalProperties: validate and/or forbid properties not matched above
--  - propertyNames: validate each property name as a string instance
--  - required: ensure listed properties exist
--  - dependentSchemas: when a property exists, apply another schema to the whole object
--  - dependentRequired: when a property exists, require additional properties
validateProperties :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateProperties :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateProperties [Text]
path Value
root Object
km Value
value Int
fuel =
  case Value
value of
    Object Object
obj ->
      let props_schema :: Maybe Value
props_schema = Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"properties"
          pattern_props_schema :: Maybe Value
pattern_props_schema = Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"patternProperties"
          additional_props_schema :: Maybe Value
additional_props_schema = Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"additionalProperties"
          property_names_schema :: Maybe Value
property_names_schema = Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"propertyNames"
          required_props :: [Text]
required_props = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"required" of
            Just (Array Array
arr) -> [Text
t | String Text
t <- Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
arr]
            Maybe Value
_ -> []

          -- Validate properties defined in 'properties'
          prop_errors :: [ValidationError]
prop_errors = case Maybe Value
props_schema of
            Just (Object Object
schema_obj) ->
              [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ case Object
obj Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
key of
                  Just Value
prop_value ->
                    [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Key -> Text
K.toText Key
key]) Value
root Value
schema Value
prop_value Int
fuel
                  Maybe Value
Nothing -> []
                | (Key
key, Value
schema) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
schema_obj
                ]
            Maybe Value
_ -> []

          -- Validate properties matching patterns in 'patternProperties'
          pattern_prop_errors :: [ValidationError]
pattern_prop_errors = case Maybe Value
pattern_props_schema of
            Just (Object Object
patterns) ->
              [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                  [ if Key -> Text
K.toText Key
obj_key Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Key -> Text
K.toText Key
pattern_key
                    then [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Key -> Text
K.toText Key
obj_key]) Value
root Value
pattern_schema Value
obj_value Int
fuel
                    else []
                  | (Key
pattern_key, Value
pattern_schema) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
patterns
                  ]
                | (Key
obj_key, Value
obj_value) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
obj
                ]
            Maybe Value
_ -> []

          -- Determine which properties are handled by properties or patternProperties
          handled_by_props :: [Key]
handled_by_props = case Maybe Value
props_schema of
            Just (Object Object
schema_obj) -> Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
schema_obj
            Maybe Value
_ -> []
          handled_by_patterns :: [Key]
handled_by_patterns = case Maybe Value
pattern_props_schema of
            Just (Object Object
patterns) ->
              [ Key
obj_key
              | Key
obj_key <- Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj
              , (Key -> Bool) -> [Key] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Key
pattern_key -> Key -> Text
K.toText Key
obj_key Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Key -> Text
K.toText Key
pattern_key) (Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
patterns)
              ]
            Maybe Value
_ -> []
          unhandled_keys :: [Key]
unhandled_keys = (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Key
k -> Key
k Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Key]
handled_by_props Bool -> Bool -> Bool
&& Key
k Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Key]
handled_by_patterns) (Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj)

          -- Validate additional properties
          additional_errors :: [ValidationError]
additional_errors = case Maybe Value
additional_props_schema of
            Just (Bool Bool
False) ->
              [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                Text
"Additional property not allowed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
key
              | Key
key <- [Key]
unhandled_keys
              ]
            Just Value
schema ->
              [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ case Object
obj Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
key of
                  Just Value
prop_value ->
                    [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Key -> Text
K.toText Key
key]) Value
root Value
schema Value
prop_value Int
fuel
                  Maybe Value
Nothing -> []
                | Key
key <- [Key]
unhandled_keys
                ]
            Maybe Value
Nothing -> []

          -- Validate property names
          property_name_errors :: [ValidationError]
property_name_errors = case Maybe Value
property_names_schema of
            Just Value
schema ->
              [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ let key_value :: Value
key_value = Text -> Value
String (Key -> Text
K.toText Key
key)
                  in  [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"propertyName:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
key]) Value
root Value
schema Value
key_value Int
fuel
                | Key
key <- Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj
                ]
            Maybe Value
_ -> []

          -- Validate required properties
          required_errors :: [ValidationError]
required_errors =
            [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
              Text
"Missing required property: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prop
            | Text
prop <- [Text]
required_props
            , Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing (Object
obj Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Text -> Key
K.fromText Text
prop)
            ]

          -- Handle dependent schemas and required
          dependent_errors :: [ValidationError]
dependent_errors = [Text] -> Value -> Object -> Object -> Int -> [ValidationError]
validateDependencies [Text]
path Value
root Object
km Object
obj Int
fuel
      in  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ValidationError]
prop_errors, [ValidationError]
pattern_prop_errors, [ValidationError]
additional_errors, [ValidationError]
property_name_errors, [ValidationError]
required_errors, [ValidationError]
dependent_errors]
    Value
_ -> []

-- | Validate dependentSchemas and dependentRequired.
--
-- - dependentSchemas: if key K present, validate the entire object against a schema S
-- - dependentRequired: if key K present, require listed properties to also be present
validateDependencies :: [Text] -> Value -> KM.KeyMap Value -> KM.KeyMap Value -> Int -> [ValidationError]
validateDependencies :: [Text] -> Value -> Object -> Object -> Int -> [ValidationError]
validateDependencies [Text]
path Value
root Object
km Object
obj Int
fuel =
  let dep_schemas_errors :: [ValidationError]
dep_schemas_errors = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"dependentSchemas" of
        Just (Object Object
dep_schemas) ->
          [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Object
obj Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
dep_key)
              then [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
dep_schema (Object -> Value
Object Object
obj) Int
fuel
              else []
            | (Key
dep_key, Value
dep_schema) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
dep_schemas
            ]
        Maybe Value
_ -> []

      dep_required_errors :: [ValidationError]
dep_required_errors = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"dependentRequired" of
        Just (Object Object
dep_required) ->
          [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Object
obj Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
dep_key)
              then
                ( case Value
dep_value of
                    Array Array
required_arr ->
                      [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                        Text
"Property '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
dep_key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' requires property: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
req_prop
                      | String Text
req_prop <- Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
required_arr
                      , Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing (Object
obj Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Text -> Key
K.fromText Text
req_prop)
                      ]
                    Value
_ -> []
                )
              else []
            | (Key
dep_key, Value
dep_value) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
dep_required
            ]
        Maybe Value
_ -> []
  in  [ValidationError]
dep_schemas_errors [ValidationError] -> [ValidationError] -> [ValidationError]
forall a. Semigroup a => a -> a -> a
<> [ValidationError]
dep_required_errors

-- | Validate array items
-- Implements 2020-12 array applicators semantics:
--  - "prefixItems": array of schemas applied positionally to the first N items
--  - "items": schema applied to all items with index >= N (N = prefixItems length, or 0 if absent)
--  - "items": false forbids any items beyond N; if N == 0, array must be empty
-- | Validate the "items" applicator for arrays in 2020-12.
--
-- Semantics:
--  - prefixItems: schemas applied positionally to first N items
--  - items: schema for items at index >= N; items=false forbids any items beyond N
validateItems :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateItems :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateItems [Text]
path Value
root Object
km Value
value Int
fuel =
  case Value
value of
    Array Array
arr ->
      let prefix_len :: Maybe Int
prefix_len = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"prefixItems" of
            Just (Array Array
prefixes) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Array -> Int
forall a. Vector a -> Int
V.length Array
prefixes)
            Maybe Value
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
          n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
prefix_len
          arr_len :: Int
arr_len = Array -> Int
forall a. Vector a -> Int
V.length Array
arr
          rest_indices :: [Int]
rest_indices = [Int
n .. Int
arr_len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
      in  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"items" of
            Just (Bool Bool
False) ->
              [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                Text
"Array has "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
arr_len)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" items but only "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" allowed"
              | Int
arr_len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
              ]
            Just Value
item_schema ->
              [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i]) Value
root Value
item_schema (Array
arr Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i) Int
fuel
                | Int
i <- [Int]
rest_indices
                ]
            Maybe Value
Nothing -> []
    Value
_ -> []

-- | Validate the "prefixItems" applicator for arrays (positionally for the first N items).
validatePrefixItems :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validatePrefixItems :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validatePrefixItems [Text]
path Value
root Object
km Value
value Int
fuel =
  case Value
value of
    Array Array
arr ->
      case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"prefixItems" of
        Just (Array Array
prefixes) ->
          let limit :: Int
limit = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Array -> Int
forall a. Vector a -> Int
V.length Array
prefixes) (Array -> Int
forall a. Vector a -> Int
V.length Array
arr)
          in  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i]) Value
root (Array
prefixes Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i) (Array
arr Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i) Int
fuel
                | Int
i <- [Int
0 .. Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                ]
        Maybe Value
_ -> []
    Value
_ -> []

-- | Validate string constraints: minLength, maxLength, pattern.
-- Note: "format" is treated as an annotation and not asserted.
validateStringConstraints :: [Text] -> KM.KeyMap Value -> Value -> [ValidationError]
validateStringConstraints :: [Text] -> Object -> Value -> [ValidationError]
validateStringConstraints [Text]
path Object
km Value
value =
  case Value
value of
    String Text
str ->
      let l :: Int
l = Text -> Int
unicodeLength Text
str
      in  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"minLength" of
                Just (Number Scientific
n)
                  | Just Int
min_len <- Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n ->
                      [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                        Text
"String length "
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
l)
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is less than minimum "
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
min_len)
                      | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
min_len :: Int)
                      ]
                Maybe Value
_ -> []
            , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"maxLength" of
                Just (Number Scientific
n)
                  | Just Int
max_len <- Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n ->
                      ( [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                          Text
"String length "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
l)
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exceeds maximum "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
max_len)
                        | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
max_len :: Int)
                        ]
                      )
                Maybe Value
_ -> []
            , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"pattern" of
                Just (String Text
pattern) ->
                  [[Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ Text
"String does not match pattern: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pattern | Bool -> Bool
not (Text
str Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text
pattern)]
                Maybe Value
_ -> []
                -- format validation is optional and can be added later
            ]
    Value
_ -> []

-- | Validate numeric constraints: minimum, maximum, exclusiveMinimum, exclusiveMaximum, multipleOf.
-- multipleOf is checked exactly using rationals to avoid floating point error.
validateNumberConstraints :: [Text] -> KM.KeyMap Value -> Value -> [ValidationError]
validateNumberConstraints :: [Text] -> Object -> Value -> [ValidationError]
validateNumberConstraints [Text]
path Object
km Value
value =
  case Value
value of
    Number Scientific
num ->
      let fmt :: Scientific -> Text
          fmt :: Scientific -> Text
fmt = String -> Text
T.pack (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
Sci.formatScientific FPFormat
Sci.Generic Maybe Int
forall a. Maybe a
Nothing
      in  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"minimum" of
                Just (Number Scientific
min_val) ->
                  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                    Text
"Value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is less than minimum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
min_val
                  | Scientific
num Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
min_val
                  ]
                Maybe Value
_ -> []
            , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"exclusiveMinimum" of
                Just (Number Scientific
min_val) ->
                  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                    Text
"Value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not greater than exclusiveMinimum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
min_val
                  | Scientific
num Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
min_val
                  ]
                Maybe Value
_ -> []
            , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"maximum" of
                Just (Number Scientific
max_val) ->
                  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                    Text
"Value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exceeds maximum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
max_val
                  | Scientific
num Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
> Scientific
max_val
                  ]
                Maybe Value
_ -> []
            , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"exclusiveMaximum" of
                Just (Number Scientific
max_val) ->
                  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                    Text
"Value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not less than exclusiveMaximum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
max_val
                  | Scientific
num Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
max_val
                  ]
                Maybe Value
_ -> []
            , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"multipleOf" of
                Just (Number Scientific
divisor) ->
                  ( [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                      Text
"Value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a multiple of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scientific -> Text
fmt Scientific
divisor
                    | Bool -> Bool
not (Scientific -> Scientific -> Bool
isMultipleOf Scientific
num Scientific
divisor)
                    ]
                  )
                Maybe Value
_ -> []
            ]
    Value
_ -> []

-- | Validate logical combinators: anyOf, oneOf, allOf, not.
validateCombinators :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateCombinators :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateCombinators [Text]
path Value
root Object
km Value
value Int
fuel =
  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateAnyOf [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateOneOf [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateAllOf [Text]
path Value
root Object
km Value
value Int
fuel
    , [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateNot [Text]
path Value
root Object
km Value
value Int
fuel
    ]

-- | anyOf: valid if at least one subschema validates (merges annotations of matching subschemas).
validateAnyOf :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateAnyOf :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateAnyOf [Text]
path Value
root Object
km Value
value Int
fuel =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"anyOf" of
    Just (Array Array
schemas) ->
      let results :: [[ValidationError]]
results = [[Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
schema Value
value Int
fuel | Value
schema <- Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
schemas]
      in  [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Value does not match any of the schemas in 'anyOf'" | Bool -> Bool
not (([ValidationError] -> Bool) -> [[ValidationError]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ValidationError]]
results)]
    Maybe Value
_ -> []

-- | oneOf: valid if exactly one subschema validates.
validateOneOf :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateOneOf :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateOneOf [Text]
path Value
root Object
km Value
value Int
fuel =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"oneOf" of
    Just (Array Array
schemas) ->
      let results :: [[ValidationError]]
results = [[Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
schema Value
value Int
fuel | Value
schema <- Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
schemas]
          valid_count :: Int
valid_count = [[ValidationError]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[ValidationError]] -> Int) -> [[ValidationError]] -> Int
forall a b. (a -> b) -> a -> b
$ ([ValidationError] -> Bool)
-> [[ValidationError]] -> [[ValidationError]]
forall a. (a -> Bool) -> [a] -> [a]
filter [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ValidationError]]
results
      in  case Int
valid_count of
            Int
0 -> [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Value does not match any schema in 'oneOf'"]
            Int
1 -> []
            Int
_ ->
              [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ Text
"Value matches " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
valid_count) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" schemas in 'oneOf' but must match exactly one"
              ]
    Maybe Value
_ -> []

-- | allOf: valid only if all subschemas validate; accumulates all errors.
validateAllOf :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateAllOf :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateAllOf [Text]
path Value
root Object
km Value
value Int
fuel =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"allOf" of
    Just (Array Array
schemas) ->
      [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
schema Value
value Int
fuel | Value
schema <- Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
schemas]
    Maybe Value
_ -> []

-- | not: valid only if the subschema does not validate.
validateNot :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateNot :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateNot [Text]
path Value
root Object
km Value
value Int
fuel =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"not" of
    Just Value
not_schema ->
      [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Value matches schema in 'not'" | [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
not_schema Value
value Int
fuel)]
    Maybe Value
_ -> []

-- | Validate array count/membership constraints: minItems, maxItems, uniqueItems, contains.
validateArrayConstraints :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateArrayConstraints :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateArrayConstraints [Text]
path Value
root Object
km Value
value Int
fuel =
  case Value
value of
    Array Array
arr ->
      [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"minItems" of
            Just (Number Scientific
n)
              | Just Int
min_items <- Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n ->
                  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                    Text
"Array has "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Array -> Int
forall a. Vector a -> Int
V.length Array
arr)
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" items but minimum is "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
min_items)
                  | Array -> Int
forall a. Vector a -> Int
V.length Array
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min_items
                  ]
            Maybe Value
_ -> []
        , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"maxItems" of
            Just (Number Scientific
n)
              | Just Int
max_items <- Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n ->
                  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                    Text
"Array has "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Array -> Int
forall a. Vector a -> Int
V.length Array
arr)
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" items but maximum is "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
max_items)
                  | Array -> Int
forall a. Vector a -> Int
V.length Array
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max_items
                  ]
            Maybe Value
_ -> []
        , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"uniqueItems" of
            Just (Bool Bool
True) ->
              let items :: [Value]
items = Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
arr
              in  [[Text] -> Text -> ValidationError
ValidationError [Text]
path Text
"Array items are not unique" | [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
items Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Value] -> [Value]
forall a. Eq a => [a] -> [a]
nub [Value]
items)]
            Maybe Value
_ -> []
        , [Text] -> Value -> Object -> Array -> Int -> [ValidationError]
validateContains [Text]
path Value
root Object
km Array
arr Int
fuel
        ]
    Value
_ -> []

-- | Validate contains constraints
-- | Validate contains/minContains/maxContains: counts items matching the subschema.
-- Note: when "contains" is false, minContains defaults to 1, making any array invalid.
validateContains :: [Text] -> Value -> KM.KeyMap Value -> V.Vector Value -> Int -> [ValidationError]
validateContains :: [Text] -> Value -> Object -> Array -> Int -> [ValidationError]
validateContains [Text]
path Value
root Object
km Array
arr Int
fuel =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"contains" of
    Maybe Value
Nothing -> []
    Just Value
contains_schema ->
      let matches :: Array
matches = (Value -> Bool) -> Array -> Array
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\Value
item -> [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ValidationError] -> Bool) -> [ValidationError] -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
contains_schema Value
item Int
fuel) Array
arr
          match_count :: Int
match_count = Array -> Int
forall a. Vector a -> Int
V.length Array
matches
          min_contains :: Int
min_contains = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"minContains" of
            Just (Number Scientific
n) -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n)
            Maybe Value
_ -> Int
1
          max_contains :: Maybe Int
max_contains = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"maxContains" of
            Just (Number Scientific
n) -> Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n
            Maybe Value
_ -> Maybe Int
forall a. Maybe a
Nothing
      in  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                Text
"Array has "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
match_count)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" matching items but minContains is "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
min_contains)
              | Int
match_count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min_contains
              ]
            , case Maybe Int
max_contains of
                Just Int
max_cont ->
                  [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                    Text
"Array has "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
match_count)
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" matching items but maxContains is "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
max_cont)
                  | Int
match_count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max_cont
                  ]
                Maybe Int
Nothing -> []
            ]

-- | Validate object constraints (minProperties, maxProperties)
-- | Validate object property count constraints: minProperties and maxProperties.
validateObjectConstraints :: [Text] -> KM.KeyMap Value -> Value -> [ValidationError]
validateObjectConstraints :: [Text] -> Object -> Value -> [ValidationError]
validateObjectConstraints [Text]
path Object
km Value
value =
  case Value
value of
    Object Object
obj ->
      let prop_count :: Int
prop_count = Object -> Int
forall v. KeyMap v -> Int
KM.size Object
obj
      in  [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"minProperties" of
                Just (Number Scientific
n)
                  | Just Int
min_props <- Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n ->
                      [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                        Text
"Object has "
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
prop_count)
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" properties but minimum is "
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
min_props)
                      | Int
prop_count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min_props
                      ]
                Maybe Value
_ -> []
            , case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"maxProperties" of
                Just (Number Scientific
n)
                  | Just Int
max_props <- Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n ->
                      [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
                        Text
"Object has "
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
prop_count)
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" properties but maximum is "
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
max_props)
                      | Int
prop_count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max_props
                      ]
                Maybe Value
_ -> []
            ]
    Value
_ -> []

-- | Validate conditional logic (if/then/else)
-- | Validate conditional keywords: if/then/else.
validateConditional :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateConditional :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateConditional [Text]
path Value
root Object
km Value
value Int
fuel =
  case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"if" of
    Maybe Value
Nothing -> []
    Just Value
if_schema ->
      let if_matches :: Bool
if_matches = [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ValidationError] -> Bool) -> [ValidationError] -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
if_schema Value
value Int
fuel
      in  if Bool
if_matches
            then case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"then" of
              Just Value
then_schema -> [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
then_schema Value
value Int
fuel
              Maybe Value
Nothing -> []
            else case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"else" of
              Just Value
else_schema -> [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
else_schema Value
value Int
fuel
              Maybe Value
Nothing -> []

-- | Check if a number is a multiple of another
-- Exact multipleOf using rationals (avoids floating point error).
-- | Exact multipleOf check using rationals (denominator must be 1).
isMultipleOf :: Scientific -> Scientific -> Bool
isMultipleOf :: Scientific -> Scientific -> Bool
isMultipleOf Scientific
value Scientific
divisor =
  let q :: Rational
q = Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
value Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
divisor
  in  Rational -> Integer
forall a. Ratio a -> a
denominator Rational
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1

-- Count Unicode code points (not UTF-16 code units)

-- | Count Unicode code points (not UTF-16 code units) for string length.
unicodeLength :: Text -> Int
unicodeLength :: Text -> Int
unicodeLength = (Int -> Char -> Int) -> Int -> Text -> Int
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\Int
n Char
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0

-- | Helper to show JSON values as text
showJSON :: Value -> Text
showJSON :: Value -> Text
showJSON = Int -> Text -> Text
T.take Int
100 (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Value -> String) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> String
forall a. Show a => a -> String
show

-- | Resolve a local $ref against the root schema using JSON Pointer
-- Supports only fragment starting with '#'. External URIs and anchors are not resolved.
-- | Resolve a local $ref against the root schema using JSON Pointer.
-- Supports only fragments starting with '#'; external URIs/anchors are not resolved.
resolveRef :: Value -> Text -> Maybe Value
resolveRef :: Value -> Text -> Maybe Value
resolveRef Value
root Text
ref_path =
  case Text -> Maybe (Char, Text)
T.uncons Text
ref_path of
    Just (Char
'#', Text
rest) ->
      -- empty fragment or pointer
      if Text -> Bool
T.null Text
rest
        then Value -> Maybe Value
forall a. a -> Maybe a
Just Value
root
        else
          if HasCallStack => Text -> Char
Text -> Char
T.head Text
rest Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
            then Value -> Text -> Maybe Value
jsonPointer Value
root (HasCallStack => Text -> Text
Text -> Text
T.tail Text
rest)
            else Maybe Value
forall a. Maybe a
Nothing -- unsupported non-pointer fragment
    Maybe (Char, Text)
_ -> Maybe Value
forall a. Maybe a
Nothing -- unsupported non-fragment refs

-- | Evaluate a JSON Pointer (RFC 6901) against a JSON value.
jsonPointer :: Value -> Text -> Maybe Value
jsonPointer :: Value -> Text -> Maybe Value
jsonPointer Value
v Text
ptr =
  let tokens :: [Text]
tokens = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
unescapePointer ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" Text
ptr
  in  Value -> [Text] -> Maybe Value
go Value
v [Text]
tokens
  where
    go :: Value -> [Text] -> Maybe Value
    go :: Value -> [Text] -> Maybe Value
go Value
cur [] = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
cur
    go (Object Object
km) (Text
t : [Text]
ts) =
      case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
K.fromText Text
t) Object
km of
        Just Value
nxt -> Value -> [Text] -> Maybe Value
go Value
nxt [Text]
ts
        Maybe Value
Nothing -> Maybe Value
forall a. Maybe a
Nothing
    go (Array Array
arr) (Text
t : [Text]
ts)
      | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
t) =
          let i :: Int
i = String -> Int
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
t) :: Int
          in  if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array -> Int
forall a. Vector a -> Int
V.length Array
arr then Value -> [Text] -> Maybe Value
go (Array
arr Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i) [Text]
ts else Maybe Value
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe Value
forall a. Maybe a
Nothing
    go Value
_ [Text]
_ = Maybe Value
forall a. Maybe a
Nothing

    unescapePointer :: Text -> Text
    unescapePointer :: Text -> Text
unescapePointer = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"~1" Text
"/" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"~0" Text
"~"

-- | Validate "unevaluatedProperties":
-- Forbids or constrains properties that were not covered by properties,
-- patternProperties, or additionalProperties at the current schema location.
-- This implementation approximates evaluated sets locally and does not
-- perform full annotation merging across nested applicators.
validateUnevaluatedProperties :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateUnevaluatedProperties :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateUnevaluatedProperties [Text]
path Value
root Object
km Value
value Int
fuel =
  case (Value
value, Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"unevaluatedProperties") of
    (Object Object
obj, Just Value
uneval_schema) ->
      let props_schema :: Maybe Value
props_schema = Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"properties"
          pattern_props_schema :: Maybe Value
pattern_props_schema = Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"patternProperties"

          props_handled :: [Key]
props_handled = case Maybe Value
props_schema of
            Just (Object Object
schema_obj) -> [Key
k | (Key
k, Value
_) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
schema_obj, Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
KM.member Key
k Object
obj]
            Maybe Value
_ -> []
          patterns_handled :: [Key]
patterns_handled = case Maybe Value
pattern_props_schema of
            Just (Object Object
patterns) ->
              [ Key
obj_key
              | Key
obj_key <- Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj
              , (Key -> Bool) -> [Key] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Key
pattern_key -> Key -> Text
K.toText Key
obj_key Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Key -> Text
K.toText Key
pattern_key) (Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
patterns)
              ]
            Maybe Value
_ -> []
          extras :: [Key]
extras = [Key
k | Key
k <- Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj, Key
k Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Key]
props_handled, Key
k Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Key]
patterns_handled]

          -- If additionalProperties is present, consider extras handled by it
          extras_handled_by_additional :: [Key]
extras_handled_by_additional = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"additionalProperties" of
            Just Value
_ -> [Key]
extras
            Maybe Value
Nothing -> []

          unevaluated_keys :: [Key]
unevaluated_keys = [Key
k | Key
k <- [Key]
extras, Key
k Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Key]
extras_handled_by_additional]

          applyUnevaluated :: Value -> [ValidationError]
applyUnevaluated (Bool Bool
False) =
            [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
              Text
"Unevaluated property not allowed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
k
            | Key
k <- [Key]
unevaluated_keys
            ]
          applyUnevaluated Value
sch =
            [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ case Object
obj Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
k of
                Just Value
v -> [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Key -> Text
K.toText Key
k]) Value
root Value
sch Value
v Int
fuel
                Maybe Value
Nothing -> []
              | Key
k <- [Key]
unevaluated_keys
              ]
      in  Value -> [ValidationError]
applyUnevaluated Value
uneval_schema
    (Value, Maybe Value)
_ -> []

-- | Validate "unevaluatedItems":
-- Applies to array indices not covered by prefixItems, items, or contains When false, any such index is prohibited; when a schema, each such item
-- is validated against it. This uses local evaluated-set approximation.
validateUnevaluatedItems :: [Text] -> Value -> KM.KeyMap Value -> Value -> Int -> [ValidationError]
validateUnevaluatedItems :: [Text] -> Value -> Object -> Value -> Int -> [ValidationError]
validateUnevaluatedItems [Text]
path Value
root Object
km Value
value Int
fuel =
  case (Value
value, Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"unevaluatedItems") of
    (Array Array
arr, Just Value
uneval_schema) ->
      let arr_len :: Int
arr_len = Array -> Int
forall a. Vector a -> Int
V.length Array
arr
          -- prefix items coverage
          prefix_count :: Int
prefix_count = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"prefixItems" of
            Just (Array Array
prefixes) -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Array -> Int
forall a. Vector a -> Int
V.length Array
prefixes) Int
arr_len
            Maybe Value
_ -> Int
0
          prefix_idx :: [Int]
prefix_idx = [Int
0 .. Int
prefix_count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
          -- items coverage for rest if present
          rest_idx :: [Int]
rest_idx = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"items" of
            Just Value
_ -> [Int
prefix_count .. Int
arr_len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            Maybe Value
Nothing -> []
          -- contains matched indices (optional)
          contains_idx :: [Int]
contains_idx = case Object
km Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
KM.!? Key
"contains" of
            Maybe Value
Nothing -> []
            Just Value
sch ->
              [ Int
i
              | Int
i <- [Int
0 .. Int
arr_len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
              , [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ValidationError] -> Bool) -> [ValidationError] -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue [Text]
path Value
root Value
sch (Array
arr Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i) Int
fuel
              ]
          evaluated :: [Int]
evaluated = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int]
prefix_idx [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int]
rest_idx [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int]
contains_idx)
          unevaluated :: [Int]
unevaluated = [Int
i | Int
i <- [Int
0 .. Int
arr_len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
i Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
evaluated]
          applyItems :: Value -> [ValidationError]
applyItems (Bool Bool
False) =
            [ [Text] -> Text -> ValidationError
ValidationError [Text]
path (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$
              Text
"Unevaluated item not allowed at index " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i)
            | Int
i <- [Int]
unevaluated
            ]
          applyItems Value
sch =
            [[ValidationError]] -> [ValidationError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [Text] -> Value -> Value -> Value -> Int -> [ValidationError]
validateValue ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i)]) Value
root Value
sch (Array
arr Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i) Int
fuel
              | Int
i <- [Int]
unevaluated
              ]
      in  Value -> [ValidationError]
applyItems Value
uneval_schema
    (Value, Maybe Value)
_ -> []