module Hydra.Sources.Tier4.Langs.Owl.Syntax where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Sources.Tier4.Langs.Rdf.Syntax
import Hydra.Sources.Tier4.Langs.Xml.Schema
import Hydra.Dsl.Types as Types
import qualified Hydra.Dsl.Terms as Terms


key_iri :: String
key_iri :: String
key_iri = String
"iri"

withIri :: String -> Type -> Type
withIri :: String -> Type -> Type
withIri String
iriStr = String -> Maybe Term -> Type -> Type
annotateType String
key_iri (Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.string String
iriStr)

nonNegativeInteger :: Type
nonNegativeInteger :: Type
nonNegativeInteger = Type
Types.bigint

owlIri :: [Char] -> Type -> Type
owlIri :: String -> Type -> Type
owlIri String
local = String -> Type -> Type
withIri (String -> Type -> Type) -> String -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String
"http://www.w3.org/2002/07/owl#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
local

owlSyntaxModule :: Module
owlSyntaxModule :: Module
owlSyntaxModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCoreModule, Module
rdfSyntaxModule, Module
xmlSchemaModule] [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
"An OWL 2 syntax model. See https://www.w3.org/TR/owl2-syntax"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/owl/syntax"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns

    owl :: String -> Type
owl = 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
    xsd :: String -> Type
xsd = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
xmlSchemaModule

    objectPropertyConstraint :: String -> Element
objectPropertyConstraint String
lname = String -> Type -> Element
def String
lname (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
      String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"Annotation",
      String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression"]

    simpleUnion :: [String] -> Type
simpleUnion [String]
names = [FieldType] -> Type
union ([FieldType] -> Type) -> [FieldType] -> Type
forall a b. (a -> b) -> a -> b
$ (\String
n -> Name -> Type -> FieldType
FieldType (String -> Name
Name (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String -> String
decapitalize String
n) (Type -> FieldType) -> Type -> FieldType
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
n) (String -> FieldType) -> [String] -> [FieldType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
names

    withAnns :: [FieldType] -> Type
withAnns [FieldType]
fields = [FieldType] -> Type
record ([FieldType] -> Type) -> [FieldType] -> Type
forall a b. (a -> b) -> a -> b
$
      (String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (String -> Type
owl String
"Annotation"))FieldType -> [FieldType] -> [FieldType]
forall a. a -> [a] -> [a]
:[FieldType]
fields

    elements :: [Element]
elements = [Element]
generalDefinitions [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
owl2Definitions -- ++ instances

--    instances = [
--      inst "Nothing" (owl "Class") Terms.unit,
--      inst "Thing" (owl "Class") Terms.unit]

    generalDefinitions :: [Element]
generalDefinitions = [
-- nonNegativeInteger := a nonempty finite sequence of digits between 0 and 9
-- quotedString := a finite sequence of characters in which " (U+22) and \ (U+5C) occur only in pairs of the form \" (U+5C, U+22) and \\ (U+5C, U+5C), enclosed in a pair of " (U+22) characters
-- languageTag := @ (U+40) followed a nonempty sequence of characters matching the langtag production from [BCP 47]
-- nodeID := a finite sequence of characters matching the BLANK_NODE_LABEL production of [SPARQL]
-- fullIRI := an IRI as defined in [RFC3987], enclosed in a pair of < (U+3C) and > (U+3E) characters
-- prefixName := a finite sequence of characters matching the as PNAME_NS production of [SPARQL]
-- abbreviatedIRI := a finite sequence of characters matching the PNAME_LN production of [SPARQL]
-- IRI := fullIRI | abbreviatedIRI
-- ontologyDocument := { prefixDeclaration } Ontology
-- prefixDeclaration := 'Prefix' '(' prefixName '=' fullIRI ')'

-- Ontology :=
--     'Ontology' '(' [ ontologyIRI [ versionIRI ] ]
--        directlyImportsDocuments
--        ontologyAnnotations
--        axioms
--     ')'
      String -> Type -> Element
def String
"Ontology" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [ -- note: omitting IRI and version
        String
"directImports"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"Ontology",
        String
"annotations"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"Annotation",
        String
"axioms"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"Axiom"],

-- ontologyIRI := IRI
-- versionIRI := IRI
-- directlyImportsDocuments := { 'Import' '(' IRI ')' }
-- ontologyAnnotations := { Annotation }
-- axioms := { Axiom }

-- Declaration := 'Declaration' '(' axiomAnnotations Entity ')'
      String -> Type -> Element
def String
"Declaration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"entity"String -> Type -> FieldType
>: String -> Type
owl String
"Entity"],

-- Entity :=
--     'Class' '(' Class ')' |
--     'Datatype' '(' Datatype ')' |
--     'ObjectProperty' '(' ObjectProperty ')' |
--     'DataProperty' '(' DataProperty ')' |
--     'AnnotationProperty' '(' AnnotationProperty ')' |
--     'NamedIndividual' '(' NamedIndividual ')'
      String -> Type -> Element
def String
"Entity" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
simpleUnion [
        String
"AnnotationProperty",
        String
"Class",
        String
"DataProperty",
        String
"Datatype",
        String
"NamedIndividual",
        String
"ObjectProperty"],

-- AnnotationSubject := IRI | AnonymousIndividual
      String -> Type -> Element
def String
"AnnotationSubject" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"iri"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri",
        String
"anonymousIndividual"String -> Type -> FieldType
>: String -> Type
owl String
"AnonymousIndividual"],

-- AnnotationValue := AnonymousIndividual | IRI | Literal
      String -> Type -> Element
def String
"AnnotationValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"anonymousIndividual"String -> Type -> FieldType
>: String -> Type
owl String
"AnonymousIndividual",
        String
"iri"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri",
        String
"literal"String -> Type -> FieldType
>: String -> Type
rdf String
"Literal"],

-- axiomAnnotations := { Annotation }

-- Annotation := 'Annotation' '(' annotationAnnotations AnnotationProperty AnnotationValue ')'
      String -> Type -> Element
def String
"Annotation" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationProperty",
        String
"value"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationValue"],

-- annotationAnnotations  := { Annotation }

-- AnnotationAxiom := AnnotationAssertion | SubAnnotationPropertyOf | AnnotationPropertyDomain | AnnotationPropertyRange
      String -> Type -> Element
def String
"AnnotationAxiom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
simpleUnion [
        String
"AnnotationAssertion",
        String
"AnnotationPropertyDomain",
        String
"AnnotationPropertyRange",
        String
"SubAnnotationPropertyOf"],

-- AnnotationAssertion := 'AnnotationAssertion' '(' axiomAnnotations AnnotationProperty AnnotationSubject AnnotationValue ')'
      String -> Type -> Element
def String
"AnnotationAssertion" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationProperty",
        String
"subject"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationSubject",
        String
"value"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationValue"],

-- SubAnnotationPropertyOf := 'SubAnnotationPropertyOf' '(' axiomAnnotations subAnnotationProperty superAnnotationProperty ')'
      String -> Type -> Element
def String
"SubAnnotationPropertyOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"subProperty"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationProperty",
        String
"superProperty"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationProperty"],

-- subAnnotationProperty := AnnotationProperty
-- superAnnotationProperty := AnnotationProperty

-- AnnotationPropertyDomain := 'AnnotationPropertyDomain' '(' axiomAnnotations AnnotationProperty IRI ')'
      String -> Type -> Element
def String
"AnnotationPropertyDomain" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationProperty",
        String
"iri"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri"],

-- AnnotationPropertyRange := 'AnnotationPropertyRange' '(' axiomAnnotations AnnotationProperty IRI ')'
      String -> Type -> Element
def String
"AnnotationPropertyRange" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"AnnotationProperty",
        String
"iri"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri"]]

    owl2Definitions :: [Element]
owl2Definitions = [
-- Class := IRI
      String -> Type -> Element
def String
"Class" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Classes" Type
unit,

-- Datatype := IRI
      String -> Type -> Element
def String
"Datatype" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Datatypes" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"xmlSchema"String -> Type -> FieldType
>:
            String -> Type -> Type
note (String
"XML Schema datatypes are treated as a special case in this model " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
"(not in the OWL 2 specification itself) because they are particularly common") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
xsd String
"Datatype",
          String
"other"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri"],

-- ObjectProperty := IRI
      String -> Type -> Element
def String
"ObjectProperty" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Object_Properties" Type
unit,

-- DataProperty := IRI
      String -> Type -> Element
def String
"DataProperty" Type
unit,

-- AnnotationProperty := IRI
      String -> Type -> Element
def String
"AnnotationProperty" Type
unit,

-- Individual := NamedIndividual | AnonymousIndividual
      String -> Type -> Element
def String
"Individual" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"named"String -> Type -> FieldType
>: String -> Type
owl String
"NamedIndividual",
        String
"anonymous"String -> Type -> FieldType
>: String -> Type
owl String
"AnonymousIndividual"],

-- NamedIndividual := IRI
      String -> Type -> Element
def String
"NamedIndividual" Type
unit,

-- AnonymousIndividual := nodeID
      String -> Type -> Element
def String
"AnonymousIndividual" Type
unit,

-- Literal := typedLiteral | stringLiteralNoLanguage | stringLiteralWithLanguage
-- typedLiteral := lexicalForm '^^' Datatype
-- lexicalForm := quotedString
-- stringLiteralNoLanguage := quotedString
-- stringLiteralWithLanguage := quotedString languageTag

-- ObjectPropertyExpression := ObjectProperty | InverseObjectProperty
      String -> Type -> Element
def String
"ObjectPropertyExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union [
        String
"object"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectProperty",
        String
"inverseObject"String -> Type -> FieldType
>: String -> Type
owl String
"InverseObjectProperty"],

-- InverseObjectProperty := 'ObjectInverseOf' '(' ObjectProperty ')'
      String -> Type -> Element
def String
"InverseObjectProperty" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ObjectProperty",

-- DataPropertyExpression := DataProperty
      String -> Type -> Element
def String
"DataPropertyExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataProperty",

-- DataRange :=
--     Datatype |
--     DataIntersectionOf |
--     DataUnionOf |
--     DataComplementOf |
--     DataOneOf |
--     DatatypeRestriction
      String -> Type -> Element
def String
"DataRange" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Data_Ranges" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
simpleUnion [
          String
"DataComplementOf",
          String
"DataIntersectionOf",
          String
"DataOneOf",
          String
"DataUnionOf",
          String
"Datatype",
          String
"DatatypeRestriction"],

-- DataIntersectionOf := 'DataIntersectionOf' '(' DataRange DataRange { DataRange } ')'
      String -> Type -> Element
def String
"DataIntersectionOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Intersection_of_Data_Ranges" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataRange",

-- DataUnionOf := 'DataUnionOf' '(' DataRange DataRange { DataRange } ')'
      String -> Type -> Element
def String
"DataUnionOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Union_of_Data_Ranges" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataRange",

-- DataComplementOf := 'DataComplementOf' '(' DataRange ')'
      String -> Type -> Element
def String
"DataComplementOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Complement_of_Data_Ranges" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type
owl String
"DataRange",

-- DataOneOf := 'DataOneOf' '(' Literal { Literal } ')'
      String -> Type -> Element
def String
"DataOneOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Enumeration_of_Literals" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
rdf String
"Literal",

-- DatatypeRestriction := 'DatatypeRestriction' '(' Datatype constrainingFacet restrictionValue { constrainingFacet restrictionValue } ')'
-- constrainingFacet := IRI
-- restrictionValue := Literal
      String -> Type -> Element
def String
"DatatypeRestriction" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Datatype_Restrictions" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"datatype"String -> Type -> FieldType
>: String -> Type
owl String
"Datatype",
          String
"constraints"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DatatypeRestriction.Constraint"],

      String -> Type -> Element
def String
"DatatypeRestriction.Constraint" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"constrainingFacet"String -> Type -> FieldType
>: String -> Type
owl String
"DatatypeRestriction.ConstrainingFacet",
        String
"restrictionValue"String -> Type -> FieldType
>: String -> Type
rdf String
"Literal"],

      String -> Type -> Element
def String
"DatatypeRestriction.ConstrainingFacet" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"xmlSchema"String -> Type -> FieldType
>:
            String -> Type -> Type
note (String
"XML Schema constraining facets are treated as a special case in this model " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
"(not in the OWL 2 specification itself) because they are particularly common") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
xsd String
"ConstrainingFacet",
          String
"other"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri"],

-- ClassExpression :=
--     Class |
--     ObjectIntersectionOf | ObjectUnionOf | ObjectComplementOf | ObjectOneOf |
--     ObjectSomeValuesFrom | ObjectAllValuesFrom | ObjectHasValue | ObjectHasSelf |
--     ObjectMinCardinality | ObjectMaxCardinality | ObjectExactCardinality |
--     DataSomeValuesFrom | DataAllValuesFrom | DataHasValue |
--     DataMinCardinality | DataMaxCardinality | DataExactCardinality
      String -> Type -> Element
def String
"ClassExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
simpleUnion [
        String
"Class",
        String
"DataSomeValuesFrom",
        String
"DataAllValuesFrom",
        String
"DataHasValue",
        String
"DataMinCardinality",
        String
"DataMaxCardinality",
        String
"DataExactCardinality",
        String
"ObjectAllValuesFrom",
        String
"ObjectExactCardinality",
        String
"ObjectHasSelf",
        String
"ObjectHasValue",
        String
"ObjectIntersectionOf",
        String
"ObjectMaxCardinality",
        String
"ObjectMinCardinality",
        String
"ObjectOneOf",
        String
"ObjectSomeValuesFrom",
        String
"ObjectUnionOf"],

-- ObjectIntersectionOf := 'ObjectIntersectionOf' '(' ClassExpression ClassExpression { ClassExpression } ')'
      String -> Type -> Element
def String
"ObjectIntersectionOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression",

-- ObjectUnionOf := 'ObjectUnionOf' '(' ClassExpression ClassExpression { ClassExpression } ')'
      String -> Type -> Element
def String
"ObjectUnionOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression",

-- ObjectComplementOf := 'ObjectComplementOf' '(' ClassExpression ')'
      String -> Type -> Element
def String
"ObjectComplementOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression",

-- ObjectOneOf := 'ObjectOneOf' '(' Individual { Individual }')'
      String -> Type -> Element
def String
"ObjectOneOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"Individual",

-- ObjectSomeValuesFrom := 'ObjectSomeValuesFrom' '(' ObjectPropertyExpression ClassExpression ')'
      String -> Type -> Element
def String
"ObjectSomeValuesFrom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
        String
"class"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression"],

-- ObjectAllValuesFrom := 'ObjectAllValuesFrom' '(' ObjectPropertyExpression ClassExpression ')'
      String -> Type -> Element
def String
"ObjectAllValuesFrom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
        String
"class"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression"],

-- ObjectHasValue := 'ObjectHasValue' '(' ObjectPropertyExpression Individual ')'
      String -> Type -> Element
def String
"ObjectHasValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
        String
"individual"String -> Type -> FieldType
>: String -> Type
owl String
"Individual"],

