2b873214c9ab511bbca437c036371ab664aedaceChristian Maeder{- |

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian MaederModule : $Header$

c63ebf815c8a874525cf18670ad74847f7fc7b26Christian MaederClassExpression : Manchester syntax parser for OWL 2

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

54ed6a6b1a6c7d27fadb39ec5b59d0806c81f7c8Christian MaederLicense : GPLv2 or higher, see LICENSE.txt

75a6279dbae159d018ef812185416cf6df386c10Till Mossakowski

3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de

75a6279dbae159d018ef812185416cf6df386c10Till MossakowskiStability : provisional

75a6279dbae159d018ef812185416cf6df386c10Till MossakowskiPortability : portable

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian Maeder

c092fcac4b8f5c524c22ca579189c4487c13edf7Christian MaederManchester syntax parser for OWL 2

dda5ab793f1615c1ba1dcaa97a4346b0878da6b1Christian Maeder<http://www.w3.org/TR/2009/NOTE-owl2-manchester-syntax-20091027/>

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian Maederadpated from

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian MaederManchester syntax parser for OWL 1.1

da955132262baab309a50fdffe228c9efe68251dCui Jian<http://www.webont.org/owled/2008dc/papers/owled2008dc_paper_11.pdf>

dda5ab793f1615c1ba1dcaa97a4346b0878da6b1Christian Maeder<http://www.faqs.org/rfcs/rfc3987.html>

dda5ab793f1615c1ba1dcaa97a4346b0878da6b1Christian Maeder<http://www.faqs.org/rfcs/rfc4646.html>

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian Maeder-}

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian Maeder

0799b5dc3f06d2640e66e9ab54b8b217348fd719Christian Maedermodule OWL2.Parse where

0799b5dc3f06d2640e66e9ab54b8b217348fd719Christian Maeder

52d922076b89f12234f721974e82531bc69a6f69Christian Maederimport OWL2.AS

52d922076b89f12234f721974e82531bc69a6f69Christian Maederimport OWL2.Symbols

43b4c41fbb07705c9df321221ab9cb9832460407Christian Maederimport OWL.Keywords

4c8d3c5a9e938633f6147b5a595b9b93bfca99e6Christian Maederimport OWL.ColonKeywords

91eeff7b19b22d7e5c5d83fa6e357496e291c718Christian Maeder

fbc4f8708092d571a45cb483f37cc6b674da45a7Christian Maederimport Common.Keywords

fbc4f8708092d571a45cb483f37cc6b674da45a7Christian Maederimport Common.Lexer

fbc4f8708092d571a45cb483f37cc6b674da45a7Christian Maederimport Common.Parsec

31bc219bae758272d0f064281b8ce7740a4553e9Till Mossakowskiimport Common.AnnoParser (commentLine)

b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowskiimport Common.Token (criticalKeywords)

f77f29e84b3f6e791c82e61b13fbf76582bedd2fChristian Maederimport Common.Utils (nubOrd)

dda5ab793f1615c1ba1dcaa97a4346b0878da6b1Christian Maeder

9175e29c044318498a40f323f189f9dfd50378efChristian Maederimport Text.ParserCombinators.Parsec

f77f29e84b3f6e791c82e61b13fbf76582bedd2fChristian Maederimport Data.Char

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian Maeder

c0c2380bced8159ff0297ece14eba948bd236471Christian Maedertype URI = IRI

da333ffa6336cf59a4071fcddad358c5eafd3e61Sonja Gröning

c0c2380bced8159ff0297ece14eba948bd236471Christian Maedercharacters :: [Character]

6352f3c31da3043783a13be6594aacb2147378baRazvan Pascanucharacters = [minBound .. maxBound]

8ef91a173e69219fc2ebd45c76a35891c7785abdMarkus Gross

fc1a590cd3ee36797c0a032ff41e07f8e2469341Christian Maeder-- | OWL and CASL structured keywords including 'andS' and 'notS'

