{- |

Module : $Header$

Description : Manchester syntax parser for OWL 2

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

License : GPLv2 or higher

Maintainer : Christian.Maeder@dfki.de

Stability : provisional

Portability : portable

Manchester syntax parser for OWL 2

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

adpated from

Manchester syntax parser for OWL 1.1

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

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

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

-}

module OWL.Parse (basicSpec, symbItems, symbMapItems) where

import OWL.AS

import OWL.Keywords

import OWL.ColonKeywords

import Common.Keywords

import Common.Lexer

import Common.Parsec

import Common.AnnoParser (commentLine)

import Common.Token (casl_structured_reserved_words)

import Common.Utils (nubOrd)

import Text.ParserCombinators.Parsec

import Data.Char

import qualified Data.Map as Map

characters :: [Character]

characters = [minBound .. maxBound]

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

owlKeywords :: [String]

owlKeywords = notS : stringS : map show entityTypes

++ map show characters ++ keywords ++ casl_structured_reserved_words

ncNameStart :: Char -> Bool

ncNameStart c = isAlpha c || c == '_'

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

ncNameChar :: Char -> Bool

ncNameChar c = isAlphaNum c || elem c ".+-_\183"

prefix :: CharParser st String

prefix = satisfy ncNameStart <:> many (satisfy ncNameChar)

iunreserved :: Char -> Bool

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

-- maybe lower case hex-digits should be illegal

pctEncoded :: CharParser st String

pctEncoded = char '%' <:> hexDigit <:> single hexDigit

{- comma and parens are removed here

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

subDelims :: Char -> Bool

subDelims c = elem c "!$&'*+;="

iunreservedSubDelims :: String -> CharParser st Char

iunreservedSubDelims cs =

satisfy $ \ c -> iunreserved c || subDelims c || elem c cs

iunreservedPctEncodedSubDelims :: String -> CharParser st String

iunreservedPctEncodedSubDelims cs =

single (iunreservedSubDelims cs) <|> pctEncoded

ipChar :: CharParser st String

ipChar = iunreservedPctEncodedSubDelims ":@"

ifragment :: CharParser st String

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

iquery :: CharParser st String

iquery = ifragment -- ignore iprivate

iregName :: CharParser st String

iregName = flat $ many $ iunreservedPctEncodedSubDelims ""

iuserinfo :: CharParser st String

iuserinfo = flat $ many $ iunreservedPctEncodedSubDelims ":"

-- | parse zero or at most n consecutive arguments

atMost :: Int -> GenParser tok st a -> GenParser tok st [a]

atMost n p = if n <= 0 then return [] else

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

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

atMost1 :: Int -> GenParser tok st a -> GenParser tok st [a]

atMost1 n p = p <:> atMost (n - 1) p

decOctet :: CharParser st String

decOctet = atMost 3 digit

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

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

iPv4Adress :: CharParser st String

iPv4Adress = decOctet <++> string "."

<++> decOctet <++> string "."

<++> decOctet <++> string "."

<++> decOctet

ihost :: CharParser st String

ihost = iregName <|> iPv4Adress -- or ipLiteral

port :: CharParser st String

port = many digit

iauthority :: CharParser st String

iauthority = optionL (try $ iuserinfo <++> string "@") <++> ihost

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

isegment :: CharParser st String

isegment = flat $ many ipChar

isegmentNz :: CharParser st String

isegmentNz = flat $ many1 ipChar

ipathAbempty :: CharParser st String

ipathAbempty = flat $ many (char '/' <:> isegment)

ipathAbsolute :: CharParser st String

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

{- within abbreviated IRIs only ipath-noscheme should be used

that excludes colons via isegment-nz-nc -}

ipathRootless :: CharParser st String

ipathRootless = 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)

stringConstant :: CharParser st Constant

stringConstant = do

s <- stringLit

do

string cTypeS

d <- datatypeUri

return $ Constant s $ Typed d

<|> do

string asP

t <- skips languageTag

return $ Constant s $ Untyped t

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

constant :: CharParser st Constant

constant = do

f <- skips $ try floatingPointLit

return $ Constant f $ Typed $ mkQName floatS

<|> do

d <- skips decimalLit

return $ Constant d $ Typed $ mkQName

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

<|> stringConstant

-- * description

owlClassUri :: CharParser st QName

owlClassUri = uriP

individualUri :: CharParser st QName

individualUri = uriP

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 Description

atomic = parensP description

<|> fmap ObjectOneOf (bracesP $ sepByComma individualUri)

