{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}

module Data.Medea.Analysis
  ( AnalysisError (..),
    ArrayType (..),
    CompiledSchema (..),
    TypeNode (..),
    compileSchemata,
  )
where

import Algebra.Graph.Acyclic.AdjacencyMap (toAcyclic)
import qualified Algebra.Graph.AdjacencyMap as Cyclic
import Control.Applicative ((<|>))
import Control.Monad (foldM, when)
import Control.Monad.Except (MonadError (..))
import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as NEList
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (isJust, isNothing, mapMaybe)
import Data.Medea.JSONType (JSONType (..))
import Data.Medea.Parser.Primitive
  ( Identifier,
    MedeaString (..),
    Natural,
    PrimTypeIdentifier (..),
    ReservedIdentifier (..),
    identFromReserved,
    isReserved,
    isStartIdent,
    tryPrimType,
    typeOf,
  )
import Data.Medea.Parser.Spec.Array
  ( elementType,
    maxLength,
    minLength,
    tupleSpec,
  )
import Data.Medea.Parser.Spec.Object
  ( additionalAllowed,
    additionalSchema,
    properties,
  )
import Data.Medea.Parser.Spec.Property (propName, propOptional, propSchema)
import qualified Data.Medea.Parser.Spec.Schema as Schema
import qualified Data.Medea.Parser.Spec.Schemata as Schemata
import qualified Data.Medea.Parser.Spec.String as String
import qualified Data.Medea.Parser.Spec.Type as Type
import qualified Data.Set as S
import Data.Set.NonEmpty (NESet)
import qualified Data.Set.NonEmpty as NESet
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Prelude

data AnalysisError
  = DuplicateSchemaName !Identifier
  | NoStartSchema
  | DanglingTypeReference !Identifier !Identifier
  | TypeRelationIsCyclic
  | ReservedDefined !Identifier
  | DefinedButNotUsed !Identifier
  | MinMoreThanMax !Identifier
  | DanglingTypeRefProp !Identifier !Identifier
  | DanglingTypeRefList !Identifier !Identifier
  | DanglingTypeRefTuple !Identifier !Identifier
  | DuplicatePropName !Identifier !MedeaString
  | PropertyWithoutObject !Identifier
  | ListWithoutArray !Identifier
  | TupleWithoutArray !Identifier
  | StringValsWithoutString !Identifier
  deriving stock (AnalysisError -> AnalysisError -> Bool
(AnalysisError -> AnalysisError -> Bool)
-> (AnalysisError -> AnalysisError -> Bool) -> Eq AnalysisError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnalysisError -> AnalysisError -> Bool
$c/= :: AnalysisError -> AnalysisError -> Bool
== :: AnalysisError -> AnalysisError -> Bool
$c== :: AnalysisError -> AnalysisError -> Bool
Eq, Int -> AnalysisError -> ShowS
[AnalysisError] -> ShowS
AnalysisError -> String
(Int -> AnalysisError -> ShowS)
-> (AnalysisError -> String)
-> ([AnalysisError] -> ShowS)
-> Show AnalysisError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnalysisError] -> ShowS
$cshowList :: [AnalysisError] -> ShowS
show :: AnalysisError -> String
$cshow :: AnalysisError -> String
showsPrec :: Int -> AnalysisError -> ShowS
$cshowsPrec :: Int -> AnalysisError -> ShowS
Show)

data TypeNode
  = AnyNode
  | PrimitiveNode !JSONType
  | CustomNode !Identifier
  deriving stock (TypeNode -> TypeNode -> Bool
(TypeNode -> TypeNode -> Bool)
-> (TypeNode -> TypeNode -> Bool) -> Eq TypeNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeNode -> TypeNode -> Bool
$c/= :: TypeNode -> TypeNode -> Bool
== :: TypeNode -> TypeNode -> Bool
$c== :: TypeNode -> TypeNode -> Bool
Eq, Eq TypeNode
Eq TypeNode
-> (TypeNode -> TypeNode -> Ordering)
-> (TypeNode -> TypeNode -> Bool)
-> (TypeNode -> TypeNode -> Bool)
-> (TypeNode -> TypeNode -> Bool)
-> (TypeNode -> TypeNode -> Bool)
-> (TypeNode -> TypeNode -> TypeNode)
-> (TypeNode -> TypeNode -> TypeNode)
-> Ord TypeNode
TypeNode -> TypeNode -> Bool
TypeNode -> TypeNode -> Ordering
TypeNode -> TypeNode -> TypeNode
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 :: TypeNode -> TypeNode -> TypeNode
$cmin :: TypeNode -> TypeNode -> TypeNode
max :: TypeNode -> TypeNode -> TypeNode
$cmax :: TypeNode -> TypeNode -> TypeNode
>= :: TypeNode -> TypeNode -> Bool
$c>= :: TypeNode -> TypeNode -> Bool
> :: TypeNode -> TypeNode -> Bool
$c> :: TypeNode -> TypeNode -> Bool
<= :: TypeNode -> TypeNode -> Bool
$c<= :: TypeNode -> TypeNode -> Bool
< :: TypeNode -> TypeNode -> Bool
$c< :: TypeNode -> TypeNode -> Bool
compare :: TypeNode -> TypeNode -> Ordering
$ccompare :: TypeNode -> TypeNode -> Ordering
$cp1Ord :: Eq TypeNode
Ord, Int -> TypeNode -> ShowS
[TypeNode] -> ShowS
TypeNode -> String
(Int -> TypeNode -> ShowS)
-> (TypeNode -> String) -> ([TypeNode] -> ShowS) -> Show TypeNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeNode] -> ShowS
$cshowList :: [TypeNode] -> ShowS
show :: TypeNode -> String
$cshow :: TypeNode -> String
showsPrec :: Int -> TypeNode -> ShowS
$cshowsPrec :: Int -> TypeNode -> ShowS
Show)