-- ObjectHasSelf := 'ObjectHasSelf' '(' ObjectPropertyExpression ')'
      String -> Type -> Element
def String
"ObjectHasSelf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ObjectPropertyExpression",

-- ObjectMinCardinality := 'ObjectMinCardinality' '(' nonNegativeInteger ObjectPropertyExpression [ ClassExpression ] ')'
      String -> Type -> Element
def String
"ObjectMinCardinality" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Minimum_Cardinality" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"bound"String -> Type -> FieldType
>: Type
nonNegativeInteger,
          String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
          String
"class"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression"],

-- ObjectMaxCardinality := 'ObjectMaxCardinality' '(' nonNegativeInteger ObjectPropertyExpression [ ClassExpression ] ')'
      String -> Type -> Element
def String
"ObjectMaxCardinality" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Maximum_Cardinality" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"bound"String -> Type -> FieldType
>: Type
nonNegativeInteger,
          String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
          String
"class"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression"],

-- ObjectExactCardinality := 'ObjectExactCardinality' '(' nonNegativeInteger ObjectPropertyExpression [ ClassExpression ] ')'
      String -> Type -> Element
def String
"ObjectExactCardinality" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Exact_Cardinality" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"bound"String -> Type -> FieldType
>: Type
nonNegativeInteger,
          String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
          String
