{-# LANGUAGE OverloadedStrings #-}

module Hydra.Impl.Haskell.Sources.Ext.Shacl.Model where

import Hydra.Impl.Haskell.Sources.Core

import Hydra.Kernel
import Hydra.Impl.Haskell.Dsl.Types as Types
import Hydra.Impl.Haskell.Dsl.Standard
import Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax


shaclModelModule :: Module Meta
shaclModelModule :: Module Meta
shaclModelModule = forall m.
Namespace -> [Element m] -> [Module m] -> Maybe String -> Module m
Module Namespace
ns [Element Meta]
elements [Module Meta
rdfSyntaxModule] forall a b. (a -> b) -> a -> b
$
    forall a. a -> Maybe a
Just String
"A SHACL syntax model. See https://www.w3.org/TR/shacl"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/ext/shacl/model"
    def :: String -> Type m -> Element m
def = forall m. Namespace -> String -> Type m -> Element m
datatype Namespace
ns
    shacl :: String -> Type m
shacl = forall m. Namespace -> String -> Type m
nsref Namespace
ns
    rdf :: String -> Type m
rdf = forall m. Namespace -> String -> Type m
nsref forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module Meta
rdfSyntaxModule

    elements :: [Element Meta]
elements = [

      forall {m}. String -> Type m -> Element m
def String
"Closed" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"isClosed"forall m. String -> Type m -> FieldType m
>: forall m. Type m
boolean,
          String
"ignoredProperties"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m
optional forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Property"],

      forall {m}. String -> Type m -> Element m
def String
"CommonConstraint" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"Any of a number of constraint parameters which can be applied either to node or property shapes" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"and"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#AndConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"Reference" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"Shape",

          String
"closed"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#ClosedConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
shacl String
"Closed",

          String
"class"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#ClassConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"RdfsClass",

          String
"datatype"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#DatatypeConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"Iri",

          String
"disjoint"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#DisjointConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Property",

          String
"equals"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#EqualsConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Property",

          String
"hasValue"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc (String
"Specifies the condition that at least one value node is equal to the given RDF term. " forall a. [a] -> [a] -> [a]
++
                 String
"See https://www.w3.org/TR/shacl/#HasValueConstraintComponent") forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Node",

          String
"in"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc (String
"Specifies the condition that each value node is a member of a provided SHACL list. " forall a. [a] -> [a] -> [a]
++
                 String
"See https://www.w3.org/TR/shacl/#InConstraintComponent") forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
list forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Node",

          String
"languageIn"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#LanguageInConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"LanguageTag",

          String
"nodeKind"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#NodeKindConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
shacl String
"NodeKind",

          String
"node"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#NodeConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"Reference" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"NodeShape",

          String
"not"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#NotConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"Reference" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"Shape",

          String
"maxExclusive"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"Literal",

          String
"maxInclusive"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"Literal",

          String
"maxLength"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m
bigint,

          String
"minExclusive"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"Literal",

          String
"minInclusive"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"Literal",

          String
"minLength"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#MinLengthConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m
bigint,

          String
"pattern"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#PatternConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
shacl String
"Pattern",

          String
"property"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#PropertyConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"Reference" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"PropertyShape",

          String
"or"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#OrConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"Reference" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"Shape",

          String
"xone"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#XoneConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"Reference" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"Shape"],

      forall {m}. String -> Type m -> Element m
def String
"CommonProperties" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"Common constraint parameters and other properties for SHACL shapes" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"constraints"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc String
"Common constraint parameters attached to this shape"
            forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"CommonConstraint",

          String
"deactivated"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#deactivated" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
optional forall m. Type m
boolean,

          String
"message"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#message" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"LangStrings",

          String
"severity"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#severity" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
shacl String
"Severity",

          String
"targetClass"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#targetClass" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"RdfsClass",

          String
"targetNode"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#targetNode" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"IriOrLiteral",

          String
"targetObjectsOf"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#targetObjectsOf" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Property",

          String
"targetSubjectsOf"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#targetSubjectsOf" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Property"],

      forall {m}. String -> Type m -> Element m
def String
"Definition" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance" forall a b. (a -> b) -> a -> b
$
        forall m. String -> Type m -> Type m
lambda String
"a" forall a b. (a -> b) -> a -> b
$ forall m. [FieldType m] -> Type m
record [
          String
"iri"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
rdf String
"Iri",
          String
"target"forall m. String -> Type m -> FieldType m
>: Type Meta
"a"],

      forall {m}. String -> Type m -> Element m
def String
"NodeKind" forall a b. (a -> b) -> a -> b
$ forall m. [FieldType m] -> Type m
union [
        String
"blankNode"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"A blank node" forall m. Type m
unit,
        String
"iri"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"An IRI" forall m. Type m
unit,
        String
"literal"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"A literal" forall m. Type m
unit,
        String
"blankNodeOrIri"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"A blank node or an IRI" forall m. Type m
unit,
        String
"blankNodeOrLiteral"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"A blank node or a literal" forall m. Type m
unit,
        String
"iriOrLiteral"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"An IRI or a literal" forall m. Type m
unit],

      forall {m}. String -> Type m -> Element m
def String
"NodeShape" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"common"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
shacl String
"CommonProperties"],

      forall {m}. String -> Type m -> Element m
def String
"Pattern" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"regex"forall m. String -> Type m -> FieldType m
>: forall m. Type m
string,
          String
"flags"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m
optional forall m. Type m
string],

      forall {m}. String -> Type m -> Element m
