{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Shacl.Model where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Sources.Tier4.Langs.Rdf.Syntax
import Hydra.Dsl.Types as Types


shaclModelModule :: Module
shaclModelModule :: Module
shaclModelModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
rdfSyntaxModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
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/langs/shacl/model"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    shacl :: String -> Type
shacl = Namespace -> String -> Type
typeref Namespace
ns
    rdf :: String -> Type
rdf = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
rdfSyntaxModule

    elements :: [Element]
elements = [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      String -> Type -> Element
def String
"Reference" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
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" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
lambda String
"a" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
          String
"named"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri",
          String
"anonymous"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"An anonymous instance"
            Type
"a",
          String
"definition"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"An inline definition" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
shacl String
"Definition" Type -> Type -> Type
@@ Type
"a"],

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

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

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