"class"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression"],

-- DataSomeValuesFrom := 'DataSomeValuesFrom' '(' DataPropertyExpression { DataPropertyExpression } DataRange ')'
      String -> Type -> Element
def String
"DataSomeValuesFrom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"property"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataPropertyExpression",
        String
"range"String -> Type -> FieldType
>: String -> Type
owl String
"DataRange"],

-- DataAllValuesFrom := 'DataAllValuesFrom' '(' DataPropertyExpression { DataPropertyExpression } DataRange ')'
      String -> Type -> Element
def String
"DataAllValuesFrom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"property"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataPropertyExpression",
        String
"range"String -> Type -> FieldType
>: String -> Type
owl String
"DataRange"],

-- DataHasValue := 'DataHasValue' '(' DataPropertyExpression Literal ')'
      String -> Type -> Element
def String
"DataHasValue" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"value"String -> Type -> FieldType
>: String -> Type
rdf String
"Literal"],

-- DataMinCardinality := 'DataMinCardinality' '(' nonNegativeInteger DataPropertyExpression [ DataRange ] ')'
      String -> Type -> Element
def String
"DataMinCardinality" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"bound"String -> Type -> FieldType
>: Type
nonNegativeInteger,
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"range"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataRange"],

-- DataMaxCardinality := 'DataMaxCardinality' '(' nonNegativeInteger DataPropertyExpression [ DataRange ] ')'
      String -> Type -> Element
