Rename.hs revision 1341e758a8a0785dd7063b93aed3989f13b36f2a
842ae4bd224140319ae7feec1872b93dfd491143fielding{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesimport qualified Data.Map as Map
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesimport qualified Data.Set as Set
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesimport qualified Common.AS_Annotation as Common.Annotation
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesimport Data.List (find, nub)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesimport Data.Char (isDigit)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholestype TranslationMap = Map.Map String String
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesclass PrefixClass a where
e8f95a682820a599fe41b22977010636be5c2717jim mv :: TranslationMap -> a -> a
e8f95a682820a599fe41b22977010636be5c2717jimmaybeRename :: (PrefixClass a) => TranslationMap -> Maybe a -> Maybe a
1747d30b98aa1bdbc43994c02cd46ab4cb9319e4fieldingmaybeRename tMap = fmap $ mv tMap
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass PrefixMap where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap oldPs =
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes foldl (\ ns (pre, ouri) ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Map.insert (Map.findWithDefault pre pre tMap) ouri ns)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass QName where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap old = let pre = namePrefix old in
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes old { namePrefix = Map.findWithDefault pre pre tMap }
5c0419d51818eb02045cf923a9fe456127a44c60wroweinstance PrefixClass Sign where
5c0419d51818eb02045cf923a9fe456127a44c60wrowe mv tMap (Sign p1 p2 p3 p4 p5 p6 p7) =
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Sign (Set.map (mv tMap) p1)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (Set.map (mv tMap) p2)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (Set.map (mv tMap) p3)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (Set.map (mv tMap) p4)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (Set.map (mv tMap) p5)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (Set.map (mv tMap) p6)
d266c3777146d36a4c23c17aad6f153aebea1bf4jorton (mv tMap p7)
d266c3777146d36a4c23c17aad6f153aebea1bf4jortoninstance PrefixClass (DomainOrRangeOrFunc a) where
d266c3777146d36a4c23c17aad6f153aebea1bf4jorton mv tMap dor = case dor of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DomainOrRange ty des -> DomainOrRange ty $ mv tMap des
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes RDRange dr -> RDRange $ mv tMap dr
22f8da8087791fcb95b836c8a81937c5a9bba202bnicholesinstance PrefixClass SignAxiom where
22f8da8087791fcb95b836c8a81937c5a9bba202bnicholes mv tMap signAxiom =
22f8da8087791fcb95b836c8a81937c5a9bba202bnicholes case signAxiom of
22f8da8087791fcb95b836c8a81937c5a9bba202bnicholes Subconcept cId1 cId2 ->
22f8da8087791fcb95b836c8a81937c5a9bba202bnicholes Subconcept (mv tMap cId1)
cd3bbd6d2df78d6c75e5d159a81ef8bdd5f70df9trawick (mv tMap cId2)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Role rdr id1 ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Role (mv tMap rdr) (mv tMap id1)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Data rdr id1 ->
0568280364eb026393be492ebc732795c4934643jorton Data (mv tMap rdr) (mv tMap id1)
0568280364eb026393be492ebc732795c4934643jorton Conceptmembership iId des ->
0568280364eb026393be492ebc732795c4934643jorton Conceptmembership (mv tMap iId)
0568280364eb026393be492ebc732795c4934643jorton (mv tMap des)
0568280364eb026393be492ebc732795c4934643jortoninstance PrefixClass (Common.Annotation.Named Axiom) where
0568280364eb026393be492ebc732795c4934643jorton mv tMap sent = sent {
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Entity where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap (Entity ty euri) = Entity ty $ mv tMap euri
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Literal where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap lit = case lit of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Literal l (Typed curi) ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Literal l $ Typed $ mv tMap curi
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass ObjectPropertyExpression where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap opExp = case opExp of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectProp opuri -> ObjectProp (mv tMap opuri)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectInverseOf invOp -> ObjectInverseOf (mv tMap invOp)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass DataRange where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap dr =
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes let rnRest (facet, value) = (facet, mv tMap value)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes in case dr of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataType druri restrList ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataType (mv tMap druri) (map rnRest restrList)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataJunction ty drlist -> DataJunction ty (map (mv tMap) drlist)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataComplementOf dataRange -> DataComplementOf (mv tMap dataRange)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataOneOf constList -> DataOneOf (map (mv tMap) constList)
8113dac419143273351446c3ad653f3fe5ba5cfdwroweinstance PrefixClass ClassExpression where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap desc = case desc of
482f676c6c19b1c5bb5cca04dad11509c1da3a4cwrowe Expression curi -> Expression (mv tMap curi)
e8f95a682820a599fe41b22977010636be5c2717jim ObjectJunction ty descList ->
482f676c6c19b1c5bb5cca04dad11509c1da3a4cwrowe ObjectJunction ty (map (mv tMap) descList)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectComplementOf desc' -> ObjectComplementOf (mv tMap desc')
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectOneOf indsList -> ObjectOneOf (map (mv tMap) indsList)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectValuesFrom ty opExp desc' -> ObjectValuesFrom ty
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (mv tMap opExp) (mv tMap desc')
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectHasSelf opExp -> ObjectHasSelf (mv tMap opExp)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectHasValue opExp indUri -> ObjectHasValue
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (mv tMap opExp) (mv tMap indUri)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectCardinality (Cardinality ty card opExp maybeDesc) ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectCardinality $ Cardinality ty card
713a2b68bac4aeb1e9c48785006c0732451039depquerna (mv tMap opExp) (maybeRename tMap maybeDesc)
713a2b68bac4aeb1e9c48785006c0732451039depquerna DataValuesFrom ty dpExp dataRange ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataValuesFrom ty (mv tMap dpExp) (mv tMap dataRange)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataHasValue dpExp const' -> DataHasValue
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (mv tMap dpExp) (mv tMap const')
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataCardinality (Cardinality ty card dpExp maybeRange) ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataCardinality $ Cardinality ty card
482f676c6c19b1c5bb5cca04dad11509c1da3a4cwrowe (mv tMap dpExp) (maybeRename tMap maybeRange)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Annotation where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap anno = case anno of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Annotation annos ap av -> Annotation (map (mv tMap) annos)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (mv tMap ap) (mv tMap av)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass AnnotationValue where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv ns av = case av of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes AnnValue iri -> AnnValue (mv ns iri)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes AnnValLit l -> AnnValLit (mv ns l)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Annotations where
f43b67c5a9d29b572eac916f8335cedc80c908bebnicholes mv tMap = map (mv tMap)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass a => PrefixClass (AnnotatedList a) where
8113dac419143273351446c3ad653f3fe5ba5cfdwrowe mv tMap = map (\ (ans, b) -> (mv tMap ans, mv tMap b))
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass ListFrameBit where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap lfb = case lfb of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes AnnotationBit anl -> AnnotationBit (mv tMap anl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ExpressionBit anl -> ExpressionBit (mv tMap anl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectBit anl -> ObjectBit (mv tMap anl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataBit anl -> DataBit (mv tMap anl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes IndividualSameOrDifferent anl ->
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes IndividualSameOrDifferent (mv tMap anl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataPropRange anl -> DataPropRange (mv tMap anl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes IndividualFacts ans -> IndividualFacts (mv tMap ans)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass AnnFrameBit where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap afb = case afb of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DatatypeBit dr -> DatatypeBit (mv tMap dr)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ClassDisjointUnion cel -> ClassDisjointUnion (map (mv tMap) cel)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ClassHasKey ol dl -> ClassHasKey (map (mv tMap) ol) (map (mv tMap) dl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectSubPropertyChain ol -> ObjectSubPropertyChain (map (mv tMap) ol)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass FrameBit where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap fb = case fb of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ListFrameBit mr lfb -> ListFrameBit mr (mv tMap lfb)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes AnnFrameBit ans afb -> AnnFrameBit (mv tMap ans) (mv tMap afb)
8113dac419143273351446c3ad653f3fe5ba5cfdwroweinstance PrefixClass Extended where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap ex = case ex of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Misc ans -> Misc $ mv tMap ans
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes SimpleEntity e -> SimpleEntity $ mv tMap e
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ClassEntity ce -> ClassEntity $ mv tMap ce
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectEntity op -> ObjectEntity $ mv tMap op
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Frame where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap (Frame ex fbl) = Frame (mv tMap ex) (map (mv tMap) fbl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Axiom where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap (PlainAxiom ex fbl) = PlainAxiom (mv tMap ex) (mv tMap fbl)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Fact where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap f = case f of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes ObjectPropertyFact pn op i -> ObjectPropertyFact pn (mv tMap op) (mv tMap i)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes DataPropertyFact pn dp l -> DataPropertyFact pn (mv tMap dp) (mv tMap l)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass OntologyDocument where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap ( OntologyDocument pm onto) =
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes OntologyDocument (mv tMap pm) (mv tMap onto)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesinstance PrefixClass Ontology where
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes mv tMap ( Ontology ouri impList anList f) =
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Ontology (mv tMap ouri) (map (mv tMap) impList)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (map (mv tMap) anList) (map (mv tMap) f)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholestestAndInteg :: (String, String)
f43b67c5a9d29b572eac916f8335cedc80c908bebnicholes -> (PrefixMap, TranslationMap) -> (PrefixMap, TranslationMap)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholestestAndInteg (pre, oiri) (old, tm) = case Map.lookup pre old of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes if oiri == iri then (old, tm)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes else let pre' = disambiguateName pre old
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes in (Map.insert pre' oiri old, Map.insert pre pre' tm)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes Nothing -> (Map.insert pre oiri old, tm)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesdisambiguateName :: String -> PrefixMap -> String
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesdisambiguateName name nameMap =
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes let newname = reverse . dropWhile isDigit $ reverse name
f43b67c5a9d29b572eac916f8335cedc80c908bebnicholes in fromJust $ find (not . flip Map.member nameMap)
e8f95a682820a599fe41b22977010636be5c2717jim [newname ++ show (i :: Int) | i <- [1 ..]]
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesuniteSign :: Sign -> Sign -> Result Sign
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesuniteSign s1 s2 = do
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes let (pm, tm) = integPref (prefixMap s1) (prefixMap s2)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes if Map.null tm then return (addSign s1 s2) {prefixMap = pm}
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes else fail "Static analysis could not unite signatures"
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesintegPref :: PrefixMap -> PrefixMap
b08925593f214f621161742925dcf074a8047e0acovener -> (PrefixMap, TranslationMap)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesintegPref oldNsMap testNsMap =
54d22ed1c429b903b029bbd62621f11a9e286137minfrin foldr testAndInteg (oldNsMap, Map.empty) (Map.toList testNsMap)
e8f95a682820a599fe41b22977010636be5c2717jimnewOid :: OntologyIRI -> OntologyIRI -> OntologyIRI
3dfeb02cfb853d8717ca0cc259b59fea610173f5bnicholesnewOid id1 id2 =
3dfeb02cfb853d8717ca0cc259b59fea610173f5bnicholes let lid1 = localPart id1
54d22ed1c429b903b029bbd62621f11a9e286137minfrin lid2 = localPart id2
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes in if null lid1 then id2
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes else if null lid2 || id1 == id2 then id1
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes else id1 { localPart = uriToName lid1 ++ "_" ++ uriToName lid2 }
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholesintegrateOntologyDoc :: OntologyDocument -> OntologyDocument
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes -> OntologyDocument
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholesintegrateOntologyDoc of1@( OntologyDocument ns1
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes ( Ontology oid1 imp1 anno1 frames1))
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes of2@( OntologyDocument ns2
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes ( Ontology oid2 imp2 anno2 frames2)) =
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes if of1 == of2 then of1
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes let (newPref, tm) = integPref ns1 ns2
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes in OntologyDocument newPref
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes (Ontology (newOid oid1 oid2) (nub $ imp1 ++ map (mv tm) imp2)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (nub $ anno1 ++ map (mv tm) anno2)
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes (nub $ frames1 ++ map (mv tm) frames2))
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholesuriToName :: String -> String
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholesuriToName str = let
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes str' = case str of
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes '"' : _ -> read str
d330a801b1e5d63a4b8b4fd431542ad0903fd71bbnicholes in takeWhile (/= '.') $ reverse $ case takeWhile (/= '/') $ reverse str' of
d5b12fe8ae917e654a33247fd4e59dc9e75170aebnicholes '#' : r -> r