data CompiledSchema = CompiledSchema
  { CompiledSchema -> TypeNode
schemaNode :: !TypeNode,
    CompiledSchema -> NESet TypeNode
typesAs :: {-# UNPACK #-} !(NESet TypeNode),
    CompiledSchema -> Maybe Natural
minArrayLen :: !(Maybe Natural),
    CompiledSchema -> Maybe Natural
maxArrayLen :: !(Maybe Natural),
    CompiledSchema -> Maybe ArrayType
arrayTypes :: !(Maybe ArrayType),
    CompiledSchema -> HashMap Text (TypeNode, Bool)
props :: !(HashMap Text (TypeNode, Bool)),
    CompiledSchema -> Bool
additionalProps :: !Bool,
    CompiledSchema -> TypeNode
additionalPropSchema :: !TypeNode,
    CompiledSchema -> Vector Text
stringVals :: {-# UNPACK #-} !(Vector Text)
  }
  deriving stock (CompiledSchema -> CompiledSchema -> Bool
(CompiledSchema -> CompiledSchema -> Bool)
-> (CompiledSchema -> CompiledSchema -> Bool) -> Eq CompiledSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompiledSchema -> CompiledSchema -> Bool
$c/= :: CompiledSchema -> CompiledSchema -> Bool
== :: CompiledSchema -> CompiledSchema -> Bool
$c== :: CompiledSchema -> CompiledSchema -> Bool
Eq, Int -> CompiledSchema -> ShowS
[CompiledSchema] -> ShowS
CompiledSchema -> String
(Int -> CompiledSchema -> ShowS)
-> (CompiledSchema -> String)
-> ([CompiledSchema] -> ShowS)
-> Show CompiledSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompiledSchema] -> ShowS
$cshowList :: [CompiledSchema] -> ShowS
show :: CompiledSchema -> String
$cshow :: CompiledSchema -> String
showsPrec :: Int -> CompiledSchema -> ShowS
$cshowsPrec :: Int -> CompiledSchema -> ShowS
Show)

data ArrayType
  = ListType !TypeNode
  | TupleType {-# UNPACK #-} !(Vector TypeNode)
  deriving stock (ArrayType -> ArrayType -> Bool
(ArrayType -> ArrayType -> Bool)
-> (ArrayType -> ArrayType -> Bool) -> Eq ArrayType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayType -> ArrayType -> Bool
$c/= :: ArrayType -> ArrayType -> Bool
== :: ArrayType -> ArrayType -> Bool
$c== :: ArrayType -> ArrayType -> Bool
Eq, Int -> ArrayType -> ShowS
[ArrayType] -> ShowS
ArrayType -> String
(Int -> ArrayType -> ShowS)
-> (ArrayType -> String)
-> ([ArrayType] -> ShowS)
-> Show ArrayType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayType] -> ShowS
$cshowList :: [ArrayType] -> ShowS
show :: ArrayType -> String
$cshow :: ArrayType -> String
showsPrec :: Int -> ArrayType -> ShowS
$cshowsPrec :: Int -> ArrayType -> ShowS
Show)

checkAcyclic ::
  (MonadError AnalysisError m) =>
  Map Identifier CompiledSchema ->
  m ()
checkAcyclic :: Map Identifier CompiledSchema -> m ()
checkAcyclic Map Identifier CompiledSchema
m =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (AdjacencyMap TypeNode) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (AdjacencyMap TypeNode) -> Bool)
-> (Map Identifier CompiledSchema -> Maybe (AdjacencyMap TypeNode))
-> Map Identifier CompiledSchema
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap TypeNode -> Maybe (AdjacencyMap TypeNode)
forall a. Ord a => AdjacencyMap a -> Maybe (AdjacencyMap a)
toAcyclic (AdjacencyMap TypeNode -> Maybe (AdjacencyMap TypeNode))
-> (Map Identifier CompiledSchema -> AdjacencyMap TypeNode)
-> Map Identifier CompiledSchema
-> Maybe (AdjacencyMap TypeNode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier CompiledSchema -> AdjacencyMap TypeNode
getTypesAsGraph (Map Identifier CompiledSchema -> Bool)
-> Map Identifier CompiledSchema -> Bool
forall a b. (a -> b) -> a -> b
$ Map Identifier CompiledSchema
m) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AnalysisError
TypeRelationIsCyclic

compileSchemata ::
  (MonadError AnalysisError m) =>
  Schemata.Specification ->
  m (Map Identifier CompiledSchema)
compileSchemata :: Specification -> m (Map Identifier CompiledSchema)
compileSchemata (Schemata.Specification Vector Specification
v) = do
  Map Identifier CompiledSchema
m <- (Map Identifier CompiledSchema
 -> Specification -> m (Map Identifier CompiledSchema))
-> Map Identifier CompiledSchema
-> Vector Specification
-> m (Map Identifier CompiledSchema)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Identifier CompiledSchema
-> Specification -> m (Map Identifier CompiledSchema)
forall (f :: * -> *).
MonadError AnalysisError f =>
Map Identifier CompiledSchema
-> Specification -> f (Map Identifier CompiledSchema)
go Map Identifier CompiledSchema
forall k a. Map k a
M.empty Vector Specification
v
  Map Identifier CompiledSchema -> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