def String
"DataMaxCardinality" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"bound"String -> Type -> FieldType
>: Type
nonNegativeInteger,
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"range"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataRange"],

-- DataExactCardinality := 'DataExactCardinality' '(' nonNegativeInteger DataPropertyExpression [ DataRange ] ')'
      String -> Type -> Element
def String
"DataExactCardinality" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
        String
"bound"String -> Type -> FieldType
>: Type
nonNegativeInteger,
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"range"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataRange"],

-- Axiom := Declaration | ClassAxiom | ObjectPropertyAxiom | DataPropertyAxiom | DatatypeDefinition | HasKey | Assertion | AnnotationAxiom
      String -> Type -> Element
def String
"Axiom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Axioms" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
simpleUnion [
          String
"AnnotationAxiom",
          String
"Assertion",
          String
"ClassAxiom",
          String
"DataPropertyAxiom",
          String
"DatatypeDefinition",
          String
"Declaration",
          String
"HasKey",
          String
"ObjectPropertyAxiom"],

-- ClassAxiom := SubClassOf | EquivalentClasses | DisjointClasses | DisjointUnion
      String -> Type -> Element
def String
"ClassAxiom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
simpleUnion [
        String
"DisjointClasses",
        String
"DisjointUnion",
        String
"EquivalentClasses",
        String
"SubClassOf"],