objectPropertyExpr :: CharParser st ObjectPropertyExpression

objectPropertyExpr = do

keyword inverseS

fmap InverseOp objectPropertyExpr

<|> fmap OpURI uriP

facetValuePair :: CharParser st (DatatypeFacet, 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 <- constant

return (df, rv)

dataRangeRestriction :: CharParser st DataRange

dataRangeRestriction = do

d <- fmap DRDatatype datatypeUri

option d $ fmap (DatatypeRestriction d) $ bracketsP

$ sepByComma facetValuePair

dataConjunct :: CharParser st DataRange

dataConjunct = fmap head $ sepBy1 dataPrimary $ keyword andS

dataRange :: CharParser st DataRange

dataRange = fmap head $ sepBy1 dataConjunct $ keyword orS

dataPrimary :: CharParser st DataRange

dataPrimary = do

keyword notS

fmap DataComplementOf dataPrimary

<|> fmap DataOneOf (bracesP $ sepByComma constant)

<|> dataRangeRestriction

someOrOnly :: CharParser st QuantifierType

someOrOnly = choice

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

[AllValuesFrom, SomeValuesFrom]

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)

individualOrConstant :: CharParser st (Either QName Constant)

individualOrConstant = fmap Right constant <|> fmap Left individualUri

individualOrConstantList :: CharParser st (Either [QName] [Constant])

individualOrConstantList = do

ioc <- individualOrConstant

case ioc of

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

$ commaP >> sepByComma individualUri

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

$ commaP >> sepByComma constant

primaryOrDataRange :: CharParser st (Either Description DataRange)

primaryOrDataRange = do

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

ed <- do

u <- datatypeUri

fmap Left (restrictionAny $ OpURI u)

<|> fmap (Right . DatatypeRestriction (DRDatatype u))

(bracketsP $ sepByComma facetValuePair)

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

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

then Right $ DRDatatype u

else Left $ OWLClassDescription 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 -> [Description] -> Description

mkObjectJunction ty ds = case nubOrd ds of

[] -> error "mkObjectJunction"

[x] -> x

ns -> ObjectJunction ty ns

restrictionAny :: ObjectPropertyExpression -> CharParser st Description

restrictionAny opExpr = do

keyword valueS

e <- individualOrConstant

case e of

Left u -> return $ ObjectHasValue opExpr u

Right c -> case opExpr of

OpURI dpExpr -> return $ DataHasValue dpExpr c

_ -> unexpected "constant"

<|> do

keyword selfS

return $ ObjectExistsSelf 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 <- individualUri

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

OpURI 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

OpURI dpExpr ->

return $ DataCardinality $ Cardinality c n dpExpr $ Just r

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

restriction :: CharParser st Description

restriction = objectPropertyExpr >>= restrictionAny

restrictionOrAtomic :: CharParser st Description

restrictionOrAtomic = do

opExpr <- objectPropertyExpr

restrictionAny opExpr <|> case opExpr of

OpURI euri -> return $ OWLClassDescription 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 Description

primary = optNot ObjectComplementOf restrictionOrAtomic

conjunction :: CharParser st Description

conjunction = do

curi <- fmap OWLClassDescription $ 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 Description

description =

fmap (mkObjectJunction UnionOf) $ sepBy1 conjunction $ keyword orS

entityType :: CharParser st EntityType

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

entityTypes

entity :: CharParser st Entity

entity = do

t <- entityType

u <- parensP uriP

return $ Entity t u

annotation :: CharParser st Annotation

annotation = do

a <- uriP

do

c <- constant

return $ ExplicitAnnotation a c

<|> do

e <- entity

return $ Annotation a e

<|> do

individualUri

fail "unsupported individualURI of annotation"

optAnnos :: CharParser st a -> CharParser st ([Annotation], a)

optAnnos p = do

as <- annotations

a <- p

return (as, a)

annotations :: CharParser st [Annotation]

annotations = optionL realAnnotations

realAnnotations :: CharParser st [Annotation]

realAnnotations = do

pkeyword annotationsC

as <- sepByComma $ optAnnos annotation

return $ map snd as -- annoted annotations not supported yet

descriptionAnnotatedList :: CharParser st [([Annotation], Description)]

descriptionAnnotatedList = sepByComma $ optAnnos description

equivOrDisjointL :: [EquivOrDisjoint]

equivOrDisjointL = [Equivalent, Disjoint]

equivOrDisjoint :: CharParser st EquivOrDisjoint