Map Identifier CompiledSchema -> m ()
checkStartSchema Map Identifier CompiledSchema
m
  (CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
(CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
checkDanglingReferences CompiledSchema -> [TypeNode]
getTypeRefs Identifier -> Identifier -> AnalysisError
DanglingTypeReference Map Identifier CompiledSchema
m
  (CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
(CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
checkDanglingReferences CompiledSchema -> [TypeNode]
getPropertyTypeRefs Identifier -> Identifier -> AnalysisError
DanglingTypeRefProp Map Identifier CompiledSchema
m
  (CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
(CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
checkDanglingReferences CompiledSchema -> [TypeNode]
getListTypeRefs Identifier -> Identifier -> AnalysisError
DanglingTypeRefList Map Identifier CompiledSchema
m
  (CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
(CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
checkDanglingReferences CompiledSchema -> [TypeNode]
getTupleTypeRefs Identifier -> Identifier -> AnalysisError
DanglingTypeRefTuple Map Identifier CompiledSchema
m
  Map Identifier CompiledSchema -> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
Map Identifier CompiledSchema -> m ()
checkUnusedSchemata Map Identifier CompiledSchema
m
  Map Identifier CompiledSchema -> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
Map Identifier CompiledSchema -> m ()
checkAcyclic Map Identifier CompiledSchema
m
  Map Identifier CompiledSchema -> m (Map Identifier CompiledSchema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Identifier CompiledSchema
m
  where
    go :: Map Identifier CompiledSchema
-> Specification -> f (Map Identifier CompiledSchema)
go Map Identifier CompiledSchema
acc Specification
spec = (Maybe CompiledSchema -> f (Maybe CompiledSchema))
-> Identifier
-> Map Identifier CompiledSchema
-> f (Map Identifier CompiledSchema)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF (Specification -> Maybe CompiledSchema -> f (Maybe CompiledSchema)
forall (f :: * -> *) a.
MonadError AnalysisError f =>
Specification -> Maybe a -> f (Maybe CompiledSchema)
checkedInsert Specification
spec) (Specification -> Identifier
Schema.name Specification
spec) Map Identifier CompiledSchema
acc
    checkedInsert :: Specification -> Maybe a -> f (Maybe CompiledSchema)
checkedInsert Specification
spec = \case
      Maybe a
Nothing -> CompiledSchema -> Maybe CompiledSchema
forall a. a -> Maybe a
Just (CompiledSchema -> Maybe CompiledSchema)
-> f CompiledSchema -> f (Maybe CompiledSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Specification -> f CompiledSchema
forall (m :: * -> *).
MonadError AnalysisError m =>
Specification -> m CompiledSchema
compileSchema Specification
spec
      Just a
_ -> AnalysisError -> f (Maybe CompiledSchema)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> f (Maybe CompiledSchema))
-> (Identifier -> AnalysisError)
-> Identifier
-> f (Maybe CompiledSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> AnalysisError
DuplicateSchemaName (Identifier -> f (Maybe CompiledSchema))
-> Identifier -> f (Maybe CompiledSchema)
forall a b. (a -> b) -> a -> b
$ Identifier
ident
      where
        ident :: Identifier
ident = Specification -> Identifier
Schema.name Specification
spec

compileSchema ::
  (MonadError AnalysisError m) =>
  Schema.Specification ->
  m CompiledSchema
compileSchema :: Specification -> m CompiledSchema
compileSchema Specification
scm = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Identifier -> Bool
isReserved Identifier
schemaName Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Identifier -> Bool) -> Identifier -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Bool
isStartIdent) Identifier
schemaName)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> m ())
-> (Identifier -> AnalysisError) -> Identifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> AnalysisError
ReservedDefined
    (Identifier -> m ()) -> Identifier -> m ()
forall a b. (a -> b) -> a -> b
$ Identifier
schemaName
  let minListLen :: Maybe Natural
minListLen = Specification -> Maybe Natural
minLength Specification
arraySpec
      maxListLen :: Maybe Natural
maxListLen = Specification -> Maybe Natural
maxLength Specification
arraySpec
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Natural -> Bool
forall a. Maybe a -> Bool
isJust Maybe Natural
minListLen Bool -> Bool -> Bool
&& Maybe Natural -> Bool
forall a. Maybe a -> Bool
isJust Maybe Natural
maxListLen Bool -> Bool -> Bool
&& Maybe Natural
minListLen Maybe Natural -> Maybe Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Maybe Natural
maxListLen)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (AnalysisError -> m ()) -> AnalysisError -> m ()
forall a b. (a -> b) -> a -> b
$ Identifier -> AnalysisError
MinMoreThanMax Identifier
schemaName
  HashMap Text (TypeNode, Bool)
propMap <- (HashMap Text (TypeNode, Bool)
 -> Specification -> m (HashMap Text (TypeNode, Bool)))
-> HashMap Text (TypeNode, Bool)
-> Vector Specification
-> m (HashMap Text (TypeNode, Bool))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashMap Text (TypeNode, Bool)
-> Specification -> m (HashMap Text (TypeNode, Bool))
forall (f :: * -> *) k.
(Eq k, Hashable k, MonadError AnalysisError f, Coercible k Text) =>
HashMap k (TypeNode, Bool)
-> Specification -> f (HashMap k (TypeNode, Bool))
go HashMap Text (TypeNode, Bool)
forall k v. HashMap k v
HM.empty (Vector Specification
-> (Specification -> Vector Specification)
-> Maybe Specification
-> Vector Specification
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector Specification
forall a. Vector a
V.empty Specification -> Vector Specification
properties Maybe Specification
objSpec)
  let arrType :: Maybe ArrayType
arrType = Maybe Identifier -> Maybe [Identifier] -> Maybe ArrayType
getArrayTypes (Specification -> Maybe Identifier
elementType Specification
arraySpec) (Specification -> Maybe [Identifier]
tupleSpec Specification
arraySpec)
      tupleLen :: Maybe Natural
tupleLen = Maybe ArrayType -> Maybe Natural
getTupleTypeLen Maybe ArrayType
arrType
      hasPropSpec :: Bool
hasPropSpec = Maybe Specification -> Bool
forall a. Maybe a -> Bool
isJust Maybe Specification
objSpec
      compiledScm :: CompiledSchema
compiledScm =
        CompiledSchema :: TypeNode
-> NESet TypeNode
-> Maybe Natural
-> Maybe Natural
-> Maybe ArrayType
-> HashMap Text (TypeNode, Bool)
-> Bool
-> TypeNode
-> Vector Text
-> CompiledSchema
CompiledSchema
          { schemaNode :: TypeNode
schemaNode = Maybe Identifier -> TypeNode
identToNode (Maybe Identifier -> TypeNode)
-> (Identifier -> Maybe Identifier) -> Identifier -> TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> TypeNode) -> Identifier -> TypeNode
forall a b. (a -> b) -> a -> b
$ Identifier
schemaName,
            typesAs :: NESet TypeNode
typesAs = NonEmpty TypeNode -> NESet TypeNode
forall a. Ord a => NonEmpty a -> NESet a
NESet.fromList (NonEmpty TypeNode -> NESet TypeNode)
-> (Vector Identifier -> NonEmpty TypeNode)
-> Vector Identifier
-> NESet TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeNode] -> NonEmpty TypeNode
defaultToAny ([TypeNode] -> NonEmpty TypeNode)
-> (Vector Identifier -> [TypeNode])
-> Vector Identifier
-> NonEmpty TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector TypeNode -> [TypeNode]
forall a. Vector a -> [a]
V.toList (Vector TypeNode -> [TypeNode])
-> (Vector Identifier -> Vector TypeNode)
-> Vector Identifier
-> [TypeNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> TypeNode) -> Vector Identifier -> Vector TypeNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Identifier -> TypeNode
identToNode (Maybe Identifier -> TypeNode)
-> (Identifier -> Maybe Identifier) -> Identifier -> TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just) (Vector Identifier -> NESet TypeNode)
-> Vector Identifier -> NESet TypeNode
forall a b. (a -> b) -> a -> b
$ Vector Identifier
types,
            minArrayLen :: Maybe Natural
minArrayLen = Maybe Natural
minListLen Maybe Natural -> Maybe Natural -> Maybe Natural
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Natural
tupleLen,
            maxArrayLen :: Maybe Natural
maxArrayLen = Maybe Natural
maxListLen Maybe Natural -> Maybe Natural -> Maybe Natural
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Natural
tupleLen,
            arrayTypes :: Maybe ArrayType
arrayTypes = Maybe ArrayType
arrType,
            props :: HashMap Text (TypeNode, Bool)
props = HashMap Text (TypeNode, Bool)
propMap,
            additionalProps :: Bool
additionalProps = Bool -> (Specification -> Bool) -> Maybe Specification -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Specification -> Bool
additionalAllowed Maybe Specification
objSpec,
            additionalPropSchema :: TypeNode
additionalPropSchema = Maybe Identifier -> TypeNode
identToNode (Maybe Identifier -> TypeNode) -> Maybe Identifier -> TypeNode
forall a b. (a -> b) -> a -> b
$ Maybe Specification
objSpec Maybe Specification
-> (Specification -> Maybe Identifier) -> Maybe Identifier
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Specification -> Maybe Identifier
additionalSchema,
            stringVals :: Vector Text
stringVals = Specification -> Vector Text
String.toReducedSpec Specification
stringValsSpec
          }
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CompiledSchema -> Bool -> Bool
shouldNotHavePropertySpec CompiledSchema
compiledScm Bool
hasPropSpec)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> m ())
-> (Identifier -> AnalysisError) -> Identifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> AnalysisError
PropertyWithoutObject
    (Identifier -> m ()) -> Identifier -> m ()
