module Data.OpenApi.Compare.Validate.Schema.TypedJson
( JsonType (..),
describeJSONType,
TypedValue (..),
untypeValue,
ForeachType (..),
foldType,
forType_,
)
where
import Algebra.Lattice
import qualified Data.Aeson as A
import Data.Kind
import Data.Monoid
import Data.Scientific
import Data.String
import Data.Text (Text)
import Data.Typeable
data JsonType
= Null
| Boolean
| Number
| String
| Array
| Object
deriving stock (JsonType -> JsonType -> Bool
(JsonType -> JsonType -> Bool)
-> (JsonType -> JsonType -> Bool) -> Eq JsonType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonType -> JsonType -> Bool
$c/= :: JsonType -> JsonType -> Bool
== :: JsonType -> JsonType -> Bool
$c== :: JsonType -> JsonType -> Bool
Eq, Eq JsonType
Eq JsonType
-> (JsonType -> JsonType -> Ordering)
-> (JsonType -> JsonType -> Bool)
-> (JsonType -> JsonType -> Bool)
-> (JsonType -> JsonType -> Bool)
-> (JsonType -> JsonType -> Bool)
-> (JsonType -> JsonType -> JsonType)
-> (JsonType -> JsonType -> JsonType)
-> Ord JsonType
JsonType -> JsonType -> Bool
JsonType -> JsonType -> Ordering
JsonType -> JsonType -> JsonType
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 :: JsonType -> JsonType -> JsonType
$cmin :: JsonType -> JsonType -> JsonType
max :: JsonType -> JsonType -> JsonType
$cmax :: JsonType -> JsonType -> JsonType
>= :: JsonType -> JsonType -> Bool
$c>= :: JsonType -> JsonType -> Bool
> :: JsonType -> JsonType -> Bool
$c> :: JsonType -> JsonType -> Bool
<= :: JsonType -> JsonType -> Bool
$c<= :: JsonType -> JsonType -> Bool
< :: JsonType -> JsonType -> Bool
$c< :: JsonType -> JsonType -> Bool
compare :: JsonType -> JsonType -> Ordering
$ccompare :: JsonType -> JsonType -> Ordering
$cp1Ord :: Eq JsonType
Ord, Int -> JsonType -> ShowS
[JsonType] -> ShowS
JsonType -> String
(Int -> JsonType -> ShowS)
-> (JsonType -> String) -> ([JsonType] -> ShowS) -> Show JsonType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonType] -> ShowS
$cshowList :: [JsonType] -> ShowS
show :: JsonType -> String
$cshow :: JsonType -> String
showsPrec :: Int -> JsonType -> ShowS
$cshowsPrec :: Int -> JsonType -> ShowS
Show)
describeJSONType :: IsString s => JsonType -> s
describeJSONType :: JsonType -> s
describeJSONType = \case
JsonType
Null -> s
"Null"
JsonType
Boolean -> s
"Boolean"
JsonType
Number -> s
"Number"
JsonType
String -> s
"String"
JsonType
Array -> s
"Array"
JsonType
Object -> s
"Object"
data TypedValue :: JsonType -> Type where
TNull :: TypedValue 'Null
TBool :: !Bool -> TypedValue 'Boolean
TNumber :: !Scientific -> TypedValue 'Number
TString :: !Text -> TypedValue 'String
TArray :: !A.Array -> TypedValue 'Array
TObject :: !A.Object -> TypedValue 'Object
deriving stock instance Eq (TypedValue t)
deriving stock instance Ord (TypedValue t)
deriving stock instance Show (TypedValue t)
untypeValue :: TypedValue t -> A.Value
untypeValue :: TypedValue t -> Value
untypeValue TypedValue t
TNull = Value
A.Null
untypeValue (TBool Bool
b) = Bool -> Value
A.Bool Bool
b
untypeValue (TNumber Scientific
n) = Scientific -> Value
A.Number Scientific
n
untypeValue (TString Text
s) = Text -> Value
A.String Text
s
untypeValue (TArray Array
a) = Array -> Value
A.Array Array
a
untypeValue (TObject Object
o) = Object -> Value
A.Object Object
o
data ForeachType (f :: JsonType -> Type) = ForeachType
{ ForeachType f -> f 'Null
forNull :: f 'Null
, ForeachType f -> f 'Boolean
forBoolean :: f 'Boolean
, ForeachType f -> f 'Number
forNumber :: f 'Number
, ForeachType f -> f 'String
forString :: f 'String
, ForeachType f -> f 'Array
forArray :: f 'Array
, ForeachType f -> f 'Object
forObject :: f 'Object
}
deriving stock instance (forall x. Typeable x => Eq (f x)) => Eq (ForeachType f)
deriving stock instance (forall x. Typeable x => Ord (f x)) => Ord (ForeachType f)
deriving stock instance (forall x. Typeable x => Show (f x)) => Show (ForeachType f)
foldType :: Monoid m => (forall x. Typeable x => JsonType -> (ForeachType f -> f x) -> m) -> m
foldType :: (forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m)
-> m
foldType forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m
k =
JsonType -> (ForeachType f -> f 'Null) -> m
forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m
k JsonType
Null ForeachType f -> f 'Null
forall (f :: JsonType -> *). ForeachType f -> f 'Null
forNull
m -> m -> m
forall a. Semigroup a => a -> a -> a
<> JsonType -> (ForeachType f -> f 'Boolean) -> m
forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m
k JsonType
Boolean ForeachType f -> f 'Boolean
forall (f :: JsonType -> *). ForeachType f -> f 'Boolean
forBoolean
m -> m -> m
forall a. Semigroup a => a -> a -> a
<> JsonType -> (ForeachType f -> f 'Number) -> m
forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m
k JsonType
Number ForeachType f -> f 'Number
forall (f :: JsonType -> *). ForeachType f -> f 'Number
forNumber
m -> m -> m
forall a. Semigroup a => a -> a -> a
<> JsonType -> (ForeachType f -> f 'String) -> m
forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m
k JsonType
String ForeachType f -> f 'String
forall (f :: JsonType -> *). ForeachType f -> f 'String
forString
m -> m -> m
forall a. Semigroup a => a -> a -> a
<> JsonType -> (ForeachType f -> f 'Array) -> m
forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m
k JsonType
Array ForeachType f -> f 'Array
forall (f :: JsonType -> *). ForeachType f -> f 'Array
forArray
m -> m -> m
forall a. Semigroup a => a -> a -> a
<> JsonType -> (ForeachType f -> f 'Object) -> m
forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m
k JsonType
Object ForeachType f -> f 'Object
forall (f :: JsonType -> *). ForeachType f -> f 'Object
forObject
forType_ :: Applicative m => (forall x. Typeable x => JsonType -> (ForeachType f -> f x) -> m ()) -> m ()
forType_ :: (forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m ())
-> m ()
forType_ forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m ()
k = Ap m () -> m ()
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap m () -> m ()) -> Ap m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> Ap m ())
-> Ap m ()
forall m (f :: JsonType -> *).
Monoid m =>
(forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m)
-> m
foldType (\JsonType
ty ForeachType f -> f x
proj -> m () -> Ap m ()
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (m () -> Ap m ()) -> m () -> Ap m ()
forall a b. (a -> b) -> a -> b
$ JsonType -> (ForeachType f -> f x) -> m ()
forall (x :: JsonType).
Typeable x =>
JsonType -> (ForeachType f -> f x) -> m ()
k JsonType
ty ForeachType f -> f x
proj)
broadcastType :: (forall x. Typeable x => f x) -> ForeachType f
broadcastType :: (forall (x :: JsonType). Typeable x => f x) -> ForeachType f
broadcastType forall (x :: JsonType). Typeable x => f x
k =
ForeachType :: forall (f :: JsonType -> *).
f 'Null
-> f 'Boolean
-> f 'Number
-> f 'String
-> f 'Array
-> f 'Object
-> ForeachType f
ForeachType
{ $sel:forNull:ForeachType :: f 'Null
forNull = f 'Null
forall (x :: JsonType). Typeable x => f x
k
, $sel:forBoolean:ForeachType :: f 'Boolean
forBoolean = f 'Boolean
forall (x :: JsonType). Typeable x => f x
k
, $sel:forNumber:ForeachType :: f 'Number
forNumber = f 'Number
forall (x :: JsonType). Typeable x => f x
k
, $sel:forString:ForeachType :: f 'String
forString = f 'String
forall (x :: JsonType). Typeable x => f x
k
, $sel:forArray:ForeachType :: f 'Array
forArray = f 'Array
forall (x :: JsonType). Typeable x => f x
k
, $sel:forObject:ForeachType :: f 'Object
forObject = f 'Object
forall (x :: JsonType). Typeable x => f x
k
}
zipType :: (forall x. Typeable x => f x -> g x -> h x) -> ForeachType f -> ForeachType g -> ForeachType h
zipType :: (forall (x :: JsonType). Typeable x => f x -> g x -> h x)
-> ForeachType f -> ForeachType g -> ForeachType h
zipType forall (x :: JsonType). Typeable x => f x -> g x -> h x
k ForeachType f
f1 ForeachType g
f2 =
ForeachType :: forall (f :: JsonType -> *).
f 'Null
-> f 'Boolean
-> f 'Number
-> f 'String
-> f 'Array
-> f 'Object
-> ForeachType f
ForeachType
{ $sel:forNull:ForeachType :: h 'Null
forNull = f 'Null -> g 'Null -> h 'Null
forall (x :: JsonType). Typeable x => f x -> g x -> h x
k (ForeachType f -> f 'Null
forall (f :: JsonType -> *). ForeachType f -> f 'Null
forNull ForeachType f
f1) (ForeachType g -> g 'Null
forall (f :: JsonType -> *). ForeachType f -> f 'Null
forNull ForeachType g
f2)
, $sel:forBoolean:ForeachType :: h 'Boolean
forBoolean = f 'Boolean -> g 'Boolean -> h 'Boolean
forall (x :: JsonType). Typeable x => f x -> g x -> h x
k (ForeachType f -> f 'Boolean
forall (f :: JsonType -> *). ForeachType f -> f 'Boolean
forBoolean ForeachType f
f1) (ForeachType g -> g 'Boolean
forall (f :: JsonType -> *). ForeachType f -> f 'Boolean
forBoolean ForeachType g
f2)
, $sel:forNumber:ForeachType :: h 'Number
forNumber = f 'Number -> g 'Number -> h 'Number
forall (x :: JsonType). Typeable x => f x -> g x -> h x
k (ForeachType f -> f 'Number
forall (f :: JsonType -> *). ForeachType f -> f 'Number
forNumber ForeachType f
f1) (ForeachType g -> g 'Number
forall (f :: JsonType -> *). ForeachType f -> f 'Number
forNumber ForeachType g
f2)
, $sel:forString:ForeachType :: h 'String
forString = f 'String -> g 'String -> h 'String
forall (x :: JsonType). Typeable x => f x -> g x -> h x
k (ForeachType f -> f 'String
forall (f :: JsonType -> *). ForeachType f -> f 'String
forString ForeachType f
f1) (ForeachType g -> g 'String
forall (f :: JsonType -> *). ForeachType f -> f 'String
forString ForeachType g
f2)
, $sel:forArray:ForeachType :: h 'Array
forArray = f 'Array -> g 'Array -> h 'Array
forall (x :: JsonType). Typeable x => f x -> g x -> h x
k (ForeachType f -> f 'Array
forall (f :: JsonType -> *). ForeachType f -> f 'Array
forArray ForeachType f
f1) (ForeachType g -> g 'Array
forall (f :: JsonType -> *). ForeachType f -> f 'Array
forArray ForeachType g
f2)
, $sel:forObject:ForeachType :: h 'Object
forObject = f 'Object -> g 'Object -> h 'Object
forall (x :: JsonType). Typeable x => f x -> g x -> h x
k (ForeachType f -> f 'Object
forall (f :: JsonType -> *). ForeachType f -> f 'Object
forObject ForeachType f
f1) (ForeachType g -> g 'Object
forall (f :: JsonType -> *). ForeachType f -> f 'Object
forObject ForeachType g
f2)
}
instance (forall x. Lattice (f x)) => Lattice (ForeachType f) where
\/ :: ForeachType f -> ForeachType f -> ForeachType f
(\/) = (forall (x :: JsonType). Typeable x => f x -> f x -> f x)
-> ForeachType f -> ForeachType f -> ForeachType f
forall (f :: JsonType -> *) (g :: JsonType -> *)
(h :: JsonType -> *).
(forall (x :: JsonType). Typeable x => f x -> g x -> h x)
-> ForeachType f -> ForeachType g -> ForeachType h
zipType forall a. Lattice a => a -> a -> a
forall (x :: JsonType). Typeable x => f x -> f x -> f x
(\/)
/\ :: ForeachType f -> ForeachType f -> ForeachType f
(/\) = (forall (x :: JsonType). Typeable x => f x -> f x -> f x)
-> ForeachType f -> ForeachType f -> ForeachType f
forall (f :: JsonType -> *) (g :: JsonType -> *)
(h :: JsonType -> *).
(forall (x :: JsonType). Typeable x => f x -> g x -> h x)
-> ForeachType f -> ForeachType g -> ForeachType h
zipType forall a. Lattice a => a -> a -> a
forall (x :: JsonType). Typeable x => f x -> f x -> f x
(/\)
instance (forall x. BoundedJoinSemiLattice (f x)) => BoundedJoinSemiLattice (ForeachType f) where
bottom :: ForeachType f
bottom = (forall (x :: JsonType). Typeable x => f x) -> ForeachType f
forall (f :: JsonType -> *).
(forall (x :: JsonType). Typeable x => f x) -> ForeachType f
broadcastType forall a. BoundedJoinSemiLattice a => a
forall (x :: JsonType). Typeable x => f x
bottom
instance (forall x. BoundedMeetSemiLattice (f x)) => BoundedMeetSemiLattice (ForeachType f) where
top :: ForeachType f
top = (forall (x :: JsonType). Typeable x => f x) -> ForeachType f
forall (f :: JsonType -> *).
(forall (x :: JsonType). Typeable x => f x) -> ForeachType f
broadcastType forall a. BoundedMeetSemiLattice a => a
forall (x :: JsonType). Typeable x => f x
top