dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina{- |

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaModule : $Header$

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaCopyright : (c) Felix Gabriel Mance

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaLicense : GPLv2 or higher, see LICENSE.txt

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaMaintainer : f.mance@jacobs-university.de

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaStability : provisional

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaPortability : portable

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaOWL/XML Syntax Parsing

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinamodule OWL2.XML where

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport Common.Lexer

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport OWL2.AS

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport OWL2.Extract

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport OWL2.Keywords

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport OWL2.MS

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport OWL2.XMLKeywords

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport Text.XML.Light

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březinaimport Data.Maybe

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březinaimport Data.List

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaimport qualified Data.Map as Map

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinatype XMLBase = String

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | error messages for the parser

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaerr :: String -> t

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaerr s = error $ "XML parser: " ++ s

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina{- two functions from Text.XML.Light.Proc version 1.3.7 for compatibility

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina with previous versions -}

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinavLookupAttrBy :: (Text.XML.Light.QName -> Bool) -> [Attr] -> Maybe String

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinavLookupAttrBy p as = attrVal `fmap` find (p . attrKey) as

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinavFindAttrBy :: (Text.XML.Light.QName -> Bool) -> Element -> Maybe String

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinavFindAttrBy p e = vLookupAttrBy p (elAttribs e)

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaisSmth :: String -> Text.XML.Light.QName -> Bool

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaisSmth s = (s ==) . qName

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaisSmthList :: [String] -> Text.XML.Light.QName -> Bool

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaisSmthList l qn = qName qn `elem` l

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinaisNotSmth :: Text.XML.Light.QName -> Bool

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaisNotSmth q = let qn = qName q in qn `notElem` [declarationK,

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina prefixK, importK, annotationK]

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | parses all children with the given name

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterCh :: String -> Element -> [Element]

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterCh s = filterChildrenName (isSmth s)

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | parses all children with names in the list

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterChL :: [String] -> Element -> [Element]

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterChL l = filterChildrenName (isSmthList l)

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | parses one child with the given name

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterC :: String -> Element -> Element

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterC s e = fromMaybe (err "child not found")

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina $ filterChildName (isSmth s) e

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | parses one child with the name in the list

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterCL :: [String] -> Element -> Element

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinafilterCL l e = fromMaybe (err "child not found")

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina $ filterChildName (isSmthList l) e

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | parses an IRI

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetIRI :: XMLBase -> Element -> IRI

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinagetIRI b e =

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina let [a] = elAttribs e

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina iri = attrVal a

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina ty = case qName $ attrKey a of

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina "abbreviatedIRI" -> Abbreviated

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina "IRI" -> Full

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina "nodeID" -> NodeID

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina _ -> cssIRI iri

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina in appendBase b $ nullQName {localPart = iri, iriType = ty}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina{- | if the IRI contains colon, it is split there;

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaelse, the xml:base needs to be prepended to the local part

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březinaand then the IRI must be splitted -}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaappendBase :: XMLBase -> IRI -> IRI

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaappendBase b qn =

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina let r = localPart qn

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina in splitIRI $ if ':' `elem` r

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina then qn

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina else qn {localPart = b ++ r, iriType = Full}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | splits an IRI at the colon

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinasplitIRI :: IRI -> IRI

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinasplitIRI qn = case iriType qn of

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina NodeID -> mkNodeID qn

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina _ -> let lp = localPart qn

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina np = takeWhile (/= ':') lp

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina ':' : nlp = dropWhile (/= ':') lp

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina in qn {namePrefix = np, localPart = nlp}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | prepends "_:" to the nodeID if is not there already

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinamkNodeID :: IRI -> IRI

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinamkNodeID qn =

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina let lp = localPart qn

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina in case lp of

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina '_' : ':' : _ -> qn

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina _ -> qn {localPart = "_:" ++ lp}

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | gets the content of an element with name IRI, AbbreviatedIRI or Import

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinacontentIRI :: XMLBase -> Element -> IRI

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinacontentIRI b e =

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina let cont = strContent e

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina iri = nullQName {localPart = cont}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina in case getName e of

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina "AbbreviatedIRI" -> splitIRI iri

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina "IRI" -> if ':' `elem` cont

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina then splitIRI $ iri {iriType = Full}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina else appendBase b iri

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina "Import" -> appendBase b $ iri {iriType = cssIRI cont}

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina _ -> err "invalid type of iri"

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina-- | gets the name of an axiom in XML Syntax

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetName :: Element -> String

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetName e =

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina let n = (qName . elName) e

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina q = (qURI . elName) e

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina in case q of

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Just "http://www.w3.org/2002/07/owl#" -> n

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina _ -> ""

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina-- | gets the cardinality

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinagetInt :: Element -> Int

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinagetInt e = let [int] = elAttribs e in value 10 $ attrVal int

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetEntityType :: String -> EntityType

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinagetEntityType ty = fromMaybe (err $ "no entity type " ++ ty)

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina . lookup ty $ map (\ e -> (show e, e)) entityTypes

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinagetEntity :: XMLBase -> Element -> Entity

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetEntity b e = Entity (getEntityType $ (qName . elName) e) $ getIRI b e

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetDeclaration :: XMLBase -> Element -> Axiom

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinagetDeclaration b e = case getName e of

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina "Declaration" ->

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina PlainAxiom (mkExtendedEntity $ getEntity b $ filterCL entityList e)

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina $ AnnFrameBit (getAllAnnos b e) $ AnnotationFrameBit Declaration

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina _ -> err "not declaration"

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinaisPlainLiteral :: String -> Bool

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinaisPlainLiteral s =

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina "http://www.w3.org/1999/02/22-rdf-syntax-ns#PlainLiteral" == s

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina-- | put an "f" for float if not there already (eg. 123.45 --> 123.45f)

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinacorrectLit :: Literal -> Literal

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel BřezinacorrectLit l = case l of

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Literal lf (Typed dt) ->

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina let nlf = if isSuffixOf "float" (localPart dt) && last lf /= 'f'

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina then lf ++ "f"

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina else lf

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina in Literal nlf (Typed dt)

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina _ -> l

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetLiteral :: XMLBase -> Element -> Literal

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel BřezinagetLiteral b e = case getName e of

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina "Literal" ->

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina let lf = strContent e

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina mdt = findAttr (unqual "datatypeIRI") e

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina mattr = vFindAttrBy (isSmth "lang") e

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina in case mdt of

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Nothing -> case mattr of

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Just lang -> Literal lf $ Untyped $ Just lang

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Nothing -> Literal lf $ Untyped Nothing

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Just dt -> case mattr of

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Just lang -> Literal lf $ Untyped $ Just lang

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Nothing -> if isPlainLiteral dt then

e07d700ed9daf0cf96607fa2d72978cb2431b794Pavel Březina Literal lf $ Untyped Nothing

dea636af4d1902a081ee891f1b19ee2f8729d759Pavel Březina else correctLit $ Literal lf $ Typed $ appendBase b $

nullQName {localPart = dt, iriType = cssIRI dt}

_ -> err "not literal"

getValue :: XMLBase -> Element -> AnnotationValue

getValue b e = case getName e of

"Literal" -> AnnValLit $ getLiteral b e

"AnonymousIndividual" -> AnnValue $ getIRI b e

_ -> AnnValue $ contentIRI b e

getSubject :: XMLBase -> Element -> IRI

getSubject b e = case getName e of

"AnonymousIndividual" -> getIRI b e

_ -> contentIRI b e

getAnnotation :: XMLBase -> Element -> Annotation

getAnnotation b e =

let hd = filterCh "Annotation" e

[ap] = filterCh "AnnotationProperty" e

av = filterCL annotationValueList e

in Annotation (map (getAnnotation b) hd) (getIRI b ap) $ getValue b av

-- | returns a list of annotations

getAllAnnos :: XMLBase -> Element -> [Annotation]

getAllAnnos b e = map (getAnnotation b) $ filterCh "Annotation" e

getObjProp :: XMLBase -> Element -> ObjectPropertyExpression

getObjProp b e = case getName e of

"ObjectProperty" -> ObjectProp $ getIRI b e

"ObjectInverseOf" ->

let [ch] = elChildren e

[cch] = elChildren ch

in case getName ch of

"ObjectInverseOf" -> getObjProp b cch

"ObjectProperty" -> ObjectInverseOf $ ObjectProp $ getIRI b ch

_ -> err "not objectProperty"

_ -> err "not objectProperty"

-- | replaces eg. "minExclusive" with ">"

properFacet :: ConstrainingFacet -> ConstrainingFacet

properFacet cf

| iriType cf == Full =

let p = showQU cf \\ "http://www.w3.org/2001/XMLSchema#"

in case p of

"minInclusive" -> facetToIRI MININCLUSIVE

"minExclusive" -> facetToIRI MINEXCLUSIVE

"maxInclusive" -> facetToIRI MAXINCLUSIVE

"maxExclusive" -> facetToIRI MAXEXCLUSIVE

_ -> cf

| otherwise = cf

getFacetValuePair :: XMLBase -> Element -> (ConstrainingFacet, RestrictionValue)

getFacetValuePair b e = case getName e of

"FacetRestriction" ->

let [ch] = elChildren e

in (properFacet $ getIRI b e, getLiteral b ch)

_ -> err "not facet"

getDataRange :: XMLBase -> Element -> DataRange

getDataRange b e =

let ch@(ch1 : _) = elChildren e

in case getName e of

"Datatype" -> DataType (getIRI b e) []

"DatatypeRestriction" ->

let dt = getIRI b $ filterC "Datatype" e

fvp = map (getFacetValuePair b) $ filterCh "FacetRestriction" e

in DataType dt fvp

"DataComplementOf" -> DataComplementOf $ getDataRange b ch1

"DataOneOf" -> DataOneOf $ map (getLiteral b) $ filterCh "Literal" e

"DataIntersectionOf" -> DataJunction IntersectionOf

$ map (getDataRange b) ch

"DataUnionOf" -> DataJunction UnionOf $ map (getDataRange b) ch

_ -> err "not data range"

getClassExpression :: XMLBase -> Element -> ClassExpression

getClassExpression b e =

let ch@(ch1 : _) = elChildren e

rch1 : _ = reverse ch

in case getName e of

"Class" -> Expression $ getIRI b e

"ObjectIntersectionOf" -> ObjectJunction IntersectionOf

$ map (getClassExpression b) ch

"ObjectUnionOf" -> ObjectJunction UnionOf $ map (getClassExpression b) ch

"ObjectComplementOf" -> ObjectComplementOf $ getClassExpression b ch1

"ObjectOneOf" -> ObjectOneOf $ map (getIRI b) ch

"ObjectSomeValuesFrom" -> ObjectValuesFrom SomeValuesFrom

(getObjProp b ch1) $ getClassExpression b rch1

"ObjectAllValuesFrom" -> ObjectValuesFrom AllValuesFrom

(getObjProp b ch1) $ getClassExpression b rch1

"ObjectHasValue" -> ObjectHasValue (getObjProp b ch1) $ getIRI b rch1

"ObjectHasSelf" -> ObjectHasSelf $ getObjProp b ch1

"DataSomeValuesFrom" -> DataValuesFrom SomeValuesFrom (getIRI b ch1)

$ getDataRange b rch1

"DataAllValuesFrom" -> DataValuesFrom AllValuesFrom (getIRI b ch1)

$ getDataRange b rch1

"DataHasValue" -> DataHasValue (getIRI b ch1) $ getLiteral b rch1

_ -> getObjCard b e ch rch1

getObjCard :: XMLBase -> Element -> [Element] -> Element -> ClassExpression

getObjCard b e ch rch1 =

let ch1 : _ = ch

i = getInt e

op = getObjProp b ch1

ce = if length ch == 2

then Just $ getClassExpression b rch1

else Nothing

in case getName e of

"ObjectMinCardinality" -> ObjectCardinality $ Cardinality

MinCardinality i op ce

"ObjectMaxCardinality" -> ObjectCardinality $ Cardinality

MaxCardinality i op ce

"ObjectExactCardinality" -> ObjectCardinality $ Cardinality

ExactCardinality i op ce

_ -> getDataCard b e ch rch1

getDataCard :: XMLBase -> Element -> [Element] -> Element -> ClassExpression

getDataCard b e ch rch1 =

let ch1 : _ = ch

i = getInt e

dp = getIRI b ch1

dr = if length ch == 2

then Just $ getDataRange b rch1

else Nothing

in case getName e of

"DataMinCardinality" -> DataCardinality $ Cardinality

MinCardinality i dp dr

"DataMaxCardinality" -> DataCardinality $ Cardinality

MaxCardinality i dp dr

"DataExactCardinality" -> DataCardinality $ Cardinality

ExactCardinality i dp dr

_ -> err "not class expression"

getClassAxiom :: XMLBase -> Element -> Axiom

getClassAxiom b e =

let ch = elChildren e

as = getAllAnnos b e

l@(hd : tl) = filterChL classExpressionList e

[dhd, dtl] = filterChL dataRangeList e

cel = map (getClassExpression b) l

in case getName e of

"SubClassOf" ->

let [sub, super] = drop (length ch - 2) ch

in PlainAxiom (ClassEntity $ getClassExpression b sub)

$ ListFrameBit (Just SubClass) $ ExpressionBit

[(as, getClassExpression b super)]

"EquivalentClasses" -> PlainAxiom (Misc as) $ ListFrameBit

(Just $ EDRelation Equivalent) $ ExpressionBit $ emptyAnnoList cel

"DisjointClasses" -> PlainAxiom (Misc as) $ ListFrameBit

(Just $ EDRelation Disjoint) $ ExpressionBit $ emptyAnnoList cel

"DisjointUnion" -> PlainAxiom (ClassEntity $ getClassExpression b hd)

$ AnnFrameBit as $ ClassDisjointUnion $ map (getClassExpression b) tl

"DatatypeDefinition" ->

PlainAxiom (SimpleEntity $ Entity Datatype $ getIRI b dhd)

$ AnnFrameBit as $ DatatypeBit $ getDataRange b dtl

_ -> getKey b e

getKey :: XMLBase -> Element -> Axiom

getKey b e = case getName e of

"HasKey" ->

let as = getAllAnnos b e

[ce] = filterChL classExpressionList e

op = map (getObjProp b) $ filterChL objectPropList e

dp = map (getIRI b) $ filterChL dataPropList e

in PlainAxiom (ClassEntity $ getClassExpression b ce)

$ AnnFrameBit as $ ClassHasKey op dp

_ -> getOPAxiom b e

getOPAxiom :: XMLBase -> Element -> Axiom

getOPAxiom b e =

let as = getAllAnnos b e

op = getObjProp b $ filterCL objectPropList e

in case getName e of

"SubObjectPropertyOf" ->

let opchain = concatMap (map $ getObjProp b) $ map elChildren

$ filterCh "ObjectPropertyChain" e

in if null opchain

then let [o1, o2] = map (getObjProp b) $ filterChL objectPropList e

in PlainAxiom (ObjectEntity o1) $ ListFrameBit

(Just SubPropertyOf) $ ObjectBit [(as, o2)]

else PlainAxiom (ObjectEntity op) $ AnnFrameBit as

$ ObjectSubPropertyChain opchain

"EquivalentObjectProperties" ->

let opl = map (getObjProp b) $ filterChL objectPropList e

in PlainAxiom (Misc as) $ ListFrameBit (Just $ EDRelation Equivalent)

$ ObjectBit $ emptyAnnoList opl

"DisjointObjectProperties" ->

let opl = map (getObjProp b) $ filterChL objectPropList e

in PlainAxiom (Misc as) $ ListFrameBit (Just $ EDRelation Disjoint)

$ ObjectBit $ emptyAnnoList opl

"ObjectPropertyDomain" ->

let ce = getClassExpression b $ filterCL classExpressionList e

in PlainAxiom (ObjectEntity op) $ ListFrameBit

(Just $ DRRelation ADomain) $ ExpressionBit [(as, ce)]

"ObjectPropertyRange" ->

let ce = getClassExpression b $ filterCL classExpressionList e

in PlainAxiom (ObjectEntity op) $ ListFrameBit

(Just $ DRRelation ARange) $ ExpressionBit [(as, ce)]

"InverseObjectProperties" ->

let [hd, lst] = map (getObjProp b) $ filterChL objectPropList e

in PlainAxiom (ObjectEntity hd) $ ListFrameBit (Just InverseOf)

$ ObjectBit [(as, lst)]

"FunctionalObjectProperty" -> PlainAxiom (ObjectEntity op) $ ListFrameBit

Nothing $ ObjectCharacteristics [(as, Functional)]

"InverseFunctionalObjectProperty" -> PlainAxiom (ObjectEntity op)

$ ListFrameBit Nothing $ ObjectCharacteristics

[(as, InverseFunctional)]

"ReflexiveObjectProperty" -> PlainAxiom (ObjectEntity op) $ ListFrameBit

Nothing $ ObjectCharacteristics [(as, Reflexive)]

"IrreflexiveObjectProperty" -> PlainAxiom (ObjectEntity op) $ ListFrameBit

Nothing $ ObjectCharacteristics [(as, Irreflexive)]

"SymmetricObjectProperty" -> PlainAxiom (ObjectEntity op) $ ListFrameBit

Nothing $ ObjectCharacteristics [(as, Symmetric)]

"AsymmetricObjectProperty" -> PlainAxiom (ObjectEntity op) $ ListFrameBit

Nothing $ ObjectCharacteristics [(as, Asymmetric)]

"AntisymmetricObjectProperty" -> PlainAxiom (ObjectEntity op) $ ListFrameBit

Nothing $ ObjectCharacteristics [(as, Antisymmetric)]

"TransitiveObjectProperty" -> PlainAxiom (ObjectEntity op) $ ListFrameBit

Nothing $ ObjectCharacteristics [(as, Transitive)]

_ -> getDPAxiom b e

getDPAxiom :: XMLBase -> Element -> Axiom

getDPAxiom b e =

let as = getAllAnnos b e

in case getName e of

"SubDataPropertyOf" ->

let [hd, lst] = map (getIRI b) $ filterChL dataPropList e

in PlainAxiom (SimpleEntity $ Entity DataProperty hd)

$ ListFrameBit (Just SubPropertyOf) $ DataBit [(as, lst)]

"EquivalentDataProperties" ->

let dpl = map (getIRI b) $ filterChL dataPropList e

in PlainAxiom (Misc as) $ ListFrameBit (Just $ EDRelation Equivalent)

$ DataBit $ emptyAnnoList dpl

"DisjointDataProperties" ->

let dpl = map (getIRI b) $ filterChL dataPropList e

in PlainAxiom (Misc as) $ ListFrameBit (Just $ EDRelation Disjoint)

$ DataBit $ emptyAnnoList dpl

"DataPropertyDomain" ->

let dp = getIRI b $ filterCL dataPropList e

ce = getClassExpression b $ filterCL classExpressionList e

in PlainAxiom (SimpleEntity $ Entity DataProperty dp) $ ListFrameBit

(Just $ DRRelation ADomain) $ ExpressionBit [(as, ce)]

"DataPropertyRange" ->

let dp = getIRI b $ filterCL dataPropList e

dr = getDataRange b $ filterCL dataRangeList e

in PlainAxiom (SimpleEntity $ Entity DataProperty dp)

$ ListFrameBit Nothing $ DataPropRange [(as, dr)]

"FunctionalDataProperty" ->

let dp = getIRI b $ filterCL dataPropList e

in PlainAxiom (SimpleEntity $ Entity DataProperty dp)

$ AnnFrameBit as DataFunctional

_ -> getDataAssertion b e

getDataAssertion :: XMLBase -> Element -> Axiom

getDataAssertion b e =

let as = getAllAnnos b e

dp = getIRI b $ filterCL dataPropList e

ind = getIRI b $ filterCL individualList e

lit = getLiteral b $ filterC "Literal" e

in case getName e of

"DataPropertyAssertion" ->

PlainAxiom (SimpleEntity $ Entity NamedIndividual ind)

$ ListFrameBit Nothing $ IndividualFacts

[(as, DataPropertyFact Positive dp lit)]

"NegativeDataPropertyAssertion" ->

PlainAxiom (SimpleEntity $ Entity NamedIndividual ind)

$ ListFrameBit Nothing $ IndividualFacts

[(as, DataPropertyFact Negative dp lit)]

_ -> getObjectAssertion b e

getObjectAssertion :: XMLBase -> Element -> Axiom

getObjectAssertion b e =

let as = getAllAnnos b e

op = getObjProp b $ filterCL objectPropList e

[hd, lst] = map (getIRI b) $ filterChL individualList e

in case getName e of

"ObjectPropertyAssertion" ->

PlainAxiom (SimpleEntity $ Entity NamedIndividual hd)

$ ListFrameBit Nothing $ IndividualFacts

[(as, ObjectPropertyFact Positive op lst)]

"NegativeObjectPropertyAssertion" ->

PlainAxiom (SimpleEntity $ Entity NamedIndividual hd)

$ ListFrameBit Nothing $ IndividualFacts

[(as, ObjectPropertyFact Negative op lst)]

_ -> getIndividualAssertion b e

getIndividualAssertion :: XMLBase -> Element -> Axiom

getIndividualAssertion b e =

let as = getAllAnnos b e

ind = map (getIRI b) $ filterChL individualList e

l = emptyAnnoList ind

in case getName e of

"SameIndividual" ->

PlainAxiom (Misc as) $ ListFrameBit (Just (SDRelation Same))

$ IndividualSameOrDifferent l

"DifferentIndividuals" ->

PlainAxiom (Misc as) $ ListFrameBit (Just (SDRelation Different))

$ IndividualSameOrDifferent l

_ -> getClassAssertion b e

getClassAssertion :: XMLBase -> Element -> Axiom

getClassAssertion b e = case getName e of

"ClassAssertion" ->

let as = getAllAnnos b e

ce = getClassExpression b $ filterCL classExpressionList e

ind = getIRI b $ filterCL individualList e

in PlainAxiom (SimpleEntity $ Entity NamedIndividual ind)

$ ListFrameBit (Just Types) $ ExpressionBit [(as, ce)]

_ -> getAnnoAxiom b e

getAnnoAxiom :: XMLBase -> Element -> Axiom

getAnnoAxiom b e =

let as = getAllAnnos b e

ap = getIRI b $ filterC "AnnotationProperty" e

[ch] = filterChL [iriK, abbreviatedIRI] e

iri = contentIRI b ch

in case getName e of

"AnnotationAssertion" ->

let [s, v] = filterChL annotationValueList e

sub = getSubject b s

-- the misc will be converted to entities in static analysis

in PlainAxiom (Misc [Annotation [] sub $ AnnValue sub])

$ AnnFrameBit [Annotation as ap (getValue b v)]

$ AnnotationFrameBit Assertion

"SubAnnotationPropertyOf" ->

let [hd, lst] = map (getIRI b) $ filterCh "AnnotationProperty" e

in PlainAxiom (SimpleEntity $ Entity AnnotationProperty hd)

$ ListFrameBit (Just SubPropertyOf) $ AnnotationBit [(as, lst)]

"AnnotationPropertyDomain" ->

PlainAxiom (SimpleEntity $ Entity AnnotationProperty ap)

$ ListFrameBit (Just $ DRRelation ADomain)

$ AnnotationBit [(as, iri)]

"AnnotationPropertyRange" ->

PlainAxiom (SimpleEntity $ Entity AnnotationProperty ap)

$ ListFrameBit (Just $ DRRelation ARange)

$ AnnotationBit [(as, iri)]

_ -> err $ "bad frame " ++ ppElement e

getFrames :: XMLBase -> Element -> [Frame]

getFrames b e =

let ax = filterChildrenName isNotSmth e

f = map (axToFrame . getDeclaration b) (filterCh "Declaration" e)

++ map (axToFrame . getClassAxiom b) ax

in f ++ signToFrames f

getOnlyAxioms :: XMLBase -> Element -> [Axiom]

getOnlyAxioms b e = map (getClassAxiom b) $ filterChildrenName isNotSmth e

getImports :: XMLBase -> Element -> [ImportIRI]

getImports b e = map (contentIRI b) $ filterCh importK e

get1Map :: Element -> (String, String)

get1Map e =

let [pref, pmap] = map attrVal $ elAttribs e

in (pref, pmap)

getPrefixMap :: Element -> [(String, String)]

getPrefixMap e = map get1Map $ filterCh "Prefix" e

getOntologyIRI :: XMLBase -> Element -> OntologyIRI

getOntologyIRI b e =

let oi = findAttr (unqual "ontologyIRI") e

in case oi of

Nothing -> dummyQName

Just iri -> appendBase b

$ nullQName {localPart = iri, iriType = cssIRI iri}

getBase :: Element -> XMLBase

getBase e = fromJust $ vFindAttrBy (isSmth "base") e

-- | parses an ontology document

xmlBasicSpec :: Element -> OntologyDocument

xmlBasicSpec e =

let b = getBase e

in OntologyDocument (Map.fromList $ getPrefixMap e)

(emptyOntology $ getFrames b e)

{

imports = getImports b e,

ann = [getAllAnnos b e],

name = getOntologyIRI b e

}