forall a b. (a -> b) -> a -> b
$ Identifier
schemaName
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CompiledSchema -> Bool
shouldNotHaveListSpec CompiledSchema
compiledScm)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> m ())
-> (Identifier -> AnalysisError) -> Identifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> AnalysisError
ListWithoutArray
    (Identifier -> m ()) -> Identifier -> m ()
forall a b. (a -> b) -> a -> b
$ Identifier
schemaName
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CompiledSchema -> Bool
shouldNotHaveTupleSpec CompiledSchema
compiledScm)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> m ())
-> (Identifier -> AnalysisError) -> Identifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> AnalysisError
TupleWithoutArray
    (Identifier -> m ()) -> Identifier -> m ()
forall a b. (a -> b) -> a -> b
$ Identifier
schemaName
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CompiledSchema -> Bool
shouldNotHaveStringSpec CompiledSchema
compiledScm)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> m ())
-> (Identifier -> AnalysisError) -> Identifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> AnalysisError
StringValsWithoutString
    (Identifier -> m ()) -> Identifier -> m ()
forall a b. (a -> b) -> a -> b
$ Identifier
schemaName
  CompiledSchema -> m CompiledSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompiledSchema
compiledScm
  where
    Schema.Specification Identifier
schemaName (Type.Specification Vector Identifier
types) Specification
stringValsSpec Specification
arraySpec Maybe Specification
objSpec =
      Specification
scm
    go :: HashMap k (TypeNode, Bool)
-> Specification -> f (HashMap k (TypeNode, Bool))
go HashMap k (TypeNode, Bool)
acc Specification
prop = (Maybe (TypeNode, Bool) -> f (Maybe (TypeNode, Bool)))
-> k
-> HashMap k (TypeNode, Bool)
-> f (HashMap k (TypeNode, Bool))
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HM.alterF (Specification
-> Maybe (TypeNode, Bool) -> f (Maybe (TypeNode, Bool))
forall (f :: * -> *) a.
MonadError AnalysisError f =>
Specification -> Maybe a -> f (Maybe (TypeNode, Bool))
checkedInsert Specification
prop) (MedeaString -> k
coerce (MedeaString -> k) -> MedeaString -> k
forall a b. (a -> b) -> a -> b
$ Specification -> MedeaString
propName Specification
prop) HashMap k (TypeNode, Bool)
acc
    checkedInsert :: Specification -> Maybe a -> f (Maybe (TypeNode, Bool))
