{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./RDF/Morphism.hs
Description :  RDF Morphism
Copyright   :  (c) Francisc-Nicolae Bungiu, Felix Gabriel Mance, 2011
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  f.bungiu@jacobs-university.de
Stability   :  provisional
Portability :  portable

Morphisms for RDF
-}

module RDF.Morphism where

import Common.DocUtils
import Common.Doc
{-
import Common.Lib.State
import Common.Lib.MapSet (setToMap)
import Common.Result

import qualified OWL2.AS as AS
import RDF.AS
-}
import RDF.Sign
import RDF.Function
{- import RDF.StaticAnalysis
import RDF.Symbols -}
import RDF.Print ()
{- }
import Control.Monad
import Data.Maybe
-}
import Data.Data
import qualified Data.Map as Map
import qualified Data.Set as Set

data RDFMorphism = RDFMorphism
  { RDFMorphism -> Sign
osource :: Sign
  , RDFMorphism -> Sign
otarget :: Sign
  , RDFMorphism -> MorphMap
mmaps :: MorphMap
  } deriving (Int -> RDFMorphism -> ShowS
[RDFMorphism] -> ShowS
RDFMorphism -> String
(Int -> RDFMorphism -> ShowS)
-> (RDFMorphism -> String)
-> ([RDFMorphism] -> ShowS)
-> Show RDFMorphism
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RDFMorphism] -> ShowS
$cshowList :: [RDFMorphism] -> ShowS
show :: RDFMorphism -> String
$cshow :: RDFMorphism -> String
showsPrec :: Int -> RDFMorphism -> ShowS
$cshowsPrec :: Int -> RDFMorphism -> ShowS
Show, RDFMorphism -> RDFMorphism -> Bool
(RDFMorphism -> RDFMorphism -> Bool)
-> (RDFMorphism -> RDFMorphism -> Bool) -> Eq RDFMorphism
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RDFMorphism -> RDFMorphism -> Bool
$c/= :: RDFMorphism -> RDFMorphism -> Bool
== :: RDFMorphism -> RDFMorphism -> Bool
$c== :: RDFMorphism -> RDFMorphism -> Bool
Eq, Eq RDFMorphism
Eq RDFMorphism =>
(RDFMorphism -> RDFMorphism -> Ordering)
-> (RDFMorphism -> RDFMorphism -> Bool)
-> (RDFMorphism -> RDFMorphism -> Bool)
-> (RDFMorphism -> RDFMorphism -> Bool)
-> (RDFMorphism -> RDFMorphism -> Bool)
-> (RDFMorphism -> RDFMorphism -> RDFMorphism)
-> (RDFMorphism -> RDFMorphism -> RDFMorphism)
-> Ord RDFMorphism
RDFMorphism -> RDFMorphism -> Bool
RDFMorphism -> RDFMorphism -> Ordering
RDFMorphism -> RDFMorphism -> RDFMorphism
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RDFMorphism -> RDFMorphism -> RDFMorphism
$cmin :: RDFMorphism -> RDFMorphism -> RDFMorphism
max :: RDFMorphism -> RDFMorphism -> RDFMorphism
$cmax :: RDFMorphism -> RDFMorphism -> RDFMorphism
>= :: RDFMorphism -> RDFMorphism -> Bool
$c>= :: RDFMorphism -> RDFMorphism -> Bool
> :: RDFMorphism -> RDFMorphism -> Bool
$c> :: RDFMorphism -> RDFMorphism -> Bool
<= :: RDFMorphism -> RDFMorphism -> Bool
$c<= :: RDFMorphism -> RDFMorphism -> Bool
< :: RDFMorphism -> RDFMorphism -> Bool
$c< :: RDFMorphism -> RDFMorphism -> Bool
compare :: RDFMorphism -> RDFMorphism -> Ordering
$ccompare :: RDFMorphism -> RDFMorphism -> Ordering
$cp1Ord :: Eq RDFMorphism
Ord, Typeable, Typeable RDFMorphism
Constr
DataType
Typeable RDFMorphism =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RDFMorphism -> c RDFMorphism)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RDFMorphism)
-> (RDFMorphism -> Constr)
-> (RDFMorphism -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RDFMorphism))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RDFMorphism))
-> ((forall b. Data b => b -> b) -> RDFMorphism -> RDFMorphism)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r)
-> (forall u. (forall d. Data d => d -> u) -> RDFMorphism -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RDFMorphism -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism)
-> Data RDFMorphism
RDFMorphism -> Constr
RDFMorphism -> DataType
(forall b. Data b => b -> b) -> RDFMorphism -> RDFMorphism
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RDFMorphism -> c RDFMorphism
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RDFMorphism
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RDFMorphism -> u
forall u. (forall d. Data d => d -> u) -> RDFMorphism -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RDFMorphism
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RDFMorphism -> c RDFMorphism
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RDFMorphism)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RDFMorphism)
$cRDFMorphism :: Constr
$tRDFMorphism :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
gmapMp :: (forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
gmapM :: (forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RDFMorphism -> m RDFMorphism
gmapQi :: Int -> (forall d. Data d => d -> u) -> RDFMorphism -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RDFMorphism -> u
gmapQ :: (forall d. Data d => d -> u) -> RDFMorphism -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RDFMorphism -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RDFMorphism -> r
gmapT :: (forall b. Data b => b -> b) -> RDFMorphism -> RDFMorphism
$cgmapT :: (forall b. Data b => b -> b) -> RDFMorphism -> RDFMorphism
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RDFMorphism)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RDFMorphism)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RDFMorphism)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RDFMorphism)
dataTypeOf :: RDFMorphism -> DataType
$cdataTypeOf :: RDFMorphism -> DataType
toConstr :: RDFMorphism -> Constr
$ctoConstr :: RDFMorphism -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RDFMorphism
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RDFMorphism
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RDFMorphism -> c RDFMorphism
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RDFMorphism -> c RDFMorphism
$cp1Data :: Typeable RDFMorphism
Data)
{- }
inclRDFMorphism :: Sign -> Sign -> RDFMorphism
inclRDFMorphism s t = RDFMorphism
 { osource = s
 , otarget = t
 , mmaps = Map.empty }

