Sign.hs

{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./OWL2/Sign.hs
Copyright   :  Heng Jiang, Uni Bremen 2007
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

OWL 2 signature and sentences
-}

module OWL2.Sign where


import Common.IRI
import OWL2.AS

import qualified Data.Set as Set
import qualified Data.Map as Map

import Common.Lib.State
import Common.Result

import Control.Monad

import Data.Data

data Sign = Sign
            { concepts :: Set.Set Class
              -- classes
            , datatypes :: Set.Set Datatype -- datatypes
            , objectProperties :: Set.Set ObjectProperty
              -- object properties
            , dataProperties :: Set.Set DataProperty
              -- data properties
            , annotationRoles :: Set.Set AnnotationProperty
              -- annotation properties
            , individuals :: Set.Set NamedIndividual  -- named individuals
            , labelMap :: Map.Map IRI String -- labels (for better readability)
            , prefixMap :: PrefixMap
            } deriving (Show, Typeable, Data)

instance Ord Sign where
  compare (Sign c1 d1 op1 dp1 ar1 iv1 _ _) (Sign c2 d2 op2 dp2 ar2 iv2 _ _)
    = compare (c1, d1, op1, dp1, ar1, iv1) (c2, d2, op2, dp2, ar2, iv2)

instance Eq Sign where
  s1 == s2 = compare s1 s2 == EQ

data SignAxiom =
    Subconcept ClassExpression ClassExpression   -- subclass, superclass
  | Role (DomainOrRangeOrFunc (RoleKind, RoleType)) ObjectPropertyExpression
  | Data (DomainOrRangeOrFunc ()) DataPropertyExpression
  | Conceptmembership Individual ClassExpression
    deriving (Show, Eq, Ord, Typeable, Data)

data RoleKind = FuncRole | RefRole deriving (Show, Eq, Ord, Typeable, Data)

data RoleType = IRole | DRole deriving (Show, Eq, Ord, Typeable, Data)

data DesKind = RDomain | DDomain | RIRange
  deriving (Show, Eq, Ord, Typeable, Data)

data DomainOrRangeOrFunc a =
    DomainOrRange DesKind ClassExpression
  | RDRange DataRange
  | FuncProp a
    deriving (Show, Eq, Ord, Typeable, Data)

emptySign :: Sign
emptySign = Sign
  { concepts = Set.empty
  , datatypes = Set.empty
  , objectProperties = Set.empty
  , dataProperties = Set.empty
  , annotationRoles = Set.empty
  , individuals = Set.empty
  , labelMap = Map.empty
  , prefixMap = Map.empty
  }

diffSig :: Sign -> Sign -> Sign
diffSig a b =
    a { concepts = concepts a `Set.difference` concepts b
      , datatypes = datatypes a `Set.difference` datatypes b
      , objectProperties = objectProperties a
            `Set.difference` objectProperties b
      , dataProperties = dataProperties a `Set.difference` dataProperties b
      , annotationRoles = annotationRoles a `Set.difference` annotationRoles b
      , individuals = individuals a `Set.difference` individuals b
      }

addSymbToSign :: Sign -> Entity -> Result Sign
addSymbToSign sig ent =
 case ent of
   Entity _ Class eIri ->
    return sig {concepts = Set.insert eIri $ concepts sig}
   Entity _ ObjectProperty eIri ->
    return sig {objectProperties = Set.insert eIri $ objectProperties sig}
   Entity _ NamedIndividual eIri ->
    return sig {individuals = Set.insert eIri $ individuals sig}
   _ -> return sig

addSign :: Sign -> Sign -> Sign
addSign toIns totalSign =
    totalSign {
                concepts = Set.union (concepts totalSign)
                                     (concepts toIns),
                datatypes = Set.union (datatypes totalSign)
                                      (datatypes toIns),
                objectProperties = Set.union (objectProperties totalSign)
                                           (objectProperties toIns),
                dataProperties = Set.union (dataProperties totalSign)
                                            (dataProperties toIns),
                annotationRoles = Set.union (annotationRoles totalSign)
                                            (annotationRoles toIns),
                individuals = Set.union (individuals totalSign)
                                        (individuals toIns)
              }

isSubSign :: Sign -> Sign -> Bool
isSubSign a b =
    Set.isSubsetOf (concepts a) (concepts b)
       && Set.isSubsetOf (datatypes a) (datatypes b)
       && Set.isSubsetOf (objectProperties a) (objectProperties b)
       && Set.isSubsetOf (dataProperties a) (dataProperties b)
       && Set.isSubsetOf (annotationRoles a) (annotationRoles b)
       && Set.isSubsetOf (individuals a) (individuals b)

symOf :: Sign -> Set.Set Entity
symOf s = Set.unions
  [ Set.map (\ ir -> Entity (Map.lookup ir $ labelMap s) Class ir) $ concepts s
  , Set.map (mkEntity Datatype) $ datatypes s
  , Set.map (mkEntity ObjectProperty) $ objectProperties s
  , Set.map (mkEntity DataProperty) $ dataProperties s
  , Set.map (mkEntity NamedIndividual) $ individuals s
  , Set.map (mkEntity AnnotationProperty) $ annotationRoles s ]

-- | takes an entity and modifies the sign according to the given function
modEntity :: (IRI -> Set.Set IRI -> Set.Set IRI) -> Entity -> State Sign ()
modEntity f (Entity _ ty u) = do
  s <- get
  let chg = f u
  unless (isDatatypeKey u || isThing u) $ put $ case ty of
    Datatype -> s { datatypes = chg $ datatypes s }
    Class -> s { concepts = chg $ concepts s }
    ObjectProperty -> s { objectProperties = chg $ objectProperties s }
    DataProperty -> s { dataProperties = chg $ dataProperties s }
    NamedIndividual -> if isAnonymous u then s
         else s { individuals = chg $ individuals s }
    AnnotationProperty -> s {annotationRoles = chg $ annotationRoles s}

-- | adding entities to the signature
addEntity :: Entity -> State Sign ()
addEntity = modEntity Set.insert