1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder{- |

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederModule : $Header$

f9e0b18852b238ddb649d341194e05d7200d1bbeChristian MaederDescription : Manchester syntax parser for OWL 2

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederCopyright : (c) DFKI GmbH, Uni Bremen 2007-2010

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher, see LICENSE.txt

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederMaintainer : Christian.Maeder@dfki.de

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederStability : provisional

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederPortability : portable

f9e0b18852b238ddb649d341194e05d7200d1bbeChristian Maeder

f9e0b18852b238ddb649d341194e05d7200d1bbeChristian MaederContains : Parser for the Manchester Syntax into Abstract Syntax of OWL 2

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederReferences : <http://www.w3.org/TR/2009/NOTE-owl2-manchester-syntax-20091027/>

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder-}

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maedermodule OWL2.Parse where

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder

ecf557c0b4f953106755a239da2c0b168064d3f4Christian Maederimport OWL2.AS

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederimport OWL2.Symbols

64e1905404e5135e98a26d2ab4150b6764956576Christian Maederimport OWL2.Keywords

f9e0b18852b238ddb649d341194e05d7200d1bbeChristian Maederimport OWL2.ColonKeywords

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederimport Common.Keywords

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuimport Common.Lexer

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuimport Common.Parsec

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederimport Common.AnnoParser (commentLine)

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederimport Common.Token (criticalKeywords)

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederimport Common.Utils (nubOrd)

67869d63d1725c79e4c07b51acd466a31932b275Christian Maeder

bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulzimport Text.ParserCombinators.Parsec

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederimport Data.Char

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder

64e1905404e5135e98a26d2ab4150b6764956576Christian Maedertype URI = IRI

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder

64e1905404e5135e98a26d2ab4150b6764956576Christian Maedercharacters :: [Character]

64e1905404e5135e98a26d2ab4150b6764956576Christian Maedercharacters = [minBound .. maxBound]

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescu

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescu-- | OWL and CASL structured keywords including 'andS' and 'notS'

64e1905404e5135e98a26d2ab4150b6764956576Christian MaederowlKeywords :: [String]

4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian MaederowlKeywords = notS : stringS : map show entityTypes

4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder ++ map show characters ++ keywords ++ criticalKeywords

4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederncNameStart :: Char -> Bool

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederncNameStart c = isAlpha c || c == '_'

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder-- | rfc3987 plus '+' from scheme (scheme does not allow the dots)

67869d63d1725c79e4c07b51acd466a31932b275Christian MaederncNameChar :: Char -> Bool

083a5256468076d5a9bfeb22a6e97076c224252eChristian MaederncNameChar c = isAlphaNum c || elem c ".+-_\183"

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

64e1905404e5135e98a26d2ab4150b6764956576Christian Maederprefix :: CharParser st String

64e1905404e5135e98a26d2ab4150b6764956576Christian Maederprefix = satisfy ncNameStart <:> many (satisfy ncNameChar)

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maederiunreserved :: Char -> Bool

bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulziunreserved c = isAlphaNum c || elem c "-._~" || ord c >= 160 && ord c <= 55295

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

65dce48b81f69e11a36bf1051314a845299446e1Christian Maeder-- maybe lower case hex-digits should be illegal

64e1905404e5135e98a26d2ab4150b6764956576Christian MaederpctEncoded :: CharParser st String

64e1905404e5135e98a26d2ab4150b6764956576Christian MaederpctEncoded = char '%' <:> hexDigit <:> single hexDigit

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder{- comma and parens are removed here

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder but would cause no problems for full IRIs within angle brackets -}

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaedersubDelims :: Char -> Bool

67869d63d1725c79e4c07b51acd466a31932b275Christian MaedersubDelims c = elem c "!$&'*+;="

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederiunreservedSubDelims :: String -> CharParser st Char

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederiunreservedSubDelims cs =

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder satisfy $ \ c -> iunreserved c || subDelims c || elem c cs

62eaa2fb831613d8a6e59687f83a45be1041ab17Christian Maeder