equivOrDisjoint = choice

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

equivOrDisjointL

entityAnnos :: QName -> EntityType -> CharParser st [Axiom]

entityAnnos qn ty = do

as <- realAnnotations

return [PlainAxiom as $ Declaration $ Entity ty qn]

datatypeFrame :: CharParser st [Axiom]

datatypeFrame = do

pkeyword datatypeC

duri <- datatypeUri

as1 <- many realAnnotations

option () $ do

pkeyword equivalentToC

annotations

dataRange

return ()

as2 <- many realAnnotations

return [ PlainAxiom (concat $ as1 ++ as2)

$ Declaration $ Entity Datatype duri ]

classFrameBit :: QName -> CharParser st [Axiom]

classFrameBit curi = let duri = OWLClassDescription curi in

entityAnnos curi Class

<|> do

pkeyword subClassOfC

ds <- descriptionAnnotatedList

return $ map (\ (as, d) -> PlainAxiom as $ SubClassOf duri d) ds

<|> do

e <- equivOrDisjoint

ds <- descriptionAnnotatedList

return [PlainAxiom (concatMap fst ds)

$ EquivOrDisjointClasses e $ duri : map snd ds]

<|> do

pkeyword disjointUnionOfC

as <- annotations

ds <- sepByComma description

return [PlainAxiom as $ DisjointUnion curi ds]

<|> do

pkeyword hasKeyC

annotations

many objectPropertyExpr

return []

classFrame :: CharParser st [Axiom]

classFrame = do

pkeyword classC

curi <- owlClassUri

as <- flat $ many $ classFrameBit curi

return $ if null as

then [PlainAxiom [] $ Declaration $ Entity Class curi]

else as

domainOrRange :: CharParser st ObjDomainOrRange

domainOrRange = choice

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

[ObjDomain, ObjRange]

objectPropertyCharacter :: CharParser st Character

objectPropertyCharacter =

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

objPropExprAList :: CharParser st [([Annotation], ObjectPropertyExpression)]

objPropExprAList = sepByComma $ optAnnos objectPropertyExpr

subPropertyKey :: CharParser st ()

subPropertyKey = pkeyword subPropertyOfC

characterKey :: CharParser st ()

characterKey = pkeyword characteristicsC

objectFrameBit :: QName -> CharParser st [Axiom]

objectFrameBit ouri = let opExp = OpURI ouri in

entityAnnos ouri ObjectProperty

<|> do

r <- domainOrRange

ds <- descriptionAnnotatedList

return $ map (\ (as, d) -> PlainAxiom as

$ ObjectPropertyDomainOrRange r opExp d) ds

<|> do

characterKey

ds <- sepByComma $ optAnnos objectPropertyCharacter

return $ map (\ (as, c) -> PlainAxiom as

$ ObjectPropertyCharacter c opExp) ds

<|> do

subPropertyKey

ds <- objPropExprAList

return $ map (\ (as, s) -> PlainAxiom as

$ SubObjectPropertyOf (OPExpression s) opExp) ds

<|> do

e <- equivOrDisjoint

ds <- objPropExprAList

return [PlainAxiom (concatMap fst ds)

$ EquivOrDisjointObjectProperties e $ opExp : map snd ds]

<|> do

pkeyword inverseOfC

ds <- objPropExprAList

return $ map (\ (as, i) -> PlainAxiom as

$ InverseObjectProperties opExp i) ds

<|> do

pkeyword subPropertyChainC

as <- annotations

os <- sepBy1 objectPropertyExpr (keyword oS)

return [PlainAxiom as

$ SubObjectPropertyOf (SubObjectPropertyChain os) opExp]

objectPropertyFrame :: CharParser st [Axiom]

objectPropertyFrame = do

pkeyword objectPropertyC

ouri <- uriP

as <- flat $ many $ objectFrameBit ouri

return $ if null as

then [PlainAxiom [] $ Declaration $ Entity ObjectProperty ouri]

else as

dataPropExprAList :: CharParser st [([Annotation], DataPropertyExpression)]

dataPropExprAList = sepByComma $ optAnnos uriP

dataFrameBit :: QName -> CharParser st [Axiom]

dataFrameBit duri =

entityAnnos duri DataProperty

<|> do

pkeyword domainC

ds <- descriptionAnnotatedList

return $ map (\ (as, d) -> PlainAxiom as

$ DataPropertyDomainOrRange (DataDomain d) duri) ds

<|> do

pkeyword rangeC

