module Data.OpenApi.Compare.Validate.Schema.JsonFormula
( Bound (..),
showBound,
Property (..),
Condition (..),
showCondition,
satisfiesTyped,
checkStringFormat,
checkNumberFormat,
SomeCondition (..),
JsonFormula (..),
satisfiesFormula,
satisfies,
showJSONValue,
showJSONValueInline,
)
where
import Algebra.Lattice
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Foldable as F
import Data.Functor
import qualified Data.HashMap.Strict as HM
import Data.Int
import Data.Kind
import qualified Data.Map as M
import Data.Maybe
import Data.OpenApi
import Data.OpenApi.Compare.Orphans ()
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.Schema.DNF
import Data.OpenApi.Compare.Validate.Schema.TypedJson
import Data.Ord
import Data.Ratio
import Data.Scientific
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable
import Text.Pandoc.Builder hiding (Format, Null)
import Text.Regex.Pcre2
data Bound a = Exclusive !a | Inclusive !a
deriving stock (Bound a -> Bound a -> Bool
(Bound a -> Bound a -> Bool)
-> (Bound a -> Bound a -> Bool) -> Eq (Bound a)
forall a. Eq a => Bound a -> Bound a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bound a -> Bound a -> Bool
$c/= :: forall a. Eq a => Bound a -> Bound a -> Bool
== :: Bound a -> Bound a -> Bool
$c== :: forall a. Eq a => Bound a -> Bound a -> Bool
Eq, Int -> Bound a -> ShowS
[Bound a] -> ShowS
Bound a -> String
(Int -> Bound a -> ShowS)
-> (Bound a -> String) -> ([Bound a] -> ShowS) -> Show (Bound a)
forall a. Show a => Int -> Bound a -> ShowS
forall a. Show a => [Bound a] -> ShowS
forall a. Show a => Bound a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bound a] -> ShowS
$cshowList :: forall a. Show a => [Bound a] -> ShowS
show :: Bound a -> String
$cshow :: forall a. Show a => Bound a -> String
showsPrec :: Int -> Bound a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Bound a -> ShowS
Show, a -> Bound b -> Bound a
(a -> b) -> Bound a -> Bound b
(forall a b. (a -> b) -> Bound a -> Bound b)
-> (forall a b. a -> Bound b -> Bound a) -> Functor Bound
forall a b. a -> Bound b -> Bound a
forall a b. (a -> b) -> Bound a -> Bound b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Bound b -> Bound a
$c<$ :: forall a b. a -> Bound b -> Bound a
fmap :: (a -> b) -> Bound a -> Bound b
$cfmap :: forall a b. (a -> b) -> Bound a -> Bound b
Functor)
instance Ord a => Ord (Bound a) where
Exclusive a
a compare :: Bound a -> Bound a -> Ordering
`compare` Exclusive a
b = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
Exclusive a
a `compare` Inclusive a
b = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
Inclusive a
a `compare` Exclusive a
b = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
Inclusive a
a `compare` Inclusive a
b = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
showBound :: Show a => Bound a -> Inlines
showBound :: Bound a -> Inlines
showBound (Inclusive a
x) = a -> Inlines
forall x. Show x => x -> Inlines
show' a
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" inclusive"
showBound (Exclusive a
x) = a -> Inlines
forall x. Show x => x -> Inlines
show' a
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" exclusive"
data Property = Property
{ Property -> Bool
propRequired :: Bool
, Property -> ForeachType JsonFormula
propFormula :: ForeachType JsonFormula
, Property -> Traced (Referenced Schema)
propRefSchema :: Traced (Referenced Schema)
}
deriving stock (Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq, Eq Property
Eq Property
-> (Property -> Property -> Ordering)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Property)
-> (Property -> Property -> Property)
-> Ord Property
Property -> Property -> Bool
Property -> Property -> Ordering
Property -> Property -> Property
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Property -> Property -> Property
$cmin :: Property -> Property -> Property
max :: Property -> Property -> Property
$cmax :: Property -> Property -> Property
>= :: Property -> Property -> Bool
$c>= :: Property -> Property -> Bool
> :: Property -> Property -> Bool
$c> :: Property -> Property -> Bool
<= :: Property -> Property -> Bool
$c<= :: Property -> Property -> Bool
< :: Property -> Property -> Bool
$c< :: Property -> Property -> Bool
compare :: Property -> Property -> Ordering
$ccompare :: Property -> Property -> Ordering
$cp1Ord :: Eq Property
Ord, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show)
data Condition :: JsonType -> Type where
Exactly :: TypedValue t -> Condition t
Maximum :: !(Bound Scientific) -> Condition 'Number
Minimum ::
!(Down (Bound (Down Scientific))) ->
Condition 'Number
MultipleOf :: !Scientific -> Condition 'Number
NumberFormat :: !Format -> Condition 'Number
MaxLength :: !Integer -> Condition 'String
MinLength :: !Integer -> Condition 'String
Pattern :: !Pattern -> Condition 'String
StringFormat :: !Format -> Condition 'String
Items ::
!(ForeachType JsonFormula) ->
!(Traced (Referenced Schema)) ->
Condition 'Array
TupleItems ::
![(ForeachType JsonFormula, Traced (Referenced Schema))] ->
Condition 'Array
MaxItems :: !Integer -> Condition 'Array
MinItems :: !Integer -> Condition 'Array
UniqueItems :: Condition 'Array
Properties ::
!(M.Map Text Property) ->
!(ForeachType JsonFormula) ->
!(Maybe (Traced (Referenced Schema))) ->
Condition 'Object
MaxProperties :: !Integer -> Condition 'Object
MinProperties :: !Integer -> Condition 'Object
deriving stock instance Eq (Condition t)
deriving stock instance Ord (Condition t)
deriving stock instance Show (Condition t)
showCondition :: Condition a -> Blocks
showCondition :: Condition a -> Blocks
showCondition = \case
(Exactly TypedValue a
v) -> Inlines -> Blocks
para Inlines
"The value should be:" Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Value -> Blocks
showJSONValue (TypedValue a -> Value
forall (t :: JsonType). TypedValue t -> Value
untypeValue TypedValue a
v)
(Maximum Bound Scientific
b) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The value should be less than " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
b Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(Minimum (Down Bound (Down Scientific)
b)) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The value should be more than " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound (Down Scientific -> Scientific
forall a. Down a -> a
getDown (Down Scientific -> Scientific)
-> Bound (Down Scientific) -> Bound Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bound (Down Scientific)
b) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(MultipleOf Scientific
n) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The value should be a multiple of " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Scientific -> Inlines
forall x. Show x => x -> Inlines
show' Scientific
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(NumberFormat Format
p) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The number should have the following format:" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Format -> Inlines
code Format
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(Pattern Format
p) -> Inlines -> Blocks
para Inlines
"The value should satisfy the following pattern (regular expression):" Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Format -> Blocks
codeBlock Format
p
(StringFormat Format
p) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The string should have the following format:" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Format -> Inlines
code Format
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(MaxLength Integer
p) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The length of the string should be less than or equal to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(MinLength Integer
p) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The length of the string should be more than or equal to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(Items ForeachType JsonFormula
i Traced (Referenced Schema)
_) -> Inlines -> Blocks
para Inlines
"The items of the array should satisfy:" Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> ForeachType JsonFormula -> Blocks
showForEachJsonFormula ForeachType JsonFormula
i
(TupleItems [(ForeachType JsonFormula, Traced (Referenced Schema))]
is) -> Inlines -> Blocks
para (Inlines
"There should be " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Int -> Inlines
forall x. Show x => x -> Inlines
show' ([(ForeachType JsonFormula, Traced (Referenced Schema))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ForeachType JsonFormula, Traced (Referenced Schema))]
is) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" items in the array:") Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Blocks] -> Blocks
bulletList (ForeachType JsonFormula -> Blocks
showForEachJsonFormula (ForeachType JsonFormula -> Blocks)
-> ((ForeachType JsonFormula, Traced (Referenced Schema))
-> ForeachType JsonFormula)
-> (ForeachType JsonFormula, Traced (Referenced Schema))
-> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ForeachType JsonFormula, Traced (Referenced Schema))
-> ForeachType JsonFormula
forall a b. (a, b) -> a
fst ((ForeachType JsonFormula, Traced (Referenced Schema)) -> Blocks)
-> [(ForeachType JsonFormula, Traced (Referenced Schema))]
-> [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ForeachType JsonFormula, Traced (Referenced Schema))]
is)
(MaxItems Integer
n) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The length of the array should be less than or equal to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(MinItems Integer
n) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The length of the array should be more than or equal to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
Condition a
UniqueItems -> Inlines -> Blocks
para Inlines
"The elements in the array should be unique."
(Properties Map Format Property
props ForeachType JsonFormula
additional Maybe (Traced (Referenced Schema))
_) ->
[Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$
( Map Format Property -> [(Format, Property)]
forall k a. Map k a -> [(k, a)]
M.toList Map Format Property
props
[(Format, Property)] -> ((Format, Property) -> Blocks) -> [Blocks]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(Format
k, Property
p) ->
Inlines -> Blocks
para (Format -> Inlines
code Format
k)
Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Inlines -> Blocks
para (Inlines -> Inlines
strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ if Property -> Bool
propRequired Property
p then Inlines
"Required" else Inlines
"Optional")
Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> ForeachType JsonFormula -> Blocks
showForEachJsonFormula (Property -> ForeachType JsonFormula
propFormula Property
p)
)
)
[Blocks] -> [Blocks] -> [Blocks]
forall a. Semigroup a => a -> a -> a
<> [ Inlines -> Blocks
para (Inlines -> Inlines
emph Inlines
"Additional properties")
Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> ForeachType JsonFormula -> Blocks
showForEachJsonFormula ForeachType JsonFormula
additional
]
(MaxProperties Integer
n) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The maximum number of fields should be " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
(MinProperties Integer
n) -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The minimum number of fields should be " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
where
showForEachJsonFormula :: ForeachType JsonFormula -> Blocks
showForEachJsonFormula :: ForeachType JsonFormula -> Blocks
showForEachJsonFormula ForeachType JsonFormula
i =
[Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$
(forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType JsonFormula -> JsonFormula x) -> [Blocks])
-> [Blocks]
forall m (f :: JsonType -> *).
Monoid m =>
(forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m)
-> m
foldType
( \JsonType
t ForeachType JsonFormula -> JsonFormula x
f -> 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
f ForeachType JsonFormula
i of
DNF (Condition x)
BottomDNF -> [Blocks]
forall a. Monoid a => a
mempty
(DNF Set (Disjunct (Condition x))
conds) ->
[ Inlines -> Blocks
para (JsonType -> Inlines
forall s. IsString s => JsonType -> s
describeJSONType JsonType
t)
Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Blocks] -> Blocks
bulletList
( Set (Disjunct (Condition x)) -> [Disjunct (Condition x)]
forall a. Set a -> [a]
S.toList Set (Disjunct (Condition x))
conds [Disjunct (Condition x)]
-> (Disjunct (Condition x) -> Blocks) -> [Blocks]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Disjunct (Set (Condition x) -> [Condition x]
forall a. Set a -> [a]
S.toList -> []) -> Inlines -> Blocks
para Inlines
"Empty"
Disjunct (Set (Condition x) -> [Condition x]
forall a. Set a -> [a]
S.toList -> [Condition x]
cond) -> [Blocks] -> Blocks
bulletList (Condition x -> Blocks
forall (a :: JsonType). Condition a -> Blocks
showCondition (Condition x -> Blocks) -> [Condition x] -> [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Condition x]
cond)
)
]
)
showJSONValue :: A.Value -> Blocks
showJSONValue :: Value -> Blocks
showJSONValue Value
v = Attr -> Format -> Blocks
codeBlockWith (Format
"", [Format
"json"], [(Format, Format)]
forall a. Monoid a => a
mempty) (ByteString -> Format
T.decodeUtf8 (ByteString -> Format) -> (Value -> ByteString) -> Value -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> Format) -> Value -> Format
forall a b. (a -> b) -> a -> b
$ Value
v)
showJSONValueInline :: A.Value -> Inlines
showJSONValueInline :: Value -> Inlines
showJSONValueInline Value
v = Format -> Inlines
code (ByteString -> Format
T.decodeUtf8 (ByteString -> Format) -> (Value -> ByteString) -> Value -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> Format) -> Value -> Format
forall a b. (a -> b) -> a -> b
$ Value
v)
show' :: Show x => x -> Inlines
show' :: x -> Inlines
show' = Format -> Inlines
str (Format -> Inlines) -> (x -> Format) -> x -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Format
T.pack (String -> Format) -> (x -> String) -> x -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> String
forall a. Show a => a -> String
show
satisfiesTyped :: TypedValue t -> Condition t -> Bool
satisfiesTyped :: TypedValue t -> Condition t -> Bool
satisfiesTyped TypedValue t
e (Exactly TypedValue t
e') = TypedValue t
e TypedValue t -> TypedValue t -> Bool
forall a. Eq a => a -> a -> Bool
== TypedValue t
e'
satisfiesTyped (TNumber Scientific
n) (Maximum (Exclusive Scientific
m)) = Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
m
satisfiesTyped (TNumber Scientific
n) (Maximum (Inclusive Scientific
m)) = Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
m
satisfiesTyped (TNumber Scientific
n) (Minimum (Down (Exclusive (Down Scientific
m)))) = Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
> Scientific
m
satisfiesTyped (TNumber Scientific
n) (Minimum (Down (Inclusive (Down Scientific
m)))) = Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
m
satisfiesTyped (TNumber Scientific
n) (MultipleOf Scientific
m) = Ratio Integer -> Integer
forall a. Ratio a -> a
denominator (Scientific -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Scientific
n Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Scientific -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Scientific
m) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
satisfiesTyped (TNumber Scientific
n) (NumberFormat Format
f) = Format -> Scientific -> Bool
checkNumberFormat Format
f Scientific
n
satisfiesTyped (TString Format
s) (MaxLength Integer
m) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Format -> Int
T.length Format
s) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
m
satisfiesTyped (TString Format
s) (MinLength Integer
m) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Format -> Int
T.length Format
s) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
m
satisfiesTyped (TString Format
s) (Pattern Format
p) = Maybe Format -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Format -> Bool) -> Maybe Format -> Bool
forall a b. (a -> b) -> a -> b
$ Format -> Format -> Maybe Format
forall (f :: * -> *). Alternative f => Format -> Format -> f Format
match Format
p Format
s
satisfiesTyped (TString Format
s) (StringFormat Format
f) = Format -> Format -> Bool
checkStringFormat Format
f Format
s
satisfiesTyped (TArray Array
a) (Items ForeachType JsonFormula
f Traced (Referenced Schema)
_) = (Value -> Bool) -> Array -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Value -> ForeachType JsonFormula -> Bool
`satisfies` ForeachType JsonFormula
f) Array
a
satisfiesTyped (TArray Array
a) (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
== Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array
a Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Value -> ForeachType JsonFormula -> Bool)
-> [Value] -> [ForeachType JsonFormula] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Value -> ForeachType JsonFormula -> Bool
satisfies (Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Array
a) ((ForeachType JsonFormula, Traced (Referenced Schema))
-> ForeachType JsonFormula
forall a b. (a, b) -> a
fst ((ForeachType JsonFormula, Traced (Referenced Schema))
-> ForeachType JsonFormula)
-> [(ForeachType JsonFormula, Traced (Referenced Schema))]
-> [ForeachType JsonFormula]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ForeachType JsonFormula, Traced (Referenced Schema))]
fs))
satisfiesTyped (TArray Array
a) (MaxItems Integer
m) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array
a) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
m
satisfiesTyped (TArray Array
a) (MinItems Integer
m) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array
a) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
m
satisfiesTyped (TArray Array
a) Condition t
UniqueItems = Set Value -> Int
forall a. Set a -> Int
S.size ([Value] -> Set Value
forall a. Ord a => [a] -> Set a
S.fromList ([Value] -> Set Value) -> [Value] -> Set Value
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Array
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array
a
satisfiesTyped (TObject Object
o) (Properties Map Format Property
props ForeachType JsonFormula
additional Maybe (Traced (Referenced Schema))
_) =
(Format -> Bool) -> [Format] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Format -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` Object
o) (Map Format Property -> [Format]
forall k a. Map k a -> [k]
M.keys ((Property -> Bool) -> Map Format Property -> Map Format Property
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Property -> Bool
propRequired Map Format Property
props))
Bool -> Bool -> Bool
&& ((Format, Value) -> Bool) -> [(Format, Value)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Format
k, Value
v) -> Value -> ForeachType JsonFormula -> Bool
satisfies Value
v (ForeachType JsonFormula -> Bool)
-> ForeachType JsonFormula -> Bool
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula
-> (Property -> ForeachType JsonFormula)
-> Maybe Property
-> ForeachType JsonFormula
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ForeachType JsonFormula
additional Property -> ForeachType JsonFormula
propFormula (Maybe Property -> ForeachType JsonFormula)
-> Maybe Property -> ForeachType JsonFormula
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) (Object -> [(Format, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
o)
satisfiesTyped (TObject Object
o) (MaxProperties Integer
m) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Object -> Int
forall k v. HashMap k v -> Int
HM.size Object
o) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
m
satisfiesTyped (TObject Object
o) (MinProperties Integer
m) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Object -> Int
forall k v. HashMap k v -> Int
HM.size Object
o) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
m
checkNumberFormat :: Format -> Scientific -> Bool
checkNumberFormat :: Format -> Scientific -> Bool
checkNumberFormat Format
"int32" (Scientific -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational -> Ratio Integer
n) =
Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
Bool -> Bool -> Bool
&& Ratio Integer
n Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Int32
forall a. Bounded a => a
minBound :: Int32)
Bool -> Bool -> Bool
&& Ratio Integer
n Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Int32
forall a. Bounded a => a
maxBound :: Int32)
checkNumberFormat Format
"int64" (Scientific -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational -> Ratio Integer
n) =
Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
Bool -> Bool -> Bool
&& Ratio Integer
n Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Int64
forall a. Bounded a => a
minBound :: Int64)
Bool -> Bool -> Bool
&& Ratio Integer
n Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Int64
forall a. Bounded a => a
maxBound :: Int64)
checkNumberFormat Format
"float" Scientific
_n = Bool
True
checkNumberFormat Format
"double" Scientific
_n = Bool
True
checkNumberFormat Format
f Scientific
_n = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Invalid number format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Format -> String
T.unpack Format
f
checkStringFormat :: Format -> Text -> Bool
checkStringFormat :: Format -> Format -> Bool
checkStringFormat Format
"byte" Format
_s = Bool
True
checkStringFormat Format
"binary" Format
_s = Bool
True
checkStringFormat Format
"date" Format
_s = Bool
True
checkStringFormat Format
"date-time" Format
_s = Bool
True
checkStringFormat Format
"password" Format
_s = Bool
True
checkStringFormat Format
"uuid" Format
_s = Bool
True
checkStringFormat Format
f Format
_s = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Invalid string format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Format -> String
T.unpack Format
f
data SomeCondition where
SomeCondition :: Typeable t => Condition t -> SomeCondition
instance Eq SomeCondition where
SomeCondition Condition t
x == :: SomeCondition -> SomeCondition -> Bool
== SomeCondition Condition t
y = case Condition t -> Maybe (Condition t)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Condition t
x of
Just Condition t
x' -> Condition t
x' Condition t -> Condition t -> Bool
forall a. Eq a => a -> a -> Bool
== Condition t
y
Maybe (Condition t)
Nothing -> Bool
False
instance Ord SomeCondition where
compare :: SomeCondition -> SomeCondition -> Ordering
compare (SomeCondition Condition t
x) (SomeCondition Condition t
y) = case Condition t -> Maybe (Condition t)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Condition t
x of
Just Condition t
x' -> Condition t -> Condition t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Condition t
x' Condition t
y
Maybe (Condition t)
Nothing -> TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Condition t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Condition t
x) (Condition t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Condition t
y)
deriving stock instance Show SomeCondition
newtype JsonFormula t = JsonFormula {JsonFormula t -> DNF (Condition t)
getJsonFormula :: DNF (Condition t)}
deriving stock (JsonFormula t -> JsonFormula t -> Bool
(JsonFormula t -> JsonFormula t -> Bool)
-> (JsonFormula t -> JsonFormula t -> Bool) -> Eq (JsonFormula t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
/= :: JsonFormula t -> JsonFormula t -> Bool
$c/= :: forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
== :: JsonFormula t -> JsonFormula t -> Bool
$c== :: forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
Eq, Eq (JsonFormula t)
Eq (JsonFormula t)
-> (JsonFormula t -> JsonFormula t -> Ordering)
-> (JsonFormula t -> JsonFormula t -> Bool)
-> (JsonFormula t -> JsonFormula t -> Bool)
-> (JsonFormula t -> JsonFormula t -> Bool)
-> (JsonFormula t -> JsonFormula t -> Bool)
-> (JsonFormula t -> JsonFormula t -> JsonFormula t)
-> (JsonFormula t -> JsonFormula t -> JsonFormula t)
-> Ord (JsonFormula t)
JsonFormula t -> JsonFormula t -> Bool
JsonFormula t -> JsonFormula t -> Ordering
JsonFormula t -> JsonFormula t -> JsonFormula t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (t :: JsonType). Eq (JsonFormula t)
forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Ordering
forall (t :: JsonType).
JsonFormula t -> JsonFormula t -> JsonFormula t
min :: JsonFormula t -> JsonFormula t -> JsonFormula t
$cmin :: forall (t :: JsonType).
JsonFormula t -> JsonFormula t -> JsonFormula t
max :: JsonFormula t -> JsonFormula t -> JsonFormula t
$cmax :: forall (t :: JsonType).
JsonFormula t -> JsonFormula t -> JsonFormula t
>= :: JsonFormula t -> JsonFormula t -> Bool
$c>= :: forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
> :: JsonFormula t -> JsonFormula t -> Bool
$c> :: forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
<= :: JsonFormula t -> JsonFormula t -> Bool
$c<= :: forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
< :: JsonFormula t -> JsonFormula t -> Bool
$c< :: forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Bool
compare :: JsonFormula t -> JsonFormula t -> Ordering
$ccompare :: forall (t :: JsonType). JsonFormula t -> JsonFormula t -> Ordering
$cp1Ord :: forall (t :: JsonType). Eq (JsonFormula t)
Ord, Int -> JsonFormula t -> ShowS
[JsonFormula t] -> ShowS
JsonFormula t -> String
(Int -> JsonFormula t -> ShowS)
-> (JsonFormula t -> String)
-> ([JsonFormula t] -> ShowS)
-> Show (JsonFormula t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: JsonType). Int -> JsonFormula t -> ShowS
forall (t :: JsonType). [JsonFormula t] -> ShowS
forall (t :: JsonType). JsonFormula t -> String
showList :: [JsonFormula t] -> ShowS
$cshowList :: forall (t :: JsonType). [JsonFormula t] -> ShowS
show :: JsonFormula t -> String
$cshow :: forall (t :: JsonType). JsonFormula t -> String
showsPrec :: Int -> JsonFormula t -> ShowS
$cshowsPrec :: forall (t :: JsonType). Int -> JsonFormula t -> ShowS
Show)
deriving newtype (JsonFormula t -> JsonFormula t -> JsonFormula t
(JsonFormula t -> JsonFormula t -> JsonFormula t)
-> (JsonFormula t -> JsonFormula t -> JsonFormula t)
-> Lattice (JsonFormula t)
forall a. (a -> a -> a) -> (a -> a -> a) -> Lattice a
forall (t :: JsonType).
JsonFormula t -> JsonFormula t -> JsonFormula t
/\ :: JsonFormula t -> JsonFormula t -> JsonFormula t
$c/\ :: forall (t :: JsonType).
JsonFormula t -> JsonFormula t -> JsonFormula t
\/ :: JsonFormula t -> JsonFormula t -> JsonFormula t
$c\/ :: forall (t :: JsonType).
JsonFormula t -> JsonFormula t -> JsonFormula t
Lattice, Lattice (JsonFormula t)
JsonFormula t
Lattice (JsonFormula t)
-> JsonFormula t -> BoundedJoinSemiLattice (JsonFormula t)
forall a. Lattice a -> a -> BoundedJoinSemiLattice a
forall (t :: JsonType). Lattice (JsonFormula t)
forall (t :: JsonType). JsonFormula t
bottom :: JsonFormula t
$cbottom :: forall (t :: JsonType). JsonFormula t
$cp1BoundedJoinSemiLattice :: forall (t :: JsonType). Lattice (JsonFormula t)
BoundedJoinSemiLattice, Lattice (JsonFormula t)
JsonFormula t
Lattice (JsonFormula t)
-> JsonFormula t -> BoundedMeetSemiLattice (JsonFormula t)
forall a. Lattice a -> a -> BoundedMeetSemiLattice a
forall (t :: JsonType). Lattice (JsonFormula t)
forall (t :: JsonType). JsonFormula t
top :: JsonFormula t
$ctop :: forall (t :: JsonType). JsonFormula t
$cp1BoundedMeetSemiLattice :: forall (t :: JsonType). Lattice (JsonFormula t)
BoundedMeetSemiLattice)
satisfiesFormula :: TypedValue t -> JsonFormula t -> Bool
satisfiesFormula :: TypedValue t -> JsonFormula t -> Bool
satisfiesFormula TypedValue t
val = (Condition t -> Bool) -> DNF (Condition t) -> Bool
forall l a. BoundedLattice l => (a -> l) -> DNF a -> l
foldDNF (TypedValue t -> Condition t -> Bool
forall (t :: JsonType). TypedValue t -> Condition t -> Bool
satisfiesTyped TypedValue t
val) (DNF (Condition t) -> Bool)
-> (JsonFormula t -> DNF (Condition t)) -> JsonFormula t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonFormula t -> DNF (Condition t)
forall (t :: JsonType). JsonFormula t -> DNF (Condition t)
getJsonFormula
satisfies :: A.Value -> ForeachType JsonFormula -> Bool
satisfies :: Value -> ForeachType JsonFormula -> Bool
satisfies Value
val ForeachType JsonFormula
p = case Value
val of
Value
A.Null -> TypedValue 'Null -> JsonFormula 'Null -> Bool
forall (t :: JsonType). TypedValue t -> JsonFormula t -> Bool
satisfiesFormula TypedValue 'Null
TNull (JsonFormula 'Null -> Bool) -> JsonFormula 'Null -> Bool
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula 'Null
forall (f :: JsonType -> *). ForeachType f -> f 'Null
forNull ForeachType JsonFormula
p
A.Bool Bool
b -> TypedValue 'Boolean -> JsonFormula 'Boolean -> Bool
forall (t :: JsonType). TypedValue t -> JsonFormula t -> Bool
satisfiesFormula (Bool -> TypedValue 'Boolean
TBool Bool
b) (JsonFormula 'Boolean -> Bool) -> JsonFormula 'Boolean -> Bool
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula 'Boolean
forall (f :: JsonType -> *). ForeachType f -> f 'Boolean
forBoolean ForeachType JsonFormula
p
A.Number Scientific
n -> TypedValue 'Number -> JsonFormula 'Number -> Bool
forall (t :: JsonType). TypedValue t -> JsonFormula t -> Bool
satisfiesFormula (Scientific -> TypedValue 'Number
TNumber Scientific
n) (JsonFormula 'Number -> Bool) -> JsonFormula 'Number -> Bool
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula 'Number
forall (f :: JsonType -> *). ForeachType f -> f 'Number
forNumber ForeachType JsonFormula
p
A.String Format
s -> TypedValue 'String -> JsonFormula 'String -> Bool
forall (t :: JsonType). TypedValue t -> JsonFormula t -> Bool
satisfiesFormula (Format -> TypedValue 'String
TString Format
s) (JsonFormula 'String -> Bool) -> JsonFormula 'String -> Bool
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula 'String
forall (f :: JsonType -> *). ForeachType f -> f 'String
forString ForeachType JsonFormula
p
A.Array Array
a -> TypedValue 'Array -> JsonFormula 'Array -> Bool
forall (t :: JsonType). TypedValue t -> JsonFormula t -> Bool
satisfiesFormula (Array -> TypedValue 'Array
TArray Array
a) (JsonFormula 'Array -> Bool) -> JsonFormula 'Array -> Bool
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula 'Array
forall (f :: JsonType -> *). ForeachType f -> f 'Array
forArray ForeachType JsonFormula
p
A.Object Object
o -> TypedValue 'Object -> JsonFormula 'Object -> Bool
forall (t :: JsonType). TypedValue t -> JsonFormula t -> Bool
satisfiesFormula (Object -> TypedValue 'Object
TObject Object
o) (JsonFormula 'Object -> Bool) -> JsonFormula 'Object -> Bool
forall a b. (a -> b) -> a -> b
$ ForeachType JsonFormula -> JsonFormula 'Object
forall (f :: JsonType -> *). ForeachType f -> f 'Object
forObject ForeachType JsonFormula
p