{-# OPTIONS_GHC -Wno-orphans #-}
module Data.OpenApi.Compare.Validate.Schema
(
)
where
import Control.Monad.Writer
import qualified Data.Aeson as A
import Data.Coerce
import Data.Foldable (for_, toList)
import Data.Functor
import Data.HList
import Data.List (genericIndex, genericLength, group)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe
import Data.OpenApi
import Data.OpenApi.Compare.Behavior
import Data.OpenApi.Compare.Paths
import qualified Data.OpenApi.Compare.PathsPrefixTree as P
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.Schema.DNF
import Data.OpenApi.Compare.Validate.Schema.Issues
import Data.OpenApi.Compare.Validate.Schema.JsonFormula
import Data.OpenApi.Compare.Validate.Schema.Partition
import Data.OpenApi.Compare.Validate.Schema.Process
import Data.OpenApi.Compare.Validate.Schema.Traced
import Data.OpenApi.Compare.Validate.Schema.TypedJson
import Data.Ord
import Data.Ratio
import Data.Semigroup
import qualified Data.Set as S
import Data.Text (Text)
checkFormulas ::
(ReassembleHList xs (CheckEnv (Referenced Schema))) =>
HList xs ->
Behavior 'SchemaLevel ->
ProdCons (Trace Schema) ->
ProdCons (Traced (Definitions Schema)) ->
ProdCons (ForeachType JsonFormula, P.PathsPrefixTree Behave AnIssue 'SchemaLevel) ->
SemanticCompatFormula ()
checkFormulas :: HList xs
-> Behavior 'SchemaLevel
-> ProdCons (Trace Schema)
-> ProdCons (Traced (Definitions Schema))
-> ProdCons
(ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel)
-> SemanticCompatFormula ()
checkFormulas HList xs
env Behavior 'SchemaLevel
beh ProdCons (Trace Schema)
trs ProdCons (Traced (Definitions Schema))
defs (ProdCons (ForeachType JsonFormula
fp, PathsPrefixTree Behave AnIssue 'SchemaLevel
ep) (ForeachType JsonFormula
fc, PathsPrefixTree Behave AnIssue 'SchemaLevel
ec)) =
case PathsPrefixTree Behave AnIssue 'SchemaLevel
-> [AnItem Behave AnIssue 'SchemaLevel]
forall k (q :: k -> k -> *) (f :: k -> *) (r :: k).
PathsPrefixTree q f r -> [AnItem q f r]
P.toList PathsPrefixTree Behave AnIssue 'SchemaLevel
ep [AnItem Behave AnIssue 'SchemaLevel]
-> [AnItem Behave AnIssue 'SchemaLevel]
-> [AnItem Behave AnIssue 'SchemaLevel]
forall a. [a] -> [a] -> [a]
++ PathsPrefixTree Behave AnIssue 'SchemaLevel
-> [AnItem Behave AnIssue 'SchemaLevel]
forall k (q :: k -> k -> *) (f :: k -> *) (r :: k).
PathsPrefixTree q f r -> [AnItem q f r]
P.toList PathsPrefixTree Behave AnIssue 'SchemaLevel
ec of
issues :: [AnItem Behave AnIssue 'SchemaLevel]
issues@(AnItem Behave AnIssue 'SchemaLevel
_ : [AnItem Behave AnIssue 'SchemaLevel]
_) -> [AnItem Behave AnIssue 'SchemaLevel]
-> (AnItem Behave AnIssue 'SchemaLevel
-> Compose CompatM (FormulaF Behave AnIssue 'APILevel) Any)
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [AnItem Behave AnIssue 'SchemaLevel]
issues ((AnItem Behave AnIssue 'SchemaLevel
-> Compose CompatM (FormulaF Behave AnIssue 'APILevel) Any)
-> SemanticCompatFormula ())
-> (AnItem Behave AnIssue 'SchemaLevel
-> Compose CompatM (FormulaF Behave AnIssue 'APILevel) Any)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Behavior 'SchemaLevel
-> CompatFormula' Behave AnIssue 'SchemaLevel Any
-> Compose CompatM (FormulaF Behave AnIssue 'APILevel) Any
forall k (q :: k -> k -> *) (r :: k) (l :: k) (f :: k -> *) a.
Paths q r l -> CompatFormula' q f l a -> CompatFormula' q f r a
embedFormula Behavior 'SchemaLevel
beh (CompatFormula' Behave AnIssue 'SchemaLevel Any
-> Compose CompatM (FormulaF Behave AnIssue 'APILevel) Any)
-> (AnItem Behave AnIssue 'SchemaLevel
-> CompatFormula' Behave AnIssue 'SchemaLevel Any)
-> AnItem Behave AnIssue 'SchemaLevel
-> Compose CompatM (FormulaF Behave AnIssue 'APILevel) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnItem Behave AnIssue 'SchemaLevel
-> CompatFormula' Behave AnIssue 'SchemaLevel Any
forall (q :: BehaviorLevel -> BehaviorLevel -> *)
(r :: BehaviorLevel) a.
AnItem q AnIssue r -> CompatFormula' q AnIssue r a
anItem
[] -> do
let typesRestricted :: Bool
typesRestricted = Bool -> Bool
not (ForeachType JsonFormula -> Bool
anyBottomTypes ForeachType JsonFormula
fp) Bool -> Bool -> Bool
&& ForeachType JsonFormula -> Bool
anyBottomTypes ForeachType JsonFormula
fc
Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
typesRestricted (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Behavior 'SchemaLevel
-> Issue 'SchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Behavior 'SchemaLevel
beh (Issue 'SchemaLevel -> SemanticCompatFormula ())
-> Issue 'SchemaLevel -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ [JsonType] -> Issue 'SchemaLevel
TypesRestricted ([JsonType] -> Issue 'SchemaLevel)
-> [JsonType] -> Issue 'SchemaLevel
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> [JsonType]
nonBottomTypes ForeachType JsonFormula
fc
(forall (x :: JsonType).
Typeable x =>
JsonType
-> (ForeachType JsonFormula -> JsonFormula x)
-> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (m :: * -> *) (f :: JsonType -> *).
Applicative m =>
(forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m ())
-> m ()
forType_ ((forall (x :: JsonType).
Typeable x =>
JsonType
-> (ForeachType JsonFormula -> JsonFormula x)
-> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (forall (x :: JsonType).
Typeable x =>
JsonType
-> (ForeachType JsonFormula -> JsonFormula x)
-> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \JsonType
tyName ForeachType JsonFormula -> JsonFormula x
ty -> do
let beh' :: Paths Behave 'APILevel 'TypedSchemaLevel
beh' = Behavior 'SchemaLevel
beh Behavior 'SchemaLevel
-> Paths Behave 'SchemaLevel 'TypedSchemaLevel
-> Paths Behave 'APILevel 'TypedSchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'SchemaLevel 'TypedSchemaLevel
-> Paths Behave 'SchemaLevel 'TypedSchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (JsonType -> Behave 'SchemaLevel 'TypedSchemaLevel
OfType JsonType
tyName)
case (JsonFormula x -> DNF (Condition x)
forall (t :: JsonType). JsonFormula t -> DNF (Condition t)
getJsonFormula (JsonFormula x -> DNF (Condition x))
-> JsonFormula x -> DNF (Condition x)
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula x
ty ForeachType JsonFormula
fp, JsonFormula x -> DNF (Condition x)
forall (t :: JsonType). JsonFormula t -> DNF (Condition t)
getJsonFormula (JsonFormula x -> DNF (Condition x))
-> JsonFormula x -> DNF (Condition x)
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula x
ty ForeachType JsonFormula
fc) of
(DNF Set (Disjunct (Condition x))
pss, DNF (Condition x)
BottomDNF) -> Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
typesRestricted (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ do
Set (Disjunct (Condition x))
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Disjunct (Condition x))
pss ((Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Disjunct Set (Condition x)
ps) -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Maybe Partition -> Set (Condition x) -> SemanticCompatFormula ()
forall (t :: JsonType).
Paths Behave 'APILevel 'TypedSchemaLevel
-> Maybe Partition -> Set (Condition t) -> SemanticCompatFormula ()
checkContradiction Paths Behave 'APILevel 'TypedSchemaLevel
beh' Maybe Partition
forall a. Maybe a
Nothing Set (Condition x)
ps
(DNF Set (Disjunct (Condition x))
pss, SingleDisjunct (Disjunct Set (Condition x)
cs)) -> Set (Disjunct (Condition x))
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Disjunct (Condition x))
pss ((Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Disjunct Set (Condition x)
ps) -> do
Set (Condition x)
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Condition x)
cs ((Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition x)
-> Condition x
-> SemanticCompatFormula ()
forall (xs :: [*]) (t :: JsonType).
ReassembleHList xs (CheckEnv (Referenced Schema)) =>
HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition t)
-> Condition t
-> SemanticCompatFormula ()
checkImplication HList xs
env Paths Behave 'APILevel 'TypedSchemaLevel
beh' ProdCons (Trace Schema)
trs Set (Condition x)
ps
(DNF (Condition x)
TopDNF, DNF Set (Disjunct (Condition x))
css) ->
Set (Disjunct (Condition x))
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Disjunct (Condition x))
css ((Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Disjunct Set (Condition x)
cs) -> Set (Condition x)
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Condition x)
cs ((Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition x)
-> Condition x
-> SemanticCompatFormula ()
forall (xs :: [*]) (t :: JsonType).
ReassembleHList xs (CheckEnv (Referenced Schema)) =>
HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition t)
-> Condition t
-> SemanticCompatFormula ()
checkImplication HList xs
env Paths Behave 'APILevel 'TypedSchemaLevel
beh' ProdCons (Trace Schema)
trs Set (Condition x)
forall a. Set a
S.empty
(DNF (Condition x)
pss', DNF (Condition x)
css') -> [(Maybe Partition, ProdCons (JsonFormula x))]
-> ((Maybe Partition, ProdCons (JsonFormula x))
-> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ProdCons (Traced (Definitions Schema))
-> ProdCons (JsonFormula x)
-> [(Maybe Partition, ProdCons (JsonFormula x))]
forall (t :: JsonType).
ProdCons (Traced (Definitions Schema))
-> ProdCons (JsonFormula t)
-> [(Maybe Partition, ProdCons (JsonFormula t))]
tryPartition ProdCons (Traced (Definitions Schema))
defs (ProdCons (JsonFormula x)
-> [(Maybe Partition, ProdCons (JsonFormula x))])
-> ProdCons (JsonFormula x)
-> [(Maybe Partition, ProdCons (JsonFormula x))]
forall a b. (a -> b) -> a -> b
$ JsonFormula x -> JsonFormula x -> ProdCons (JsonFormula x)
forall a. a -> a -> ProdCons a
ProdCons (DNF (Condition x) -> JsonFormula x
forall (t :: JsonType). DNF (Condition t) -> JsonFormula t
JsonFormula DNF (Condition x)
pss') (DNF (Condition x) -> JsonFormula x
forall (t :: JsonType). DNF (Condition t) -> JsonFormula t
JsonFormula DNF (Condition x)
css')) (((Maybe Partition, ProdCons (JsonFormula x))
-> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> ((Maybe Partition, ProdCons (JsonFormula x))
-> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
(Maybe Partition
mPart, ProdCons JsonFormula x
pf JsonFormula x
cf) -> do
let beh'' :: Paths Behave 'APILevel 'TypedSchemaLevel
beh'' = (Partition
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'APILevel 'TypedSchemaLevel)
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> Maybe Partition
-> Paths Behave 'APILevel 'TypedSchemaLevel
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Paths Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'APILevel 'TypedSchemaLevel
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(<<<) (Paths Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'APILevel 'TypedSchemaLevel)
-> (Partition -> Paths Behave 'TypedSchemaLevel 'TypedSchemaLevel)
-> Partition
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'APILevel 'TypedSchemaLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'TypedSchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'TypedSchemaLevel)
-> (Partition -> Behave 'TypedSchemaLevel 'TypedSchemaLevel)
-> Partition
-> Paths Behave 'TypedSchemaLevel 'TypedSchemaLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> Behave 'TypedSchemaLevel 'TypedSchemaLevel
InPartition) Paths Behave 'APILevel 'TypedSchemaLevel
beh' Maybe Partition
mPart
case (JsonFormula x -> DNF (Condition x)
forall (t :: JsonType). JsonFormula t -> DNF (Condition t)
getJsonFormula JsonFormula x
pf, JsonFormula x -> DNF (Condition x)
forall (t :: JsonType). JsonFormula t -> DNF (Condition t)
getJsonFormula JsonFormula x
cf) of
(DNF Set (Disjunct (Condition x))
pss, DNF (Condition x)
BottomDNF) -> Set (Disjunct (Condition x))
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Disjunct (Condition x))
pss ((Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Disjunct Set (Condition x)
ps) -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Maybe Partition -> Set (Condition x) -> SemanticCompatFormula ()
forall (t :: JsonType).
Paths Behave 'APILevel 'TypedSchemaLevel
-> Maybe Partition -> Set (Condition t) -> SemanticCompatFormula ()
checkContradiction Paths Behave 'APILevel 'TypedSchemaLevel
beh' Maybe Partition
mPart Set (Condition x)
ps
(DNF Set (Disjunct (Condition x))
pss, SingleDisjunct (Disjunct Set (Condition x)
cs)) -> Set (Disjunct (Condition x))
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Disjunct (Condition x))
pss ((Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Disjunct Set (Condition x)
ps) -> do
Set (Condition x)
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Condition x)
cs ((Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition x)
-> Condition x
-> SemanticCompatFormula ()
forall (xs :: [*]) (t :: JsonType).
ReassembleHList xs (CheckEnv (Referenced Schema)) =>
HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition t)
-> Condition t
-> SemanticCompatFormula ()
checkImplication HList xs
env Paths Behave 'APILevel 'TypedSchemaLevel
beh'' ProdCons (Trace Schema)
trs Set (Condition x)
ps
(DNF Set (Disjunct (Condition x))
pss, DNF Set (Disjunct (Condition x))
css) -> Set (Disjunct (Condition x))
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Disjunct (Condition x))
pss ((Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Disjunct (Condition x) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Disjunct Set (Condition x)
ps) -> do
Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> [SemanticCompatFormula ()]
-> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l
-> Issue l
-> [CompatFormula' q AnIssue r a]
-> CompatFormula' q AnIssue r a
anyOfAt
Paths Behave 'APILevel 'TypedSchemaLevel
beh'
(Maybe Partition -> Set (Condition x) -> Issue 'TypedSchemaLevel
forall (t :: JsonType).
Typeable t =>
Maybe Partition -> Set (Condition t) -> Issue 'TypedSchemaLevel
issueFromDisjunct Maybe Partition
forall a. Maybe a
Nothing Set (Condition x)
ps)
[Set (Condition x)
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set (Condition x)
cs ((Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ())
-> (Condition x -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition x)
-> Condition x
-> SemanticCompatFormula ()
forall (xs :: [*]) (t :: JsonType).
ReassembleHList xs (CheckEnv (Referenced Schema)) =>
HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition t)
-> Condition t
-> SemanticCompatFormula ()
checkImplication HList xs
env Paths Behave 'APILevel 'TypedSchemaLevel
beh' ProdCons (Trace Schema)
trs Set (Condition x)
ps | Disjunct Set (Condition x)
cs <- Set (Disjunct (Condition x)) -> [Disjunct (Condition x)]
forall a. Set a -> [a]
S.toList Set (Disjunct (Condition x))
css]
pure ()
where
anyBottomTypes :: ForeachType JsonFormula -> Bool
anyBottomTypes ForeachType JsonFormula
f = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$
(forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType JsonFormula -> JsonFormula x) -> Any)
-> Any
forall m (f :: JsonType -> *).
Monoid m =>
(forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m)
-> m
foldType ((forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType JsonFormula -> JsonFormula x) -> Any)
-> Any)
-> (forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType JsonFormula -> JsonFormula x) -> Any)
-> Any
forall a b. (a -> b) -> a -> b
$ \JsonType
_ ForeachType JsonFormula -> JsonFormula x
ty -> case JsonFormula x -> DNF (Condition x)
forall (t :: JsonType). JsonFormula t -> DNF (Condition t)
getJsonFormula (JsonFormula x -> DNF (Condition x))
-> JsonFormula x -> DNF (Condition x)
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula x
ty ForeachType JsonFormula
f of
DNF (Condition x)
BottomDNF -> Bool -> Any
Any Bool
True
DNF (Condition x)
_ -> Any
forall a. Monoid a => a
mempty
nonBottomTypes :: ForeachType JsonFormula -> [JsonType]
nonBottomTypes ForeachType JsonFormula
f = (forall (x :: JsonType).
Typeable x =>
JsonType
-> (ForeachType JsonFormula -> JsonFormula x) -> [JsonType])
-> [JsonType]
forall m (f :: JsonType -> *).
Monoid m =>
(forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m)
-> m
foldType ((forall (x :: JsonType).
Typeable x =>
JsonType
-> (ForeachType JsonFormula -> JsonFormula x) -> [JsonType])
-> [JsonType])
-> (forall (x :: JsonType).
Typeable x =>
JsonType
-> (ForeachType JsonFormula -> JsonFormula x) -> [JsonType])
-> [JsonType]
forall a b. (a -> b) -> a -> b
$ \JsonType
tyName ForeachType JsonFormula -> JsonFormula x
ty -> case JsonFormula x -> DNF (Condition x)
forall (t :: JsonType). JsonFormula t -> DNF (Condition t)
getJsonFormula (JsonFormula x -> DNF (Condition x))
-> JsonFormula x -> DNF (Condition x)
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula x
ty ForeachType JsonFormula
f of
DNF (Condition x)
BottomDNF -> [JsonType]
forall a. Monoid a => a
mempty
DNF (Condition x)
_ -> [JsonType
tyName]
issueFromDisjunct :: Typeable t => Maybe Partition -> S.Set (Condition t) -> Issue 'TypedSchemaLevel
issueFromDisjunct :: Maybe Partition -> Set (Condition t) -> Issue 'TypedSchemaLevel
issueFromDisjunct Maybe Partition
_ Set (Condition t)
ps
| Just TypedValue t
e <- Set (Condition t) -> Maybe (TypedValue t)
forall (t :: JsonType). Set (Condition t) -> Maybe (TypedValue t)
findExactly Set (Condition t)
ps
, (Condition t -> Bool) -> Set (Condition t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TypedValue t -> Condition t -> Bool
forall (t :: JsonType). TypedValue t -> Condition t -> Bool
satisfiesTyped TypedValue t
e) Set (Condition t)
ps =
Value -> Issue 'TypedSchemaLevel
EnumDoesntSatisfy (Value -> Issue 'TypedSchemaLevel)
-> Value -> Issue 'TypedSchemaLevel
forall a b. (a -> b) -> a -> b
$ TypedValue t -> Value
forall (t :: JsonType). TypedValue t -> Value
untypeValue TypedValue t
e
issueFromDisjunct Maybe Partition
mPart Set (Condition t)
ps = Maybe Partition -> [SomeCondition] -> Issue 'TypedSchemaLevel
NoMatchingCondition Maybe Partition
mPart ([SomeCondition] -> Issue 'TypedSchemaLevel)
-> [SomeCondition] -> Issue 'TypedSchemaLevel
forall a b. (a -> b) -> a -> b
$ Condition t -> SomeCondition
forall (t :: JsonType). Typeable t => Condition t -> SomeCondition
SomeCondition (Condition t -> SomeCondition) -> [Condition t] -> [SomeCondition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Condition t) -> [Condition t]
forall a. Set a -> [a]
S.toList Set (Condition t)
ps
checkContradiction ::
Behavior 'TypedSchemaLevel ->
Maybe Partition ->
S.Set (Condition t) ->
SemanticCompatFormula ()
checkContradiction :: Paths Behave 'APILevel 'TypedSchemaLevel
-> Maybe Partition -> Set (Condition t) -> SemanticCompatFormula ()
checkContradiction Paths Behave 'APILevel 'TypedSchemaLevel
beh Maybe Partition
mPart Set (Condition t)
_ = Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (Issue 'TypedSchemaLevel -> SemanticCompatFormula ())
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Issue 'TypedSchemaLevel
-> (Partition -> Issue 'TypedSchemaLevel)
-> Maybe Partition
-> Issue 'TypedSchemaLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Issue 'TypedSchemaLevel
TypeBecomesEmpty Partition -> Issue 'TypedSchemaLevel
PartitionBecomesEmpty Maybe Partition
mPart
checkImplication ::
(ReassembleHList xs (CheckEnv (Referenced Schema))) =>
HList xs ->
Behavior 'TypedSchemaLevel ->
ProdCons (Trace Schema) ->
S.Set (Condition t) ->
Condition t ->
SemanticCompatFormula ()
checkImplication :: HList xs
-> Paths Behave 'APILevel 'TypedSchemaLevel
-> ProdCons (Trace Schema)
-> Set (Condition t)
-> Condition t
-> SemanticCompatFormula ()
checkImplication HList xs
env Paths Behave 'APILevel 'TypedSchemaLevel
beh ProdCons (Trace Schema)
trs Set (Condition t)
prods Condition t
cons = case Set (Condition t) -> Maybe (TypedValue t)
forall (t :: JsonType). Set (Condition t) -> Maybe (TypedValue t)
findExactly Set (Condition t)
prods of
Just TypedValue t
e
| (Condition t -> Bool) -> Set (Condition t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TypedValue t -> Condition t -> Bool
forall (t :: JsonType). TypedValue t -> Condition t -> Bool
satisfiesTyped TypedValue t
e) Set (Condition t)
prods ->
if TypedValue t -> Condition t -> Bool
forall (t :: JsonType). TypedValue t -> Condition t -> Bool
satisfiesTyped TypedValue t
e Condition t
cons
then () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (Value -> Issue 'TypedSchemaLevel
EnumDoesntSatisfy (Value -> Issue 'TypedSchemaLevel)
-> Value -> Issue 'TypedSchemaLevel
forall a b. (a -> b) -> a -> b
$ TypedValue t -> Value
forall (t :: JsonType). TypedValue t -> Value
untypeValue TypedValue t
e)
| Bool
otherwise -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe (TypedValue t)
Nothing -> case Condition t
cons of
Exactly TypedValue t
e -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (Value -> Issue 'TypedSchemaLevel
NoMatchingEnum (Value -> Issue 'TypedSchemaLevel)
-> Value -> Issue 'TypedSchemaLevel
forall a b. (a -> b) -> a -> b
$ TypedValue t -> Value
forall (t :: JsonType). TypedValue t -> Value
untypeValue TypedValue t
e)
Maximum Bound Scientific
m -> (Bound Scientific -> Bound Scientific -> Bound Scientific)
-> Bound Scientific
-> (Bound Scientific -> Issue 'TypedSchemaLevel)
-> (ProdCons (Bound Scientific) -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType).
Condition t -> Maybe (Bound Scientific))
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Bound Scientific -> Bound Scientific -> Bound Scientific
forall a. Ord a => a -> a -> a
min Bound Scientific
m Bound Scientific -> Issue 'TypedSchemaLevel
NoMatchingMaximum ProdCons (Bound Scientific) -> Issue 'TypedSchemaLevel
MatchingMaximumWeak ((forall (t :: JsonType). Condition t -> Maybe (Bound Scientific))
-> SemanticCompatFormula ())
-> (forall (t :: JsonType).
Condition t -> Maybe (Bound Scientific))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
Maximum Bound Scientific
m' -> Bound Scientific -> Maybe (Bound Scientific)
forall a. a -> Maybe a
Just Bound Scientific
m'
Condition t
_ -> Maybe (Bound Scientific)
forall a. Maybe a
Nothing
Minimum Down (Bound (Down Scientific))
m -> (Down (Bound (Down Scientific))
-> Down (Bound (Down Scientific))
-> Down (Bound (Down Scientific)))
-> Down (Bound (Down Scientific))
-> (Down (Bound (Down Scientific)) -> Issue 'TypedSchemaLevel)
-> (ProdCons (Down (Bound (Down Scientific)))
-> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType).
Condition t -> Maybe (Down (Bound (Down Scientific))))
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Down (Bound (Down Scientific))
-> Down (Bound (Down Scientific)) -> Down (Bound (Down Scientific))
forall a. Ord a => a -> a -> a
max Down (Bound (Down Scientific))
m (Bound Scientific -> Issue 'TypedSchemaLevel
NoMatchingMinimum (Bound Scientific -> Issue 'TypedSchemaLevel)
-> (Down (Bound (Down Scientific)) -> Bound Scientific)
-> Down (Bound (Down Scientific))
-> Issue 'TypedSchemaLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Down (Bound (Down Scientific)) -> Bound Scientific
coerce) (ProdCons (Bound Scientific) -> Issue 'TypedSchemaLevel
MatchingMinimumWeak (ProdCons (Bound Scientific) -> Issue 'TypedSchemaLevel)
-> (ProdCons (Down (Bound (Down Scientific)))
-> ProdCons (Bound Scientific))
-> ProdCons (Down (Bound (Down Scientific)))
-> Issue 'TypedSchemaLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProdCons (Down (Bound (Down Scientific)))
-> ProdCons (Bound Scientific)
coerce) ((forall (t :: JsonType).
Condition t -> Maybe (Down (Bound (Down Scientific))))
-> SemanticCompatFormula ())
-> (forall (t :: JsonType).
Condition t -> Maybe (Down (Bound (Down Scientific))))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
Minimum Down (Bound (Down Scientific))
m' -> Down (Bound (Down Scientific))
-> Maybe (Down (Bound (Down Scientific)))
forall a. a -> Maybe a
Just Down (Bound (Down Scientific))
m'
Condition t
_ -> Maybe (Down (Bound (Down Scientific)))
forall a. Maybe a
Nothing
MultipleOf Scientific
m -> (Scientific -> Scientific -> Scientific)
-> Scientific
-> (Scientific -> Issue 'TypedSchemaLevel)
-> (ProdCons Scientific -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe Scientific)
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Scientific -> Scientific -> Scientific
forall a a a. (Real a, Real a, Fractional a) => a -> a -> a
lcmScientific Scientific
m Scientific -> Issue 'TypedSchemaLevel
NoMatchingMultipleOf ProdCons Scientific -> Issue 'TypedSchemaLevel
MatchingMultipleOfWeak ((forall (t :: JsonType). Condition t -> Maybe Scientific)
-> SemanticCompatFormula ())
-> (forall (t :: JsonType). Condition t -> Maybe Scientific)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
MultipleOf Scientific
m' -> Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
m'
Condition t
_ -> Maybe Scientific
forall a. Maybe a
Nothing
NumberFormat Format
f -> case ((Condition t -> Bool) -> Set (Condition t) -> Bool)
-> Set (Condition t) -> (Condition t -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Condition t -> Bool) -> Set (Condition t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Set (Condition t)
prods ((Condition t -> Bool) -> Bool) -> (Condition t -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \case
NumberFormat Format
f' -> Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
f'
Condition t
_ -> Bool
False of
Bool
True -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
False -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (Format -> Issue 'TypedSchemaLevel
NoMatchingFormat Format
f)
MaxLength Integer
m -> (Integer -> Integer -> Integer)
-> Integer
-> (Integer -> Issue 'TypedSchemaLevel)
-> (ProdCons Integer -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
m Integer -> Issue 'TypedSchemaLevel
NoMatchingMaxLength ProdCons Integer -> Issue 'TypedSchemaLevel
MatchingMaxLengthWeak ((forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ())
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
MaxLength Integer
m' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
m'
Condition t
_ -> Maybe Integer
forall a. Maybe a
Nothing
MinLength Integer
m -> (Integer -> Integer -> Integer)
-> Integer
-> (Integer -> Issue 'TypedSchemaLevel)
-> (ProdCons Integer -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
m Integer -> Issue 'TypedSchemaLevel
NoMatchingMinLength ProdCons Integer -> Issue 'TypedSchemaLevel
MatchingMinLengthWeak ((forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ())
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
MinLength Integer
m' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
m'
Condition t
_ -> Maybe Integer
forall a. Maybe a
Nothing
Pattern Format
p -> case ((Condition t -> Bool) -> Set (Condition t) -> Bool)
-> Set (Condition t) -> (Condition t -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Condition t -> Bool) -> Set (Condition t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Set (Condition t)
prods ((Condition t -> Bool) -> Bool) -> (Condition t -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \case
Pattern Format
p' -> Format
p Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
p'
Condition t
_ -> Bool
False of
Bool
True -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
False -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (Format -> Issue 'TypedSchemaLevel
NoMatchingPattern Format
p)
StringFormat Format
f -> case ((Condition t -> Bool) -> Set (Condition t) -> Bool)
-> Set (Condition t) -> (Condition t -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Condition t -> Bool) -> Set (Condition t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Set (Condition t)
prods ((Condition t -> Bool) -> Bool) -> (Condition t -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \case
StringFormat Format
f' -> Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
f'
Condition t
_ -> Bool
False of
Bool
True -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
False -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (Format -> Issue 'TypedSchemaLevel
NoMatchingFormat Format
f)
Items ForeachType JsonFormula
_ Traced (Referenced Schema)
cons' -> case ((Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
-> (Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
-> (Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)])))
-> Set (Condition t)
-> (Condition t
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)])))
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
forall b a. (b -> b -> b) -> Set a -> (a -> Maybe b) -> Maybe b
foldSome (Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
-> (Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
-> (Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
forall a. Semigroup a => a -> a -> a
(<>) Set (Condition t)
prods ((Condition t
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)])))
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)])))
-> (Condition t
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)])))
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
forall a b. (a -> b) -> a -> b
$ \case
Items ForeachType JsonFormula
_ Traced (Referenced Schema)
rs -> (Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
forall a. a -> Maybe a
Just (NonEmpty (Traced (Referenced Schema))
-> Maybe (NonEmpty (Traced (Referenced Schema)))
forall a. a -> Maybe a
Just (Traced (Referenced Schema)
rs Traced (Referenced Schema)
-> [Traced (Referenced Schema)]
-> NonEmpty (Traced (Referenced Schema))
forall a. a -> [a] -> NonEmpty a
NE.:| []), Maybe (NonEmpty [Traced (Referenced Schema)])
forall a. Monoid a => a
mempty)
TupleItems (((ForeachType JsonFormula, Traced (Referenced Schema))
-> Traced (Referenced Schema))
-> [(ForeachType JsonFormula, Traced (Referenced Schema))]
-> [Traced (Referenced Schema)]
forall a b. (a -> b) -> [a] -> [b]
map (ForeachType JsonFormula, Traced (Referenced Schema))
-> Traced (Referenced Schema)
forall a b. (a, b) -> b
snd -> [Traced (Referenced Schema)]
fs) -> (Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
-> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
forall a. a -> Maybe a
Just (Maybe (NonEmpty (Traced (Referenced Schema)))
forall a. Monoid a => a
mempty, NonEmpty [Traced (Referenced Schema)]
-> Maybe (NonEmpty [Traced (Referenced Schema)])
forall a. a -> Maybe a
Just ([Traced (Referenced Schema)]
fs [Traced (Referenced Schema)]
-> [[Traced (Referenced Schema)]]
-> NonEmpty [Traced (Referenced Schema)]
forall a. a -> [a] -> NonEmpty a
NE.:| []))
Condition t
_ -> Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
forall a. Maybe a
Nothing of
Just (Maybe (NonEmpty (Traced (Referenced Schema)))
mItems, Just NonEmpty [Traced (Referenced Schema)]
pfs)
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ NonEmpty Int -> Bool
forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> Bool
allSame ([Traced (Referenced Schema)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Traced (Referenced Schema)] -> Int)
-> NonEmpty [Traced (Referenced Schema)] -> NonEmpty Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [Traced (Referenced Schema)]
pfs) -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| let plen :: Integer
plen = [Traced (Referenced Schema)] -> Integer
forall i a. Num i => [a] -> i
genericLength (NonEmpty [Traced (Referenced Schema)]
-> [Traced (Referenced Schema)]
forall a. NonEmpty a -> a
NE.head NonEmpty [Traced (Referenced Schema)]
pfs) ->
AnItem Behave AnIssue 'APILevel
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (q :: BehaviorLevel -> BehaviorLevel -> *)
(r :: BehaviorLevel) a.
AnItem q AnIssue r
-> CompatFormula' q AnIssue r a -> CompatFormula' q AnIssue r a
clarifyIssue (Paths Behave 'APILevel 'TypedSchemaLevel
-> AnIssue 'TypedSchemaLevel -> AnItem Behave AnIssue 'APILevel
forall k (f :: k -> *) (a :: k) (q :: k -> k -> *) (r :: k).
Ord (f a) =>
Paths q r a -> f a -> AnItem q f r
AnItem Paths Behave 'APILevel 'TypedSchemaLevel
beh (Issue 'TypedSchemaLevel -> AnIssue 'TypedSchemaLevel
forall (l :: BehaviorLevel). Issuable l => Issue l -> AnIssue l
anIssue Issue 'TypedSchemaLevel
TupleToArray)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
[Integer]
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Integer
0 .. Integer
plen Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1] ((Integer -> SemanticCompatFormula ()) -> SemanticCompatFormula ())
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
let prod' :: Traced (Referenced Schema)
prod' = NonEmpty (Traced (Referenced Schema)) -> Traced (Referenced Schema)
tracedConjunct (NonEmpty (Traced (Referenced Schema))
-> Traced (Referenced Schema))
-> NonEmpty (Traced (Referenced Schema))
-> Traced (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ case Maybe (NonEmpty (Traced (Referenced Schema)))
mItems of
Just NonEmpty (Traced (Referenced Schema))
prods' -> (([Traced (Referenced Schema)]
-> Integer -> Traced (Referenced Schema)
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i) ([Traced (Referenced Schema)] -> Traced (Referenced Schema))
-> NonEmpty [Traced (Referenced Schema)]
-> NonEmpty (Traced (Referenced Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [Traced (Referenced Schema)]
pfs) NonEmpty (Traced (Referenced Schema))
-> NonEmpty (Traced (Referenced Schema))
-> NonEmpty (Traced (Referenced Schema))
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Traced (Referenced Schema))
prods'
Maybe (NonEmpty (Traced (Referenced Schema)))
Nothing -> ([Traced (Referenced Schema)]
-> Integer -> Traced (Referenced Schema)
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i) ([Traced (Referenced Schema)] -> Traced (Referenced Schema))
-> NonEmpty [Traced (Referenced Schema)]
-> NonEmpty (Traced (Referenced Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [Traced (Referenced Schema)]
pfs
Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Integer -> Behave 'TypedSchemaLevel 'SchemaLevel
InItem Integer
i)) HList xs
env (ProdCons (Traced (Referenced Schema)) -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
prod' Traced (Referenced Schema)
cons'
Just (Just NonEmpty (Traced (Referenced Schema))
prods', Maybe (NonEmpty [Traced (Referenced Schema)])
Nothing) -> do
let prod' :: Traced (Referenced Schema)
prod' = NonEmpty (Traced (Referenced Schema)) -> Traced (Referenced Schema)
tracedConjunct NonEmpty (Traced (Referenced Schema))
prods'
Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Behave 'TypedSchemaLevel 'SchemaLevel
InItems) HList xs
env (ProdCons (Traced (Referenced Schema)) -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
prod' Traced (Referenced Schema)
cons'
Maybe
(Maybe (NonEmpty (Traced (Referenced Schema))),
Maybe (NonEmpty [Traced (Referenced Schema)]))
_ -> AnItem Behave AnIssue 'APILevel
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (q :: BehaviorLevel -> BehaviorLevel -> *)
(r :: BehaviorLevel) a.
AnItem q AnIssue r
-> CompatFormula' q AnIssue r a -> CompatFormula' q AnIssue r a
clarifyIssue (Paths Behave 'APILevel 'TypedSchemaLevel
-> AnIssue 'TypedSchemaLevel -> AnItem Behave AnIssue 'APILevel
forall k (f :: k -> *) (a :: k) (q :: k -> k -> *) (r :: k).
Ord (f a) =>
Paths q r a -> f a -> AnItem q f r
AnItem Paths Behave 'APILevel 'TypedSchemaLevel
beh (Issue 'TypedSchemaLevel -> AnIssue 'TypedSchemaLevel
forall (l :: BehaviorLevel). Issuable l => Issue l -> AnIssue l
anIssue Issue 'TypedSchemaLevel
NoMatchingItems)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ do
Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Behave 'TypedSchemaLevel 'SchemaLevel
InItems) HList xs
env (ProdCons (Traced (Referenced Schema)) -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
prodTopSchema Traced (Referenced Schema)
cons'
TupleItems (((ForeachType JsonFormula, Traced (Referenced Schema))
-> Traced (Referenced Schema))
-> [(ForeachType JsonFormula, Traced (Referenced Schema))]
-> [Traced (Referenced Schema)]
forall a b. (a -> b) -> [a] -> [b]
map (ForeachType JsonFormula, Traced (Referenced Schema))
-> Traced (Referenced Schema)
forall a b. (a, b) -> b
snd -> [Traced (Referenced Schema)]
fs) -> case ((Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema)))))
-> Set (Condition t)
-> (Condition t
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema)))))
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall b a. (b -> b -> b) -> Set a -> (a -> Maybe b) -> Maybe b
foldSome (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall a. Semigroup a => a -> a -> a
(<>) Set (Condition t)
prods ((Condition t
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema)))))
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema)))))
-> (Condition t
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema)))))
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall a b. (a -> b) -> a -> b
$ \case
TupleItems (((ForeachType JsonFormula, Traced (Referenced Schema))
-> Traced (Referenced Schema))
-> [(ForeachType JsonFormula, Traced (Referenced Schema))]
-> [Traced (Referenced Schema)]
forall a b. (a -> b) -> [a] -> [b]
map (ForeachType JsonFormula, Traced (Referenced Schema))
-> Traced (Referenced Schema)
forall a b. (a, b) -> b
snd -> [Traced (Referenced Schema)]
fs') -> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall a. a -> Maybe a
Just (NonEmpty [Traced (Referenced Schema)]
-> Maybe (NonEmpty [Traced (Referenced Schema)])
forall a. a -> Maybe a
Just (NonEmpty [Traced (Referenced Schema)]
-> Maybe (NonEmpty [Traced (Referenced Schema)]))
-> NonEmpty [Traced (Referenced Schema)]
-> Maybe (NonEmpty [Traced (Referenced Schema)])
forall a b. (a -> b) -> a -> b
$ [Traced (Referenced Schema)]
fs' [Traced (Referenced Schema)]
-> [[Traced (Referenced Schema)]]
-> NonEmpty [Traced (Referenced Schema)]
forall a. a -> [a] -> NonEmpty a
NE.:| [], Max Integer -> Maybe (Max Integer)
forall a. a -> Maybe a
Just (Max Integer -> Maybe (Max Integer))
-> (Integer -> Max Integer) -> Integer -> Maybe (Max Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Max Integer
forall a. a -> Max a
Max (Integer -> Maybe (Max Integer)) -> Integer -> Maybe (Max Integer)
forall a b. (a -> b) -> a -> b
$ [Traced (Referenced Schema)] -> Integer
forall i a. Num i => [a] -> i
genericLength [Traced (Referenced Schema)]
fs', Min Integer -> Maybe (Min Integer)
forall a. a -> Maybe a
Just (Min Integer -> Maybe (Min Integer))
-> (Integer -> Min Integer) -> Integer -> Maybe (Min Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Min Integer
forall a. a -> Min a
Min (Integer -> Maybe (Min Integer)) -> Integer -> Maybe (Min Integer)
forall a b. (a -> b) -> a -> b
$ [Traced (Referenced Schema)] -> Integer
forall i a. Num i => [a] -> i
genericLength [Traced (Referenced Schema)]
fs', Maybe (NonEmpty (Traced (Referenced Schema)))
forall a. Monoid a => a
mempty)
MinItems Integer
m' -> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall a. a -> Maybe a
Just (Maybe (NonEmpty [Traced (Referenced Schema)])
forall a. Monoid a => a
mempty, Max Integer -> Maybe (Max Integer)
forall a. a -> Maybe a
Just (Max Integer -> Maybe (Max Integer))
-> (Integer -> Max Integer) -> Integer -> Maybe (Max Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Max Integer
forall a. a -> Max a
Max (Integer -> Maybe (Max Integer)) -> Integer -> Maybe (Max Integer)
forall a b. (a -> b) -> a -> b
$ Integer
m', Maybe (Min Integer)
forall a. Monoid a => a
mempty, Maybe (NonEmpty (Traced (Referenced Schema)))
forall a. Monoid a => a
mempty)
MaxItems Integer
m' -> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall a. a -> Maybe a
Just (Maybe (NonEmpty [Traced (Referenced Schema)])
forall a. Monoid a => a
mempty, Maybe (Max Integer)
forall a. Monoid a => a
mempty, Min Integer -> Maybe (Min Integer)
forall a. a -> Maybe a
Just (Min Integer -> Maybe (Min Integer))
-> (Integer -> Min Integer) -> Integer -> Maybe (Min Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Min Integer
forall a. a -> Min a
Min (Integer -> Maybe (Min Integer)) -> Integer -> Maybe (Min Integer)
forall a b. (a -> b) -> a -> b
$ Integer
m', Maybe (NonEmpty (Traced (Referenced Schema)))
forall a. Monoid a => a
mempty)
Items ForeachType JsonFormula
_ Traced (Referenced Schema)
rs -> (Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
-> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall a. a -> Maybe a
Just (Maybe (NonEmpty [Traced (Referenced Schema)])
forall a. Monoid a => a
mempty, Maybe (Max Integer)
forall a. Monoid a => a
mempty, Maybe (Min Integer)
forall a. Monoid a => a
mempty, NonEmpty (Traced (Referenced Schema))
-> Maybe (NonEmpty (Traced (Referenced Schema)))
forall a. a -> Maybe a
Just (Traced (Referenced Schema)
rs Traced (Referenced Schema)
-> [Traced (Referenced Schema)]
-> NonEmpty (Traced (Referenced Schema))
forall a. a -> [a] -> NonEmpty a
NE.:| []))
Condition t
_ -> Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
forall a. Maybe a
Nothing of
Just (Maybe (NonEmpty [Traced (Referenced Schema)])
_, Just (Max Integer
lowest), Just (Min Integer
highest), Maybe (NonEmpty (Traced (Referenced Schema)))
_) | Integer
lowest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
highest -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Just NonEmpty [Traced (Referenced Schema)]
pfs, Just (Max Integer
plen), Maybe (Min Integer)
_, Maybe (NonEmpty (Traced (Referenced Schema)))
_)
| Integer
plen Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= [Traced (Referenced Schema)] -> Integer
forall i a. Num i => [a] -> i
genericLength [Traced (Referenced Schema)]
fs ->
Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (ProdCons Integer -> Issue 'TypedSchemaLevel
TupleItemsLengthChanged ProdCons :: forall a. a -> a -> ProdCons a
ProdCons {$sel:producer:ProdCons :: Integer
producer = Integer
plen, $sel:consumer:ProdCons :: Integer
consumer = [Traced (Referenced Schema)] -> Integer
forall i a. Num i => [a] -> i
genericLength [Traced (Referenced Schema)]
fs})
| Bool
otherwise ->
[Integer]
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Integer
0 .. Integer
plen Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1] ((Integer -> SemanticCompatFormula ()) -> SemanticCompatFormula ())
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Integer -> Behave 'TypedSchemaLevel 'SchemaLevel
InItem Integer
i)) HList xs
env (ProdCons (Traced (Referenced Schema)) -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons (NonEmpty (Traced (Referenced Schema)) -> Traced (Referenced Schema)
tracedConjunct (NonEmpty (Traced (Referenced Schema))
-> Traced (Referenced Schema))
-> NonEmpty (Traced (Referenced Schema))
-> Traced (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ ([Traced (Referenced Schema)]
-> Integer -> Traced (Referenced Schema)
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i) ([Traced (Referenced Schema)] -> Traced (Referenced Schema))
-> NonEmpty [Traced (Referenced Schema)]
-> NonEmpty (Traced (Referenced Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [Traced (Referenced Schema)]
pfs) ([Traced (Referenced Schema)]
fs [Traced (Referenced Schema)]
-> Integer -> Traced (Referenced Schema)
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i)
Just (Maybe (NonEmpty [Traced (Referenced Schema)])
Nothing, Just (Max Integer
plen), Just (Min Integer
plen'), Maybe (NonEmpty (Traced (Referenced Schema)))
mProd)
| Integer
plen Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
plen' ->
AnItem Behave AnIssue 'APILevel
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (q :: BehaviorLevel -> BehaviorLevel -> *)
(r :: BehaviorLevel) a.
AnItem q AnIssue r
-> CompatFormula' q AnIssue r a -> CompatFormula' q AnIssue r a
clarifyIssue (Paths Behave 'APILevel 'TypedSchemaLevel
-> AnIssue 'TypedSchemaLevel -> AnItem Behave AnIssue 'APILevel
forall k (f :: k -> *) (a :: k) (q :: k -> k -> *) (r :: k).
Ord (f a) =>
Paths q r a -> f a -> AnItem q f r
AnItem Paths Behave 'APILevel 'TypedSchemaLevel
beh (Issue 'TypedSchemaLevel -> AnIssue 'TypedSchemaLevel
forall (l :: BehaviorLevel). Issuable l => Issue l -> AnIssue l
anIssue Issue 'TypedSchemaLevel
ArrayToTuple)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ case Maybe (NonEmpty (Traced (Referenced Schema)))
mProd of
Maybe (NonEmpty (Traced (Referenced Schema)))
_
| Integer
plen Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= [Traced (Referenced Schema)] -> Integer
forall i a. Num i => [a] -> i
genericLength [Traced (Referenced Schema)]
fs ->
Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (ProdCons Integer -> Issue 'TypedSchemaLevel
TupleItemsLengthChanged ProdCons :: forall a. a -> a -> ProdCons a
ProdCons {$sel:producer:ProdCons :: Integer
producer = Integer
plen, $sel:consumer:ProdCons :: Integer
consumer = [Traced (Referenced Schema)] -> Integer
forall i a. Num i => [a] -> i
genericLength [Traced (Referenced Schema)]
fs})
Just NonEmpty (Traced (Referenced Schema))
rs -> [Integer]
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Integer
0 .. Integer
plen Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1] ((Integer -> SemanticCompatFormula ()) -> SemanticCompatFormula ())
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Integer -> Behave 'TypedSchemaLevel 'SchemaLevel
InItem Integer
i)) HList xs
env (ProdCons (Traced (Referenced Schema)) -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons (NonEmpty (Traced (Referenced Schema)) -> Traced (Referenced Schema)
tracedConjunct NonEmpty (Traced (Referenced Schema))
rs) ([Traced (Referenced Schema)]
fs [Traced (Referenced Schema)]
-> Integer -> Traced (Referenced Schema)
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i)
Maybe (NonEmpty (Traced (Referenced Schema)))
Nothing -> AnItem Behave AnIssue 'APILevel
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (q :: BehaviorLevel -> BehaviorLevel -> *)
(r :: BehaviorLevel) a.
AnItem q AnIssue r
-> CompatFormula' q AnIssue r a -> CompatFormula' q AnIssue r a
clarifyIssue (Paths Behave 'APILevel 'TypedSchemaLevel
-> AnIssue 'TypedSchemaLevel -> AnItem Behave AnIssue 'APILevel
forall k (f :: k -> *) (a :: k) (q :: k -> k -> *) (r :: k).
Ord (f a) =>
Paths q r a -> f a -> AnItem q f r
AnItem Paths Behave 'APILevel 'TypedSchemaLevel
beh (Issue 'TypedSchemaLevel -> AnIssue 'TypedSchemaLevel
forall (l :: BehaviorLevel). Issuable l => Issue l -> AnIssue l
anIssue Issue 'TypedSchemaLevel
NoMatchingTupleItems)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ do
[Integer]
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Integer
0 .. Integer
plen Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1] ((Integer -> SemanticCompatFormula ()) -> SemanticCompatFormula ())
-> (Integer -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Integer -> Behave 'TypedSchemaLevel 'SchemaLevel
InItem Integer
i)) HList xs
env (ProdCons (Traced (Referenced Schema)) -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
prodTopSchema ([Traced (Referenced Schema)]
fs [Traced (Referenced Schema)]
-> Integer -> Traced (Referenced Schema)
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i)
Maybe
(Maybe (NonEmpty [Traced (Referenced Schema)]),
Maybe (Max Integer), Maybe (Min Integer),
Maybe (NonEmpty (Traced (Referenced Schema))))
_ -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh Issue 'TypedSchemaLevel
NoMatchingTupleItems
MaxItems Integer
m -> (Integer -> Integer -> Integer)
-> Integer
-> (Integer -> Issue 'TypedSchemaLevel)
-> (ProdCons Integer -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
m Integer -> Issue 'TypedSchemaLevel
NoMatchingMaxItems ProdCons Integer -> Issue 'TypedSchemaLevel
MatchingMaxItemsWeak ((forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ())
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
MaxItems Integer
m' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
m'
TupleItems [(ForeachType JsonFormula, Traced (Referenced Schema))]
fs -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [(ForeachType JsonFormula, Traced (Referenced Schema))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ForeachType JsonFormula, Traced (Referenced Schema))]
fs
Condition t
_ -> Maybe Integer
forall a. Maybe a
Nothing
MinItems Integer
m -> (Integer -> Integer -> Integer)
-> Integer
-> (Integer -> Issue 'TypedSchemaLevel)
-> (ProdCons Integer -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
m Integer -> Issue 'TypedSchemaLevel
NoMatchingMinItems ProdCons Integer -> Issue 'TypedSchemaLevel
MatchingMinItemsWeak ((forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ())
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
MinItems Integer
m' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
m'
TupleItems [(ForeachType JsonFormula, Traced (Referenced Schema))]
fs -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [(ForeachType JsonFormula, Traced (Referenced Schema))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ForeachType JsonFormula, Traced (Referenced Schema))]
fs
Condition t
_ -> Maybe Integer
forall a. Maybe a
Nothing
Condition t
UniqueItems -> case ((Condition t -> Bool) -> Set (Condition t) -> Bool)
-> Set (Condition t) -> (Condition t -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Condition t -> Bool) -> Set (Condition t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Set (Condition t)
prods ((Condition t -> Bool) -> Bool) -> (Condition t -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \case
Condition t
UniqueItems -> Bool
True
MaxItems Integer
1 -> Bool
True
TupleItems [(ForeachType JsonFormula, Traced (Referenced Schema))]
fs | [(ForeachType JsonFormula, Traced (Referenced Schema))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ForeachType JsonFormula, Traced (Referenced Schema))]
fs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Bool
True
Condition t
_ -> Bool
False of
Bool
True -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
False -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh Issue 'TypedSchemaLevel
NoMatchingUniqueItems
Properties Map Format Property
props ForeachType JsonFormula
_ Maybe (Traced (Referenced Schema))
madd -> case (NonEmpty (Map Format Property, Maybe (Traced (Referenced Schema)))
-> NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))
-> NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema))))
-> Set (Condition t)
-> (Condition t
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))))
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema))))
forall b a. (b -> b -> b) -> Set a -> (a -> Maybe b) -> Maybe b
foldSome NonEmpty (Map Format Property, Maybe (Traced (Referenced Schema)))
-> NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))
-> NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))
forall a. Semigroup a => a -> a -> a
(<>) Set (Condition t)
prods ((Condition t
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))))
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))))
-> (Condition t
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))))
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema))))
forall a b. (a -> b) -> a -> b
$ \case
Properties Map Format Property
props' ForeachType JsonFormula
_ Maybe (Traced (Referenced Schema))
madd' -> NonEmpty (Map Format Property, Maybe (Traced (Referenced Schema)))
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema))))
forall a. a -> Maybe a
Just (NonEmpty (Map Format Property, Maybe (Traced (Referenced Schema)))
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))))
-> NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))
-> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema))))
forall a b. (a -> b) -> a -> b
$ (Map Format Property
props', Maybe (Traced (Referenced Schema))
madd') (Map Format Property, Maybe (Traced (Referenced Schema)))
-> [(Map Format Property, Maybe (Traced (Referenced Schema)))]
-> NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema)))
forall a. a -> [a] -> NonEmpty a
NE.:| []
Condition t
_ -> Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema))))
forall a. Maybe a
Nothing of
Just NonEmpty (Map Format Property, Maybe (Traced (Referenced Schema)))
pm ->
Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> [SemanticCompatFormula ()]
-> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l
-> Issue l
-> [CompatFormula' q AnIssue r a]
-> CompatFormula' q AnIssue r a
anyOfAt Paths Behave 'APILevel 'TypedSchemaLevel
beh Issue 'TypedSchemaLevel
NoMatchingProperties ([SemanticCompatFormula ()] -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()] -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
NonEmpty (Map Format Property, Maybe (Traced (Referenced Schema)))
-> [(Map Format Property, Maybe (Traced (Referenced Schema)))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Map Format Property, Maybe (Traced (Referenced Schema)))
pm [(Map Format Property, Maybe (Traced (Referenced Schema)))]
-> ((Map Format Property, Maybe (Traced (Referenced Schema)))
-> SemanticCompatFormula ())
-> [SemanticCompatFormula ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Map Format Property
props', Maybe (Traced (Referenced Schema))
madd') -> do
Set Format
-> (Format -> SemanticCompatFormula ()) -> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Format] -> Set Format
forall a. Ord a => [a] -> Set a
S.fromList ([Format] -> Set Format) -> [Format] -> Set Format
forall a b. (a -> b) -> a -> b
$ Map Format Property -> [Format]
forall k a. Map k a -> [k]
M.keys Map Format Property
props [Format] -> [Format] -> [Format]
forall a. Semigroup a => a -> a -> a
<> Map Format Property -> [Format]
forall k a. Map k a -> [k]
M.keys Map Format Property
props') ((Format -> SemanticCompatFormula ()) -> SemanticCompatFormula ())
-> (Format -> SemanticCompatFormula ()) -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \Format
k -> do
let beh' :: Behavior 'SchemaLevel
beh' = Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Format -> Behave 'TypedSchemaLevel 'SchemaLevel
InProperty Format
k)
go :: Traced (Referenced Schema)
-> Traced (Referenced Schema) -> SemanticCompatFormula ()
go Traced (Referenced Schema)
sch Traced (Referenced Schema)
sch' = Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Behavior 'SchemaLevel
Behavior (SubtreeLevel (Referenced Schema))
beh' HList xs
env (Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
sch Traced (Referenced Schema)
sch')
case (Bool -> (Property -> Bool) -> Maybe Property -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Property -> Bool
propRequired (Maybe Property -> Bool) -> Maybe Property -> Bool
forall a b. (a -> b) -> a -> b
$ Format -> Map Format Property -> Maybe Property
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Format
k Map Format Property
props', Bool -> (Property -> Bool) -> Maybe Property -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Property -> Bool
propRequired (Maybe Property -> Bool) -> Maybe Property -> Bool
forall a b. (a -> b) -> a -> b
$ Format -> Map Format Property -> Maybe Property
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Format
k Map Format Property
props) of
(Bool
False, Bool
True) -> Behavior 'SchemaLevel
-> Issue 'SchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Behavior 'SchemaLevel
beh' Issue 'SchemaLevel
PropertyNowRequired
(Bool, Bool)
_ -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
case (Format -> Map Format Property -> Maybe Property
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Format
k Map Format Property
props', Maybe (Traced (Referenced Schema))
madd', Format -> Map Format Property -> Maybe Property
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Format
k Map Format Property
props, Maybe (Traced (Referenced Schema))
madd) of
(Maybe Property
Nothing, Maybe (Traced (Referenced Schema))
Nothing, Maybe Property
_, Maybe (Traced (Referenced Schema))
_) -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Maybe Property
_, Maybe (Traced (Referenced Schema))
_, Maybe Property
Nothing, Maybe (Traced (Referenced Schema))
Nothing) -> Behavior 'SchemaLevel
-> Issue 'SchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Behavior 'SchemaLevel
beh' Issue 'SchemaLevel
UnexpectedProperty
(Just Property
p', Maybe (Traced (Referenced Schema))
_, Just Property
p, Maybe (Traced (Referenced Schema))
_) -> Traced (Referenced Schema)
-> Traced (Referenced Schema) -> SemanticCompatFormula ()
go (Property -> Traced (Referenced Schema)
propRefSchema Property
p') (Property -> Traced (Referenced Schema)
propRefSchema Property
p)
(Maybe Property
Nothing, Just Traced (Referenced Schema)
add', Just Property
p, Maybe (Traced (Referenced Schema))
_) ->
AnItem Behave AnIssue 'APILevel
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (q :: BehaviorLevel -> BehaviorLevel -> *)
(r :: BehaviorLevel) a.
AnItem q AnIssue r
-> CompatFormula' q AnIssue r a -> CompatFormula' q AnIssue r a
clarifyIssue (Behavior 'SchemaLevel
-> AnIssue 'SchemaLevel -> AnItem Behave AnIssue 'APILevel
forall k (f :: k -> *) (a :: k) (q :: k -> k -> *) (r :: k).
Ord (f a) =>
Paths q r a -> f a -> AnItem q f r
AnItem Behavior 'SchemaLevel
beh' (Issue 'SchemaLevel -> AnIssue 'SchemaLevel
forall (l :: BehaviorLevel). Issuable l => Issue l -> AnIssue l
anIssue Issue 'SchemaLevel
AdditionalToProperty)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
Traced (Referenced Schema)
-> Traced (Referenced Schema) -> SemanticCompatFormula ()
go Traced (Referenced Schema)
add' (Property -> Traced (Referenced Schema)
propRefSchema Property
p)
(Just Property
p', Maybe (Traced (Referenced Schema))
_, Maybe Property
Nothing, Just Traced (Referenced Schema)
add) ->
AnItem Behave AnIssue 'APILevel
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (q :: BehaviorLevel -> BehaviorLevel -> *)
(r :: BehaviorLevel) a.
AnItem q AnIssue r
-> CompatFormula' q AnIssue r a -> CompatFormula' q AnIssue r a
clarifyIssue (Behavior 'SchemaLevel
-> AnIssue 'SchemaLevel -> AnItem Behave AnIssue 'APILevel
forall k (f :: k -> *) (a :: k) (q :: k -> k -> *) (r :: k).
Ord (f a) =>
Paths q r a -> f a -> AnItem q f r
AnItem Behavior 'SchemaLevel
beh' (Issue 'SchemaLevel -> AnIssue 'SchemaLevel
forall (l :: BehaviorLevel). Issuable l => Issue l -> AnIssue l
anIssue Issue 'SchemaLevel
PropertyToAdditional)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
Traced (Referenced Schema)
-> Traced (Referenced Schema) -> SemanticCompatFormula ()
go (Property -> Traced (Referenced Schema)
propRefSchema Property
p') Traced (Referenced Schema)
add
(Maybe Property
Nothing, Just Traced (Referenced Schema)
_, Maybe Property
Nothing, Just Traced (Referenced Schema)
_) -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
pure ()
case (Maybe (Traced (Referenced Schema))
madd', Maybe (Traced (Referenced Schema))
madd) of
(Maybe (Traced (Referenced Schema))
Nothing, Maybe (Traced (Referenced Schema))
_) -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Maybe (Traced (Referenced Schema))
_, Maybe (Traced (Referenced Schema))
Nothing) -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh Issue 'TypedSchemaLevel
NoAdditionalProperties
(Just Traced (Referenced Schema)
add', Just Traced (Referenced Schema)
add) -> Behavior (SubtreeLevel (Referenced Schema))
-> HList xs
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'TypedSchemaLevel
beh Paths Behave 'APILevel 'TypedSchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
-> Behavior 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'TypedSchemaLevel 'SchemaLevel
-> Paths Behave 'TypedSchemaLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Behave 'TypedSchemaLevel 'SchemaLevel
InAdditionalProperty) HList xs
env (Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
add' Traced (Referenced Schema)
add)
pure ()
Maybe
(NonEmpty
(Map Format Property, Maybe (Traced (Referenced Schema))))
Nothing -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh Issue 'TypedSchemaLevel
NoMatchingProperties
MaxProperties Integer
m -> (Integer -> Integer -> Integer)
-> Integer
-> (Integer -> Issue 'TypedSchemaLevel)
-> (ProdCons Integer -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
m Integer -> Issue 'TypedSchemaLevel
NoMatchingMaxProperties ProdCons Integer -> Issue 'TypedSchemaLevel
MatchingMaxPropertiesWeak ((forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ())
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
MaxProperties Integer
m' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
m'
Condition t
_ -> Maybe Integer
forall a. Maybe a
Nothing
MinProperties Integer
m -> (Integer -> Integer -> Integer)
-> Integer
-> (Integer -> Issue 'TypedSchemaLevel)
-> (ProdCons Integer -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a.
Eq a =>
(a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
m Integer -> Issue 'TypedSchemaLevel
NoMatchingMinProperties ProdCons Integer -> Issue 'TypedSchemaLevel
MatchingMinPropertiesWeak ((forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ())
-> (forall (t :: JsonType). Condition t -> Maybe Integer)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \case
MinProperties Integer
m' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
m'
Condition t
_ -> Maybe Integer
forall a. Maybe a
Nothing
where
lcmScientific :: a -> a -> a
lcmScientific (a -> Rational
forall a. Real a => a -> Rational
toRational -> Rational
a) (a -> Rational
forall a. Real a => a -> Rational
toRational -> Rational
b) =
Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
a) (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
b) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
a) (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
b)
foldCheck ::
Eq a =>
(a -> a -> a) ->
a ->
(a -> Issue 'TypedSchemaLevel) ->
(ProdCons a -> Issue 'TypedSchemaLevel) ->
(forall t. Condition t -> Maybe a) ->
SemanticCompatFormula ()
foldCheck :: (a -> a -> a)
-> a
-> (a -> Issue 'TypedSchemaLevel)
-> (ProdCons a -> Issue 'TypedSchemaLevel)
-> (forall (t :: JsonType). Condition t -> Maybe a)
-> SemanticCompatFormula ()
foldCheck a -> a -> a
f a
m a -> Issue 'TypedSchemaLevel
missing ProdCons a -> Issue 'TypedSchemaLevel
weak forall (t :: JsonType). Condition t -> Maybe a
extr = case (a -> a -> a)
-> Set (Condition t) -> (Condition t -> Maybe a) -> Maybe a
forall b a. (b -> b -> b) -> Set a -> (a -> Maybe b) -> Maybe b
foldSome a -> a -> a
f Set (Condition t)
prods Condition t -> Maybe a
forall (t :: JsonType). Condition t -> Maybe a
extr of
Just a
m'
| a -> a -> a
f a
m' a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m' -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (ProdCons a -> Issue 'TypedSchemaLevel
weak ProdCons :: forall a. a -> a -> ProdCons a
ProdCons {$sel:producer:ProdCons :: a
producer = a
m', $sel:consumer:ProdCons :: a
consumer = a
m})
Maybe a
Nothing -> Paths Behave 'APILevel 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
(q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'TypedSchemaLevel
beh (a -> Issue 'TypedSchemaLevel
missing a
m)
prodTopSchema :: Traced (Referenced Schema)
prodTopSchema = Trace (Referenced Schema)
-> Referenced Schema -> Traced (Referenced Schema)
forall a. Trace a -> a -> Traced a
traced (ProdCons (Trace Schema) -> Trace Schema
forall a. ProdCons a -> a
producer ProdCons (Trace Schema)
trs Trace Schema
-> Paths Step Schema (Referenced Schema)
-> Trace (Referenced Schema)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step Schema (Referenced Schema)
-> Paths Step Schema (Referenced Schema)
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step Schema (Referenced Schema)
ImplicitTopSchema) (Referenced Schema -> Traced (Referenced Schema))
-> Referenced Schema -> Traced (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
forall a. Monoid a => a
mempty
allSame :: (Foldable f, Eq a) => f a -> Bool
allSame :: f a -> Bool
allSame f a
xs = case [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs) of
[] -> Bool
True
[[a]
_] -> Bool
True
[[a]]
_ -> Bool
False
foldSome :: (b -> b -> b) -> S.Set a -> (a -> Maybe b) -> Maybe b
foldSome :: (b -> b -> b) -> Set a -> (a -> Maybe b) -> Maybe b
foldSome b -> b -> b
combine Set a
xs a -> Maybe b
extr =
(NonEmpty b -> b) -> Maybe (NonEmpty b) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b -> b) -> NonEmpty b -> b
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 b -> b -> b
combine) (Maybe (NonEmpty b) -> Maybe b)
-> (Set a -> Maybe (NonEmpty b)) -> Set a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Maybe (NonEmpty b)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([b] -> Maybe (NonEmpty b))
-> (Set a -> [b]) -> Set a -> Maybe (NonEmpty b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
extr ([a] -> [b]) -> (Set a -> [a]) -> Set a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> Maybe b) -> Set a -> Maybe b
forall a b. (a -> b) -> a -> b
$ Set a
xs
findExactly :: S.Set (Condition t) -> Maybe (TypedValue t)
findExactly :: Set (Condition t) -> Maybe (TypedValue t)
findExactly Set (Condition t)
xs = (TypedValue t -> TypedValue t -> TypedValue t)
-> Set (Condition t)
-> (Condition t -> Maybe (TypedValue t))
-> Maybe (TypedValue t)
forall b a. (b -> b -> b) -> Set a -> (a -> Maybe b) -> Maybe b
foldSome TypedValue t -> TypedValue t -> TypedValue t
forall a b. a -> b -> a
const Set (Condition t)
xs ((Condition t -> Maybe (TypedValue t)) -> Maybe (TypedValue t))
-> (Condition t -> Maybe (TypedValue t)) -> Maybe (TypedValue t)
forall a b. (a -> b) -> a -> b
$ \case
Exactly TypedValue t
x -> TypedValue t -> Maybe (TypedValue t)
forall a. a -> Maybe a
Just TypedValue t
x
Condition t
_ -> Maybe (TypedValue t)
forall a. Maybe a
Nothing
instance Subtree Schema where
type SubtreeLevel Schema = 'SchemaLevel
type CheckEnv Schema = '[ProdCons (Traced (Definitions Schema))]
checkStructuralCompatibility :: HList (CheckEnv Schema)
-> ProdCons (Traced Schema) -> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv Schema)
env ProdCons (Traced Schema)
pc = do
ProdCons (EnvT (Trace Schema) Identity [Format])
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity [Format])
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity [Format])
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> [Format])
-> Traced Schema -> EnvT (Trace Schema) Identity [Format]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> [Format]
_schemaRequired (Traced Schema -> EnvT (Trace Schema) Identity [Format])
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity [Format])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Bool)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Bool
_schemaNullable (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
(ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ())
-> ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
forall a.
(ProdCons a -> StructuralCompatFormula ())
-> ProdCons (Maybe a) -> StructuralCompatFormula ()
structuralMaybeWith (HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs -> ProdCons [Traced a] -> StructuralCompatFormula ()
structuralList HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env) (ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ())
-> ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Schema -> Maybe [Traced (Referenced Schema)]
tracedAllOf (Traced Schema -> Maybe [Traced (Referenced Schema)])
-> ProdCons (Traced Schema)
-> ProdCons (Maybe [Traced (Referenced Schema)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
(ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ())
-> ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
forall a.
(ProdCons a -> StructuralCompatFormula ())
-> ProdCons (Maybe a) -> StructuralCompatFormula ()
structuralMaybeWith (HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs -> ProdCons [Traced a] -> StructuralCompatFormula ()
structuralList HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env) (ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ())
-> ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Schema -> Maybe [Traced (Referenced Schema)]
tracedOneOf (Traced Schema -> Maybe [Traced (Referenced Schema)])
-> ProdCons (Traced Schema)
-> ProdCons (Maybe [Traced (Referenced Schema)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Maybe (Traced (Referenced Schema)))
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs
-> ProdCons (Maybe (Traced a)) -> StructuralCompatFormula ()
structuralMaybe HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env (ProdCons (Maybe (Traced (Referenced Schema)))
-> StructuralCompatFormula ())
-> ProdCons (Maybe (Traced (Referenced Schema)))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ EnvT
(Trace (Referenced Schema)) Identity (Maybe (Referenced Schema))
-> Maybe (Traced (Referenced Schema))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (EnvT
(Trace (Referenced Schema)) Identity (Maybe (Referenced Schema))
-> Maybe (Traced (Referenced Schema)))
-> (Traced Schema
-> EnvT
(Trace (Referenced Schema)) Identity (Maybe (Referenced Schema)))
-> Traced Schema
-> Maybe (Traced (Referenced Schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Step Schema (Referenced Schema)
-> Traced' Schema (Maybe (Referenced Schema))
-> EnvT
(Trace (Referenced Schema)) Identity (Maybe (Referenced Schema))
forall a a' b.
Steppable a a' =>
Step a a' -> Traced' a b -> Traced' a' b
stepTraced Step Schema (Referenced Schema)
NotStep (Traced' Schema (Maybe (Referenced Schema))
-> EnvT
(Trace (Referenced Schema)) Identity (Maybe (Referenced Schema)))
-> (Traced Schema -> Traced' Schema (Maybe (Referenced Schema)))
-> Traced Schema
-> EnvT
(Trace (Referenced Schema)) Identity (Maybe (Referenced Schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Maybe (Referenced Schema))
-> Traced Schema -> Traced' Schema (Maybe (Referenced Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe (Referenced Schema)
_schemaNot (Traced Schema -> Maybe (Traced (Referenced Schema)))
-> ProdCons (Traced Schema)
-> ProdCons (Maybe (Traced (Referenced Schema)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
(ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ())
-> ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
forall a.
(ProdCons a -> StructuralCompatFormula ())
-> ProdCons (Maybe a) -> StructuralCompatFormula ()
structuralMaybeWith (HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs -> ProdCons [Traced a] -> StructuralCompatFormula ()
structuralList HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env) (ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ())
-> ProdCons (Maybe [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Schema -> Maybe [Traced (Referenced Schema)]
tracedAnyOf (Traced Schema -> Maybe [Traced (Referenced Schema)])
-> ProdCons (Traced Schema)
-> ProdCons (Maybe [Traced (Referenced Schema)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
-> StructuralCompatFormula ()
forall k (xs :: [*]) v.
(ReassembleHList (k : xs) (CheckEnv v), Ord k, Subtree v,
Hashable k, Typeable k, Show k) =>
HList xs
-> ProdCons (Traced (InsOrdHashMap k v))
-> StructuralCompatFormula ()
iohmStructural HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env (ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
-> StructuralCompatFormula ())
-> ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Step Schema (InsOrdHashMap Format (Referenced Schema))
-> Traced' Schema (InsOrdHashMap Format (Referenced Schema))
-> Traced (InsOrdHashMap Format (Referenced Schema))
forall a a' b.
Steppable a a' =>
Step a a' -> Traced' a b -> Traced' a' b
stepTraced Step Schema (InsOrdHashMap Format (Referenced Schema))
PropertiesStep (Traced' Schema (InsOrdHashMap Format (Referenced Schema))
-> Traced (InsOrdHashMap Format (Referenced Schema)))
-> (Traced Schema
-> Traced' Schema (InsOrdHashMap Format (Referenced Schema)))
-> Traced Schema
-> Traced (InsOrdHashMap Format (Referenced Schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> InsOrdHashMap Format (Referenced Schema))
-> Traced Schema
-> Traced' Schema (InsOrdHashMap Format (Referenced Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> InsOrdHashMap Format (Referenced Schema)
_schemaProperties (Traced Schema
-> Traced (InsOrdHashMap Format (Referenced Schema)))
-> ProdCons (Traced Schema)
-> ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
(ProdCons (Either Bool (Traced (Referenced Schema)))
-> StructuralCompatFormula ())
-> ProdCons (Maybe (Either Bool (Traced (Referenced Schema))))
-> StructuralCompatFormula ()
forall a.
(ProdCons a -> StructuralCompatFormula ())
-> ProdCons (Maybe a) -> StructuralCompatFormula ()
structuralMaybeWith ProdCons (Either Bool (Traced (Referenced Schema)))
-> StructuralCompatFormula ()
structuralAdditionalProperties (ProdCons (Maybe (Either Bool (Traced (Referenced Schema))))
-> StructuralCompatFormula ())
-> ProdCons (Maybe (Either Bool (Traced (Referenced Schema))))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Schema -> Maybe (Either Bool (Traced (Referenced Schema)))
tracedAdditionalProperties (Traced Schema -> Maybe (Either Bool (Traced (Referenced Schema))))
-> ProdCons (Traced Schema)
-> ProdCons (Maybe (Either Bool (Traced (Referenced Schema))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
(ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
-> StructuralCompatFormula ())
-> ProdCons
(Maybe (EnvT (Trace Discriminator) Identity Discriminator))
-> StructuralCompatFormula ()
forall a.
(ProdCons a -> StructuralCompatFormula ())
-> ProdCons (Maybe a) -> StructuralCompatFormula ()
structuralMaybeWith ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
-> StructuralCompatFormula ()
structuralDiscriminator (ProdCons
(Maybe (EnvT (Trace Discriminator) Identity Discriminator))
-> StructuralCompatFormula ())
-> ProdCons
(Maybe (EnvT (Trace Discriminator) Identity Discriminator))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Schema
-> Maybe (EnvT (Trace Discriminator) Identity Discriminator)
tracedDiscriminator (Traced Schema
-> Maybe (EnvT (Trace Discriminator) Identity Discriminator))
-> ProdCons (Traced Schema)
-> ProdCons
(Maybe (EnvT (Trace Discriminator) Identity Discriminator))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Bool)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Bool
_schemaReadOnly (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Bool)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Bool
_schemaWriteOnly (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Xml))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Xml))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Xml))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Xml)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Xml)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Xml
_schemaXml (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Xml))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Xml))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Integer)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Integer
_schemaMaxProperties (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Integer)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Integer
_schemaMinProperties (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Value))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Value))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Value))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Value)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Value
_schemaDefault (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Value))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe OpenApiType))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe OpenApiType))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe OpenApiType))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe OpenApiType)
-> Traced Schema
-> EnvT (Trace Schema) Identity (Maybe OpenApiType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe OpenApiType
_schemaType (Traced Schema -> EnvT (Trace Schema) Identity (Maybe OpenApiType))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe OpenApiType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Format)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Format)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Format
_schemaFormat (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Format))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
(ProdCons
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)])
-> StructuralCompatFormula ())
-> ProdCons
(Maybe
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)]))
-> StructuralCompatFormula ()
forall a.
(ProdCons a -> StructuralCompatFormula ())
-> ProdCons (Maybe a) -> StructuralCompatFormula ()
structuralMaybeWith ProdCons
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
structuralItems (ProdCons
(Maybe
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)]))
-> StructuralCompatFormula ())
-> ProdCons
(Maybe
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)]))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Schema
-> Maybe
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)])
tracedItems (Traced Schema
-> Maybe
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)]))
-> ProdCons (Traced Schema)
-> ProdCons
(Maybe
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Scientific)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Scientific
_schemaMaximum (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Scientific))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Bool)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Bool
_schemaExclusiveMaximum (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Scientific)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Scientific
_schemaMinimum (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Scientific))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Bool)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Bool
_schemaExclusiveMinimum (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Integer)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Integer
_schemaMaxLength (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Integer)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Integer
_schemaMinLength (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Format)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Format)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Format
_schemaPattern (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Format))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Format))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Integer)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Integer
_schemaMaxItems (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Integer)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Integer
_schemaMinItems (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Integer))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Bool)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Bool
_schemaUniqueItems (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Bool))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe [Value]))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe [Value]))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe [Value]))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe [Value])
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe [Value]
_schemaEnum (Traced Schema -> EnvT (Trace Schema) Identity (Maybe [Value]))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe [Value]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Schema -> Maybe Scientific)
-> Traced Schema -> EnvT (Trace Schema) Identity (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Maybe Scientific
_schemaMultipleOf (Traced Schema -> EnvT (Trace Schema) Identity (Maybe Scientific))
-> ProdCons (Traced Schema)
-> ProdCons (EnvT (Trace Schema) Identity (Maybe Scientific))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
pc
pure ()
where
structuralAdditionalProperties :: ProdCons (Either Bool (Traced (Referenced Schema)))
-> StructuralCompatFormula ()
structuralAdditionalProperties
(ProdCons (Left Bool
x) (Left Bool
y)) = Bool -> StructuralCompatFormula () -> StructuralCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y) StructuralCompatFormula ()
forall a. StructuralCompatFormula a
structuralIssue
structuralAdditionalProperties
(ProdCons (Right Traced (Referenced Schema)
x) (Right Traced (Referenced Schema)
y)) =
HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Traced (Referenced Schema))
-> StructuralCompatFormula ()
forall (xs :: [*]) t.
(ReassembleHList xs (CheckEnv t), Subtree t) =>
HList xs -> ProdCons (Traced t) -> StructuralCompatFormula ()
checkSubstructure HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env (ProdCons (Traced (Referenced Schema))
-> StructuralCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
x Traced (Referenced Schema)
y
structuralAdditionalProperties ProdCons (Either Bool (Traced (Referenced Schema)))
_ = StructuralCompatFormula ()
forall a. StructuralCompatFormula a
structuralIssue
structuralDiscriminator :: ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
-> StructuralCompatFormula ()
structuralDiscriminator ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
pc' = do
ProdCons (EnvT (Trace Discriminator) Identity Format)
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Trace Discriminator) Identity Format)
-> StructuralCompatFormula ())
-> ProdCons (EnvT (Trace Discriminator) Identity Format)
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Discriminator -> Format)
-> EnvT (Trace Discriminator) Identity Discriminator
-> EnvT (Trace Discriminator) Identity Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Discriminator -> Format
_discriminatorPropertyName (EnvT (Trace Discriminator) Identity Discriminator
-> EnvT (Trace Discriminator) Identity Format)
-> ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
-> ProdCons (EnvT (Trace Discriminator) Identity Format)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
pc'
HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
-> StructuralCompatFormula ()
forall k (xs :: [*]) v.
(ReassembleHList (k : xs) (CheckEnv v), Ord k, Subtree v,
Hashable k, Typeable k, Show k) =>
HList xs
-> ProdCons (Traced (InsOrdHashMap k v))
-> StructuralCompatFormula ()
iohmStructural HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env (ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
-> StructuralCompatFormula ())
-> ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$
Step Discriminator (InsOrdHashMap Format (Referenced Schema))
-> Traced' Discriminator (InsOrdHashMap Format (Referenced Schema))
-> Traced (InsOrdHashMap Format (Referenced Schema))
forall a a' b.
Steppable a a' =>
Step a a' -> Traced' a b -> Traced' a' b
stepTraced Step Discriminator (InsOrdHashMap Format (Referenced Schema))
DiscriminatorMapping (Traced' Discriminator (InsOrdHashMap Format (Referenced Schema))
-> Traced (InsOrdHashMap Format (Referenced Schema)))
-> (EnvT (Trace Discriminator) Identity Discriminator
-> Traced'
Discriminator (InsOrdHashMap Format (Referenced Schema)))
-> EnvT (Trace Discriminator) Identity Discriminator
-> Traced (InsOrdHashMap Format (Referenced Schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Discriminator -> InsOrdHashMap Format (Referenced Schema))
-> EnvT (Trace Discriminator) Identity Discriminator
-> Traced' Discriminator (InsOrdHashMap Format (Referenced Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Format -> Referenced Schema)
-> InsOrdHashMap Format Format
-> InsOrdHashMap Format (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Format -> Referenced Schema
parseDiscriminatorValue (InsOrdHashMap Format Format
-> InsOrdHashMap Format (Referenced Schema))
-> (Discriminator -> InsOrdHashMap Format Format)
-> Discriminator
-> InsOrdHashMap Format (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Discriminator -> InsOrdHashMap Format Format
_discriminatorMapping) (EnvT (Trace Discriminator) Identity Discriminator
-> Traced (InsOrdHashMap Format (Referenced Schema)))
-> ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
-> ProdCons (Traced (InsOrdHashMap Format (Referenced Schema)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (EnvT (Trace Discriminator) Identity Discriminator)
pc'
pure ()
structuralItems :: ProdCons
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)])
-> StructuralCompatFormula ()
structuralItems (ProdCons (Left Traced (Referenced Schema)
a) (Left Traced (Referenced Schema)
b)) =
HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Traced (Referenced Schema))
-> StructuralCompatFormula ()
forall (xs :: [*]) t.
(ReassembleHList xs (CheckEnv t), Subtree t) =>
HList xs -> ProdCons (Traced t) -> StructuralCompatFormula ()
checkSubstructure HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env (ProdCons (Traced (Referenced Schema))
-> StructuralCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
a Traced (Referenced Schema)
b
structuralItems (ProdCons (Right [Traced (Referenced Schema)]
a) (Right [Traced (Referenced Schema)]
b)) =
HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs -> ProdCons [Traced a] -> StructuralCompatFormula ()
structuralList HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env (ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ())
-> ProdCons [Traced (Referenced Schema)]
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ [Traced (Referenced Schema)]
-> [Traced (Referenced Schema)]
-> ProdCons [Traced (Referenced Schema)]
forall a. a -> a -> ProdCons a
ProdCons [Traced (Referenced Schema)]
a [Traced (Referenced Schema)]
b
structuralItems ProdCons
(Either (Traced (Referenced Schema)) [Traced (Referenced Schema)])
_ = StructuralCompatFormula ()
forall a. StructuralCompatFormula a
structuralIssue
checkSemanticCompatibility :: HList (CheckEnv Schema)
-> Behavior (SubtreeLevel Schema)
-> ProdCons (Traced Schema)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv Schema)
env Behavior (SubtreeLevel Schema)
beh ProdCons (Traced Schema)
schs = do
let defs :: ProdCons (Traced (Definitions Schema))
defs = HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Traced (Definitions Schema))
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env
HList '[ProdCons (Traced (Definitions Schema))]
-> Behavior 'SchemaLevel
-> ProdCons (Trace Schema)
-> ProdCons (Traced (Definitions Schema))
-> ProdCons
(ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel)
-> SemanticCompatFormula ()
forall (xs :: [*]).
ReassembleHList xs (CheckEnv (Referenced Schema)) =>
HList xs
-> Behavior 'SchemaLevel
-> ProdCons (Trace Schema)
-> ProdCons (Traced (Definitions Schema))
-> ProdCons
(ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel)
-> SemanticCompatFormula ()
checkFormulas HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Schema)
env Behavior 'SchemaLevel
Behavior (SubtreeLevel Schema)
beh (Traced Schema -> Trace Schema
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask (Traced Schema -> Trace Schema)
-> ProdCons (Traced Schema) -> ProdCons (Trace Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Schema)
schs) ProdCons (Traced (Definitions Schema))
defs (ProdCons
(ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel)
-> SemanticCompatFormula ())
-> ProdCons
(ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Definitions Schema)
-> Traced Schema
-> (ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel)
schemaToFormula (Traced (Definitions Schema)
-> Traced Schema
-> (ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel))
-> ProdCons (Traced (Definitions Schema))
-> ProdCons
(Traced Schema
-> (ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced (Definitions Schema))
defs ProdCons
(Traced Schema
-> (ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel))
-> ProdCons (Traced Schema)
-> ProdCons
(ForeachType JsonFormula,
PathsPrefixTree Behave AnIssue 'SchemaLevel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons (Traced Schema)
schs
parseDiscriminatorValue :: Text -> Referenced Schema
parseDiscriminatorValue :: Format -> Referenced Schema
parseDiscriminatorValue Format
v = case FromJSON (Referenced Schema) => Value -> Result (Referenced Schema)
forall a. FromJSON a => Value -> Result a
A.fromJSON @(Referenced Schema) (Value -> Result (Referenced Schema))
-> Value -> Result (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object [Format
"$ref" Format -> Format -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Format -> v -> kv
A..= Format
v] of
A.Success Referenced Schema
x -> Referenced Schema
x
A.Error String
_ -> Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref (Reference -> Referenced Schema) -> Reference -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Format -> Reference
Reference Format
v