64e1905404e5135e98a26d2ab4150b6764956576Christian MaederiunreservedPctEncodedSubDelims :: String -> CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederiunreservedPctEncodedSubDelims cs =

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescu single (iunreservedSubDelims cs) <|> pctEncoded

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescu

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuipChar :: CharParser st String

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuipChar = iunreservedPctEncodedSubDelims ":@"

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescu

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuifragment :: CharParser st String

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuifragment = flat $ many (ipChar <|> single (char '/' <|> char '?'))

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescu

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuiquery :: CharParser st String

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuiquery = ifragment -- ignore iprivate

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescu

42e78fd3454812d4f98b06154fdabc5ec3488718mcodescuiregName :: CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederiregName = flat $ many $ iunreservedPctEncodedSubDelims ""

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederiuserinfo :: CharParser st String

67869d63d1725c79e4c07b51acd466a31932b275Christian Maederiuserinfo = flat $ many $ iunreservedPctEncodedSubDelims ":"

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder-- | parse zero or at most n consecutive arguments

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederatMost :: Int -> GenParser tok st a -> GenParser tok st [a]

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederatMost n p = if n <= 0 then return [] else

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder p <:> atMost (n - 1) p <|> return []

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

67869d63d1725c79e4c07b51acd466a31932b275Christian Maeder-- | parse at least one but at most n conse

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederatMost1 :: Int -> GenParser tok st a -> GenParser tok st [a]

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederatMost1 n p = p <:> atMost (n - 1) p

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederdecOctet :: CharParser st String

62eaa2fb831613d8a6e59687f83a45be1041ab17Christian MaederdecOctet = atMost 3 digit

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder `checkWith` \ s -> let v = value 10 s in v <= 255 &&

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder (if v == 0 then s == "0" else take 1 s /= "0")

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederiPv4Adress :: CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederiPv4Adress = decOctet <++> string "."

67869d63d1725c79e4c07b51acd466a31932b275Christian Maeder <++> decOctet <++> string "."

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder <++> decOctet <++> string "."

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder <++> decOctet

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederihost :: CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederihost = iregName <|> iPv4Adress -- or ipLiteral

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

67869d63d1725c79e4c07b51acd466a31932b275Christian Maederport :: CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederport = many digit

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederiauthority :: CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederiauthority = optionL (try $ iuserinfo <++> string "@") <++> ihost

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder <++> optionL (char ':' <:> port)

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

67869d63d1725c79e4c07b51acd466a31932b275Christian Maederisegment :: CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maederisegment = flat $ many ipChar

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederisegmentNz :: CharParser st String

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederisegmentNz = flat $ many1 ipChar

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian MaederipathAbempty :: CharParser st String

67869d63d1725c79e4c07b51acd466a31932b275Christian MaederipathAbempty = flat $ many (char '/' <:> isegment)

1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder

ecf557c0b4f953106755a239da2c0b168064d3f4Christian MaederipathAbsolute :: CharParser st String

ecf557c0b4f953106755a239da2c0b168064d3f4Christian MaederipathAbsolute = char '/' <:> optionL (isegmentNz <++> ipathAbempty)

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder

935613eb8e67d724f1c4a4d4a37be3324ef6708dChristian Maeder{- within abbreviated IRIs only ipath-noscheme should be used

656f17ae9b7610ff2de1b6eedeeadea0c3bcdc8dChristian Maeder that excludes colons via isegment-nz-nc -}

6d4d212092e2edb139e0907a14e87c4df74ff06aChristian MaederipathRootless :: CharParser st String

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederipathRootless = isegmentNz <++> ipathAbempty

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederiauthorityWithPath :: CharParser st String

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederiauthorityWithPath = tryString "//" <++> iauthority <++> ipathAbempty

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder

bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst SchulzoptQueryOrFrag :: CharParser st String

083a5256468076d5a9bfeb22a6e97076c224252eChristian MaederoptQueryOrFrag = optionL (char '?' <:> iquery)

083a5256468076d5a9bfeb22a6e97076c224252eChristian Maeder <++> optionL (char '#' <:> ifragment)

083a5256468076d5a9bfeb22a6e97076c224252eChristian Maeder

083a5256468076d5a9bfeb22a6e97076c224252eChristian Maeder-- | covers irelative-part (therefore we omit curie)

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederihierPart :: CharParser st String

083a5256468076d5a9bfeb22a6e97076c224252eChristian MaederihierPart =

