bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder{- |

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederModule : $Header$

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederCopyright : (c) Felix Gabriel Mance

97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : GPLv2 or higher, see LICENSE.txt

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder

b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiMaintainer : f.mance@jacobs-university.de

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederStability : provisional

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederPortability : portable

f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederOWL2 XML Syntax Parsing

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder-}

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maedermodule OWL2.XML where

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maederimport Common.Lexer

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder

ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maederimport OWL2.AS

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maederimport OWL2.Extract

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maederimport OWL2.MS

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maederimport OWL2.XMLKeywords

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maederimport Text.XML.Light

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder

ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maederimport Data.Maybe

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maederimport Data.List

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maederimport qualified Data.Map as Map

33a5d53a412ba0a4e5847f7538d6da2e22bd116cChristian Maeder

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maedertype XMLBase = String

e774ab5733a1d673b123b0e63b14dd533e6fd4fcChristian Maeder

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder-- ^ error messages for the parser

b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maedererr :: String -> t

ebcaad207cafc89eeb49d431f40de2ef4c48411cChristian Maedererr s = error $ "XML parser: " ++ s

b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder{- two functions from Text.XML.Light.Proc version 1.3.7 for compatibility

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder with previous versions -}

b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian MaedervLookupAttrBy :: (Text.XML.Light.QName -> Bool) -> [Attr] -> Maybe String

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedervLookupAttrBy p as = attrVal `fmap` find (p . attrKey) as

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedervFindAttrBy :: (Text.XML.Light.QName -> Bool) -> Element -> Maybe String

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedervFindAttrBy p e = vLookupAttrBy p (elAttribs e)

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederisSmth :: String -> Text.XML.Light.QName -> Bool

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederisSmth s = (s ==) . qName

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederisSmthList :: [String] -> Text.XML.Light.QName -> Bool

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederisSmthList l qn = qName qn `elem` l

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaederisNotSmth :: Text.XML.Light.QName -> Bool

38775225cf810f5895cc03b4acbcfe8f84f2513aChristian MaederisNotSmth q = let qn = qName q in qn `notElem` ["Declaration",

ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian Maeder "Prefix", "Import", "Annotation"]

ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian Maeder

ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian MaederfilterCh :: String -> Element -> [Element]

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian MaederfilterCh s = filterChildrenName (isSmth s)

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder

dfa74d066ea0f00a70276aedecc624c6b3c86deaChristian MaederfilterChL :: [String] -> Element -> [Element]

ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian MaederfilterChL l = filterChildrenName (isSmthList l)

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaederfilterC :: String -> Element -> Element

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaederfilterC s e = fromMaybe (err "child not found")

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder (filterChildName (isSmth s) e)

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaederfilterCL :: [String] -> Element -> Element

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaederfilterCL l e = fromMaybe (err "child not found")

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder (filterChildName (isSmthList l) e)

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder-- ^ parses an IRI

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaedergetIRI :: XMLBase -> Element -> IRI

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedergetIRI b e =

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder let [a] = elAttribs e

d17834302eaa101395b4b806cd73670fd864445fChristian Maeder iri = attrVal a

ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian Maeder ty = case qName $ attrKey a of

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder "abbreviatedIRI" -> Abbreviated

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder "IRI" -> Full

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder "nodeID" -> NodeID

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder _ -> err "invalid type of iri"

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder in appendBase b $ nullQName {localPart = iri, iriType = ty}

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder{- | if the IRI contains colon, it is split there;

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maederelse, the xml:base needs to be prepended to the local part

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maederand then the IRI must be splitted -}

715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederappendBase :: XMLBase -> IRI -> IRI

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaederappendBase b qn =

715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder let r = localPart qn

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder in if ':' `elem` r then splitIRI qn

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder else splitIRI $ qn {localPart = b ++ r, iriType = Full}

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder-- ^ splits an IRI at the colon

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian MaedersplitIRI :: IRI -> IRI

836e72a3c413366ba9801726f3b249c7791cb9caChristian MaedersplitIRI qn = case iriType qn of

836e72a3c413366ba9801726f3b249c7791cb9caChristian Maeder NodeID -> nodeID qn

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder _ -> let lp = localPart qn

7dec34aee2b609b9535c48d060e0f7baf3536457Christian Maeder np = takeWhile (/= ':') lp

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder ':' : nlp = dropWhile (/= ':') lp

