{- |
Module      :  ./OWL2/ColimSign.hs
Description :  OWL signatures colimits
Copyright   :  (c) Mihai Codescu, and Uni Bremen 2009
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  mcodescu@informatik.uni-bremen.de
Stability   :  provisional
Portability :  non-portable

OWL2 signature colimits, computed component-wise.

-}

module OWL2.ColimSign where

import OWL2.Sign
import OWL2.Morphism
import OWL2.AS

import Common.SetColimit
import Common.Lib.Graph

import Data.Graph.Inductive.Graph as Graph
import qualified Data.Map as Map

signColimit :: Gr Sign (Int, OWLMorphism) ->
               (Sign, Map.Map Int OWLMorphism)
signColimit graph = let
   conGraph = emap (getEntityTypeMap Class) $ nmap concepts graph
   dataGraph = emap (getEntityTypeMap Datatype) $ nmap datatypes graph
   indGraph = emap (getEntityTypeMap NamedIndividual) $ nmap individuals graph
   objGraph = emap (getEntityTypeMap ObjectProperty) $
              nmap objectProperties graph
   dataPropGraph = emap (getEntityTypeMap DataProperty) $
               nmap dataProperties graph
   annPropGraph = emap (getEntityTypeMap AnnotationProperty) $
               nmap annotationRoles graph
   _prefixGraph = emap getPrefixMap
                    $ nmap (Map.keysSet . toQName . prefixMap) graph
   (con, funC) = addIntToSymbols $ computeColimitSet conGraph
   (dat, funD) = addIntToSymbols $ computeColimitSet dataGraph
   (ind, funI) = addIntToSymbols $ computeColimitSet indGraph
   (obj, funO) = addIntToSymbols $ computeColimitSet objGraph
   (dp, funDP) = addIntToSymbols $ computeColimitSet dataPropGraph
   (ap, funAP) = addIntToSymbols $ computeColimitSet annPropGraph
   -- (pf, funP) = addIntToSymbols $ computeColimitSet prefixGraph
   morFun i = foldl Map.union Map.empty
               [ setEntityTypeMap Class $
                   Map.findWithDefault (error "maps") i funC,
                 setEntityTypeMap Datatype $
                   Map.findWithDefault (error "maps") i funD,
                 setEntityTypeMap NamedIndividual $
                   Map.findWithDefault (error "maps") i funI,
                 setEntityTypeMap ObjectProperty $
                   Map.findWithDefault (error "maps") i funO,
                 setEntityTypeMap DataProperty $
                   Map.findWithDefault (error "maps") i funDP,
                 setEntityTypeMap AnnotationProperty $
                   Map.findWithDefault (error "maps") i funAP
                ]
   morMaps = Map.fromAscList $
              map (\ x -> (x, morFun x)) $ nodes graph

   nameMap = foldl Map.union Map.empty $
             map (\ (_, l) -> prefixMap l) $ labNodes graph
   colimSign = emptySign {
                  concepts = con,
                  datatypes = dat,
                  objectProperties = obj,
                  dataProperties = dp,
                  individuals = ind,
                  annotationRoles = ap,
                  prefixMap = nameMap
                }
   colimMor = Map.fromAscList $
                map (\ (i, ssig) -> let
                         mm = Map.findWithDefault (error "mor") i morMaps
                         om = OWLMorphism {
                               osource = ssig,
                               otarget = colimSign,
                               mmaps = mm,
                               pmap = Map.empty
                              }
                                   in (i, om)
                     ) $ labNodes graph
  in (colimSign, colimMor)

getEntityTypeMap :: EntityType -> (Int, OWLMorphism)
                    -> (Int, Map.Map QName QName)
getEntityTypeMap e (i, phi) = let
 f = Map.filterWithKey
      (\ (Entity _ x _) _ -> x == e) $ mmaps phi
 in (i, Map.fromList $
    map (\ (Entity _ _ x, y) -> (x, y)) $
    Map.toAscList f)

setEntityTypeMap :: EntityType -> Map.Map QName QName
                    -> Map.Map Entity QName
setEntityTypeMap = Map.mapKeys . mkEntity

getPrefixMap :: (Int, OWLMorphism) -> (Int, Map.Map QName QName)
getPrefixMap (i, phi) = let
    f = pmap phi
    in (i, Map.fromList $
        map (\ (x, y) -> (mkQName x, mkQName y)) $
            Map.toAscList f)

toQName :: PrefixMap -> Map.Map QName String
toQName pm = Map.fromList $ map (\ (p, s) -> (mkQName p, s)) $ Map.toList pm