083a5256468076d5a9bfeb22a6e97076c224252eChristian Maeder iauthorityWithPath <|> ipathAbsolute <|> ipathRootless

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder

083a5256468076d5a9bfeb22a6e97076c224252eChristian MaederhierPartWithOpts :: CharParser st String

083a5256468076d5a9bfeb22a6e97076c224252eChristian MaederhierPartWithOpts = ihierPart <++> optQueryOrFrag

392b67dbb9414475750ac2a977348de77354c600Christian Maeder

de66af0f4b27f08f81c7ca9c573ef9cdf7ca7a07Christian Maederskips :: CharParser st a -> CharParser st a

de66af0f4b27f08f81c7ca9c573ef9cdf7ca7a07Christian Maederskips = (<< skipMany

de66af0f4b27f08f81c7ca9c573ef9cdf7ca7a07Christian Maeder (forget space <|> forget commentLine <|> nestCommentOut <?> ""))

de66af0f4b27f08f81c7ca9c573ef9cdf7ca7a07Christian Maeder

de66af0f4b27f08f81c7ca9c573ef9cdf7ca7a07Christian MaederabbrIri :: CharParser st QName

de66af0f4b27f08f81c7ca9c573ef9cdf7ca7a07Christian MaederabbrIri = try $ do

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder pre <- try $ prefix << char ':'

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder r <- hierPartWithOpts

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder return $ QN pre r False ""

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian Maeder <|> fmap mkQName hierPartWithOpts

083a5256468076d5a9bfeb22a6e97076c224252eChristian Maeder

0d7d8e3dd817450cf792778d9d4e36420f5e8abfChristian MaederfullIri :: CharParser st QName

bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst SchulzfullIri = do

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder char '<'

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder QN pre r _ _ <- abbrIri

6d4d212092e2edb139e0907a14e87c4df74ff06aChristian Maeder char '>'

6d4d212092e2edb139e0907a14e87c4df74ff06aChristian Maeder return $ QN pre r True ""

64e1905404e5135e98a26d2ab4150b6764956576Christian Maeder

656f17ae9b7610ff2de1b6eedeeadea0c3bcdc8dChristian MaederuriQ :: CharParser st QName

6d4d212092e2edb139e0907a14e87c4df74ff06aChristian MaederuriQ = fullIri <|> abbrIri

uriP :: CharParser st QName

uriP =

skips $ try $ checkWithUsing showQN uriQ $ \ q -> let p = namePrefix q in

if null p then notElem (localPart q) owlKeywords

else notElem p $ map (takeWhile (/= ':'))

$ colonKeywords

++ [ show d ++ e | d <- equivOrDisjointL, e <- [classesC, propertiesC]]

-- | parse a possibly kinded list of comma separated uris aka symbols

symbItems :: GenParser Char st SymbItems

symbItems = do

m <- optionMaybe entityType

uris <- symbs

return $ SymbItems m uris

-- | parse a comma separated list of uris

symbs :: GenParser Char st [URI]

symbs = uriP >>= \ u -> do

commaP `followedWith` uriP

us <- symbs

return $ u : us

<|> return [u]

-- | parse a possibly kinded list of comma separated symbol pairs

symbMapItems :: GenParser Char st SymbMapItems

symbMapItems = do

m <- optionMaybe entityType

uris <- symbPairs

return $ SymbMapItems m uris

-- | parse a comma separated list of uri pairs

symbPairs :: GenParser Char st [(URI, Maybe URI)]

symbPairs = uriPair >>= \ u -> do

commaP `followedWith` uriP

us <- symbPairs

return $ u : us

<|> return [u]

uriPair :: GenParser Char st (URI, Maybe URI)

uriPair = uriP >>= \ u -> do

pToken $ toKey mapsTo

u2 <- uriP

return (u, Just u2)

<|> return (u, Nothing)

datatypeUri :: CharParser st QName

datatypeUri = fmap mkQName (choice $ map keyword datatypeKeys) <|> uriP

optSign :: CharParser st String

optSign = optionL (single $ oneOf "+-")

postDecimal :: CharParser st String

postDecimal = char '.' <:> getNumber

fullDecimal :: CharParser st String

fullDecimal = getNumber <++> optionL postDecimal

