content: {-# 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
    { osource :: Sign
    , otarget :: Sign
    , mmaps :: MorphMap
    } deriving (Show, Eq, Ord, Typeable, 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 m = Map.null (mmaps m) && isSubSign (osource m) (otarget m)
  
  instance Pretty RDFMorphism where
    pretty m = let
      s = osource m
      srcD = specBraces $ space <> pretty s
      t = otarget m
      in fsep $ if isRDFInclusion m then
             if isSubSign t s then
                [text "identity morphism over", srcD]
             else
               [ text "inclusion morphism of"
               , srcD
               , text "extended with"
               , pretty $ Set.difference (symOf t) $ symOf s ]
         else
           [ pretty $ mmaps m
           , colon <+> srcD, mapsto <+> specBraces (space <> pretty 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
  -}
  