f90884915ff10ae83f59e709c68824de834e64f5Dominik Luecke{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

f90884915ff10ae83f59e709c68824de834e64f5Dominik Lueckemodule OWL2.Rename where

9eb6a481980d81a55898ba418fba72fc3c09d8c8Dominik Luecke

f90884915ff10ae83f59e709c68824de834e64f5Dominik Lueckeimport OWL2.AS

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu Prodescuimport OWL2.MS

f90884915ff10ae83f59e709c68824de834e64f5Dominik Lueckeimport OWL2.Sign

2eeec5240b424984e3ee26296da1eeab6c6d739eChristian Maederimport qualified Data.Map as Map

b72a390042c19e630cf221494b60c9df2a60d187Dominik Lueckeimport qualified Data.Set as Set

b72a390042c19e630cf221494b60c9df2a60d187Dominik Lueckeimport qualified Common.AS_Annotation as Common.Annotation

f90884915ff10ae83f59e709c68824de834e64f5Dominik Lueckeimport Data.List (find, nub)

f90884915ff10ae83f59e709c68824de834e64f5Dominik Lueckeimport Data.Maybe

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maederimport Data.Char (isDigit)

2af38fde95f93562f2124ec615fba0e509c8202eDominik Luecke

2af38fde95f93562f2124ec615fba0e509c8202eDominik Lueckeimport Common.Result

2af38fde95f93562f2124ec615fba0e509c8202eDominik Luecke

cf04ba46b9eb495d334466e24e082e391055ca7bDominik Luecketype TranslationMap = Map.Map String String

2af38fde95f93562f2124ec615fba0e509c8202eDominik Luecke

2af38fde95f93562f2124ec615fba0e509c8202eDominik Lueckeclass PrefixClass a where

926b3c5491f1c608f5b79e2d8014d7a1385558c3Dominik Luecke mv :: TranslationMap -> a -> a

2af38fde95f93562f2124ec615fba0e509c8202eDominik Luecke

f90884915ff10ae83f59e709c68824de834e64f5Dominik LueckemaybeRename :: (PrefixClass a) => TranslationMap -> Maybe a -> Maybe a

f90884915ff10ae83f59e709c68824de834e64f5Dominik LueckemaybeRename tMap = fmap $ mv tMap

da955132262baab309a50fdffe228c9efe68251dCui Jian

16e124196c6b204769042028c74f533509c9b5d3Christian Maederinstance PrefixClass PrefixMap where

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder mv tMap oldPs =

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder foldl (\ ns (pre, ouri) ->

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder Map.insert (Map.findWithDefault pre pre tMap) ouri ns)

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder Map.empty $ Map.toList oldPs

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder

16e124196c6b204769042028c74f533509c9b5d3Christian Maederinstance PrefixClass QName where

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder mv tMap old = let pre = namePrefix old in

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder old { namePrefix = Map.findWithDefault pre pre tMap }

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maederinstance PrefixClass Sign where

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder mv tMap (Sign p1 p2 p3 p4 p5 p6 p7) =

f90884915ff10ae83f59e709c68824de834e64f5Dominik Luecke Sign (Set.map (mv tMap) p1)

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Luecke (Set.map (mv tMap) p2)

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Luecke (Set.map (mv tMap) p3)

f90884915ff10ae83f59e709c68824de834e64f5Dominik Luecke (Set.map (mv tMap) p4)

5b9f5c1b3592b99fc74d3438740ebcf9eb4c94beDominik Luecke (Set.map (mv tMap) p5)

2ea0ce749d2525f96d5d2f285f519ab07b005b8dDominik Luecke (Set.map (mv tMap) p6)

5b9f5c1b3592b99fc74d3438740ebcf9eb4c94beDominik Luecke (mv tMap p7)

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Lueckeinstance PrefixClass (DomainOrRangeOrFunc a) where

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Luecke mv tMap dor = case dor of

f90884915ff10ae83f59e709c68824de834e64f5Dominik Luecke DomainOrRange ty des -> DomainOrRange ty $ mv tMap des

da955132262baab309a50fdffe228c9efe68251dCui Jian RDRange dr -> RDRange $ mv tMap dr

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder _ -> dor

f90884915ff10ae83f59e709c68824de834e64f5Dominik Luecke

16e124196c6b204769042028c74f533509c9b5d3Christian Maederinstance PrefixClass SignAxiom where

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder mv tMap signAxiom =

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder case signAxiom of

16e124196c6b204769042028c74f533509c9b5d3Christian Maeder Subconcept cId1 cId2 ->

b72a390042c19e630cf221494b60c9df2a60d187Dominik Luecke Subconcept (mv tMap cId1)

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Luecke (mv tMap cId2)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder Role rdr id1 ->

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke Role (mv tMap rdr) (mv tMap id1)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder Data rdr id1 ->

b72a390042c19e630cf221494b60c9df2a60d187Dominik Luecke Data (mv tMap rdr) (mv tMap id1)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder Conceptmembership iId des ->

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke Conceptmembership (mv tMap iId)

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke (mv tMap des)

656f17ae9b7610ff2de1b6eedeeadea0c3bcdc8dChristian Maeder

da955132262baab309a50fdffe228c9efe68251dCui Jianinstance PrefixClass (Common.Annotation.Named Axiom) where

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder mv tMap sent = sent {

548f3850942936a8c6021185c8391dfcd3b03018Dominik Luecke Common.Annotation.sentence = mv tMap

548f3850942936a8c6021185c8391dfcd3b03018Dominik Luecke (Common.Annotation.sentence sent) }

0b53895114b00141ec17ffdc7e26acded4487328Christian Maeder

656f17ae9b7610ff2de1b6eedeeadea0c3bcdc8dChristian Maederinstance PrefixClass Entity where

656f17ae9b7610ff2de1b6eedeeadea0c3bcdc8dChristian Maeder mv tMap (Entity ty euri) = Entity ty $ mv tMap euri

548f3850942936a8c6021185c8391dfcd3b03018Dominik Luecke

548f3850942936a8c6021185c8391dfcd3b03018Dominik Lueckeinstance PrefixClass Literal where

548f3850942936a8c6021185c8391dfcd3b03018Dominik Luecke mv tMap lit = case lit of

548f3850942936a8c6021185c8391dfcd3b03018Dominik Luecke Literal l (Typed curi) ->

548f3850942936a8c6021185c8391dfcd3b03018Dominik Luecke Literal l $ Typed $ mv tMap curi

548f3850942936a8c6021185c8391dfcd3b03018Dominik Luecke _ -> lit

5b2e9f4673599e1bc6e18a43ad615da28305b8e1Christian Maeder

548f3850942936a8c6021185c8391dfcd3b03018Dominik Lueckeinstance PrefixClass ObjectPropertyExpression where

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke mv tMap opExp = case opExp of

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke ObjectProp opuri -> ObjectProp (mv tMap opuri)

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke ObjectInverseOf invOp -> ObjectInverseOf (mv tMap invOp)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maederinstance PrefixClass DataRange where

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke mv tMap dr =

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke let rnRest (facet, value) = (facet, mv tMap value)

08056875f5f633ef432598d5245ea41c112d2178Dominik Luecke in case dr of

a23e572c8f957cc051a1b0831abd6fe9380d45c7Christian Maeder DataType druri restrList ->

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder DataType (mv tMap druri) (map rnRest restrList)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder DataJunction ty drlist -> DataJunction ty (map (mv tMap) drlist)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder DataComplementOf dataRange -> DataComplementOf (mv tMap dataRange)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder DataOneOf constList -> DataOneOf (map (mv tMap) constList)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maederinstance PrefixClass ClassExpression where

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Luecke mv tMap desc = case desc of

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Luecke Expression curi -> Expression (mv tMap curi)

fcac596b16bb10f475066c323b9b1ca44db2b755Dominik Luecke ObjectJunction ty descList ->

0859769b65851f4c06d6d32fac084b0f4db56c94Christian Maeder ObjectJunction ty (map (mv tMap) descList)

da955132262baab309a50fdffe228c9efe68251dCui Jian ObjectComplementOf desc' -> ObjectComplementOf (mv tMap desc')