decimalLit :: CharParser st String

decimalLit = optSign <++> fullDecimal

floatingPointLit :: CharParser st String

floatingPointLit = optSign <++> (fullDecimal <|> postDecimal)

<++> optionL (oneOf "eE" <:> optSign <++> getNumber)

<< oneOf "fF"

languageTag :: CharParser st String

languageTag = atMost1 4 letter

<++> flat (many $ char '-' <:> atMost1 8 alphaNum)

withOrWithoutLanguage :: String -> Maybe String

withOrWithoutLanguage x = if x == "" then Nothing else Just x

stringLiteral :: CharParser st Literal

stringLiteral = do

s <- stringLit

do

string cTypeS

d <- datatypeUri

return $ Literal s $ Typed d

<|> do

string asP

t <- optionL $ skips languageTag

return $ Literal s $ Untyped (withOrWithoutLanguage t)

<|> skips (return $ Literal s $ Typed $ mkQName stringS)

literal :: CharParser st Literal

literal = do

f <- skips $ try floatingPointLit

return $ Literal f $ Typed $ mkQName floatS

<|> do

d <- skips decimalLit

return $ Literal d $ Typed $ mkQName

$ if any (== '.') d then decimalS else integerS

<|> stringLiteral

-- * description

owlClassUri :: CharParser st QName

owlClassUri = uriP

individualUri :: CharParser st QName

individualUri = uriP

individual :: CharParser st Individual

individual = individualUri

skipChar :: Char -> CharParser st ()

skipChar = forget . skips . char

parensP :: CharParser st a -> CharParser st a

parensP = between (skipChar '(') (skipChar ')')

bracesP :: CharParser st a -> CharParser st a

bracesP = between (skipChar '{') (skipChar '}')

bracketsP :: CharParser st a -> CharParser st a

bracketsP = between (skipChar '[') (skipChar ']')

commaP :: CharParser st ()

commaP = skipChar ',' >> return ()

sepByComma :: CharParser st a -> CharParser st [a]

sepByComma p = sepBy1 p commaP

-- | parse character case insensitive

ichar :: Char -> CharParser st Char

ichar c = char (toUpper c) <|> char (toLower c) <?> show [c]

-- | parse string case insensitive

istring :: String -> CharParser st String

istring s = case s of

[] -> return ""

c : r -> ichar c <:> istring r

-- | plain string parser with skip

pkeyword :: String -> CharParser st ()

pkeyword s = keywordNotFollowedBy s (alphaNum <|> char '/') >> return ()

keywordNotFollowedBy :: String -> CharParser st Char -> CharParser st String

keywordNotFollowedBy s c = skips $ try $ istring s << notFollowedBy c

-- | keyword not followed by any alphanum

keyword :: String -> CharParser st String

keyword s = keywordNotFollowedBy s alphaNum

-- base OWLClass excluded

atomic :: CharParser st ClassExpression

atomic = parensP description

<|> fmap ObjectOneOf (bracesP $ sepByComma individual)

objectPropertyExpr :: CharParser st ObjectPropertyExpression

objectPropertyExpr = do

keyword inverseS

fmap ObjectInverseOf objectPropertyExpr

<|> fmap ObjectProp uriP

-- creating the facet-value pairs

facetValuePair :: CharParser st (ConstrainingFacet, RestrictionValue)

facetValuePair = do

df <- choice $ map (\ f -> keyword (showFacet f) >> return f)

[ LENGTH

, MINLENGTH

, MAXLENGTH

, PATTERN

, TOTALDIGITS

, FRACTIONDIGITS ] ++ map

(\ f -> keywordNotFollowedBy (showFacet f) (oneOf "<>=")

>> return f)

[ MININCLUSIVE

, MINEXCLUSIVE

, MAXINCLUSIVE

, MAXEXCLUSIVE ]

rv <- literal

return (facetToIRI df, rv)

facetToIRI :: DatatypeFacet -> ConstrainingFacet

facetToIRI = makeCF . showFacet

makeCF :: String -> ConstrainingFacet

makeCF lp = (mkQName lp) { namePrefix = "xsd"}

-- it returns DataType Datatype or DatatypeRestriction Datatype [facetValuePair]

dataRangeRestriction :: CharParser st DataRange