a2b04db3e156312a8596d8084f7f0f51acf8a96bChristian MaederowlKeywords :: [String]

0c885f1348fd58f7cb706472a3ff20b52dbef0a7Jonathan von SchroederowlKeywords = notS : stringS : map show entityTypes

fc1a590cd3ee36797c0a032ff41e07f8e2469341Christian Maeder ++ map show characters ++ keywords ++ criticalKeywords

66a774f13272fde036481edd2298081ab3d04678Razvan Pascanu

834c2e71b8e390e5b05c8d02bb6eb22621125133Markus GrossncNameStart :: Char -> Bool

d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederncNameStart c = isAlpha c || c == '_'

d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder

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

6e52f1dfc0da4bc4a7701cf856641c9dce08fc7dChristian MaederncNameChar :: Char -> Bool

923e25bb8c7cf9f2978c7844ad173704482cc3b0Martin KühlncNameChar c = isAlphaNum c || elem c ".+-_\183"

9f85afecbd79b3df5a0bb17bd28cd0b288dc3213Kristina Sojakova

63da71bfb4226f504944b293fb77177ebcaea7d4Ewaryst Schulzprefix :: CharParser st String

e1ea9a046e9640148ca876dfe47e391559a9fdf3Christian Maederprefix = satisfy ncNameStart <:> many (satisfy ncNameChar)

14c89b2d830777bf4db2850f038c9f60acaca486Christian Maeder

57026bc09337d158b89775048a9bcc9c17d825caChristian Maederiunreserved :: Char -> Bool

57026bc09337d158b89775048a9bcc9c17d825caChristian Maederiunreserved c = isAlphaNum c || elem c "-._~" || ord c >= 160 && ord c <= 55295

57026bc09337d158b89775048a9bcc9c17d825caChristian Maeder

9175e29c044318498a40f323f189f9dfd50378efChristian Maeder-- maybe lower case hex-digits should be illegal

e1ea9a046e9640148ca876dfe47e391559a9fdf3Christian MaederpctEncoded :: CharParser st String

923e25bb8c7cf9f2978c7844ad173704482cc3b0Martin KühlpctEncoded = char '%' <:> hexDigit <:> single hexDigit

f66fcd981f556c238df7dd6dfa42123745e3b1d2Christian Maeder

2b873214c9ab511bbca437c036371ab664aedaceChristian Maeder{- comma and parens are removed here

52d922076b89f12234f721974e82531bc69a6f69Christian Maeder but would cause no problems for full IRIs within angle brackets -}

fe495a0978e5aa70776103c37fb0eb2bd6abea69Eugen KuksasubDelims :: Char -> Bool

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

d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder

d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederiunreservedSubDelims :: String -> CharParser st Char

52d922076b89f12234f721974e82531bc69a6f69Christian MaederiunreservedSubDelims cs =

8ef91a173e69219fc2ebd45c76a35891c7785abdMarkus Gross satisfy $ \ c -> iunreserved c || subDelims c || elem c cs

8ef91a173e69219fc2ebd45c76a35891c7785abdMarkus Gross

9175e29c044318498a40f323f189f9dfd50378efChristian MaederiunreservedPctEncodedSubDelims :: String -> CharParser st String

31bc219bae758272d0f064281b8ce7740a4553e9Till MossakowskiiunreservedPctEncodedSubDelims cs =

31bc219bae758272d0f064281b8ce7740a4553e9Till Mossakowski single (iunreservedSubDelims cs) <|> pctEncoded

31bc219bae758272d0f064281b8ce7740a4553e9Till Mossakowski

31bc219bae758272d0f064281b8ce7740a4553e9Till MossakowskiipChar :: CharParser st String

a31430de8b0632d29f42634d6395e982bf31b14dChristian MaederipChar = iunreservedPctEncodedSubDelims ":@"

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maeder

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maederifragment :: CharParser st String

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maederifragment = flat $ many (ipChar <|> single (char '/' <|> char '?'))

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maeder

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maederiquery :: CharParser st String

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maederiquery = ifragment -- ignore iprivate

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maeder