-- SubClassOf := 'SubClassOf' '(' axiomAnnotations subClassExpression superClassExpression ')'
-- subClassExpression := ClassExpression
-- superClassExpression := ClassExpression
      String -> Type -> Element
def String
"SubClassOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"subClass"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression",
        String
"superClass"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression"],

-- EquivalentClasses := 'EquivalentClasses' '(' axiomAnnotations ClassExpression ClassExpression { ClassExpression } ')'
      String -> Type -> Element
def String
"EquivalentClasses" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"classes"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression"],

-- DisjointClasses := 'DisjointClasses' '(' axiomAnnotations ClassExpression ClassExpression { ClassExpression } ')'
      String -> Type -> Element
def String
"DisjointClasses" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"classes"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression"],

-- DisjointUnion := 'DisjointUnion' '(' axiomAnnotations Class disjointClassExpressions ')'
-- disjointClassExpressions := ClassExpression ClassExpression { ClassExpression }
      String -> Type -> Element
def String
"DisjointUnion" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Disjoint_Union_of_Class_Expressions" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
withAnns [
          String
"class"String -> Type -> FieldType
>: String -> Type
owl String
"Class",
          String
"classes"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ClassExpression"],

-- ObjectPropertyAxiom :=
--     SubObjectPropertyOf | EquivalentObjectProperties |
--     DisjointObjectProperties | InverseObjectProperties |
--     ObjectPropertyDomain | ObjectPropertyRange |
--     FunctionalObjectProperty | InverseFunctionalObjectProperty |
--     ReflexiveObjectProperty | IrreflexiveObjectProperty |
--     SymmetricObjectProperty | AsymmetricObjectProperty |
--     TransitiveObjectProperty
      String -> Type -> Element
def String
"ObjectPropertyAxiom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
simpleUnion [
        String
"AsymmetricObjectProperty",
        String
"DisjointObjectProperties",
        String
"EquivalentObjectProperties",
        String
"FunctionalObjectProperty",
        String
"InverseFunctionalObjectProperty",
        String
"InverseObjectProperties",
        String
"IrreflexiveObjectProperty",
        String
"ObjectPropertyDomain",
        String
"ObjectPropertyRange",
        String
"ReflexiveObjectProperty",
        String
"SubObjectPropertyOf",
        String
"SymmetricObjectProperty",
        String
"TransitiveObjectProperty"],

-- SubObjectPropertyOf := 'SubObjectPropertyOf' '(' axiomAnnotations subObjectPropertyExpression superObjectPropertyExpression ')'
      String -> Type -> Element
def String
"SubObjectPropertyOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"subProperty"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ObjectPropertyExpression",
        String
"superProperty"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression"],
-- subObjectPropertyExpression := ObjectPropertyExpression | propertyExpressionChain
-- propertyExpressionChain := 'ObjectPropertyChain' '(' ObjectPropertyExpression ObjectPropertyExpression { ObjectPropertyExpression } ')'
-- superObjectPropertyExpression := ObjectPropertyExpression

-- EquivalentObjectProperties := 'EquivalentObjectProperties' '(' axiomAnnotations ObjectPropertyExpression ObjectPropertyExpression { ObjectPropertyExpression } ')'
      String -> Type -> Element
def String
"EquivalentObjectProperties" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"properties"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ObjectPropertyExpression"],

-- DisjointObjectProperties := 'DisjointObjectProperties' '(' axiomAnnotations ObjectPropertyExpression ObjectPropertyExpression { ObjectPropertyExpression } ')'
      String -> Type -> Element
def String
"DisjointObjectProperties" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"properties"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ObjectPropertyExpression"],

-- ObjectPropertyDomain := 'ObjectPropertyDomain' '(' axiomAnnotations ObjectPropertyExpression ClassExpression ')'
      String -> Type -> Element
def String
"ObjectPropertyDomain" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Object_Property_Domain" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
withAnns [
          String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
          String
"domain"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression"],

-- ObjectPropertyRange := 'ObjectPropertyRange' '(' axiomAnnotations ObjectPropertyExpression ClassExpression ')'
      String -> Type -> Element
def String
"ObjectPropertyRange" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Object_Property_Range" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
withAnns [
          String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
          String
"range"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression"],

-- InverseObjectProperties := 'InverseObjectProperties' '(' axiomAnnotations ObjectPropertyExpression ObjectPropertyExpression ')'
      String -> Type -> Element
def String
"InverseObjectProperties" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property1"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
        String
"property2"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression"],

-- FunctionalObjectProperty := 'FunctionalObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')'
      String -> Element
objectPropertyConstraint String
"FunctionalObjectProperty",

-- InverseFunctionalObjectProperty := 'InverseFunctionalObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')'
      String -> Element
objectPropertyConstraint String
"InverseFunctionalObjectProperty",

-- ReflexiveObjectProperty := 'ReflexiveObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')'
      String -> Element