ds <- sepByComma $ optAnnos dataRange

return $ map (\ (as, r) -> PlainAxiom as

$ DataPropertyDomainOrRange (DataRange r) duri) ds

<|> do

characterKey

as <- annotations

keyword functionalS

return [PlainAxiom as $ FunctionalDataProperty duri]

<|> do

subPropertyKey

ds <- dataPropExprAList

return $ map (\ (as, s) -> PlainAxiom as $ SubDataPropertyOf s duri) ds

<|> do

e <- equivOrDisjoint

ds <- dataPropExprAList

return [PlainAxiom (concatMap fst ds)

$ EquivOrDisjointDataProperties e $ duri : map snd ds]

dataPropertyFrame :: CharParser st [Axiom]

dataPropertyFrame = do

pkeyword dataPropertyC

duri <- uriP

as <- flat $ many $ dataFrameBit duri

return $ if null as

then [PlainAxiom [] $ Declaration $ Entity DataProperty duri]

else as

sameOrDifferent :: CharParser st SameOrDifferent

sameOrDifferent = choice

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

[Same, Different]

fact :: QName -> CharParser st PlainAxiom

fact iuri = do

pn <- option Positive $ keyword notS >> return Negative

u <- uriP

do

c <- constant

return $ DataPropertyAssertion $ Assertion u pn iuri c

<|> do

t <- individualUri

return $ ObjectPropertyAssertion $ Assertion (OpURI u) pn iuri t

iFrameBit :: QName -> CharParser st [Axiom]

iFrameBit iuri =

entityAnnos iuri NamedIndividual

<|> do

pkeyword typesC

ds <- descriptionAnnotatedList

return $ map (\ (as, d) -> PlainAxiom as $ ClassAssertion iuri d) ds

<|> do

s <- sameOrDifferent

is <- sepByComma $ optAnnos individualUri

return [PlainAxiom (concatMap fst is)

$ SameOrDifferentIndividual s $ iuri : map snd is]

<|> do

pkeyword factsC

fs <- sepByComma $ optAnnos $ fact iuri

return $ map (uncurry PlainAxiom) fs

individualFrame :: CharParser st [Axiom]

individualFrame = do

pkeyword individualC

iuri <- individualUri

as <- flat $ many $ iFrameBit iuri

return $ if null as

then [PlainAxiom [] $ Declaration $ Entity NamedIndividual iuri]

else as

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)

annotationPropertyFrame :: CharParser st [Axiom]

annotationPropertyFrame = do

pkeyword annotationPropertyC

ap <- uriP

many apBit -- ignore

return [PlainAxiom [] $ Declaration $ Entity AnnotationProperty ap]

apBit :: CharParser st ()

apBit = (realAnnotations >> return ())

<|> do

pkeyword domainC <|> pkeyword rangeC <|> subPropertyKey

sepByComma $ optAnnos uriP

return ()

misc :: CharParser st Axiom

misc = do

e <- equivOrDisjointKeyword classesC

as <- annotations

ds <- sepByComma description

return $ PlainAxiom as $ EquivOrDisjointClasses e ds

<|> do

e <- equivOrDisjointKeyword propertiesC

as <- annotations

es <- sepByComma objectPropertyExpr

-- indistinguishable from dataProperties

return $ PlainAxiom as $ EquivOrDisjointObjectProperties e es

<|> do

s <- sameOrDifferentIndu

as <- annotations

is <- sepByComma individualUri

return $ PlainAxiom as $ SameOrDifferentIndividual s is

frames :: CharParser st [Axiom]

frames = flat $ many $ datatypeFrame <|> classFrame

<|> objectPropertyFrame <|> dataPropertyFrame <|> individualFrame

<|> annotationPropertyFrame <|> single misc

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

basicSpec :: CharParser st OntologyFile

basicSpec = do

nss <- many nsEntry

option () $ pkeyword ontologyC >> uriP >> return ()

many importEntry

many realAnnotations

as <- frames

return emptyOntologyFile

{ ontology = emptyOntology

{ axiomsList = as

, uri = dummyQName }

, namespaces = Map.fromList $

[ ("owl", "http://www.w3.org/2002/07/owl#")

, ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#")

, ("rdfs", "http://www.w3.org/2000/01/rdf-schema#")

, ("xsd", "http://www.w3.org/2001/XMLSchema#")

, ("owl2xml", "http://www.w3.org/2006/12/owl2-xml#") ]

++ map (\ (p, q) -> (p, showQU q)) nss }