{- |
Module      :  ./OWL2/Keywords.hs
Description :  OWL reserved keywords
  and printing
Copyright   :  (c) Christian Maeder DFKI Bremen 2008, Felix Mance, 2011
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

String constants for keywords to be used for parsing and printing
plus owl, xsd, rdf and rdfs reserved keywords. All identifiers are mixed case
-}

module OWL2.Keywords where

import Common.Keywords

keywords :: [String]
keywords :: [String]
keywords =
  [ String
digitsS
  , String
exactlyS
  , String
fractionS
  , String
functionalS
  , String
hasS
  , String
inverseS
  , String
lengthS
  , String
maxLengthS
  , String
maxS
  , String
minLengthS
  , String
minS
  , String
oS
  , String
onlyS
  , String
onlysomeS
  , String
orS
  , String
patternS
  , String
selfS
  , String
someS
  , String
thatS
  , String
valueS
  , String
xorS
  ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
datatypeKeys

base64BinaryS :: String
base64BinaryS :: String
base64BinaryS = "base64Binary"

booleanS :: String
booleanS :: String
booleanS = "boolean"

byteS :: String
byteS :: String
byteS = "byte"

dATAS :: String
dATAS :: String
dATAS = "DATA"

decimalS :: String
decimalS :: String
decimalS = "decimal"

doubleS :: String
doubleS :: String
doubleS = "double"

digitsS :: String
digitsS :: String
digitsS = "totalDigits"

exactlyS :: String
exactlyS :: String
exactlyS = "exactly"

floatS :: String
floatS :: String
floatS = "float"

fractionS :: String
fractionS :: String
fractionS = "fractionDigits"

functionalS :: String
functionalS :: String
functionalS = "Functional"

inverseFunctionalS :: String
inverseFunctionalS :: String
inverseFunctionalS = "InverseFunctional"

reflexiveS :: String
reflexiveS :: String
reflexiveS = "Reflexive"

irreflexiveS :: String
irreflexiveS :: String
irreflexiveS = "Irreflexive"

symmetricS :: String
symmetricS :: String
symmetricS = "Symmetric"

asymmetricS :: String
asymmetricS :: String
asymmetricS = "Asymmetric"

antisymmetricS :: String
antisymmetricS :: String
antisymmetricS = "Antisymmetric"

transitiveS :: String
transitiveS :: String
transitiveS = "Transitive"

hasS :: String
hasS :: String
hasS = "has"

sameAsS :: String
sameAsS :: String
sameAsS = "SameAs"

differentFromS :: String
differentFromS :: String
differentFromS = "DifferentFrom"

hexBinaryS :: String
hexBinaryS :: String
hexBinaryS = "hexBinary"

intS :: String
intS :: String
intS = "int"

integerS :: String
integerS :: String
integerS = "integer"

inverseS :: String
inverseS :: String
inverseS = "inverse"

langRangeS :: String
langRangeS :: String
langRangeS = "langRange"

lengthS :: String
lengthS :: String
lengthS = "length"

longS :: String
longS :: String
longS = "long"

maxLengthS :: String
maxLengthS :: String
maxLengthS = "maxLength"

maxS :: String
maxS :: String
maxS = "max"

minLengthS :: String
minLengthS :: String
minLengthS = "minLength"

minS :: String
minS :: String
minS = "min"

negativeIntegerS :: String
negativeIntegerS :: String
negativeIntegerS = "negativeInteger"

nonNegativeIntegerS :: String
nonNegativeIntegerS :: String
nonNegativeIntegerS = "nonNegativeInteger"

nonPositiveIntegerS :: String
nonPositiveIntegerS :: String
nonPositiveIntegerS = "nonPositiveInteger"

oS :: String
oS :: String
oS = "o"

onlyS :: String
onlyS :: String
onlyS = "only"

onlysomeS :: String
onlysomeS :: String
onlysomeS = "onlysome"

orS :: String
orS :: String
orS = "or"

positiveIntegerS :: String
positiveIntegerS :: String
positiveIntegerS = "positiveInteger"

rationalS :: String
rationalS :: String
rationalS = "rational"

realS :: String
realS :: String
realS = "real"

selfS :: String
selfS :: String
selfS = "Self"

shortS :: String
shortS :: String
shortS = "short"

someS :: String
someS :: String
someS = "some"

thatS :: String
thatS :: String
thatS = "that"

rdfsLiteral :: String
rdfsLiteral :: String
rdfsLiteral = "Literal"

rdfPlainLiteralS :: String
rdfPlainLiteralS :: String
rdfPlainLiteralS = "PlainLiteral"

unsignedByteS :: String
unsignedByteS :: String
unsignedByteS = "unsignedByte"

unsignedIntS :: String
unsignedIntS :: String
unsignedIntS = "unsignedInt"

unsignedLongS :: String
unsignedLongS :: String
unsignedLongS = "unsignedLong"

unsignedShortS :: String
unsignedShortS :: String
unsignedShortS = "unsignedShort"

valueS :: String
valueS :: String
valueS = "value"

xorS :: String
xorS :: String
xorS = "xor"

dateTimeS :: String
dateTimeS :: String
dateTimeS = "dateTime"

dateTimeStampS :: String
dateTimeStampS :: String
dateTimeStampS = "dateTimeStamp"

anyURI :: String
anyURI :: String
anyURI = "anyURI"

xmlLiteral :: String
xmlLiteral :: String
xmlLiteral = "XMLLiteral"

ncNameS :: String
ncNameS :: String
ncNameS = "NCName"

nameS :: String
nameS :: String
nameS = "Name"

nmTokenS :: String
nmTokenS :: String
nmTokenS = "NMTOKEN"

tokenS :: String
tokenS :: String
tokenS = "token"

languageS :: String
languageS :: String
languageS = "language"

normalizedStringS :: String
normalizedStringS :: String
normalizedStringS = "normalizedString"

thingS :: String
thingS :: String
thingS = "Thing"

nothingS :: String
nothingS :: String
nothingS = "Nothing"

topObjProp :: String
topObjProp :: String
topObjProp = "topObjectProperty"

bottomObjProp :: String
bottomObjProp :: String
bottomObjProp = "bottomObjectProperty"

topDataProp :: String
topDataProp :: String
topDataProp = "topDataProperty"

bottomDataProp :: String
bottomDataProp :: String
bottomDataProp = "bottomDataProperty"

label :: String
label :: String
label = "label"

comment :: String
comment :: String
comment = "comment"

seeAlso :: String
seeAlso :: String
seeAlso = "seeAlso"

isDefinedBy :: String
isDefinedBy :: String
isDefinedBy = "isDefinedBy"

deprecated :: String
deprecated :: String
deprecated = "deprecated"

versionInfo :: String
versionInfo :: String
versionInfo = "versionInfo"

priorVersion :: String
priorVersion :: String
priorVersion = "priorVersion"

backwardCompatibleWith :: String
backwardCompatibleWith :: String
backwardCompatibleWith = "backwardCompatibleWith"

incompatibleWith :: String
incompatibleWith :: String
incompatibleWith = "incompatibleWith"

implied :: String
implied :: String
implied = "Implied"

predefClass :: [String]
predefClass :: [String]
predefClass = [String
thingS, String
nothingS]

predefObjProp :: [String]
predefObjProp :: [String]
predefObjProp = [String
topObjProp, String
bottomObjProp]

predefDataProp :: [String]
predefDataProp :: [String]
predefDataProp = [String
topDataProp, String
bottomDataProp]

predefRDFSAnnoProps :: [String]
predefRDFSAnnoProps :: [String]
predefRDFSAnnoProps = [String
label, String
comment, String
seeAlso, String
isDefinedBy]

predefOWLAnnoProps :: [String]
predefOWLAnnoProps :: [String]
predefOWLAnnoProps = [String
deprecated, String
versionInfo, String
priorVersion,
    String
backwardCompatibleWith, String
incompatibleWith, String
implied]

xsdNumbers :: [String]
xsdNumbers :: [String]
xsdNumbers = [String
integerS, String
negativeIntegerS, String
nonNegativeIntegerS,
    String
nonPositiveIntegerS, String
positiveIntegerS, String
decimalS, String
doubleS, String
floatS,
    String
longS, String
intS, String
shortS, String
byteS, String
unsignedLongS, String
unsignedIntS, String
unsignedShortS,
    String
unsignedByteS]

owlNumbers :: [String]
owlNumbers :: [String]
owlNumbers = [String
realS, String
rationalS]

xsdStrings :: [String]
xsdStrings :: [String]
xsdStrings = [String
stringS, String
ncNameS, "QName", String
nameS, String
nmTokenS, "NMTOKENS", String
tokenS
  , String
languageS, String
normalizedStringS, "NOTATION", "ENTITY", "ENTITIES"
  , "ID", "IDREF", "IDREFS" ]

xsdKeys :: [String]
xsdKeys :: [String]
xsdKeys = [String
booleanS, String
dATAS, String
hexBinaryS, String
base64BinaryS, "date", "time"
  , "gYearMonth", "gYear", "gMonthDay", "gDay", "gMonth", "duration"
  , String
dateTimeS, String
dateTimeStampS, String
anyURI] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xsdNumbers [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xsdStrings

nonXSDKeys :: [String]
nonXSDKeys :: [String]
nonXSDKeys = [String]
owlNumbers [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
xmlLiteral, String
rdfsLiteral]

datatypeKeys :: [String]
datatypeKeys :: [String]
datatypeKeys = [String]
xsdKeys [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
nonXSDKeys

data DatatypeFacet =
    LENGTH
  | MINLENGTH
  | MAXLENGTH
  | PATTERN
  | LANGRANGE
  | MININCLUSIVE
  | MINEXCLUSIVE
  | MAXINCLUSIVE
  | MAXEXCLUSIVE
  | TOTALDIGITS
  | FRACTIONDIGITS
    deriving (Int -> DatatypeFacet -> ShowS
[DatatypeFacet] -> ShowS
DatatypeFacet -> String
(Int -> DatatypeFacet -> ShowS)
-> (DatatypeFacet -> String)
-> ([DatatypeFacet] -> ShowS)
-> Show DatatypeFacet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DatatypeFacet] -> ShowS
$cshowList :: [DatatypeFacet] -> ShowS
show :: DatatypeFacet -> String
$cshow :: DatatypeFacet -> String
showsPrec :: Int -> DatatypeFacet -> ShowS
$cshowsPrec :: Int -> DatatypeFacet -> ShowS
Show, DatatypeFacet -> DatatypeFacet -> Bool
(DatatypeFacet -> DatatypeFacet -> Bool)
-> (DatatypeFacet -> DatatypeFacet -> Bool) -> Eq DatatypeFacet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DatatypeFacet -> DatatypeFacet -> Bool
$c/= :: DatatypeFacet -> DatatypeFacet -> Bool
== :: DatatypeFacet -> DatatypeFacet -> Bool
$c== :: DatatypeFacet -> DatatypeFacet -> Bool
Eq, Eq DatatypeFacet
Eq DatatypeFacet =>
(DatatypeFacet -> DatatypeFacet -> Ordering)
-> (DatatypeFacet -> DatatypeFacet -> Bool)
-> (DatatypeFacet -> DatatypeFacet -> Bool)
-> (DatatypeFacet -> DatatypeFacet -> Bool)
-> (DatatypeFacet -> DatatypeFacet -> Bool)
-> (DatatypeFacet -> DatatypeFacet -> DatatypeFacet)
-> (DatatypeFacet -> DatatypeFacet -> DatatypeFacet)
-> Ord DatatypeFacet
DatatypeFacet -> DatatypeFacet -> Bool
DatatypeFacet -> DatatypeFacet -> Ordering
DatatypeFacet -> DatatypeFacet -> DatatypeFacet
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DatatypeFacet -> DatatypeFacet -> DatatypeFacet
$cmin :: DatatypeFacet -> DatatypeFacet -> DatatypeFacet
max :: DatatypeFacet -> DatatypeFacet -> DatatypeFacet
$cmax :: DatatypeFacet -> DatatypeFacet -> DatatypeFacet
>= :: DatatypeFacet -> DatatypeFacet -> Bool
$c>= :: DatatypeFacet -> DatatypeFacet -> Bool
> :: DatatypeFacet -> DatatypeFacet -> Bool
$c> :: DatatypeFacet -> DatatypeFacet -> Bool
<= :: DatatypeFacet -> DatatypeFacet -> Bool
$c<= :: DatatypeFacet -> DatatypeFacet -> Bool
< :: DatatypeFacet -> DatatypeFacet -> Bool
$c< :: DatatypeFacet -> DatatypeFacet -> Bool
compare :: DatatypeFacet -> DatatypeFacet -> Ordering
$ccompare :: DatatypeFacet -> DatatypeFacet -> Ordering
$cp1Ord :: Eq DatatypeFacet
Ord)

-- Converts a facet to string but in contrast to @showFacet@ uses text
-- instead of signs. E.g. "minInclusive" instead of "<="
showFacetAsText :: DatatypeFacet -> String
showFacetAsText :: DatatypeFacet -> String
showFacetAsText LENGTH = String
lengthS
showFacetAsText MINLENGTH = String
minLengthS
showFacetAsText MAXLENGTH = String
maxLengthS
showFacetAsText PATTERN = String
patternS
showFacetAsText LANGRANGE = String
langRangeS
showFacetAsText MININCLUSIVE = String
minInclusiveS
showFacetAsText MINEXCLUSIVE = String
minExclusiveS
showFacetAsText MAXINCLUSIVE = String
maxInclusiveS
showFacetAsText MAXEXCLUSIVE = String
maxExclusiveS
showFacetAsText TOTALDIGITS = String
digitsS
showFacetAsText FRACTIONDIGITS = String
fractionS

showFacet :: DatatypeFacet -> String
showFacet :: DatatypeFacet -> String
showFacet df :: DatatypeFacet
df = case DatatypeFacet
df of
    LENGTH -> String
lengthS
    MINLENGTH -> String
minLengthS
    MAXLENGTH -> String
maxLengthS
    PATTERN -> String
patternS
    LANGRANGE -> String
langRangeS
    MININCLUSIVE -> String
lessEq
    MINEXCLUSIVE -> String
lessS
    MAXINCLUSIVE -> String
greaterEq
    MAXEXCLUSIVE -> String
greaterS
    TOTALDIGITS -> String
digitsS
    FRACTIONDIGITS -> String
fractionS

facetList :: [DatatypeFacet]
facetList :: [DatatypeFacet]
facetList = [DatatypeFacet
LENGTH, DatatypeFacet
MINLENGTH, DatatypeFacet
MAXLENGTH, DatatypeFacet
PATTERN, DatatypeFacet
LANGRANGE, DatatypeFacet
MININCLUSIVE,
    DatatypeFacet
MINEXCLUSIVE, DatatypeFacet
MAXINCLUSIVE, DatatypeFacet
MAXEXCLUSIVE, DatatypeFacet
TOTALDIGITS, DatatypeFacet
FRACTIONDIGITS]