objectPropertyConstraint String
"ReflexiveObjectProperty",

-- IrreflexiveObjectProperty := 'IrreflexiveObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')'
      String -> Element
objectPropertyConstraint String
"IrreflexiveObjectProperty",

-- SymmetricObjectProperty := 'SymmetricObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')'
      String -> Element
objectPropertyConstraint String
"SymmetricObjectProperty",

-- AsymmetricObjectProperty := 'AsymmetricObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')'
      String -> Element
objectPropertyConstraint String
"AsymmetricObjectProperty",

-- TransitiveObjectProperty := 'TransitiveObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')'
      String -> Element
objectPropertyConstraint String
"TransitiveObjectProperty",

-- DataPropertyAxiom :=
--     SubDataPropertyOf | EquivalentDataProperties | DisjointDataProperties |
--     DataPropertyDomain | DataPropertyRange | FunctionalDataProperty
      String -> Type -> Element
def String
"DataPropertyAxiom" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
simpleUnion [
        String
"DataPropertyAxiom",
        String
"DataPropertyRange",
        String
"DisjointDataProperties",
        String
"EquivalentDataProperties",
        String
"FunctionalDataProperty",
        String
"SubDataPropertyOf"],

-- SubDataPropertyOf := 'SubDataPropertyOf' '(' axiomAnnotations subDataPropertyExpression superDataPropertyExpression ')'
      String -> Type -> Element