symMap :: MorphMap -> Map.Map RDFEntity RDFEntity
symMap = Map.mapWithKey (\ (RDFEntity ty _) -> RDFEntity ty)

inducedElems :: MorphMap -> [RDFEntity]
inducedElems = Map.elems . symMap

inducedSign :: MorphMap -> Sign -> Sign
inducedSign m = execState (do
            mapM_ (modEntity Set.delete) $ Map.keys m
            mapM_ (modEntity Set.insert) $ inducedElems m)

inducedFromMor :: Map.Map RawSymb RawSymb -> Sign -> Result RDFMorphism
inducedFromMor rm sig = do
  let syms = symOf sig
  mm <- foldM (\ m p -> case p of
        (ASymbol s@(RDFEntity _ v), ASymbol (RDFEntity _ u)) ->
            if Set.member s syms
            then return $ if u == v then m else Map.insert s u m
            else fail $ "unknown symbol: " ++ showDoc s "\n" ++ shows sig ""
        (AnUri v, AnUri u) -> case filter (`Set.member` syms)
          $ map (`RDFEntity` v) rdfEntityTypes of
          [] -> fail $ "unknown symbol: " ++ showDoc v "\n" ++ shows sig ""
          l -> return $ if u == v then m else foldr (`Map.insert` u) m l
        _ -> error "RDF.Morphism.inducedFromMor") Map.empty $ Map.toList rm
  return RDFMorphism
    { osource = sig
    , otarget = inducedSign mm sig
    , mmaps = mm }

symMapOf :: RDFMorphism -> Map.Map RDFEntity RDFEntity
symMapOf mor = Map.union (symMap $ mmaps mor) $ setToMap $ symOf $ osource mor
-}

isRDFInclusion :: RDFMorphism -> Bool
isRDFInclusion :: RDFMorphism -> Bool
isRDFInclusion m :: RDFMorphism
m = MorphMap -> Bool
forall k a. Map k a -> Bool
Map.null (RDFMorphism -> MorphMap
mmaps RDFMorphism
m) Bool -> Bool -> Bool
&& Sign -> Sign -> Bool
isSubSign (RDFMorphism -> Sign
osource RDFMorphism
m) (RDFMorphism -> Sign
otarget RDFMorphism
m)

instance Pretty RDFMorphism where
  pretty :: RDFMorphism -> Doc
pretty m :: RDFMorphism
m = let
    s :: Sign
s = RDFMorphism -> Sign
osource RDFMorphism
m
    srcD :: Doc
srcD = Doc -> Doc
specBraces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sign -> Doc
forall a. Pretty a => a -> Doc
pretty Sign
s
    t :: Sign