a31430de8b0632d29f42634d6395e982bf31b14dChristian MaederiregName :: CharParser st String

a31430de8b0632d29f42634d6395e982bf31b14dChristian MaederiregName = flat $ many $ iunreservedPctEncodedSubDelims ""

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maeder

a31430de8b0632d29f42634d6395e982bf31b14dChristian Maederiuserinfo :: CharParser st String

9175e29c044318498a40f323f189f9dfd50378efChristian Maederiuserinfo = flat $ many $ iunreservedPctEncodedSubDelims ":"

9175e29c044318498a40f323f189f9dfd50378efChristian Maeder

9175e29c044318498a40f323f189f9dfd50378efChristian Maeder-- | parse zero or at most n consecutive arguments

9175e29c044318498a40f323f189f9dfd50378efChristian MaederatMost :: Int -> GenParser tok st a -> GenParser tok st [a]

9175e29c044318498a40f323f189f9dfd50378efChristian MaederatMost n p = if n <= 0 then return [] else

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

ee1c7c5796832536932d7b06cbfb1ca13f9a0d7bMartin Kühl

f63e7684d8db7503c22e5d8d499c94a9405f8f9eChristian Maeder-- | parse at least one but at most n conse

91eeff7b19b22d7e5c5d83fa6e357496e291c718Christian MaederatMost1 :: Int -> GenParser tok st a -> GenParser tok st [a]

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

f63e7684d8db7503c22e5d8d499c94a9405f8f9eChristian Maeder

a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederdecOctet :: CharParser st String

c0c2380bced8159ff0297ece14eba948bd236471Christian MaederdecOctet = atMost 3 digit

bdc103981a28a51938de98a956d8a3767f6cf43dAivaras Jakubauskas `checkWith` \ s -> let v = value 10 s in v <= 255 &&

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

e1ea9a046e9640148ca876dfe47e391559a9fdf3Christian Maeder

e1ea9a046e9640148ca876dfe47e391559a9fdf3Christian MaederiPv4Adress :: CharParser st String

57026bc09337d158b89775048a9bcc9c17d825caChristian MaederiPv4Adress = decOctet <++> string "."

57026bc09337d158b89775048a9bcc9c17d825caChristian Maeder <++> decOctet <++> string "."

22b772f8753f0cdb4508ba460356c238de2ee375Jonathan von Schroeder <++> decOctet <++> string "."

7bbfb15142ab4286dfc6fcde2fc94a5512297e41Jonathan von Schroeder <++> decOctet

fa388aea9cef5f9734fec346159899a74432ce26Christian Maeder

63719301448519453f66383f4e583d9fd5b89ecbChristian Maederihost :: CharParser st String

a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maederihost = iregName <|> iPv4Adress -- or ipLiteral

0c885f1348fd58f7cb706472a3ff20b52dbef0a7Jonathan von Schroeder

52d922076b89f12234f721974e82531bc69a6f69Christian Maederport :: CharParser st String

52d922076b89f12234f721974e82531bc69a6f69Christian Maederport = many digit

923e25bb8c7cf9f2978c7844ad173704482cc3b0Martin Kühl

9f85afecbd79b3df5a0bb17bd28cd0b288dc3213Kristina Sojakovaiauthority :: CharParser st String

72079df98b3cb7cc1fd82a0a24984893dcd05ecaEwaryst Schulziauthority = optionL (try $ iuserinfo <++> string "@") <++> ihost

a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder <++> optionL (char ':' <:> port)

fbc4f8708092d571a45cb483f37cc6b674da45a7Christian Maeder

8a77240a809197c92c0736c431b4b88947a7bac1Christian Maederisegment :: CharParser st String

8a77240a809197c92c0736c431b4b88947a7bac1Christian Maederisegment = flat $ many ipChar

1c4dfa148603d4fcf4cdd2ed66c8b6e1de0dd696Till Mossakowski

