{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{- |
Module : ./OWL2/Function.hs
Copyright : (c) Felix Gabriel Mance
License : GPLv2 or higher, see LICENSE.txt
Maintainer : f.mance@jacobs-university.de
Stability : provisional
Portability : portable
Instances for some of the functions used in OWL 2
-}
module OWL2.Function where
import OWL2.AS
import Common.IRI
import Common.Id (stringToId)
import OWL2.MS
import OWL2.Sign
import OWL2.Symbols
import Data.List (stripPrefix)
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set
{- | this class contains general functions which operate on the ontology
document, such as prefix renaming, IRI expansion or Morphism mapping -}
class Function a where
function :: Action -> AMap -> a -> a
data Action = Rename | Expand
deriving (Show, Eq, Ord)
type StringMap = Map.Map String String
type MorphMap = Map.Map Entity IRI
data AMap =
StringMap StringMap
| MorphMap MorphMap
deriving (Show, Eq, Ord)
maybeDo :: (Function a) => Action -> AMap -> Maybe a -> Maybe a
maybeDo t mp = fmap $ function t mp
getIri :: EntityType -> IRI -> Map.Map Entity IRI -> IRI
getIri ty u = fromMaybe u . Map.lookup (mkEntity ty u)
cutWith :: EntityType -> Action -> AMap -> IRI -> IRI
cutWith ty t s anIri = cutIRI $ function t s $ mkEntity ty anIri
err :: t
err = error "operation not allowed"
instance Function PrefixMap where
function a m oldPs = case m of
StringMap mp -> case a of
Rename ->
foldl (\ ns (pre, ouri) ->
Map.insert (Map.findWithDefault pre pre mp) ouri ns)
Map.empty $ Map.toList oldPs
Expand -> oldPs
_ -> err
instance Function IRI where
function a m iri = case m of
StringMap pm -> case a of
Rename -> let pre = prefixName iri in
iri { prefixName = Map.findWithDefault pre pre pm}
Expand ->
let np = prefixName iri
lp = show $ iriPath iri
iRi = if hasFullIRI iri then let
ex = np ++ ":" ++ lp
res = let x = expandCurie (Map.map mkIRI pm) iri in
case x of
Just y -> y
Nothing -> error $ "could not expand:" ++ showIRI iri
in if elem np ["http", "https"] then -- abbreviate
case Map.lookup "" pm of
Just ep | length ep > 5 -> case stripPrefix ep ex of
Just rl@(_ : _) -> res
{ prefixName = ""
, iriPath = stringToId rl -- todo: maybe we should keep the Id structure of iriPath iri. See #1820
}
_ -> res
_ -> res
else res
else if isBlankNode iri then iri else
let iriMap = foldl (\pm' (kp, vp) ->
case parseIRI vp of
Just i -> Map.insert kp i pm'
Nothing -> if null kp then
Map.insert kp
((mkIRI vp))
pm'
else pm')
Map.empty $
Map.toList $ Map.union pm predefPrefixes
x = expandCurie iriMap iri
in case x of
Just y -> y
Nothing -> error $ "could not expand curie:" ++ showIRI iri
in setReservedPrefix iRi
_ -> iri
instance Function Sign where
function t mp (Sign p1 p2 p3 p4 p5 p6 p7 p8) = case mp of
StringMap _ ->
Sign (Set.map (function t mp) p1)
(Set.map (function t mp) p2)
(Set.map (function t mp) p3)
(Set.map (function t mp) p4)
(Set.map (function t mp) p5)
(Set.map (function t mp) p6)
(Map.mapKeys (function t mp) p7)
(function t mp p8)
_ -> err
instance Function Entity where
function t pm (Entity _ ty ent) = case pm of
StringMap _ -> mkEntity ty $ function t pm ent
MorphMap m -> mkEntity ty $ getIri ty ent m
instance Function Literal where
function t pm l = case l of
Literal lf (Typed dt) -> Literal lf $ Typed
$ cutWith Datatype t pm dt
_ -> l
instance Function ObjectPropertyExpression where
function t s opr = case opr of
ObjectProp op -> ObjectProp $ cutWith ObjectProperty t s op
ObjectInverseOf op -> ObjectInverseOf $ function t s op
instance Function DataRange where
function t s dra = case dra of
DataType dt ls -> DataType (cutWith Datatype t s dt)
$ map (\ (cf, rv) -> (function t s cf, function t s rv)) ls
DataJunction jt drl -> DataJunction jt $ map (function t s) drl
DataComplementOf dr -> DataComplementOf $ function t s dr
DataOneOf ll -> DataOneOf $ map (function t s) ll
instance Function ClassExpression where
function t s cle = case cle of
Expression c -> Expression $ cutWith Class t s c
ObjectJunction jt cel -> ObjectJunction jt $ map (function t s) cel
ObjectComplementOf ce -> ObjectComplementOf $ function t s ce
ObjectOneOf il -> ObjectOneOf $ map (cutWith NamedIndividual t s) il
ObjectValuesFrom qt op ce ->
ObjectValuesFrom qt (function t s op) $ function t s ce
ObjectHasValue op i -> ObjectHasValue (function t s op)
$ cutWith NamedIndividual t s i
ObjectHasSelf op -> ObjectHasSelf $ function t s op
ObjectCardinality (Cardinality ct i op mce) -> ObjectCardinality
$ Cardinality ct i (function t s op) $ maybeDo t s mce
DataValuesFrom qt dp dr -> DataValuesFrom qt
(cutWith DataProperty t s dp) $ function t s dr
DataHasValue dp l -> DataHasValue (cutWith DataProperty t s dp)
$ function t s l
DataCardinality (Cardinality ct i dp mdr) -> DataCardinality
$ Cardinality ct i (cutWith DataProperty t s dp) $ maybeDo t s mdr
instance Function Annotation where
function t s (Annotation al ap av) = Annotation (map (function t s) al)
(cutWith AnnotationProperty t s ap) $ function t s av
instance Function AnnotationValue where
function t s av = case av of
AnnValue anIri -> AnnValue $ function t s anIri
AnnValLit l -> AnnValLit $ function t s l
instance Function Annotations where
function t pm = map (function t pm)
-- | only for non-IRI AnnotatedLists
instance Function a => Function (AnnotatedList a) where
function t s = map (\ (ans, a) -> (map (function t s) ans, function t s a))
-- | only for IRI AnnotatedLists
mapAnnList :: EntityType -> Action -> AMap -> AnnotatedList IRI
-> AnnotatedList IRI
mapAnnList ty t m anl =
let ans = map fst anl
l = map snd anl
in zip (map (function t m) ans) $ map (cutWith ty t m) l
instance Function Fact where
function t s f = case f of
ObjectPropertyFact pn op i -> ObjectPropertyFact pn
(function t s op) $ cutWith NamedIndividual t s i
DataPropertyFact pn dp l -> DataPropertyFact pn
(cutWith DataProperty t s dp) $ function t s l
instance Function ListFrameBit where
function t s lfb = case lfb of
AnnotationBit al -> AnnotationBit $ mapAnnList AnnotationProperty t s al
ExpressionBit al -> ExpressionBit $ function t s al
ObjectBit al -> ObjectBit $ function t s al
DataBit al -> DataBit $ mapAnnList DataProperty t s al
IndividualSameOrDifferent al ->
IndividualSameOrDifferent $ mapAnnList NamedIndividual t s al
DataPropRange al -> DataPropRange $ function t s al
IndividualFacts al -> IndividualFacts $ function t s al
_ -> lfb
instance Function AnnFrameBit where
function t s afb = case afb of
DatatypeBit dr -> DatatypeBit $ function t s dr
ClassDisjointUnion cel -> ClassDisjointUnion $ map (function t s) cel
ClassHasKey opl dpl -> ClassHasKey (map (function t s) opl)
$ map (cutWith DataProperty t s) dpl
ObjectSubPropertyChain opl ->
ObjectSubPropertyChain $ map (function t s) opl
_ -> afb
instance Function FrameBit where
function t s fb = case fb of
ListFrameBit mr lfb -> ListFrameBit mr $ function t s lfb
AnnFrameBit ans afb -> AnnFrameBit (function t s ans)
(function t s afb)
instance Function Extended where
function t mp ex = case ex of
Misc ans -> Misc $ function t mp ans
SimpleEntity ent -> SimpleEntity $ function t mp ent
ClassEntity ce -> ClassEntity $ function t mp ce
ObjectEntity op -> ObjectEntity $ function t mp op
instance Function Frame where
function t mp (Frame ex fbl) = Frame (function t mp ex)
(map (function t mp) fbl)
instance Function Axiom where
function t mp (PlainAxiom ex fb) = PlainAxiom (function t mp ex)
(function t mp fb)
instance Function Ontology where
function t mp (Ontology ouri impList anList f) =
Ontology (function t mp ouri) (map (function t mp) impList)
(map (function t mp) anList) (map (function t mp) f)
instance Function OntologyDocument where
function t mp (OntologyDocument pm onto) =
OntologyDocument (function t mp pm) (function t mp onto)
instance Function RawSymb where
function t mp rs = case rs of
ASymbol e -> ASymbol $ function t mp e
AnUri i -> AnUri $ function t mp i
p -> p