module Hydra.Sources.Tier4.Langs.Xml.Schema where

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


xmlSchemaModule :: Module
xmlSchemaModule :: Module
xmlSchemaModule = 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
"A partial XML Schema model, focusing on datatypes. All simple datatypes (i.e. xsd:anySimpleType and below) are included.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"See: https://www.w3.org/TR/xmlschema-2\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"Note: for most of the XML Schema datatype definitions included here, the associated Hydra type is simply\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"      the string type. Exceptions are made for xsd:boolean and most of the numeric types, where there is a clearly\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"      corresponding Hydra literal type.")
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/xml/schema"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns

    elements :: [Element]
elements = [Element]
datatypes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
others

    datatypes :: [Element]
datatypes = [
      String -> Type -> Element
def String
"AnySimpleType" Type
string,
      String -> Type -> Element
def String
"AnyType" Type
string,
      String -> Type -> Element
def String
"AnyURI" Type
string,
      String -> Type -> Element
def String
"Base64Binary" Type
string,
      String -> Type -> Element
def String
"Boolean" Type
boolean,
      String -> Type -> Element
def String
"Byte" Type
int8,
      String -> Type -> Element
def String
"Date" Type
string,
      String -> Type -> Element
def String
"DateTime" Type
string,
      String -> Type -> Element
def String
"Decimal" Type
string,
      String -> Type -> Element
def String
"Double" Type
float64,
      String -> Type -> Element
def String
"Duration" Type
string,
      String -> Type -> Element
def String
"ENTITIES" Type
string,
      String -> Type -> Element
def String
"ENTITY" Type
string,
      String -> Type -> Element
def String
"Float" Type
float32,
      String -> Type -> Element
def String
"GDay" Type
string,
      String -> Type -> Element
def String
"GMonth" Type
string,
      String -> Type -> Element
def String
"GMonthDay" Type
string,
      String -> Type -> Element
def String
"GYear" Type
string,
      String -> Type -> Element
def String
"GYearMonth" Type
string,
      String -> Type -> Element
def String
"HexBinary" Type
string,
      String -> Type -> Element
def String
"ID" Type
string,
      String -> Type -> Element
def String
"IDREF" Type
string,
      String -> Type -> Element
def String
"IDREFS" Type
string,
      String -> Type -> Element
def String
"Int" Type
int32,
      String -> Type -> Element
def String
"Integer" Type
bigint,
      String -> Type -> Element
def String
"Language" Type
string,
      String -> Type -> Element
def String
"Long" Type
int64,
      String -> Type -> Element
def String
"NMTOKEN" Type
string,
      String -> Type -> Element
def String
"NOTATION" Type
string,
      String -> Type -> Element
def String
"Name" Type
string,
      String -> Type -> Element
def String
"NegativeInteger" Type
bigint,
      String -> Type -> Element
def String
"NonNegativeInteger" Type
bigint,
      String -> Type -> Element
def String
"NonPositiveInteger" Type
bigint,
      String -> Type -> Element
def String
"NormalizedString" Type
string,
      String -> Type -> Element
def String
"PositiveInteger" Type
bigint,
      String -> Type -> Element
def String
"QName" Type
string,
      String -> Type -> Element
def String
"Short" Type
int16,
      String -> Type -> Element
def String
"String" Type
string,
      String -> Type -> Element
def String
"Time" Type
string,
      String -> Type -> Element
def String
"Token" Type
string,
      String -> Type -> Element
def String
"UnsignedByte" Type
uint8,
      String -> Type -> Element
def String
"UnsignedInt" Type
uint32,
      String -> Type -> Element
def String
"UnsignedLong" Type
uint64,
      String -> Type -> Element
def String
"UnsignedShort" Type
uint16]

    others :: [Element]
others = [
      String -> Type -> Element
def String
"ConstrainingFacet" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
see String
"https://www.w3.org/TR/xmlschema-2/#non-fundamental" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        Type
unit, -- TODO: concrete facets

      String -> Type -> Element
def String
"Datatype" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [
        String
"anySimpleType",
        String
"anyType",
        String
"anyURI",
        String
"base64Binary",
        String
"boolean",
        String
"byte",
        String
"date",
        String
"dateTime",
        String
"decimal",
        String
"double",
        String
"duration",
        String
"ENTITIES",
        String
"ENTITY",
        String
"float",
        String
"gDay",
        String
"gMonth",
        String
"gMonthDay",
        String
"gYear",
        String
"gYearMonth",
        String
"hexBinary",
        String
"ID",
        String
"IDREF",
        String
"IDREFS",
        String
"int",
        String
"integer",
        String
"language",
        String
"long",
        String
"NMTOKEN",
        String
"NOTATION",
        String
"name",
        String
"negativeInteger",
        String
"nonNegativeInteger",
        String
"nonPositiveInteger",
        String
"normalizedString",
        String
"positiveInteger",
        String
"qName",
        String
"short",
        String
"string",
        String
"time",
        String
"token",
        String
"unsignedByte",
        String
"unsignedInt",
        String
"unsignedLong",
        String
"unsignedShort"]]