bb63f684c4f5f33ffcd1dcc02c58d6a703900fafJonathan von SchroederisegmentNz :: CharParser st String

b0234f0a84fcd3587073fbc11d38759108997c3cChristian MaederisegmentNz = flat $ many1 ipChar

b0234f0a84fcd3587073fbc11d38759108997c3cChristian Maeder

8ef91a173e69219fc2ebd45c76a35891c7785abdMarkus GrossipathAbempty :: CharParser st String

8ef91a173e69219fc2ebd45c76a35891c7785abdMarkus GrossipathAbempty = flat $ many (char '/' <:> isegment)

d56ece59c372cb887355825901222b9f3377f7e6Thiemo Wiedemeyer

d56ece59c372cb887355825901222b9f3377f7e6Thiemo WiedemeyeripathAbsolute :: CharParser st String

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

9175e29c044318498a40f323f189f9dfd50378efChristian Maeder

9175e29c044318498a40f323f189f9dfd50378efChristian Maeder{- within abbreviated IRIs only ipath-noscheme should be used

f1dec6898638ba1131a9fadbc4d1544c93dfabb0Klaus Luettich that excludes colons via isegment-nz-nc -}

9175e29c044318498a40f323f189f9dfd50378efChristian MaederipathRootless :: CharParser st String

f77f29e84b3f6e791c82e61b13fbf76582bedd2fChristian MaederipathRootless = isegmentNz <++> ipathAbempty

iauthorityWithPath :: CharParser st String

iauthorityWithPath = tryString "//" <++> iauthority <++> ipathAbempty

optQueryOrFrag :: CharParser st String

optQueryOrFrag = optionL (char '?' <:> iquery)

<++> optionL (char '#' <:> ifragment)

-- | covers irelative-part (therefore we omit curie)

ihierPart :: CharParser st String

ihierPart =

iauthorityWithPath <|> ipathAbsolute <|> ipathRootless

hierPartWithOpts :: CharParser st String

hierPartWithOpts = ihierPart <++> optQueryOrFrag

skips :: CharParser st a -> CharParser st a

skips = (<< skipMany

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

abbrIri :: CharParser st QName

abbrIri = try $ do

pre <- try $ prefix << char ':'

r <- hierPartWithOpts

return $ QN pre r False ""

<|> fmap mkQName hierPartWithOpts

fullIri :: CharParser st QName

fullIri = do

char '<'

QN pre r _ _ <- abbrIri

char '>'

return $ QN pre r True ""

uriQ :: CharParser st QName

uriQ = 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 <- uriP

rv <- literal

return (df, rv)

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

dataRangeRestriction :: CharParser st DataRange

dataRangeRestriction = do

e <- datatypeUri

option (DataType e) $ fmap (DatatypeRestriction 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 . DatatypeRestriction 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

annotation :: CharParser st Annotation

annotation = do

ap <- uriP

av <- annotationValue

return $ Annotation [] ap av

optAnnos2 :: CharParser st Annotation

optAnnos2 = do

as <- annotationList

Annotation _ ap av <- annotation

return $ Annotation as ap av

annotationList :: CharParser st [Annotation]

annotationList = optionL realAnnotations

realAnnotations :: CharParser st [Annotation]

realAnnotations = do

pkeyword annotationsC

sepByComma $ optAnnos2

equivOrDisjointL :: [EquivOrDisjoint]

equivOrDisjointL = [Equivalent, Disjoint]

equivOrDisjoint :: CharParser st EquivOrDisjoint

equivOrDisjoint = choice

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

equivOrDisjointL

domainOrRange :: CharParser st ObjDomainOrRange

domainOrRange = choice

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

[ObjDomain, ObjRange]

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

-- note the plural when different

sameOrDifferentIndu :: CharParser st SameOrDifferent

sameOrDifferentIndu =

(pkeyword sameIndividualC >> return Same)

<|> (pkeyword differentIndividualsC >> return Different)

<|> (pkeyword individualsC >> return Individuals)

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