dataRangeRestriction = do

e <- datatypeUri

option (DataType e []) $ fmap (DataType e) $ bracketsP

$ sepByComma facetValuePair

dataConjunct :: CharParser st DataRange

dataConjunct = fmap (mkDataJunction IntersectionOf) $ sepBy1 dataPrimary $ keyword andS

dataRange :: CharParser st DataRange

dataRange = fmap (mkDataJunction UnionOf) $ sepBy1 dataConjunct $ keyword orS

dataPrimary :: CharParser st DataRange

dataPrimary = do

keyword notS

fmap DataComplementOf dataPrimary

<|> fmap DataOneOf (bracesP $ sepByComma literal)

<|> dataRangeRestriction

mkDataJunction :: JunctionType -> [DataRange] -> DataRange

mkDataJunction ty ds = case nubOrd ds of

[] -> error "mkObjectJunction"

[x] -> x

ns -> DataJunction ty ns

--the input must be "some" or "only" in order for the parsing to succeed

someOrOnly :: CharParser st QuantifierType

someOrOnly = choice

$ map (\ f -> keyword (showQuantifierType f) >> return f)

[AllValuesFrom, SomeValuesFrom]

-- locates the keywords "min" "max" "exact" and their argument

card :: CharParser st (CardinalityType, Int)

card = do

c <- choice $ map (\ f -> keywordNotFollowedBy (showCardinalityType f) letter

>> return f)

[MinCardinality, MaxCardinality, ExactCardinality]

n <- skips getNumber

return (c, value 10 n)

-- tries to parse either a QName or a literal

individualOrConstant :: CharParser st (Either Individual Literal)

individualOrConstant = fmap Right literal <|> fmap Left individual

-- applies the previous one to a list separated by commas (the list needs to be all of the same type, of course)

individualOrConstantList :: CharParser st (Either [Individual] [Literal])

individualOrConstantList = do

ioc <- individualOrConstant

case ioc of

Left u -> fmap (Left . (u :)) $ optionL

$ commaP >> sepByComma individual

Right c -> fmap (Right . (c :)) $ optionL

$ commaP >> sepByComma literal

primaryOrDataRange :: CharParser st (Either ClassExpression DataRange)

primaryOrDataRange = do

ns <- many $ keyword notS -- allows multiple not before primary

ed <- do

u <- datatypeUri

fmap Left (restrictionAny $ ObjectProp u)

<|> fmap (Right . DataType u)

(bracketsP $ sepByComma facetValuePair)

<|> return (if elem (localPart u) datatypeKeys

&& elem (namePrefix u) ["", "xsd"]

then Right $ DataType u []

else Left $ Expression u) -- could still be a datatypeUri

<|> do

e <- bracesP individualOrConstantList

return $ case e of

Left us -> Left $ ObjectOneOf us

Right cs -> Right $ DataOneOf cs

<|> fmap Left restrictionOrAtomic

return $ if even (length ns) then ed else

case ed of

Left d -> Left $ ObjectComplementOf d

Right d -> Right $ DataComplementOf d

mkObjectJunction :: JunctionType -> [ClassExpression] -> ClassExpression

mkObjectJunction ty ds = case nubOrd ds of

[] -> error "mkObjectJunction"

[x] -> x

ns -> ObjectJunction ty ns

restrictionAny :: ObjectPropertyExpression -> CharParser st ClassExpression

restrictionAny opExpr = do

keyword valueS

e <- individualOrConstant

case e of

Left u -> return $ ObjectHasValue opExpr u

Right c -> case opExpr of

ObjectProp dpExpr -> return $ DataHasValue dpExpr c

_ -> unexpected "literal"

<|> do

keyword selfS

return $ ObjectHasSelf opExpr

<|> do -- sugar

keyword onlysomeS

ds <- bracketsP $ sepByComma description

let as = map (ObjectValuesFrom SomeValuesFrom opExpr) ds

o = ObjectValuesFrom AllValuesFrom opExpr

$ mkObjectJunction UnionOf ds

return $ mkObjectJunction IntersectionOf $ o : as

<|> do -- sugar

keyword hasS

iu <- individual

return $ ObjectValuesFrom SomeValuesFrom opExpr $ ObjectOneOf [iu]

<|> do

v <- someOrOnly