t = RDFMorphism -> Sign
otarget RDFMorphism
m
    in [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ if RDFMorphism -> Bool
isRDFInclusion RDFMorphism
m then
           if Sign -> Sign -> Bool
isSubSign Sign
t Sign
s then
              [String -> Doc
text "identity morphism over", Doc
srcD]
           else
             [ String -> Doc
text "inclusion morphism of"
             , Doc
srcD
             , String -> Doc
text "extended with"
             , Set RDFEntity -> Doc
forall a. Pretty a => a -> Doc
pretty (Set RDFEntity -> Doc) -> Set RDFEntity -> Doc
forall a b. (a -> b) -> a -> b
$ Set RDFEntity -> Set RDFEntity -> Set RDFEntity
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Sign -> Set RDFEntity
symOf Sign
t) (Set RDFEntity -> Set RDFEntity) -> Set RDFEntity -> Set RDFEntity
forall a b. (a -> b) -> a -> b
$ Sign -> Set RDFEntity
symOf Sign
s ]
       else
         [ MorphMap -> Doc
forall a. Pretty a => a -> Doc
pretty (MorphMap -> Doc) -> MorphMap -> Doc
forall a b. (a -> b) -> a -> b
$ RDFMorphism -> MorphMap
mmaps RDFMorphism
m
         , Doc
colon Doc -> Doc -> Doc
<+> Doc
srcD, Doc
mapsto Doc -> Doc -> Doc
<+> Doc -> Doc
specBraces (Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sign -> Doc
forall a. Pretty a => a -> Doc
pretty Sign
t) ]
{-
legalMor :: RDFMorphism -> Result ()
legalMor m = let mm = mmaps m in unless
  (Set.isSubsetOf (Map.keysSet mm) (symOf $ osource m)
  && Set.isSubsetOf (Set.fromList $ inducedElems mm) (symOf $ otarget m))
        $ fail "illegal RDF morphism"
composeMor :: RDFMorphism -> RDFMorphism -> Result RDFMorphism
composeMor m1 m2 =
  let nm = Set.fold (\ s@(RDFEntity ty u) -> let
            t = getIri ty u $ mmaps m1
            r = getIri ty t $ mmaps m2
            in if r == u then id else Map.insert s r) Map.empty
           . symOf $ osource m1
  in return m1
     { otarget = otarget m2
     , mmaps = nm }

cogeneratedSign :: Set.Set RDFEntity -> Sign -> Result RDFMorphism
cogeneratedSign s sign =
  let sig2 = execState (mapM_ (modEntity Set.delete) $ Set.toList s) sign
  in if isSubSign sig2 sign then return $ inclRDFMorphism sig2 sign else
         fail "non RDF subsignatures for (co)generatedSign"

generatedSign :: Set.Set RDFEntity -> Sign -> Result RDFMorphism
generatedSign s sign = cogeneratedSign (Set.difference (symOf sign) s) sign

matchesSym :: RDFEntity -> RawSymb -> Bool
matchesSym e@(RDFEntity _ u) r = case r of
  ASymbol s -> s == e
  AnUri s -> s == u || namePrefix u == localPart s && null (namePrefix s)

statSymbItems :: [SymbItems] -> [RawSymb]
statSymbItems = concatMap
  $ \ (SymbItems m us) -> case m of
               Nothing -> map AnUri us
               Just ty -> map (ASymbol . RDFEntity ty) us

statSymbMapItems :: [SymbMapItems] -> Result (Map.Map RawSymb RawSymb)
statSymbMapItems =
  foldM (\ m (s, t) -> case Map.lookup s m of
    Nothing -> return $ Map.insert s t m
    Just u -> case (u, t) of
      (AnUri su, ASymbol (RDFEntity _ tu)) | su == tu ->
        return $ Map.insert s t m
      (ASymbol (RDFEntity _ su), AnUri tu) | su == tu -> return m
      _ -> if u == t then return m else
        fail $ "differently mapped symbol: " ++ showDoc s "\nmapped to "
             ++ showDoc u " and " ++ showDoc t "")
  Map.empty
  . concatMap (\ (SymbMapItems m us) ->
      let ps = map (\ (u, v) -> (u, fromMaybe u v)) us in
      case m of
        Nothing -> map (\ (s, t) -> (AnUri s, AnUri t)) ps
        Just ty ->
            let mS = ASymbol . RDFEntity ty
            in map (\ (s, t) -> (mS s, mS t)) ps)

mapSen :: RDFMorphism -> Axiom -> Result Axiom
mapSen m a = return $ function Rename (MorphMap $ mmaps m) a
-}