def String
"SubDataPropertyOf" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"subProperty"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"superProperty"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression"],
-- subDataPropertyExpression := DataPropertyExpression
-- superDataPropertyExpression := DataPropertyExpression

-- EquivalentDataProperties := 'EquivalentDataProperties' '(' axiomAnnotations DataPropertyExpression DataPropertyExpression { DataPropertyExpression } ')'
      String -> Type -> Element
def String
"EquivalentDataProperties" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"properties"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataPropertyExpression"],

-- DisjointDataProperties := 'DisjointDataProperties' '(' axiomAnnotations DataPropertyExpression DataPropertyExpression { DataPropertyExpression } ')'
      String -> Type -> Element
def String
"DisjointDataProperties" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"properties"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataPropertyExpression"],

-- DataPropertyDomain := 'DataPropertyDomain' '(' axiomAnnotations DataPropertyExpression ClassExpression ')'
      String -> Type -> Element
def String
"DataPropertyDomain" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"domain"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression"],

-- DataPropertyRange := 'DataPropertyRange' '(' axiomAnnotations DataPropertyExpression DataRange ')'
      String -> Type -> Element
def String
"DataPropertyRange" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"range"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression"],

-- FunctionalDataProperty := 'FunctionalDataProperty' '(' axiomAnnotations DataPropertyExpression ')'
      String -> Type -> Element
def String
"FunctionalDataProperty" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression"],

-- DatatypeDefinition := 'DatatypeDefinition' '(' axiomAnnotations Datatype DataRange ')'
      String -> Type -> Element
def String
"DatatypeDefinition" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"datatype"String -> Type -> FieldType
>: String -> Type
owl String
"Datatype",
        String