def String
"PropertyShape" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"common"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
shacl String
"CommonProperties",

          String
"constraints"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc String
"Any property shape -specific constraint parameters" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"PropertyShapeConstraint",

          String
"defaultValue"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#defaultValue" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
optional forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Node",

          String
"description"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#name" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"LangStrings",

          String
"name"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#name" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
rdf String
"LangStrings",

          String
"order"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#order" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
optional forall m. Type m
bigint,

          String
"path"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
rdf String
"Iri"], -- TODO
          -- Note: sh:group is omitted for now, for lack of a clear definition of PropertyGroup

      forall {m}. String -> Type m -> Element m
def String
"PropertyShapeConstraint" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [

          String
"lessThan"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#LessThanConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Property",

          String
"lessThanOrEquals"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
element forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
rdf String
"Property",

          String
"maxCount"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc (String
"The maximum cardinality. Node shapes cannot have any value for sh:maxCount. " forall a. [a] -> [a] -> [a]
++
                 String
"See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent") forall a b. (a -> b) -> a -> b
$
            forall m. Type m
bigint,

          String
"minCount"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc (String
"The minimum cardinality. Node shapes cannot have any value for sh:minCount. " forall a. [a] -> [a] -> [a]
++
                 String
"See https://www.w3.org/TR/shacl/#MinCountConstraintComponent") forall a b. (a -> b) -> a -> b
$
            forall m. Type m
bigint,

          String
"uniqueLang"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall m. Type m
boolean,

          String
"qualifiedValueShape"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
shacl String
"QualifiedValueShape"],

      forall {m}. String -> Type m -> Element m
def String
"QualifiedValueShape" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
see String
"https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
record [
          String
"qualifiedValueShape"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
shacl String
"Reference" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"Shape",
          String
"qualifiedMaxCount"forall m. String -> Type m -> FieldType m
>: forall m. Type m
bigint,
          String
"qualifiedMinCount"forall m. String -> Type m -> FieldType m
>: forall m. Type m
bigint,
          String
"qualifiedValueShapesDisjoint"forall m. String -> Type m -> FieldType m
>: forall m. Type m -> Type m
optional forall m. Type m
boolean],

      forall {m}. String -> Type m -> Element m
def String
"Reference" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type" forall a b. (a -> b) -> a -> b
$
        forall m. String -> Type m -> Type m
lambda String
"a" forall a b. (a -> b) -> a -> b
$ forall m. [FieldType m] -> Type m
union [
          String
"named"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
rdf String
"Iri",
          String
"anonymous"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc String
"An anonymous instance"
            Type Meta
"a",
          String
"definition"forall m. String -> Type m -> FieldType m
>:
            String -> Type Meta -> Type Meta
doc String
"An inline definition" forall a b. (a -> b) -> a -> b
$
            forall {m}. String -> Type m
shacl String
"Definition" forall m. Type m -> Type m -> Type m
@@ Type Meta
"a"],

      forall {m}. String -> Type m -> Element m
def String
"Severity" forall a b. (a -> b) -> a -> b
$ forall m. [FieldType m] -> Type m
union [
        String
"info"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"A non-critical constraint violation indicating an informative message" forall m. Type m
unit,
        String
"warning"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"A non-critical constraint violation indicating a warning" forall m. Type m
unit,
        String
"violation"forall m. String -> Type m -> FieldType m
>: String -> Type Meta -> Type Meta
doc String
"A constraint violation" forall m. Type m
unit],

      forall {m}. String -> Type m -> Element m
def String
"Shape" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc String
"A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes" forall a b. (a -> b) -> a -> b
$
        forall m. [FieldType m] -> Type m
union [
          String
"node"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
shacl String
"NodeShape",
          String
"property"forall m. String -> Type m -> FieldType m
>: forall {m}. String -> Type m
shacl String
"PropertyShape"],

      forall {m}. String -> Type m -> Element m
def String
"ShapesGraph" forall a b. (a -> b) -> a -> b
$
        String -> Type Meta -> Type Meta
doc (String
"An RDF graph containing zero or more shapes that is passed into a SHACL validation process " forall a. [a] -> [a] -> [a]
++
             String
"so that a data graph can be validated against the shapes") forall a b. (a -> b) -> a -> b
$
        forall m. Type m -> Type m
set forall a b. (a -> b) -> a -> b
$ forall {m}. String -> Type m
shacl String
"Definition" forall m. Type m -> Type m -> Type m
@@ forall {m}. String -> Type m
shacl String
"Shape"]