7dec34aee2b609b9535c48d060e0f7baf3536457Christian Maeder in qn {namePrefix = np, localPart = nlp}

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder-- ^ prepends "_:" to the nodeID if is not there already

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian MaedernodeID :: IRI -> IRI

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian MaedernodeID qn =

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder let lp = localPart qn

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder in case lp of

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder '_' : ':' : t -> qn

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder _ -> qn {localPart = "_:" ++ lp}

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder-- ^ gets the content of an element with name IRI, AbbreviatedIRI or Import

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian MaedercontentIRI :: XMLBase -> Element -> IRI

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian MaedercontentIRI b e =

797f811e57952d59e73b8cd03b667eef276db972Christian Maeder let cont = strContent e

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder iri = nullQName {localPart = cont}

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder in case getName e of

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder "AbbreviatedIRI" -> splitIRI iri

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder "IRI" -> if ':' `elem` cont then

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder splitIRI $ iri {iriType = Full}

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder else appendBase b iri

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder "Import" -> appendBase b $ iri {iriType = cssIRI cont}

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder _ -> err "invalid type of iri"

bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder

ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian Maeder-- ^ gets the name of an axiom in XML Syntax

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaedergetName :: Element -> String

d17834302eaa101395b4b806cd73670fd864445fChristian MaedergetName e =

e1839fb37a3a2ccd457464cb0dcc5efd466dbe22Christian Maeder let n = (qName . elName) e

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder q = (qURI . elName) e

e774ab5733a1d673b123b0e63b14dd533e6fd4fcChristian Maeder in case q of

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder Just "http://www.w3.org/2002/07/owl#" -> n

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder _ -> ""

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder

7dec34aee2b609b9535c48d060e0f7baf3536457Christian Maeder-- ^ gets the cardinality

7dec34aee2b609b9535c48d060e0f7baf3536457Christian MaedergetInt :: Element -> Int

1738d16957389457347bee85075d3d33d002158fChristian MaedergetInt e = let [int] = elAttribs e in value 10 $ attrVal int

1738d16957389457347bee85075d3d33d002158fChristian Maeder

1738d16957389457347bee85075d3d33d002158fChristian MaedergetEntityType :: String -> EntityType

33a5d53a412ba0a4e5847f7538d6da2e22bd116cChristian MaedergetEntityType ty = case ty of

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder "Class" -> Class

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder "Datatype" -> Datatype

2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder "NamedIndividual" -> NamedIndividual

0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder "ObjectProperty" -> ObjectProperty

c70d42540b8f8c3c141cc0779599d25f7eb69bbfChristian Maeder "DataProperty" -> DataProperty

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder "AnnotationProperty" -> AnnotationProperty

b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder _ -> err "not entity type"

5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maeder

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaedertoEntity :: XMLBase -> Element -> Entity

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaedertoEntity b e = Entity (getEntityType $ (qName . elName) e) $ getIRI b e

88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaedergetDeclaration :: XMLBase -> Element -> Axiom

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaedergetDeclaration b e = case getName e of

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder "Declaration" ->

88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder let ent = filterCL entityList e

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder ans = getAllAnnos b e

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder entity@(Entity ty iri) = toEntity b ent

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder in case ty of

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder AnnotationProperty -> PlainAxiom (Misc ans) $ AnnFrameBit

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder [Annotation [] iri $ AnnValue iri] AnnotationFrameBit

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder _ -> PlainAxiom (SimpleEntity entity)

88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder $ AnnFrameBit ans AnnotationFrameBit

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder _ -> err "not declaration"

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaederisPlainLiteral :: String -> Bool

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian MaederisPlainLiteral s =

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder "http://www.w3.org/1999/02/22-rdf-syntax-ns#PlainLiteral" == s

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaedergetLiteral :: XMLBase -> Element -> Literal

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian MaedergetLiteral b e = case getName e of

88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder "Literal" ->

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder let lf = strContent e

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder mdt = findAttr (unqual "datatypeIRI") e

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder mattr = vFindAttrBy (isSmth "lang") e

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder in case mdt of

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder Nothing -> case mattr of

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder Just lang -> Literal lf (Untyped $ Just lang)

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder Nothing -> Literal lf (Untyped Nothing)

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder Just dt -> case mattr of

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder Just lang -> Literal lf (Untyped $ Just lang)

1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder Nothing -> if isPlainLiteral dt then

88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder Literal lf (Untyped Nothing)

aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder else 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"

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

getFacetValuePair b e = case getName e of

"FacetRestriction" ->

let [ch] = elChildren e

