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

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Types as Types
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap


rdfSyntaxModule :: Module
rdfSyntaxModule :: Module
rdfSyntaxModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCoreModule] [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 RDF 1.1 syntax model"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/rdf/syntax"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    rdf :: String -> Type
rdf = Namespace -> String -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"BlankNode" Type
string,

      String -> Type -> Element
def String
"RdfsClass"
        (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type -> Type
doc String
"Stand-in for rdfs:Class" Type
unit,

      String -> Type -> Element
def String
"Dataset" (Type -> Element) -> Type -> Element
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
"Quad",

      String -> Type -> Element
def String
"Description" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A graph of RDF statements together with a distinguished subject and/or object node" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"subject"String -> Type -> FieldType
>: String -> Type
rdf String
"Node",
          String
"graph"String -> Type -> FieldType
>: String -> Type
rdf String
"Graph"],

      String -> Type -> Element
def String
"Graph" (Type -> Element) -> Type -> Element
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
"Triple",

      String -> Type -> Element
def String
"Iri" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An Internationalized Resource Identifier"
        Type
string,

      String -> Type -> Element
def String
"IriOrLiteral" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc (String
"An IRI or a literal; " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             String
"this type is a convenience for downstream models like SHACL which may exclude blank nodes") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"iri"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri",
          String
"literal"String -> Type -> FieldType
>: String -> Type
rdf String
"Literal"],

      String -> Type -> Element
def String
"LangStrings" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A convenience type which provides at most one string value per language, and optionally a value without a language" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        Type -> Type -> Type
Types.map (Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
rdf String
"LanguageTag") Type
string,

      String -> Type -> Element
def String
"LanguageTag" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A BCP47 language tag"
        Type
string,

      String -> Type -> Element
def String
"Literal" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A value such as a string, number, or date" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"lexicalForm"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"a Unicode string, which should be in Normal Form C"
            Type
string,
          String
"datatypeIri"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"an IRI identifying a datatype that determines how the lexical form maps to a literal value" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
rdf String
"Iri",
          String
"languageTag"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"An optional language tag, present if and only if the datatype IRI is http://www.w3.org/1999/02/22-rdf-syntax-ns#langString" (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
"LanguageTag"],

      String -> Type -> Element
def String
"Node" (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
"bnode"String -> Type -> FieldType
>: String -> Type
rdf String
"BlankNode",
          String
"literal"String -> Type -> FieldType
>: String -> Type
rdf String
"Literal"],

      String -> Type -> Element
def String
"Property" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A type representing an RDF property, and encapsulating its domain, range, and subclass relationships" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"domain"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"State that any resource that has a given property is an instance of one or more classes" (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
"range"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"States that the values of a property are instances of one or more classes" (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
"subPropertyOf"String -> Type -> FieldType
>:
            Type -> Type
set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
rdf String
"Property"],

      String -> Type -> Element
def String
"Quad" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An RDF triple with an optional named graph component" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"subject"String -> Type -> FieldType
>: String -> Type
rdf String
"Resource",
          String
"predicate"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri",
          String
"object"String -> Type -> FieldType
>: String -> Type
rdf String
"Node",
          String
"graph"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
rdf String
"Iri"],

      String -> Type -> Element
def String
"Resource" (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
"bnode"String -> Type -> FieldType
>: String -> Type
rdf String
"BlankNode"],

      String -> Type -> Element
def String
"Triple" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An RDF triple defined by a subject, predicate, and object" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"subject"String -> Type -> FieldType
>: String -> Type
rdf String
"Resource",
          String
"predicate"String -> Type -> FieldType
>: String -> Type
rdf String
"Iri",
          String
"object"String -> Type -> FieldType
>: String -> Type
rdf String
"Node"]]