Morphism.hs revision e9458b1a7a19a63aa4c179f9ab20f4d50681c168
e83ed59502a681713982f25c559aae77a4145734Christian Maeder{-# LANGUAGE DeriveDataTypeable #-}
eb483f2216949400bfef8f6deb5320f071445626Christian MaederDescription : RDF Morphism
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuCopyright : (c) Francisc-Nicolae Bungiu, Felix Gabriel Mance, 2011
eb483f2216949400bfef8f6deb5320f071445626Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
eb483f2216949400bfef8f6deb5320f071445626Christian MaederMaintainer : f.bungiu@jacobs-university.de
eb483f2216949400bfef8f6deb5320f071445626Christian MaederStability : provisional
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederPortability : portable
eb483f2216949400bfef8f6deb5320f071445626Christian MaederMorphisms for RDF
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport qualified Data.Map as Map
e83ed59502a681713982f25c559aae77a4145734Christian Maederimport qualified Data.Set as Set
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederdata RDFMorphism = RDFMorphism
e83ed59502a681713982f25c559aae77a4145734Christian Maeder { osource :: Sign
e83ed59502a681713982f25c559aae77a4145734Christian Maeder , otarget :: Sign
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , mmaps :: MorphMap
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder } deriving (Show, Eq, Ord, Typeable, Data)
e83ed59502a681713982f25c559aae77a4145734Christian MaederinclRDFMorphism :: Sign -> Sign -> RDFMorphism
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederinclRDFMorphism s t = RDFMorphism
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder { osource = s
e83ed59502a681713982f25c559aae77a4145734Christian Maeder , otarget = t
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaedersymMap :: MorphMap -> Map.Map RDFEntity RDFEntity
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaedersymMap = Map.mapWithKey (\ (RDFEntity ty _) -> RDFEntity ty)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederinducedElems :: MorphMap -> [RDFEntity]
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederinducedElems = Map.elems . symMap
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederinducedSign :: MorphMap -> Sign -> Sign
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederinducedSign m = execState (do
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder mapM_ (modEntity Set.insert) $ inducedElems m)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederinducedFromMor :: Map.Map RawSymb RawSymb -> Sign -> Result RDFMorphism
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederinducedFromMor rm sig = do
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder let syms = symOf sig
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder mm <- foldM (\ m p -> case p of
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder (ASymbol s@(RDFEntity _ v), ASymbol (RDFEntity _ u)) ->
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder then return $ if u == v then m else Map.insert s u m
2eb84fc82d3ffa9116bc471fda3742bd9e5a24bbChristian Maeder else fail $ "unknown symbol: " ++ showDoc s "\n" ++ shows sig ""
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder (AnUri v, AnUri u) -> case filter (`Set.member` syms)
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder $ map (`RDFEntity` v) rdfEntityTypes of
2eb84fc82d3ffa9116bc471fda3742bd9e5a24bbChristian Maeder [] -> fail $ "unknown symbol: " ++ showDoc v "\n" ++ shows sig ""
2eb84fc82d3ffa9116bc471fda3742bd9e5a24bbChristian Maeder l -> return $ if u == v then m else foldr (`Map.insert` u) m l
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder _ -> error "RDF.Morphism.inducedFromMor") Map.empty $ Map.toList rm
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder return RDFMorphism
35db0960aa2e2a13652381c756fae5fb2b27213bChristian Maeder { osource = sig
1320edfb75af112d509a6ce0a4c02425da7fed4dChristian Maeder , otarget = inducedSign mm sig
42c01284bba8d7c8d995c8dfb96ace57d28ed1bcTill Mossakowski , mmaps = mm }
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaedersymMapOf :: RDFMorphism -> Map.Map RDFEntity RDFEntity
eb483f2216949400bfef8f6deb5320f071445626Christian MaedersymMapOf mor = Map.union (symMap $ mmaps mor) $ setToMap $ symOf $ osource mor
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederisRDFInclusion :: RDFMorphism -> Bool
eb483f2216949400bfef8f6deb5320f071445626Christian MaederisRDFInclusion m = Map.null (mmaps m) && isSubSign (osource m) (otarget m)
e83ed59502a681713982f25c559aae77a4145734Christian Maederinstance Pretty RDFMorphism where
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pretty m = let
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder s = osource m
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder srcD = specBraces $ space <> pretty s
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder t = otarget m
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder in fsep $ if isRDFInclusion m then
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski if isSubSign t s then
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski [text "identity morphism over", srcD]
e33e3b425e953236b4617870f995d263ac35b883Christian Maeder [ text "inclusion morphism of"
e83ed59502a681713982f25c559aae77a4145734Christian Maeder , text "extended with"
e33e3b425e953236b4617870f995d263ac35b883Christian Maeder , pretty $ Set.difference (symOf t) $ symOf s ]
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski [ pretty $ mmaps m
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski , colon <+> srcD, mapsto <+> specBraces (space <> pretty t) ]
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaederlegalMor :: RDFMorphism -> Result ()
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaederlegalMor m = let mm = mmaps m in unless
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder (Set.isSubsetOf (Map.keysSet mm) (symOf $ osource m)
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder && Set.isSubsetOf (Set.fromList $ inducedElems mm) (symOf $ otarget m))
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder $ fail "illegal RDF morphism"
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedercomposeMor :: RDFMorphism -> RDFMorphism -> Result RDFMorphism
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedercomposeMor m1 m2 =
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder let nm = Set.fold (\ s@(RDFEntity ty u) -> let
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder t = getIri ty u $ mmaps m1
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder r = getIri ty t $ mmaps m2
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder in if r == u then id else Map.insert s r) Map.empty
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder . symOf $ osource m1
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder { otarget = otarget m2
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder , mmaps = nm }
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedercogeneratedSign :: Set.Set RDFEntity -> Sign -> Result RDFMorphism
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedercogeneratedSign s sign =
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder let sig2 = execState (mapM_ (modEntity Set.delete) $ Set.toList s) sign
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder in if isSubSign sig2 sign then return $ inclRDFMorphism sig2 sign else
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder fail "non RDF subsignatures for (co)generatedSign"
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedergeneratedSign :: Set.Set RDFEntity -> Sign -> Result RDFMorphism
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedergeneratedSign s sign = cogeneratedSign (Set.difference (symOf sign) s) sign
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedermatchesSym :: RDFEntity -> RawSymb -> Bool
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaedermatchesSym e@(RDFEntity _ u) r = case r of
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski ASymbol s -> s == e
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder AnUri s -> s == u || namePrefix u == localPart s && null (namePrefix s)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederstatSymbItems :: [SymbItems] -> [RawSymb]
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederstatSymbItems = concatMap
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder $ \ (SymbItems m us) -> case m of
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder Nothing -> map AnUri us
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder Just ty -> map (ASymbol . RDFEntity ty) us
eb483f2216949400bfef8f6deb5320f071445626Christian MaederstatSymbMapItems :: [SymbMapItems] -> Result (Map.Map RawSymb RawSymb)
eb483f2216949400bfef8f6deb5320f071445626Christian MaederstatSymbMapItems =
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder foldM (\ m (s, t) -> case Map.lookup s m of
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder Nothing -> return $ Map.insert s t m
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder Just u -> case (u, t) of
c58a5efdb3c9fbc80deb1c69716f09c67292a41dChristian Maeder (AnUri su, ASymbol (RDFEntity _ tu)) | su == tu ->
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder (ASymbol (RDFEntity _ su), AnUri tu) | su == tu -> return m
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder _ -> if u == t then return m else
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder fail $ "differently mapped symbol: " ++ showDoc s "\nmapped to "
e83ed59502a681713982f25c559aae77a4145734Christian Maeder ++ showDoc u " and " ++ showDoc t "")
e953bea49e7f0e1a43bccf2a66c5e2a2b50848e0Christian Maeder . concatMap (\ (SymbMapItems m us) ->
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder let ps = map (\ (u, v) -> (u, fromMaybe u v)) us in
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder Nothing -> map (\ (s, t) -> (AnUri s, AnUri t)) ps
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder let mS = ASymbol . RDFEntity ty
dc427a9450cd7b463717a2255c804afa47a54365Christian Maeder in map (\ (s, t) -> (mS s, mS t)) ps)
eb483f2216949400bfef8f6deb5320f071445626Christian MaedermapSen :: RDFMorphism -> Axiom -> Result Axiom
eb483f2216949400bfef8f6deb5320f071445626Christian MaedermapSen m a = return $ function Rename (MorphMap $ mmaps m) a