checkedInsert Specification
prop = \case
      Maybe a
Nothing -> Maybe (TypeNode, Bool) -> f (Maybe (TypeNode, Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TypeNode, Bool) -> f (Maybe (TypeNode, Bool)))
-> ((TypeNode, Bool) -> Maybe (TypeNode, Bool))
-> (TypeNode, Bool)
-> f (Maybe (TypeNode, Bool))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeNode, Bool) -> Maybe (TypeNode, Bool)
forall a. a -> Maybe a
Just ((TypeNode, Bool) -> f (Maybe (TypeNode, Bool)))
-> (TypeNode, Bool) -> f (Maybe (TypeNode, Bool))
forall a b. (a -> b) -> a -> b
$ (Maybe Identifier -> TypeNode
identToNode (Specification -> Maybe Identifier
propSchema Specification
prop), Specification -> Bool
propOptional Specification
prop)
      Just a
_ -> AnalysisError -> f (Maybe (TypeNode, Bool))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> f (Maybe (TypeNode, Bool)))
-> AnalysisError -> f (Maybe (TypeNode, Bool))
forall a b. (a -> b) -> a -> b
$ Identifier -> MedeaString -> AnalysisError
DuplicatePropName Identifier
schemaName (Specification -> MedeaString
propName Specification
prop)
    defaultToAny :: [TypeNode] -> NEList.NonEmpty TypeNode
    defaultToAny :: [TypeNode] -> NonEmpty TypeNode
defaultToAny [TypeNode]
xs = case [TypeNode] -> Maybe (NonEmpty TypeNode)
forall a. [a] -> Maybe (NonEmpty a)
NEList.nonEmpty [TypeNode]
xs of
      Maybe (NonEmpty TypeNode)
Nothing -> TypeNode -> [TypeNode] -> NonEmpty TypeNode
forall a. a -> [a] -> NonEmpty a
(NEList.:|) TypeNode
AnyNode []
      Just NonEmpty TypeNode
xs' -> NonEmpty TypeNode
xs'

checkStartSchema ::
  (MonadError AnalysisError m) =>
  Map Identifier CompiledSchema ->
  m ()
checkStartSchema :: Map Identifier CompiledSchema -> m ()
checkStartSchema Map Identifier CompiledSchema
m = case Identifier -> Map Identifier CompiledSchema -> Maybe CompiledSchema
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ReservedIdentifier -> Identifier
identFromReserved ReservedIdentifier
RStart) Map Identifier CompiledSchema
m of
  Maybe CompiledSchema
Nothing -> AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AnalysisError
NoStartSchema
  Just CompiledSchema
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- We need a 'getRefs' argument here so that we can differentiate between
-- different kinds of Dangling references(type/property/list/tuple).
checkDanglingReferences ::
  (MonadError AnalysisError m) =>
  (CompiledSchema -> [TypeNode]) ->
  (Identifier -> Identifier -> AnalysisError) ->
  Map Identifier CompiledSchema ->
  m ()
checkDanglingReferences :: (CompiledSchema -> [TypeNode])
-> (Identifier -> Identifier -> AnalysisError)
-> Map Identifier CompiledSchema
-> m ()
checkDanglingReferences CompiledSchema -> [TypeNode]
getRefs Identifier -> Identifier -> AnalysisError
err Map Identifier CompiledSchema
m = ((Identifier, CompiledSchema) -> m ())
-> [(Identifier, CompiledSchema)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Identifier, CompiledSchema) -> m ()
forall (m :: * -> *).
MonadError AnalysisError m =>
(Identifier, CompiledSchema) -> m ()
go ([(Identifier, CompiledSchema)] -> m ())
-> (Map Identifier CompiledSchema
    -> [(Identifier, CompiledSchema)])
-> Map Identifier CompiledSchema
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier CompiledSchema -> [(Identifier, CompiledSchema)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Identifier CompiledSchema -> m ())
-> Map Identifier CompiledSchema -> m ()
forall a b. (a -> b) -> a -> b
$ Map Identifier CompiledSchema
m
  where
    go :: (Identifier, CompiledSchema) -> m ()
go (Identifier
schemaName, CompiledSchema
scm) = case CompiledSchema -> [Identifier]
getDanglingRefs CompiledSchema
scm of
      Identifier
danglingRef : [Identifier]
_ -> AnalysisError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> m ()) -> AnalysisError -> m ()
forall a b. (a -> b) -> a -> b
$ Identifier -> Identifier -> AnalysisError
err Identifier
danglingRef Identifier
schemaName
      [] -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    getDanglingRefs :: CompiledSchema -> [Identifier]
getDanglingRefs = (Identifier -> Bool) -> [Identifier] -> [Identifier]
forall a. (a -> Bool) -> [a] -> [a]
filter Identifier -> Bool
isUndefined ([Identifier] -> [Identifier])
-> (CompiledSchema -> [Identifier])
-> CompiledSchema
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeNode -> Maybe Identifier) -> [TypeNode] -> [Identifier]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TypeNode -> Maybe Identifier
fromCustomNode ([TypeNode] -> [Identifier])
-> (CompiledSchema -> [TypeNode]) -> CompiledSchema -> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> [TypeNode]
getRefs
    isUndefined :: Identifier -> Bool
isUndefined Identifier
ident = Maybe CompiledSchema -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe CompiledSchema -> Bool)
-> (Map Identifier CompiledSchema -> Maybe CompiledSchema)
-> Map Identifier CompiledSchema
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Map Identifier CompiledSchema -> Maybe CompiledSchema
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident (Map Identifier CompiledSchema -> Bool)
-> Map Identifier CompiledSchema -> Bool
forall a b. (a -> b) -> a -> b
$ Map Identifier CompiledSchema
m
    fromCustomNode :: TypeNode -> Maybe Identifier