pr <- primaryOrDataRange

case pr of

Left p -> return $ ObjectValuesFrom v opExpr p

Right r -> case opExpr of

ObjectProp dpExpr -> return $ DataValuesFrom v dpExpr [] r

_ -> unexpected $ "dataRange after " ++ showQuantifierType v

<|> do

(c, n) <- card

mp <- optionMaybe primaryOrDataRange

case mp of

Nothing -> return $ ObjectCardinality $ Cardinality c n opExpr Nothing

Just pr -> case pr of

Left p ->

return $ ObjectCardinality $ Cardinality c n opExpr $ Just p

Right r -> case opExpr of

ObjectProp dpExpr ->

return $ DataCardinality $ Cardinality c n dpExpr $ Just r

_ -> unexpected $ "dataRange after " ++ showCardinalityType c

restriction :: CharParser st ClassExpression

restriction = objectPropertyExpr >>= restrictionAny

restrictionOrAtomic :: CharParser st ClassExpression

restrictionOrAtomic = do

opExpr <- objectPropertyExpr

restrictionAny opExpr <|> case opExpr of

ObjectProp euri -> return $ Expression euri

_ -> unexpected "inverse object property"

<|> atomic

optNot :: (a -> a) -> CharParser st a -> CharParser st a

optNot f p = (keyword notS >> fmap f p) <|> p

primary :: CharParser st ClassExpression

primary = optNot ObjectComplementOf restrictionOrAtomic

conjunction :: CharParser st ClassExpression

conjunction = do

curi <- fmap Expression $ try (owlClassUri << keyword thatS)

rs <- sepBy1 (optNot ObjectComplementOf restriction) $ keyword andS

return $ mkObjectJunction IntersectionOf $ curi : rs

<|> fmap (mkObjectJunction IntersectionOf)

(sepBy1 primary $ keyword andS)

description :: CharParser st ClassExpression

description =

fmap (mkObjectJunction UnionOf) $ sepBy1 conjunction $ keyword orS

entityType :: CharParser st EntityType

entityType = choice $ map (\ f -> keyword (show f) >> return f)

entityTypes

-- same as annotation Target in Manchester Syntax, named annotation Value in Abstract Syntax

annotationValue :: CharParser st AnnotationValue

annotationValue = do

i <- individual

return $ AnnValue i

<|> do

l <- literal

return $ AnnValLit l

equivOrDisjointL :: [EquivOrDisjoint]

equivOrDisjointL = [Equivalent, Disjoint]

equivOrDisjoint :: CharParser st EquivOrDisjoint

equivOrDisjoint = choice

$ map (\ f -> pkeyword (showEquivOrDisjoint f) >> return f)

equivOrDisjointL

subPropertyKey :: CharParser st ()

subPropertyKey = pkeyword subPropertyOfC

characterKey :: CharParser st ()

characterKey = pkeyword characteristicsC

sameOrDifferent :: CharParser st SameOrDifferent

sameOrDifferent = choice

$ map (\ f -> pkeyword (showSameOrDifferent f) >> return f)

[Same, Different]

equivOrDisjointKeyword :: String -> CharParser st EquivOrDisjoint

equivOrDisjointKeyword ext = choice

$ map (\ f -> pkeyword (show f ++ ext) >> return f)

equivOrDisjointL

sameOrDifferentIndu :: CharParser st SameOrDifferent

sameOrDifferentIndu =

(pkeyword sameIndividualC >> return Same)

<|> (pkeyword differentIndividualsC >> return Different)

<|> (pkeyword individualsC >> return Individuals)

objectPropertyCharacter :: CharParser st Character

objectPropertyCharacter =

choice $ map (\ f -> keyword (show f) >> return f) characters

domainOrRange :: CharParser st DomainOrRange

domainOrRange = choice

$ map (\ f -> pkeyword (showDomainOrRange f) >> return f)

[ADomain, ARange]

nsEntry :: CharParser st (String, QName)

nsEntry = do

pkeyword prefixC

p <- skips (option "" prefix << char ':')

i <- skips fullIri

return (p, i)

<|> do

pkeyword namespaceC

p <- skips prefix

i <- skips fullIri

return (p, i)

importEntry :: CharParser st QName

importEntry = pkeyword importC >> uriP