Morphism.hs revision 15d62726781e67fe6458fbcf0a8c46832a7bb8da
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuModule : $Header$
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuDescription : RDF Morphism
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel ManceCopyright : (c) Francisc-Nicolae Bungiu, Felix Gabriel Mance, 2011
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuLicense : GPLv2 or higher, see LICENSE.txt
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuMaintainer : f.bungiu@jacobs-university.de
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuStability : provisional
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuPortability : portable
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuMorphisms for RDF
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Manceimport qualified Data.Set as Set
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae Bungiuimport qualified Data.Map as Map
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae Bungiudata RDFMorphism = RDFMorphism
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae Bungiu { osource :: Sign
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae Bungiu , otarget :: Sign
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae Bungiu , mmaps :: MorphMap
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae Bungiu } deriving (Show, Eq, Ord)
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuinclRDFMorphism :: Sign -> Sign -> RDFMorphism
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuinclRDFMorphism s t = RDFMorphism
5efb71382fdcce83a76a6d40e5f8def0462bf8a8Francisc Nicolae BungiuisRDFInclusion :: RDFMorphism -> Bool
386bd8214f3137fe84c392cd58338130d2f80607Felix Gabriel ManceisRDFInclusion m = Map.null (mmaps m) && isSubSign (osource m) (otarget m)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancesymMap :: MorphMap -> Map.Map RDFEntity RDFEntity
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancesymMap = Map.mapWithKey (\ (RDFEntity ty _) -> RDFEntity ty)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel ManceinducedElems :: MorphMap -> [RDFEntity]
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel ManceinducedElems = Map.elems . symMap
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel ManceinducedSign :: MorphMap -> Sign -> Sign
15d62726781e67fe6458fbcf0a8c46832a7bb8daFelix Gabriel ManceinducedSign m = execState (do
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance mapM_ (modEntity Set.delete) $ Map.keys m
15d62726781e67fe6458fbcf0a8c46832a7bb8daFelix Gabriel Mance mapM_ (modEntity Set.insert) $ inducedElems m)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel ManceinducedFromMor :: Map.Map RawSymb RawSymb -> Sign -> Result RDFMorphism
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel ManceinducedFromMor rm sig = do
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance let syms = symOf sig
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel Mance mm <- foldM (\ m p -> case p of
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance (ASymbol s@(RDFEntity _ v), ASymbol (RDFEntity _ u)) ->
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel Mance then return $ if u == v then m else Map.insert s u m
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance else fail $ "unknown symbol: " ++ showDoc s "\n" ++ shows sig ""
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance (AnUri v, AnUri u) -> case filter (`Set.member` syms)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance $ map (`RDFEntity` v) rdfEntityTypes of
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel Mance [] -> fail $ "unknown symbol: " ++ showDoc v "\n" ++ shows sig ""
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel Mance l -> return $ if u == v then m else foldr (`Map.insert` u) m l
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel Mance _ -> error "RDF.Morphism.inducedFromMor") Map.empty $ Map.toList rm
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance return RDFMorphism
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance { osource = sig
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel Mance , otarget = inducedSign mm sig
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance , mmaps = mm }
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancesymMapOf :: RDFMorphism -> Map.Map RDFEntity RDFEntity
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancesymMapOf mor = Map.union (symMap $ mmaps mor) $ setToMap $ symOf $ osource mor
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Manceinstance Pretty RDFMorphism where
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance pretty m = let
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance srcD = specBraces $ space <> pretty s
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance in if isRDFInclusion m then
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance if isSubSign t s then
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance fsep [text "identity morphism over", srcD]
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance [ text "inclusion morphism of"
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance , text "extended with"
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance , pretty $ Set.difference (symOf t) $ symOf s ]
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance [ pretty $ mmaps m
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance , colon <+> srcD, mapsto <+> specBraces (space <> pretty t) ]
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancelegalMor :: RDFMorphism -> Result ()
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancelegalMor m = let mm = mmaps m in unless
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance (Set.isSubsetOf (Map.keysSet mm) (symOf $ osource m)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance && Set.isSubsetOf (Set.fromList $ inducedElems mm) (symOf $ otarget m))
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance $ fail "illegal RDF morphism"
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancecomposeMor :: RDFMorphism -> RDFMorphism -> Result RDFMorphism
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancecomposeMor m1 m2 =
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance let nm = Set.fold (\ s@(RDFEntity ty u) -> let
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance t = getIri ty u $ mmaps m1
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance r = getIri ty t $ mmaps m2
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance in if r == u then id else Map.insert s r) Map.empty
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance . symOf $ osource m1
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance { otarget = otarget m2
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance , mmaps = nm }
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancecogeneratedSign :: Set.Set RDFEntity -> Sign -> Result RDFMorphism
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancecogeneratedSign s sign =
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance let sig2 = execState (mapM_ (modEntity Set.delete) $ Set.toList s) sign
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance in if isSubSign sig2 sign then return $ inclRDFMorphism sig2 sign else
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance fail "non RDF subsignatures for (co)generatedSign"
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancegeneratedSign :: Set.Set RDFEntity -> Sign -> Result RDFMorphism
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancegeneratedSign s sign = cogeneratedSign (Set.difference (symOf sign) s) sign
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancematchesSym :: RDFEntity -> RawSymb -> Bool
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancematchesSym e@(RDFEntity _ u) r = case r of
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance ASymbol s -> s == e
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance AnUri s -> s == u || namePrefix u == localPart s && null (namePrefix s)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancestatSymbItems :: [SymbItems] -> [RawSymb]
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancestatSymbItems = concatMap
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance $ \ (SymbItems m us) -> case m of
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance Nothing -> map AnUri us
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance Just ty -> map (ASymbol . RDFEntity ty) us
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancestatSymbMapItems :: [SymbMapItems] -> Result (Map.Map RawSymb RawSymb)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancestatSymbMapItems =
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance foldM (\ m (s, t) -> case Map.lookup s m of
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance Nothing -> return $ Map.insert s t m
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance Just u -> case (u, t) of
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance (AnUri su, ASymbol (RDFEntity _ tu)) | su == tu ->
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance (ASymbol (RDFEntity _ su), AnUri tu) | su == tu -> return m
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance _ -> if u == t then return m else
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance fail $ "differently mapped symbol: " ++ showDoc s "\nmapped to "
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance ++ showDoc u " and " ++ showDoc t "")
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance . concatMap (\ (SymbMapItems m us) ->
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance let ps = map (\ (u, v) -> (u, fromMaybe u v)) us in
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance Nothing -> map (\ (s, t) -> (AnUri s, AnUri t)) ps
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance let mS = ASymbol . RDFEntity ty
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel Mance in map (\ (s, t) -> (mS s, mS t)) ps)
e5ea4eeaeefd3521ae3475719e18c96cf91637d5Felix Gabriel MancemapSen :: RDFMorphism -> Axiom -> Result Axiom
386bd8214f3137fe84c392cd58338130d2f80607Felix Gabriel MancemapSen m a = return $ function Rename (MorphMap $ mmaps m) a