fromCustomNode (CustomNode Identifier
ident) = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
ident
    fromCustomNode TypeNode
_ = Maybe Identifier
forall a. Maybe a
Nothing

checkUnusedSchemata ::
  (MonadError AnalysisError m) =>
  Map Identifier CompiledSchema ->
  m ()
checkUnusedSchemata :: Map Identifier CompiledSchema -> m ()
checkUnusedSchemata Map Identifier CompiledSchema
m = (Identifier -> m ()) -> [Identifier] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Identifier -> m ()
forall (f :: * -> *).
MonadError AnalysisError f =>
Identifier -> f ()
checkUnused ([Identifier] -> m ())
-> (Map Identifier CompiledSchema -> [Identifier])
-> Map Identifier CompiledSchema
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier CompiledSchema -> [Identifier]
forall k a. Map k a -> [k]
M.keys (Map Identifier CompiledSchema -> m ())
-> Map Identifier CompiledSchema -> m ()
forall a b. (a -> b) -> a -> b
$ Map Identifier CompiledSchema
m
  where
    checkUnused :: Identifier -> f ()
checkUnused Identifier
ident
      | TypeNode -> Set TypeNode -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (Identifier -> TypeNode
CustomNode Identifier
ident) Set TypeNode
allReferences = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Identifier -> Bool
isStartIdent Identifier
ident = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = AnalysisError -> f ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> f ()) -> AnalysisError -> f ()
forall a b. (a -> b) -> a -> b
$ Identifier -> AnalysisError
DefinedButNotUsed Identifier
ident
    allReferences :: Set TypeNode