4df63f7187b1ba16cbe5c781db187a42f2f49579Dominik Luecke ObjectOneOf indsList -> ObjectOneOf (map (mv tMap) indsList)

b694e4b3f771a2f32042c9c505dd698bde969558Dominik Luecke ObjectValuesFrom ty opExp desc' -> ObjectValuesFrom ty

5b9f5c1b3592b99fc74d3438740ebcf9eb4c94beDominik Luecke (mv tMap opExp) (mv tMap desc')

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder ObjectHasSelf opExp -> ObjectHasSelf (mv tMap opExp)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder ObjectHasValue opExp indUri -> ObjectHasValue

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder (mv tMap opExp) (mv tMap indUri)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder ObjectCardinality (Cardinality ty card opExp maybeDesc) ->

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder ObjectCardinality $ Cardinality ty card

2ea0ce749d2525f96d5d2f285f519ab07b005b8dDominik Luecke (mv tMap opExp) (maybeRename tMap maybeDesc)

2ea0ce749d2525f96d5d2f285f519ab07b005b8dDominik Luecke DataValuesFrom ty dpExp dataRange ->

2ea0ce749d2525f96d5d2f285f519ab07b005b8dDominik Luecke DataValuesFrom ty (mv tMap dpExp) (mv tMap dataRange)

2ea0ce749d2525f96d5d2f285f519ab07b005b8dDominik Luecke DataHasValue dpExp const' -> DataHasValue

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder (mv tMap dpExp) (mv tMap const')

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder DataCardinality (Cardinality ty card dpExp maybeRange) ->

2ea0ce749d2525f96d5d2f285f519ab07b005b8dDominik Luecke DataCardinality $ Cardinality ty card

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder (mv tMap dpExp) (maybeRename tMap maybeRange)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maederinstance PrefixClass Annotation where

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder mv tMap anno = case anno of

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder Annotation annos ap av -> Annotation (map (mv tMap) annos)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder (mv tMap ap) (mv tMap av)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maederinstance PrefixClass AnnotationValue where

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder mv ns av = case av of

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder AnnValue iri -> AnnValue (mv ns iri)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder AnnValLit l -> AnnValLit (mv ns l)

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maederinstance PrefixClass Annotations where

0b53895114b00141ec17ffdc7e26acded4487328Christian Maeder mv tMap = map (mv tMap)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maederinstance PrefixClass a => PrefixClass (AnnotatedList a) where

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder mv tMap = map (\ (ans, b) -> (mv tMap ans, mv tMap b))

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maederinstance PrefixClass ListFrameBit where

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder mv tMap lfb = case lfb of

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder AnnotationBit anl -> AnnotationBit (mv tMap anl)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder ExpressionBit anl -> ExpressionBit (mv tMap anl)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder ObjectBit anl -> ObjectBit (mv tMap anl)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder DataBit anl -> DataBit (mv tMap anl)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder IndividualSameOrDifferent anl ->

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder IndividualSameOrDifferent (mv tMap anl)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder DataPropRange anl -> DataPropRange (mv tMap anl)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder IndividualFacts ans -> IndividualFacts (mv tMap ans)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder _ -> lfb

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maederinstance PrefixClass AnnFrameBit where

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder mv tMap afb = case afb of

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder DatatypeBit dr -> DatatypeBit (mv tMap dr)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder ClassDisjointUnion cel -> ClassDisjointUnion (map (mv tMap) cel)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder ClassHasKey ol dl -> ClassHasKey (map (mv tMap) ol) (map (mv tMap) dl)

202df46772cac2ee2e8627ba196a5faebb6f9a05Christian Maeder ObjectSubPropertyChain ol -> ObjectSubPropertyChain (map (mv tMap) ol)

_ -> afb

instance PrefixClass FrameBit where

mv tMap fb = case fb of

ListFrameBit mr lfb -> ListFrameBit mr (mv tMap lfb)

AnnFrameBit ans afb -> AnnFrameBit (mv tMap ans) (mv tMap afb)

instance PrefixClass Extended where

mv tMap ex = case ex of

Misc ans -> Misc $ mv tMap ans

SimpleEntity e -> SimpleEntity $ mv tMap e

ClassEntity ce -> ClassEntity $ mv tMap ce

ObjectEntity op -> ObjectEntity $ mv tMap op

instance PrefixClass Frame where

mv tMap (Frame ex fbl) = Frame (mv tMap ex) (map (mv tMap) fbl)

instance PrefixClass Axiom where

mv tMap (PlainAxiom ex fbl) = PlainAxiom (mv tMap ex) (mv tMap fbl)

instance PrefixClass Fact where

mv tMap f = case f of

ObjectPropertyFact pn op i -> ObjectPropertyFact pn (mv tMap op) (mv tMap i)

DataPropertyFact pn dp l -> DataPropertyFact pn (mv tMap dp) (mv tMap l)

instance PrefixClass OntologyDocument where

mv tMap ( OntologyDocument pm onto) =

OntologyDocument (mv tMap pm) (mv tMap onto)

instance PrefixClass Ontology where

mv tMap ( Ontology ouri impList anList f) =

Ontology (mv tMap ouri) (map (mv tMap) impList)

(map (mv tMap) anList) (map (mv tMap) f)

testAndInteg :: (String, String)

-> (PrefixMap, TranslationMap) -> (PrefixMap, TranslationMap)

testAndInteg (pre, oiri) (old, tm) = case Map.lookup pre old of

Just iri ->

if oiri == iri then (old, tm)

else let pre' = disambiguateName pre old

in (Map.insert pre' oiri old, Map.insert pre pre' tm)

Nothing -> (Map.insert pre oiri old, tm)

disambiguateName :: String -> PrefixMap -> String

disambiguateName nm nameMap =

let newname = reverse . dropWhile isDigit $ reverse nm

in fromJust $ find (not . flip Map.member nameMap)

[newname ++ show (i :: Int) | i <- [1 ..]]

uniteSign :: Sign -> Sign -> Result Sign

uniteSign s1 s2 = do

let (pm, tm) = integPref (prefixMap s1) (prefixMap s2)

if Map.null tm then return (addSign s1 s2) {prefixMap = pm}

else fail "Static analysis could not unite signatures"

integPref :: PrefixMap -> PrefixMap

-> (PrefixMap, TranslationMap)

integPref oldMap testMap =

foldr testAndInteg (oldMap, Map.empty) (Map.toList testMap)

newOid :: OntologyIRI -> OntologyIRI -> OntologyIRI

newOid id1 id2 =

let lid1 = localPart id1

lid2 = localPart id2

in if null lid1 then id2

else if null lid2 || id1 == id2 then id1

else id1 { localPart = uriToName lid1 ++ "_" ++ uriToName lid2 }

integrateOntologyDoc :: OntologyDocument -> OntologyDocument

-> OntologyDocument

integrateOntologyDoc od1@( OntologyDocument ns1

( Ontology oid1 imp1 anno1 frames1))

od2@( OntologyDocument ns2

( Ontology oid2 imp2 anno2 frames2)) =

if od1 == od2 then od1

else

let (newPref, tm) = integPref ns1 ns2

in OntologyDocument newPref

(Ontology (newOid oid1 oid2) (nub $ imp1 ++ map (mv tm) imp2)

(nub $ anno1 ++ map (mv tm) anno2)

(nub $ frames1 ++ map (mv tm) frames2))

uriToName :: String -> String

uriToName str = let

str' = case str of

'"' : _ -> read str

_ -> str

in takeWhile (/= '.') $ reverse $ case takeWhile (/= '/') $ reverse str' of

'#' : r -> r

r -> r

unifyWith1 :: OntologyDocument -> [OntologyDocument] -> [OntologyDocument]

unifyWith1 d odl = case odl of

[] -> []

[doc] -> [snd $ unifyTwo d doc]

doc1 : docs ->

let (merged, newDoc1) = unifyTwo d doc1

in newDoc1 : unifyWith1 merged docs

-- takes 2 docs and returns as snd the corrected first one

-- and as fst the merge of the two

unifyTwo :: OntologyDocument -> OntologyDocument -> (OntologyDocument, OntologyDocument)

unifyTwo od1 od2 =

let (_, tm) = integPref (prefixDeclaration od1) (prefixDeclaration od2)

newod2 = mv tm od2

alld = integrateOntologyDoc od1 od2

in (alld, newod2)

unifyDocs :: [OntologyDocument] -> [OntologyDocument]

unifyDocs = unifyWith1 emptyDoc