69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu{- |

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavuModule : $Header$

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavuCopyright : (c) Felix Gabriel Mance

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavuLicense : GPLv2 or higher, see LICENSE.txt

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavuMaintainer : f.mance@jacobs-university.de

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavuStability : provisionalM

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavuPortability : portable

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavuRenames prefixes in OntologyDocuments, so that there are

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuno prefix clashes

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu-}

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savumodule OWL2.Rename where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport OWL2.AS

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport OWL2.MS

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport OWL2.Sign

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport qualified Data.Map as Map

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport qualified Data.Set as Set

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport qualified Common.AS_Annotation as Common.Annotation

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport Data.List (find, nub)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport Data.Maybe

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport Data.Char (isDigit)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuimport Common.Result

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savutype TranslationMap = Map.Map String String

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuclass PrefixClass a where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv :: TranslationMap -> a -> a

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavumaybeRename :: (PrefixClass a) => TranslationMap -> Maybe a -> Maybe a

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert SavumaybeRename tMap = fmap $ mv tMap

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass PrefixMap where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap oldPs =

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu foldl (\ ns (pre, ouri) ->

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Map.insert (Map.findWithDefault pre pre tMap) ouri ns)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Map.empty $ Map.toList oldPs

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass QName where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap old = let pre = namePrefix old in

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu old { namePrefix = Map.findWithDefault pre pre tMap }

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass Sign where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap (Sign p1 p2 p3 p4 p5 p6 p7) =

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Sign (Set.map (mv tMap) p1)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (Set.map (mv tMap) p2)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (Set.map (mv tMap) p3)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (Set.map (mv tMap) p4)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (Set.map (mv tMap) p5)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (Set.map (mv tMap) p6)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (mv tMap p7)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass (DomainOrRangeOrFunc a) where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap dor = case dor of

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu DomainOrRange ty des -> DomainOrRange ty $ mv tMap des

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu RDRange dr -> RDRange $ mv tMap dr

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu _ -> dor

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass SignAxiom where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap signAxiom =

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu case signAxiom of

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Subconcept cId1 cId2 ->

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Subconcept (mv tMap cId1)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (mv tMap cId2)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Role rdr id1 ->

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Role (mv tMap rdr) (mv tMap id1)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Data rdr id1 ->

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Data (mv tMap rdr) (mv tMap id1)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Conceptmembership iId des ->

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Conceptmembership (mv tMap iId)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (mv tMap des)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass (Common.Annotation.Named Axiom) where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap sent = sent {

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Common.Annotation.sentence = mv tMap

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu (Common.Annotation.sentence sent) }

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass Entity where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap (Entity ty euri) = Entity ty $ mv tMap euri

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass Literal where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap lit = case lit of

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Literal l (Typed curi) ->

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu Literal l $ Typed $ mv tMap curi

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu _ -> lit

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass ObjectPropertyExpression where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap opExp = case opExp of

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu ObjectProp opuri -> ObjectProp (mv tMap opuri)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu ObjectInverseOf invOp -> ObjectInverseOf (mv tMap invOp)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savuinstance PrefixClass DataRange where

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu mv tMap dr =

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu let rnRest (facet, value) = (facet, mv tMap value)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu in case dr of

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu DataType druri restrList ->

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu DataType (mv tMap druri) (map rnRest restrList)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu DataJunction ty drlist -> DataJunction ty (map (mv tMap) drlist)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu DataComplementOf dataRange -> DataComplementOf (mv tMap dataRange)

69b1e90bbb27ce2dd365628c07c0f03a3ae97b26Robert Savu DataOneOf constList -> DataOneOf (map (mv tMap) constList)

instance PrefixClass ClassExpression where

mv tMap desc = case desc of

Expression curi -> Expression (mv tMap curi)

ObjectJunction ty descList ->

ObjectJunction ty (map (mv tMap) descList)

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

ObjectOneOf indsList -> ObjectOneOf (map (mv tMap) indsList)

ObjectValuesFrom ty opExp desc' -> ObjectValuesFrom ty

(mv tMap opExp) (mv tMap desc')

ObjectHasSelf opExp -> ObjectHasSelf (mv tMap opExp)

ObjectHasValue opExp indUri -> ObjectHasValue

(mv tMap opExp) (mv tMap indUri)

ObjectCardinality (Cardinality ty card opExp maybeDesc) ->

ObjectCardinality $ Cardinality ty card

(mv tMap opExp) (maybeRename tMap maybeDesc)

DataValuesFrom ty dpExp dataRange ->

DataValuesFrom ty (mv tMap dpExp) (mv tMap dataRange)

DataHasValue dpExp const' -> DataHasValue

(mv tMap dpExp) (mv tMap const')

DataCardinality (Cardinality ty card dpExp maybeRange) ->

DataCardinality $ Cardinality ty card

(mv tMap dpExp) (maybeRename tMap maybeRange)

instance PrefixClass Annotation where

mv tMap anno = case anno of

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

(mv tMap ap) (mv tMap av)

instance PrefixClass AnnotationValue where

mv ns av = case av of

AnnValue iri -> AnnValue (mv ns iri)

AnnValLit l -> AnnValLit (mv ns l)

instance PrefixClass Annotations where

mv tMap = map (mv tMap)

instance PrefixClass a => PrefixClass (AnnotatedList a) where

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

instance PrefixClass ListFrameBit where

mv tMap lfb = case lfb of

AnnotationBit anl -> AnnotationBit (mv tMap anl)

ExpressionBit anl -> ExpressionBit (mv tMap anl)

ObjectBit anl -> ObjectBit (mv tMap anl)

DataBit anl -> DataBit (mv tMap anl)

IndividualSameOrDifferent anl ->

IndividualSameOrDifferent (mv tMap anl)

DataPropRange anl -> DataPropRange (mv tMap anl)

IndividualFacts ans -> IndividualFacts (mv tMap ans)

_ -> lfb

instance PrefixClass AnnFrameBit where

mv tMap afb = case afb of

DatatypeBit dr -> DatatypeBit (mv tMap dr)

ClassDisjointUnion cel -> ClassDisjointUnion (map (mv tMap) cel)

ClassHasKey ol dl -> ClassHasKey (map (mv tMap) ol) (map (mv tMap) dl)

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