allReferences = [Set TypeNode] -> Set TypeNode
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set TypeNode] -> Set TypeNode)
-> (Map Identifier CompiledSchema -> [Set TypeNode])
-> Map Identifier CompiledSchema
-> Set TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompiledSchema -> Set TypeNode)
-> [CompiledSchema] -> [Set TypeNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledSchema -> Set TypeNode
getReferences ([CompiledSchema] -> [Set TypeNode])
-> (Map Identifier CompiledSchema -> [CompiledSchema])
-> Map Identifier CompiledSchema
-> [Set TypeNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier CompiledSchema -> [CompiledSchema]
forall k a. Map k a -> [a]
M.elems (Map Identifier CompiledSchema -> Set TypeNode)
-> Map Identifier CompiledSchema -> Set TypeNode
forall a b. (a -> b) -> a -> b
$ Map Identifier CompiledSchema
m
    getReferences :: CompiledSchema -> Set TypeNode
getReferences CompiledSchema
scm =
      [TypeNode] -> Set TypeNode
forall a. Ord a => [a] -> Set a
S.fromList ([TypeNode] -> Set TypeNode) -> [TypeNode] -> Set TypeNode
forall a b. (a -> b) -> a -> b
$
        CompiledSchema -> [TypeNode]
getTypeRefs CompiledSchema
scm [TypeNode] -> [TypeNode] -> [TypeNode]
forall a. [a] -> [a] -> [a]
++ CompiledSchema -> [TypeNode]
getPropertyTypeRefs CompiledSchema
scm [TypeNode] -> [TypeNode] -> [TypeNode]
forall a. [a] -> [a] -> [a]
++ CompiledSchema -> [TypeNode]
getListTypeRefs CompiledSchema
scm [TypeNode] -> [TypeNode] -> [TypeNode]
forall a. [a] -> [a] -> [a]
++ CompiledSchema -> [TypeNode]
getTupleTypeRefs CompiledSchema
scm

-- Helpers
identToNode :: Maybe Identifier -> TypeNode
identToNode :: Maybe Identifier -> TypeNode
identToNode Maybe Identifier
ident = case Maybe Identifier
ident of
  Maybe Identifier
Nothing -> TypeNode
AnyNode
  Just Identifier
t -> TypeNode
-> (PrimTypeIdentifier -> TypeNode)
-> Maybe PrimTypeIdentifier
-> TypeNode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Identifier -> TypeNode
CustomNode Identifier
t) (JSONType -> TypeNode
PrimitiveNode (JSONType -> TypeNode)
-> (PrimTypeIdentifier -> JSONType)
-> PrimTypeIdentifier
-> TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimTypeIdentifier -> JSONType
typeOf) (Maybe PrimTypeIdentifier -> TypeNode)
-> Maybe PrimTypeIdentifier -> TypeNode
forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe PrimTypeIdentifier
tryPrimType Identifier
t

getTypeRefs :: CompiledSchema -> [TypeNode]
getTypeRefs :: CompiledSchema -> [TypeNode]
getTypeRefs = NonEmpty TypeNode -> [TypeNode]
forall a. NonEmpty a -> [a]
NEList.toList (NonEmpty TypeNode -> [TypeNode])
-> (CompiledSchema -> NonEmpty TypeNode)
-> CompiledSchema
-> [TypeNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESet TypeNode -> NonEmpty TypeNode
forall a. NESet a -> NonEmpty a
NESet.toList (NESet TypeNode -> NonEmpty TypeNode)
-> (CompiledSchema -> NESet TypeNode)
-> CompiledSchema
-> NonEmpty TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> NESet TypeNode
typesAs

getPropertyTypeRefs :: CompiledSchema -> [TypeNode]
getPropertyTypeRefs :: CompiledSchema -> [TypeNode]
getPropertyTypeRefs CompiledSchema
scm = (((TypeNode, Bool) -> TypeNode) -> [(TypeNode, Bool)] -> [TypeNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeNode, Bool) -> TypeNode
forall a b. (a, b) -> a
fst ([(TypeNode, Bool)] -> [TypeNode])
-> (CompiledSchema -> [(TypeNode, Bool)])
-> CompiledSchema
-> [TypeNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (TypeNode, Bool) -> [(TypeNode, Bool)]
forall k v. HashMap k v -> [v]
HM.elems (HashMap Text (TypeNode, Bool) -> [(TypeNode, Bool)])
-> (CompiledSchema -> HashMap Text (TypeNode, Bool))
-> CompiledSchema
-> [(TypeNode, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> HashMap Text (TypeNode, Bool)
props (CompiledSchema -> [TypeNode]) -> CompiledSchema -> [TypeNode]
forall a b. (a -> b) -> a -> b
$ CompiledSchema
scm) [TypeNode] -> [TypeNode] -> [TypeNode]
forall a. [a] -> [a] -> [a]
++ [CompiledSchema -> TypeNode
additionalPropSchema CompiledSchema
scm]

getListTypeRefs :: CompiledSchema -> [TypeNode]
getListTypeRefs :: CompiledSchema -> [TypeNode]
getListTypeRefs CompiledSchema
scm = case CompiledSchema -> Maybe ArrayType
arrayTypes CompiledSchema
scm of
  Just (ListType TypeNode
typeNode) -> [TypeNode
typeNode]
  Maybe ArrayType
_ -> []

getTupleTypeRefs :: CompiledSchema -> [TypeNode]
getTupleTypeRefs :: CompiledSchema -> [TypeNode]
getTupleTypeRefs CompiledSchema
scm = case CompiledSchema -> Maybe ArrayType
arrayTypes CompiledSchema
scm of
  Just (TupleType Vector TypeNode
typeNodes) -> Vector TypeNode -> [TypeNode]
forall a. Vector a -> [a]
V.toList Vector TypeNode
typeNodes
  Maybe ArrayType
_ -> []

getArrayTypes :: Maybe Identifier -> Maybe [Identifier] -> Maybe ArrayType
getArrayTypes :: Maybe Identifier -> Maybe [Identifier] -> Maybe ArrayType
getArrayTypes Maybe Identifier
Nothing Maybe [Identifier]
Nothing = Maybe ArrayType
forall a. Maybe a
Nothing
getArrayTypes (Just Identifier
ident) Maybe [Identifier]
_ = ArrayType -> Maybe ArrayType
forall a. a -> Maybe a
Just (ArrayType -> Maybe ArrayType)
-> (Identifier -> ArrayType) -> Identifier -> Maybe ArrayType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeNode -> ArrayType
ListType (TypeNode -> ArrayType)
-> (Identifier -> TypeNode) -> Identifier -> ArrayType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Identifier -> TypeNode
identToNode (Maybe Identifier -> TypeNode)
-> (Identifier -> Maybe Identifier) -> Identifier -> TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> Maybe ArrayType) -> Identifier -> Maybe ArrayType
forall a b. (a -> b) -> a -> b
$ Identifier
ident
getArrayTypes Maybe Identifier
_ (Just [Identifier]
idents) =
  ArrayType -> Maybe ArrayType
forall a. a -> Maybe a
Just (ArrayType -> Maybe ArrayType)
-> ([TypeNode] -> ArrayType) -> [TypeNode] -> Maybe ArrayType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector TypeNode -> ArrayType
TupleType (Vector TypeNode -> ArrayType)
-> ([TypeNode] -> Vector TypeNode) -> [TypeNode] -> ArrayType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeNode] -> Vector TypeNode
forall a. [a] -> Vector a
V.fromList ([TypeNode] -> Maybe ArrayType) -> [TypeNode] -> Maybe ArrayType
forall a b. (a -> b) -> a -> b
$ Maybe Identifier -> TypeNode
identToNode (Maybe Identifier -> TypeNode)
-> (Identifier -> Maybe Identifier) -> Identifier -> TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> TypeNode) -> [Identifier] -> [TypeNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identifier]
idents

getTupleTypeLen :: Maybe ArrayType -> Maybe Natural
getTupleTypeLen :: Maybe ArrayType -> Maybe Natural
getTupleTypeLen (Just (TupleType Vector TypeNode
types)) = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural)
-> (Vector TypeNode -> Natural) -> Vector TypeNode -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural)
-> (Vector TypeNode -> Int) -> Vector TypeNode -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector TypeNode -> Int
forall a. Vector a -> Int
V.length (Vector TypeNode -> Maybe Natural)
-> Vector TypeNode -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Vector TypeNode
types
getTupleTypeLen Maybe ArrayType
_ = Maybe Natural
forall a. Maybe a
Nothing