in (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 "XML parser: 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

"ObjectMinCardinality" -> if length ch == 2 then

ObjectCardinality $ Cardinality

MinCardinality (getInt e) (getObjProp b ch1)

$ Just $ getClassExpression b rch1

else ObjectCardinality $ Cardinality

MinCardinality (getInt e) (getObjProp b ch1) Nothing

"ObjectMaxCardinality" -> if length ch == 2 then

ObjectCardinality $ Cardinality

MaxCardinality (getInt e) (getObjProp b ch1)

$ Just $ getClassExpression b rch1

else ObjectCardinality $ Cardinality

MaxCardinality (getInt e) (getObjProp b ch1) Nothing

"ObjectExactCardinality" -> if length ch == 2 then

ObjectCardinality $ Cardinality

ExactCardinality (getInt e) (getObjProp b ch1)

$ Just $ getClassExpression b rch1

else ObjectCardinality $ Cardinality

ExactCardinality (getInt e) (getObjProp b ch1) Nothing

"DataSomeValuesFrom" ->

let dp = getIRI b ch1

dr = rch1

in DataValuesFrom SomeValuesFrom dp (getDataRange b dr)

"DataAllValuesFrom" ->

let dp = getIRI b ch1

dr = rch1

in DataValuesFrom AllValuesFrom dp (getDataRange b dr)

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

"DataMinCardinality" -> if length ch == 2 then

DataCardinality $ Cardinality

MinCardinality (getInt e) (getIRI b ch1)

$ Just $ getDataRange b rch1

else DataCardinality $ Cardinality

MinCardinality (getInt e) (getIRI b ch1) Nothing

"DataMaxCardinality" -> if length ch == 2 then

DataCardinality $ Cardinality

MaxCardinality (getInt e) (getIRI b ch1)

$ Just $ getDataRange b rch1

else DataCardinality $ Cardinality

MaxCardinality (getInt e) (getIRI b ch1) Nothing

"DataExactCardinality" -> if length ch == 2 then

DataCardinality $ Cardinality

ExactCardinality (getInt e) (getIRI b ch1)

$ Just $ getDataRange b rch1

else DataCardinality $ Cardinality

ExactCardinality (getInt e) (getIRI b ch1) Nothing

_ -> err "XML parser: not ClassExpression"

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

$ map (\ x -> ([], x)) cel

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

(Just (EDRelation Disjoint)) $ ExpressionBit

$ map (\ x -> ([], x)) 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

_ -> hasKey b e

hasKey :: XMLBase -> Element -> Axiom

hasKey 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 [hd, lst] = map (getObjProp b)

$ filterChL objectPropList e

in PlainAxiom (ObjectEntity hd)

$ ListFrameBit (Just SubPropertyOf) $ ObjectBit

[(as, lst)]

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 $ map (\ x -> ([], x)) opl

"DisjointObjectProperties" ->

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

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

$ ObjectBit $ map (\ x -> ([], x)) 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 $ map (\ x -> ([], x)) dpl

"DisjointDataProperties" ->

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

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

$ DataBit $ map (\ x -> ([], x)) 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 = map (\ x -> ([], x)) 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

in case getName e of

"AnnotationAssertion" ->

let [s, v] = filterChL annotationValueList e

in PlainAxiom (SimpleEntity $ Entity AnnotationProperty ap)

$ AnnFrameBit [Annotation as (getSubject b s) (getValue b v)]

AnnotationFrameBit

"SubAnnotationPropertyOf" ->

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

in PlainAxiom (SimpleEntity $ Entity AnnotationProperty hd)

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

"AnnotationPropertyDomain" ->

let [ch] = filterChL ["IRI", "AbbreviatedIRI"] e

iri = contentIRI b ch

in PlainAxiom (SimpleEntity $ Entity AnnotationProperty ap)

$ ListFrameBit (Just (DRRelation ADomain))

$ AnnotationBit [(as, iri)]

"AnnotationPropertyRange" ->

let [ch] = filterChL ["IRI", "AbbreviatedIRI"] e

iri = contentIRI b ch

in PlainAxiom (SimpleEntity $ Entity AnnotationProperty ap)

$ ListFrameBit (Just (DRRelation ARange))

$ AnnotationBit [(as, iri)]

_ -> err "bad frame"

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 "Import" 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

xmlBasicSpec :: Element -> OntologyDocument

xmlBasicSpec e = let b = getBase e in emptyOntologyDoc

{

ontology = emptyOntologyD

{

ontFrames = getFrames b e,

imports = getImports b e,

ann = [getAllAnnos b e],

name = getOntologyIRI b e

},

prefixDeclaration = Map.fromList $ getPrefixMap e

}