"range"String -> Type -> FieldType
>: String -> Type
owl String
"DataRange"],

-- HasKey := 'HasKey' '(' axiomAnnotations ClassExpression '(' { ObjectPropertyExpression } ')' '(' { DataPropertyExpression } ')' ')'
      String -> Type -> Element
def String
"HasKey" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/owl2-syntax/#Keys" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
withAnns [
          String
"class"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression",
          String
"objectProperties"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"ObjectPropertyExpression",
          String
"dataProperties"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"DataPropertyExpression"],

-- Assertion :=
--     SameIndividual | DifferentIndividuals | ClassAssertion |
--     ObjectPropertyAssertion | NegativeObjectPropertyAssertion |
--     DataPropertyAssertion | NegativeDataPropertyAssertion
      String -> Type -> Element
def String
"Assertion" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
simpleUnion [
       String
"ClassAssertion",
       String
"DataPropertyAssertion",
       String
"DifferentIndividuals",
       String
"ObjectPropertyAssertion",
       String
"NegativeDataPropertyAssertion",
       String
"NegativeObjectPropertyAssertion",
       String
"SameIndividual"],

-- sourceIndividual := Individual
-- targetIndividual := Individual
-- targetValue := Literal
-- SameIndividual := 'SameIndividual' '(' axiomAnnotations Individual Individual { Individual } ')'
      String -> Type -> Element
def String
"SameIndividual" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"individuals"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"Individual"],

-- DifferentIndividuals := 'DifferentIndividuals' '(' axiomAnnotations Individual Individual { Individual } ')'
      String -> Type -> Element
def String
"DifferentIndividuals" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"individuals"String -> Type -> FieldType
>: Type -> Type
twoOrMoreList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
owl String
"Individual"],

-- ClassAssertion := 'ClassAssertion' '(' axiomAnnotations ClassExpression Individual ')'
      String -> Type -> Element
def String
"ClassAssertion"(Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"class"String -> Type -> FieldType
>: String -> Type
owl String
"ClassExpression",
        String
"individual"String -> Type -> FieldType
>: String -> Type
owl String
"Individual"],

-- ObjectPropertyAssertion := 'ObjectPropertyAssertion' '(' axiomAnnotations ObjectPropertyExpression sourceIndividual targetIndividual ')'
      String -> Type -> Element
def String
"ObjectPropertyAssertion" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
        String
"source"String -> Type -> FieldType
>: String -> Type
owl String
"Individual",
        String
"target"String -> Type -> FieldType
>: String -> Type
owl String
"Individual"],

-- NegativeObjectPropertyAssertion := 'NegativeObjectPropertyAssertion' '(' axiomAnnotations ObjectPropertyExpression sourceIndividual targetIndividual ')'
      String -> Type -> Element
def String
"NegativeObjectPropertyAssertion" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"ObjectPropertyExpression",
        String
"source"String -> Type -> FieldType
>: String -> Type
owl String
"Individual",
        String
"target"String -> Type -> FieldType
>: String -> Type
owl String
"Individual"],

-- DataPropertyAssertion := 'DataPropertyAssertion' '(' axiomAnnotations DataPropertyExpression sourceIndividual targetValue ')'
      String -> Type -> Element
def String
"DataPropertyAssertion" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"source"String -> Type -> FieldType
>: String -> Type
owl String
"Individual",
        String
"target"String -> Type -> FieldType
>: String -> Type
owl String
"Individual"],

-- NegativeDataPropertyAssertion := 'NegativeDataPropertyAssertion' '(' axiomAnnotations DataPropertyExpression sourceIndividual targetValue ')'
      String -> Type -> Element
def String
"NegativeDataPropertyAssertion" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
withAnns [
        String
"property"String -> Type -> FieldType
>: String -> Type
owl String
"DataPropertyExpression",
        String
"source"String -> Type -> FieldType
>: String -> Type
owl String
"Individual",
        String
"target"String -> Type -> FieldType
>: String -> Type
owl String
"Individual"]]