getTypesAsGraph :: Map Identifier CompiledSchema -> Cyclic.AdjacencyMap TypeNode
getTypesAsGraph :: Map Identifier CompiledSchema -> AdjacencyMap TypeNode
getTypesAsGraph = [(TypeNode, TypeNode)] -> AdjacencyMap TypeNode
forall a. Ord a => [(a, a)] -> AdjacencyMap a
Cyclic.edges ([(TypeNode, TypeNode)] -> AdjacencyMap TypeNode)
-> (Map Identifier CompiledSchema -> [(TypeNode, TypeNode)])
-> Map Identifier CompiledSchema
-> AdjacencyMap TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompiledSchema -> [(TypeNode, TypeNode)])
-> [CompiledSchema] -> [(TypeNode, TypeNode)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CompiledSchema -> [(TypeNode, TypeNode)]
intoTypesAsEdges ([CompiledSchema] -> [(TypeNode, TypeNode)])
-> (Map Identifier CompiledSchema -> [CompiledSchema])
-> Map Identifier CompiledSchema
-> [(TypeNode, TypeNode)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier CompiledSchema -> [CompiledSchema]
forall k a. Map k a -> [a]
M.elems

intoTypesAsEdges :: CompiledSchema -> [(TypeNode, TypeNode)]
intoTypesAsEdges :: CompiledSchema -> [(TypeNode, TypeNode)]
intoTypesAsEdges CompiledSchema
scm = (TypeNode -> (TypeNode, TypeNode))
-> [TypeNode] -> [(TypeNode, TypeNode)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompiledSchema -> TypeNode
schemaNode CompiledSchema
scm,) ([TypeNode] -> [(TypeNode, TypeNode)])
-> (CompiledSchema -> [TypeNode])
-> CompiledSchema
-> [(TypeNode, TypeNode)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TypeNode -> [TypeNode]
forall a. NonEmpty a -> [a]
NEList.toList (NonEmpty TypeNode -> [TypeNode])
-> (CompiledSchema -> NonEmpty TypeNode)
-> CompiledSchema
-> [TypeNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESet TypeNode -> NonEmpty TypeNode
forall a. NESet a -> NonEmpty a
NESet.toList (NESet TypeNode -> NonEmpty TypeNode)
-> (CompiledSchema -> NESet TypeNode)
-> CompiledSchema
-> NonEmpty TypeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> NESet TypeNode
typesAs (CompiledSchema -> [(TypeNode, TypeNode)])
-> CompiledSchema -> [(TypeNode, TypeNode)]
forall a b. (a -> b) -> a -> b
$ CompiledSchema
scm

arrayNode :: TypeNode
arrayNode :: TypeNode
arrayNode = JSONType -> TypeNode
PrimitiveNode JSONType
JSONArray

objectNode :: TypeNode
objectNode :: TypeNode
objectNode = JSONType -> TypeNode
PrimitiveNode JSONType
JSONObject

stringNode :: TypeNode
stringNode :: TypeNode
stringNode = JSONType -> TypeNode
PrimitiveNode JSONType
JSONString

hasListSpec :: CompiledSchema -> Bool
hasListSpec :: CompiledSchema -> Bool
hasListSpec CompiledSchema
scm = case CompiledSchema -> Maybe ArrayType
arrayTypes CompiledSchema
scm of
  Just (ListType TypeNode
_) -> Bool
True
  Just (TupleType Vector TypeNode
_) -> Bool
False
  Maybe ArrayType
_ -> Maybe Natural -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Natural -> Bool) -> Maybe Natural -> Bool
forall a b. (a -> b) -> a -> b
$ CompiledSchema -> Maybe Natural
minArrayLen CompiledSchema
scm Maybe Natural -> Maybe Natural -> Maybe Natural
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CompiledSchema -> Maybe Natural
maxArrayLen CompiledSchema
scm

hasTupleSpec :: CompiledSchema -> Bool
hasTupleSpec :: CompiledSchema -> Bool
hasTupleSpec CompiledSchema
scm = case CompiledSchema -> Maybe ArrayType
arrayTypes CompiledSchema
scm of
  Just (TupleType Vector TypeNode
_) -> Bool
True
  Maybe ArrayType
_ -> Bool
False

hasStringSpec :: CompiledSchema -> Bool
hasStringSpec :: CompiledSchema -> Bool
hasStringSpec = Bool -> Bool
not (Bool -> Bool)
-> (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Text -> Bool
forall a. Vector a -> Bool
V.null (Vector Text -> Bool)
-> (CompiledSchema -> Vector Text) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> Vector Text
stringVals

shouldNotHavePropertySpec :: CompiledSchema -> Bool -> Bool
shouldNotHavePropertySpec :: CompiledSchema -> Bool -> Bool
shouldNotHavePropertySpec CompiledSchema
scm Bool
hasPropSpec = Bool
hasPropSpec Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeNode -> NESet TypeNode -> Bool
forall a. Ord a => a -> NESet a -> Bool
NESet.member TypeNode
objectNode (NESet TypeNode -> Bool)
-> (CompiledSchema -> NESet TypeNode) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> NESet TypeNode
typesAs (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall a b. (a -> b) -> a -> b
$ CompiledSchema
scm)

shouldNotHaveListSpec :: CompiledSchema -> Bool
shouldNotHaveListSpec :: CompiledSchema -> Bool
shouldNotHaveListSpec CompiledSchema
scm = CompiledSchema -> Bool
hasListSpec CompiledSchema
scm Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeNode -> NESet TypeNode -> Bool
forall a. Ord a => a -> NESet a -> Bool
NESet.member TypeNode
arrayNode (NESet TypeNode -> Bool)
-> (CompiledSchema -> NESet TypeNode) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> NESet TypeNode
typesAs (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall a b. (a -> b) -> a -> b
$ CompiledSchema
scm)

shouldNotHaveTupleSpec :: CompiledSchema -> Bool
shouldNotHaveTupleSpec :: CompiledSchema -> Bool
shouldNotHaveTupleSpec CompiledSchema
scm = CompiledSchema -> Bool
hasTupleSpec CompiledSchema
scm Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeNode -> NESet TypeNode -> Bool
forall a. Ord a => a -> NESet a -> Bool
NESet.member TypeNode
arrayNode (NESet TypeNode -> Bool)
-> (CompiledSchema -> NESet TypeNode) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> NESet TypeNode
typesAs (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall a b. (a -> b) -> a -> b
$ CompiledSchema
scm)

shouldNotHaveStringSpec :: CompiledSchema -> Bool
shouldNotHaveStringSpec :: CompiledSchema -> Bool
shouldNotHaveStringSpec CompiledSchema
scm = CompiledSchema -> Bool
hasStringSpec CompiledSchema
scm Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeNode -> NESet TypeNode -> Bool
forall a. Ord a => a -> NESet a -> Bool
NESet.member TypeNode
stringNode (NESet TypeNode -> Bool)
-> (CompiledSchema -> NESet TypeNode) -> CompiledSchema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledSchema -> NESet TypeNode
typesAs (CompiledSchema -> Bool) -> CompiledSchema -> Bool
forall a b. (a -> b) -> a -> b
$ CompiledSchema
scm)