MMiSSOntology.hs revision 9035db0b84603cb494e48ec767f138641d389ca0
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederModule : $Header$
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederCopyright : (c) Uni Bremen 2004-2007
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiMaintainer : luecke@informatik.uni-bremen.de
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederStability : provisional
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederPortability : non-portable (imports Control.Monad.Error)
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederMMiSSOntology provides the abstract data type for an Ontology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederWithin the MMiSS project a language for defining and representing
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederontologies has been created. In general classes, relations, predicates
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederand operations between classes, objects and links between objects can
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederbe expressed. Inheritance is possible for classes and
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederrelations. Further details about ontologies in MMiSS are given in the
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederpaper "Semantic Interrelation with Ontologies".
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederAt the moment, the module ist designed for storing ontologies in the
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich"MMiSS sense". Later on, it should be investigated, if it is
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederreasonable to adapt the module for OWL or KIF ontologies.
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederThe module defines a data type \tt{MMISSOntology} which stores all
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederinformation contained in a MMiSS-Ontology. \tt{emptyMMiSSOntology}
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederprovides a fresh, clean ontology labeld with the delivered name. After
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedercreating an empty ontology, the insertion functions () should be used
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederto fill the ontology. -}
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng Jiang ( MMiSSOntology
25a0b76bc87e80c0f697951d9817862755a71d33Christian Maeder , DefaultText
25a0b76bc87e80c0f697951d9817862755a71d33Christian Maeder , Cardinality
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , RelationProperty(..)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , InsertMode(..)
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder , OntoObjectType(..)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , ClassType(..)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , fromWithError
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich , emptyMMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , insertClass
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , insertObject
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , insertBaseRelation
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , insertRelationType
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getOntologyName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getRelationNames
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getClassGraph
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getRelationGraph
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederimport Data.Char (toLower)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederimport qualified Data.Map as Map
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype ClassName = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype ObjectName = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype SuperClass = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype DefaultText = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype Cardinality = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype SuperRel = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype RelName = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype RelationText = String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype AutoInserted = Bool
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maedertype WithError = Either String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype ClassGraph = Gr (String, String, OntoObjectType) String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederhasError :: String -> WithError a
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederhasError = Left
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian MaederhasValue :: a -> WithError a
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian MaederhasValue = Right
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder-- | like either
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederweither :: (String -> b) -> (a -> b) -> WithError a -> b
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederweither = either
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder-- | convert to another monad
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederfromWithError :: (Monad m) => WithError a -> m a
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederfromWithError = either fail return
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederdata RelationProperty = InversOf String | Functional deriving (Eq, Read, Show)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder AutoInsert: When a new class is to be inserted and the given
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder SuperClass is not present in the ontology, it is
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder automatically inserted with just it's name. The caller
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder can later on insert the missing class without getting
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder an error message (the class information is beeing
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder updated). The same happens if a SuperRelation is not
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder present when a new relation is inserted.
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ThrowError: The insertClass or insertRelation function calls will
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder throw an error instead of performing an autoinsert.
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederdata InsertMode = AutoInsert | ThrowError deriving (Eq, Read, Show)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederdata ClassType = SubSort | Predicate deriving (Eq, Read, Show)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederdata MMiSSOntology = MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder { getOntologyName :: String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , classes :: Map.Map String ClassDecl
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , objects :: Map.Map String ObjectDecl
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng Jiang , relations :: Map.Map String RelationDecl
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , objectLinks :: [ObjectLink]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , mode :: InsertMode
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getClassGraph :: ClassGraph
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getRelationGraph :: Gr String String }
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederdata ClassDecl = ClassDecl
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [(RelName, [ClassName])]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (Maybe ClassType)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederdata ObjectDecl = ObjectDecl ObjectName DefaultText ClassName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederdata RelationDecl = RelationDecl
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (Maybe Cardinality)
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder [RelationTypeDecl]
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder (Maybe SuperRel)
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maederdata RelationTypeDecl = RelationTypeDecl ClassName ClassName
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maederdata ObjectLink = ObjectLink ObjectName ObjectName RelName
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng JiangemptyMMiSSOntology :: String -> InsertMode -> MMiSSOntology
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian MaederemptyMMiSSOntology ontoName insertMode = MMiSSOntology
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder { getOntologyName = ontoName
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder , objectLinks = []
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , mode = insertMode
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getClassGraph = empty
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getRelationGraph = empty }
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetRelationNames :: MMiSSOntology -> [String]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetRelationNames = Map.keys . relations
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng JianginsError :: String -> String -> WithError a
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsError s r = hasError $ "Insertion of " ++ s ++ r
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsErr :: String -> WithError a
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsErr str = insError str " doesn't exist in the Ontology.\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkMsgStr :: String -> String -> String -> WithError a
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkMsgStr str nam e = insErr $
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder map toLower str ++ ": " ++ nam ++ " -> " ++ str ++ e
3a9d784341454573b50b32fa1b494e7418df3086Christian MaederwriteErr :: String -> String -> WithError a
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwriteErr str nam = mkMsgStr str nam
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " is properly defined and can't be overridden. (AutoInsert is on).\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederdupErr :: String -> String -> WithError a
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederdupErr str nam = mkMsgStr str nam
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " is already defined in Ontology.\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertClass :: MMiSSOntology -> ClassName -> DefaultText -> [SuperClass]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> (Maybe ClassType) -> WithError MMiSSOntology
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian MaederinsertClass onto className optText superCs maybeType =
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder (myInsertClass className optText superCs maybeType)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ( \ (ClassDecl _ _ _ _ auto _) ->
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder case mode onto of
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng Jiang AutoInsert ->
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder then myInsertClass className optText superCs maybeType
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder else writeErr "Class" className
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> dupErr "Class" className)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder $ Map.lookup className $ classes onto
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder myInsertClass cn opt super classType =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let class1 = (cn, (ClassDecl cn opt super [] False classType))
3a9d784341454573b50b32fa1b494e7418df3086Christian Maeder in case super of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [] -> addClasses' [class1] super
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder superClasses ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let undefSC =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder filter ( \ sC -> not $ Map.member sC $ classes onto)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder sClassDecls =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder map ( \ sC -> (sC, (ClassDecl sC "" [] []
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder True Nothing))) undefSC
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in if null undefSC
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder then addClasses' [class1] super
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder else case mode onto of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder AutoInsert -> addClasses' (class1 : sClassDecls) super
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> insErr $ "class: " ++ cn ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " -> Superclass " ++ show undefSC
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder addClasses' :: [(String, ClassDecl)] -> [SuperClass]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> WithError MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder addClasses' cList superCls =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let g = getClassGraph onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case cList of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [(classNam, ClassDecl _ _ _ _ _ cType)] ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let (g1, node1) = getInsNode g classNam cType
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in foldl (addIsaEdge node1) g1 superCls
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (subClass, ClassDecl _ _ _ _ _ subcType) : _ ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let (g1, node1) = getInsNode g subClass subcType
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in foldl (insClass node1) g1 superCls
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in hasValue $ (addOnlyClasses onto cList) { getClassGraph = newgraph }
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder getInsNode g cl clType =
4b1833c7d3af466e6bcba24f16304e0a78e8da87Christian Maeder maybe (let n = head (newNodes 1 g)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in (insNode (n,(cl,"", getClassNodeType clType)) g, n))
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (\ node -> (g, node))
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (findLNode g cl)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder insClass node1 g1 sC =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case getInsNode g1 sC Nothing of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -- at this place all autoinserted classes have type
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -- Nothing (s. def. of sClassDecls)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (g2,node2) -> insEdge (node1, node2, "isa") g2
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder addIsaEdge node1 g1 =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder maybe g1 (\ sNode -> insEdge (node1, sNode, "isa") g1)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder . findLNode g1
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder getClassNodeType = maybe OntoClass ( \ cType -> case cType of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Predicate -> OntoPredicate
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> OntoClass)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddRelations :: MMiSSOntology -> [(String, RelationDecl)] -> MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddRelations o rList = o
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder { relations = Map.union (relations o) $ Map.fromList rList }
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder{- | inserts a new Relation into the Ontology. It throws an error if
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder the relation name already exists. -}
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertBaseRelation :: MMiSSOntology -> RelName -> DefaultText
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> Maybe SuperRel -> Maybe Cardinality
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> WithError MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertBaseRelation onto relName defText superRel card =
4b1833c7d3af466e6bcba24f16304e0a78e8da87Christian Maeder case Map.lookup relName (relations onto) of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> myInsertRel relName defText superRel card
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just(RelationDecl _ _ _ _ _ auto) ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case mode onto of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder AutoInsert ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder then myInsertRel relName defText superRel card
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder else writeErr "Relation" relName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> dupErr "Relation" relName
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder addRels = hasValue . addRelations onto
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder myInsertRel rn def super c =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let rel1 = (rn, (RelationDecl rn c def [] super False))
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in case super of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> addRels [rel1]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just superR ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder if Map.member superR $ relations onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder then addRels [rel1]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder else case mode onto of
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder AutoInsert ->
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder let rel2 = (superR, (RelationDecl superR Nothing ""
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [] Nothing True))
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in addRels [rel1, rel2]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> insErr $ "relation: " ++ rn ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " -> Superrelation " ++ superR
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddOnlyClasses :: MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddOnlyClasses o cList =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder o { classes = Map.union (classes o) $ Map.fromList cList }
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddClasses :: MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddClasses o cList = (addOnlyClasses o cList)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder { getClassGraph = foldl addClassNodeWithoutDecl (getClassGraph o) cList }
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian MaederinsertClasses :: MMiSSOntology -> ClassName -> String
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder -> WithError MMiSSOntology
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian MaederinsertClasses o className str = case Map.lookup className $ classes o of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> case mode o of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder AutoInsert -> return $ addClasses o
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [(className, ClassDecl className "" [] [] True Nothing)]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> insErr $ str ++ className
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> return o
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder{- | inserts a new RelationType declaration into the Ontology. It
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder throws an error if the relation name doesn't exist. -}
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertRelationType :: MMiSSOntology -> RelName -> ClassName -> ClassName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> WithError MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertRelationType onto relName source target =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder do o1 <- lookupClass onto source
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder o2 <- lookupClass o1 target
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder o3 <- case Map.lookup relName (relations o2) of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> case mode o2 of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder AutoInsert -> return $ addRelations o2
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [(relName, RelationDecl relName Nothing "" [] Nothing True)]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> insErr $ "relation type: Relation " ++ relName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just (RelationDecl nam card defText typeList super inserted) ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let newType = RelationTypeDecl source target
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder newRel = (RelationDecl nam card defText
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (typeList ++ [newType]) super inserted)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in return (addRelations o2 [(nam, newRel)])
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder addEdge o3 (getClassGraph o3) relName source target
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder lookupClass o className =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case Map.lookup className $ classes o of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> insertClasses o className "relation type: Class "
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just (ClassDecl cn defT sup typeList ai classType) ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder if cn == source
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder then let mayTypeDecl = find ((relName ==) . fst) typeList
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder newClassList = case mayTypeDecl of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just (_, clist) -> clist ++ [target]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> [target]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder newTypeList = deleteBy isEqualTypelist (relName, [])
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder typeList ++ [(relName, newClassList)]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in return (addClasses o
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [(className, (ClassDecl cn defT sup newTypeList
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ai classType))])
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder else return o
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder addEdge ontol g rel src tar =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case findLNode g src of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> return ontol
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just snode -> case findLNode g tar of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> return ontol
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just tnode -> return ontol
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder { getClassGraph = insEdge (snode, tnode, rel) g }
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederisEqualTypelist :: (RelName, [ClassName]) -> (RelName, [ClassName]) -> Bool
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederisEqualTypelist (r1, _) (r2, _) = r1 == r2
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertObject :: MMiSSOntology -> ObjectName -> DefaultText -> ClassName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> WithError MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertObject onto objectName defText className =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder do o1 <- if Map.member objectName (objects onto)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder then hasError("Insertion of object: " ++ objectName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ " already exists.")
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder else return onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder o2 <- insertClasses o1 className $
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "object: " ++ objectName ++ " -> Class "
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder { classes = classes o2
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , objects = Map.insert objectName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (ObjectDecl objectName defText className) $ objects onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getClassGraph = addObjectToGraph objectName className
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder $ getClassGraph onto }
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder addObjectToGraph nam classNam g =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case findLNode g nam of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> let n = head (newNodes 1 g)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in insNode (n, ("_" ++ nam ++ "_", classNam,
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder OntoObject)) g
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder{- | inserts a new link of type RelationName between the two given
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder objects. Throws an error if RelationName, SourceObject or
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder TargetObject doesn't exist. -}
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertLink :: MMiSSOntology -> String -> String -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> WithError MMiSSOntology
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederinsertLink onto source target relName = do
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng Jiang let objs = objects onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case Map.lookup source objs of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just _ -> return ()
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> insErr' "Object" source
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case Map.lookup target objs of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just _ -> return ()
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> insErr' "Object" target
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case Map.lookup relName $ relations onto of
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng Jiang Just _ -> return ()
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Nothing -> insErr' "Relation" relName
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder { objectLinks = objectLinks onto ++ [ObjectLink source target relName]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , getClassGraph = addObjectLinkToGraph source target
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder relName $ getClassGraph onto }
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder insErr' str val =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder insErr $ map toLower str ++ " link: " ++ str ++ " " ++ val
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder addObjectLinkToGraph src tar relNam g =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case findLNode g $ "_" ++ src ++ "_" of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just sNode -> case findLNode g $ "_" ++ tar ++ "_" of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Just tNode -> insEdge (sNode, tNode, relNam) g
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder{- | is checking ontologies which have been created in AutoInsert
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder mode. For these ontologies there could be classes and relations
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder that were inserted automatically rather than defined properly
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder via insertClass or insertRelation. If the InsertMode of the
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder provided ontology is 'ThrowError' returns an empty list. If
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder there are no classes or relations with AutoInserted mark returns
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder also an empty list, otherwise it returns a list of error
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder messages stating, which class or which relation definition is
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederisComplete :: MMiSSOntology -> [String]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederisComplete onto = case mode onto of
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng Jiang ThrowError -> []
c8f7825c403897ea0295a9a6d2b626aefb2b7f61Heng Jiang _ -> Map.foldWithKey checkClass [] (classes onto)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ Map.foldWithKey checkRel [] (relations onto)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder mkMsg str nam = [str ++ nam ++ " is not properly defined."]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder checkClass className (ClassDecl _ _ _ _ inserted _) l =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder if inserted then l ++ mkMsg "Class " className else l
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder checkRel relName (RelationDecl _ _ _ _ _ inserted) l =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder if inserted then l ++ mkMsg "Relation " relName else l
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederexportOWL :: MMiSSOntology -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederexportOWL onto =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let startStr = owlStart $ getOntologyName onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder relationsStr = foldl writeOWLRelation "" $ Map.elems $ relations onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder classesStr = foldl writeOWLClass "" $ Map.elems $ classes onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder objectsStr = foldl writeOWLObject "" $ Map.elems $ objects onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder linksStr = foldl writeOWLLink "" $ objectLinks onto
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder endStr = "</rdf:RDF>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in startStr ++ classesStr ++ relationsStr ++ objectsStr ++ linksStr ++ endStr
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwriteOWLLink :: String -> ObjectLink -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwriteOWLLink inStr (ObjectLink object1 object2 relName) =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let start = "<rdf:Description rdf:about=\"#" ++ object1 ++ "\">\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder propStr = "<" ++ relName ++ " rdf:resource=\"#" ++ object2 ++ "\"/>\n"
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder end = "</rdf:Description>\n"
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder in inStr ++ start ++ propStr ++ end
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwriteOWLObject :: String -> ObjectDecl -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwriteOWLObject inStr (ObjectDecl nam defText instanceOf) =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let start = "<rdf:Description" ++ " rdf:about=\"#" ++ nam ++ "\">\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder defTextStr = "<MPhrase>" ++ latexToEntity defText ++ "</MPhrase>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder classStr = "<rdf:type>\n <owl:Class rdf:about=\"#" ++ instanceOf
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ "\"/>\n</rdf:type>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder end = "</rdf:Description>"
3a9d784341454573b50b32fa1b494e7418df3086Christian Maeder in inStr ++ start ++ defTextStr ++ classStr ++ end
3a9d784341454573b50b32fa1b494e7418df3086Christian MaederwriteOWLClass :: String -> ClassDecl -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwriteOWLClass inStr (ClassDecl nam defText super relTypes _ _) =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let start = "<owl:Class rdf:ID=\"" ++ nam ++ "\">\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder defTextStr = " <MPhrase>" ++ latexToEntity defText ++ "</MPhrase>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder concatMap (\ str -> "<rdfs:subClassOf rdf:resource=\"#" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder str ++ "\"/>\n" ) super
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder propertyRestrictions = foldl writePropRestriction "" relTypes
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder end = "</owl:Class>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in inStr ++ start ++ defTextStr ++ superStr ++ propertyRestrictions ++ end
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwritePropRestriction :: String -> (RelName, [ClassName]) -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwritePropRestriction inStr (relName, classList) =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder case classList of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder start = "<rdfs:subClassOf>\n <owl:Restriction>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder classStr = " <owl:allValuesFrom>\n" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " <owl:Class rdf:about=\"#" ++ hd
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ "\"/>\n" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " </owl:allValuesFrom>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder onPropStr = " <owl:onProperty>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ " <owl:ObjectProperty rdf:about=\"#"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ relName ++ "\"/>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ " </owl:onProperty>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder end = " </owl:Restriction>\n</rdfs:subClassOf>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in inStr ++ start ++ onPropStr ++ classStr ++ end
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder _ -> let start = "<rdfs:subClassOf>\n <owl:Restriction>\n " ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "<owl:onProperty>\n" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " <owl:ObjectProperty rdf:about=\"#" ++ relName ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " </owl:onProperty>\n" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " <owl:allValuesFrom>\n" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " <owl:Class>\n" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder " <owl:unionOf rdf:parseType=\"Collection\">\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder restrictions = foldl writeSingleClassRestriction "" classList
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder end = "</owl:unionOf>\n</owl:Class>\n</owl:allValuesFrom>\n" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "</owl:Restriction>\n</rdfs:subClassOf>\n"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in inStr ++ start ++ restrictions ++ end
3a9d784341454573b50b32fa1b494e7418df3086Christian MaederwriteSingleClassRestriction :: String -> ClassName -> String
3a9d784341454573b50b32fa1b494e7418df3086Christian MaederwriteSingleClassRestriction inStr className =
3a9d784341454573b50b32fa1b494e7418df3086Christian Maeder inStr ++ "<owl:Class rdf:about=\"#" ++ className ++ "\"/>\n"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus LuettichwriteOWLRelation :: String -> RelationDecl -> String
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus LuettichwriteOWLRelation inStr (RelationDecl relName card relText _ super _) =
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich let start = "<owl:ObjectProperty rdf:ID=\"" ++ relName ++ "\">\n"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich propStr = case card of
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Just "->" -> " <rdf:type rdf:resource=\"&owl;FunctionalProperty\"/>"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Just ">" -> " <rdf:type rdf:resource=\"&owl;TransitiveProperty\"/>"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Just ">=" -> " <rdf:type rdf:resource=\"&owl;TransitiveProperty\"/>"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Just "=" -> " <rdf:type rdf:resource=\"&owl;TransitiveProperty\"/>"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich ++ " <rdf:type rdf:resource=\"&owl;SymmetricProperty\"/>"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Just "<->" -> " <rdf:type rdf:resource=\"&owl;FunctionalProperty\"/>"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich ++ " <rdf:type rdf:resource=\"&owl;InverseFunctionalProperty\"/>"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich cardStr = case card of
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Just str -> " <MCardinality>" ++ latexToEntity str
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich ++ "</MCardinality>\n"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Nothing -> ""
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich defText = " <MPhrase>" ++ relText ++ "</MPhrase>\n"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich superStr = case super of
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Just str -> " <rdfs:subPropertyOf rdf:resource=\"#" ++ str
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich Nothing -> ""
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich end = "</owl:ObjectProperty>\n"
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich in inStr ++ start ++ propStr ++ cardStr ++ defText ++ superStr ++ end
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus LuettichowlStart :: String -> String
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus LuettichowlStart nam = unlines
fbc7d11880751ef87862b1f4650b16c01c6763f1Klaus Luettich [ "<?xml version=\"1.0\"?>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "<!DOCTYPE rdf:RDF ["
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <!ENTITY rdf \"http://www.w3.org/1999/02/22-rdf-syntax-ns#\">"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <!ENTITY rdfs \"http://www.w3.org/2000/01/rdf-schema#\" >"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <!ENTITY xsd \"http://www.w3.org/2001/XMLSchema#\" >"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <!ENTITY owl \"http://www.w3.org/2002/07/owl#\">"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "xmlns:rdf=\"&rdf;\""
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "xmlns:rdfs=\"&rdfs;\""
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "xmlns:owl=\"&owl;\""
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "xmlns:vcard=\"http://www.w3.org/2001/vcard-rdf/3.0#\""
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "xmlns:daml=\"http://www.daml.org/2001/03/daml+oil#\""
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "xmlns:dc=\"http://purl.org/dc/elements/1.1/\""
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "xmlns=\"" ++ nam ++ ".owl\">"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "<owl:Ontology rdf:about=\"" ++ nam ++ "\">"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , "<rdfs:comment>OWL ontology created by MMiSS OntoTool v0.2. " ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "For more information about the MMiSS project please visit " ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "http://www.mmiss.de</rdfs:comment>" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "</owl:Ontology>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <owl:AnnotationProperty rdf:ID=\"MPhrase\">"
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder , " <rdfs:range rdf:resource=" ++
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder "\"http://www.w3.org/2001/XMLSchema#string\"/>"
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder , " <rdf:type rdf:resource=" ++
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder "\"http://www.w3.org/2002/07/owl#DatatypeProperty\"/>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " </owl:AnnotationProperty>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <owl:AnnotationProperty rdf:ID=\"MCardinality\">"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <rdfs:range rdf:resource=" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "\"http://www.w3.org/2001/XMLSchema#string\"/>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " <rdf:type rdf:resource=" ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder "\"http://www.w3.org/2002/07/owl#DatatypeProperty\"/>"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , " </owl:AnnotationProperty>"
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederlatexToEntityList :: [(String, String)]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederlatexToEntityList = [("<", "&#60;"), (">", ">"), ("&", "&#38;")]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ++ [("'", "'"), ("\"", """)]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederlatexToEntity :: String -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederlatexToEntity inStr = foldl (applyTranslation "") inStr latexToEntityList
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederapplyTranslation :: String -> String -> (String, String) -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederapplyTranslation outStr inStr (search, replaceStr)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | lenInStr < lenSearch = outStr ++ inStr
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | isPrefixOf search inStr = applyTranslation (outStr ++ replaceStr)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (genericDrop lenSearch inStr) (search, replaceStr)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | otherwise = applyTranslation (outStr ++ take 1 inStr)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (drop 1 inStr) (search, replaceStr)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder lenInStr = genericLength inStr
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder lenSearch = genericLength search :: Integer
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergselLab :: ((String, String, OntoObjectType) -> Bool) -> ClassGraph
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> [Context (String, String, OntoObjectType) String]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergselLab f = gsel ( \ (_, _, l, _) -> f l)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergselName :: String -> ClassGraph
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> [Context (String, String, OntoObjectType) String]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergselName n = gselLab ( \ (l, _, _) -> n == l)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergselType :: (OntoObjectType -> Bool) -> ClassGraph
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -> [Context (String, String, OntoObjectType) String]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergselType f = gselLab ( \ (_, _, t) -> f t)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederfindLNode :: ClassGraph -> String -> Maybe Node
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederfindLNode gr label = case gselName label gr of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [] -> Nothing
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder hd : _ -> Just $ node' hd
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder{- | Insert a class-node into the graph. The ClassDecl doesn't have to
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederbe considered, because classes added here have no Superclass (they are
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederinserted in AutoInsert-Mode). -}
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddClassNodeWithoutDecl :: ClassGraph -> (String, ClassDecl) -> ClassGraph
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederaddClassNodeWithoutDecl g (cn, _) = case findLNode g cn of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder let node = head (newNodes 1 g)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder in insNode (node, (cn, "", OntoClass)) g