{- |
Module      :  ./Taxonomy/MMiSSOntology.hs
Copyright   :  (c) Uni Bremen 2004-2007
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  luecke@informatik.uni-bremen.de
Stability   :  provisional
Portability :  non-portable (imports Control.Monad.Error)

MMiSSOntology provides the abstract data type for an Ontology
-}

{-
Within the MMiSS project a language for defining and representing
ontologies has been created. In general classes, relations, predicates
and operations between classes, objects and links between objects can
be expressed. Inheritance is possible for classes and
relations. Further details about ontologies in MMiSS are given in the
paper "Semantic Interrelation with Ontologies".

At the moment, the module ist designed for storing ontologies in the
"MMiSS sense". Later on, it should be investigated, if it is
reasonable to adapt the module for OWL or KIF ontologies.

The module defines a data type \tt{MMISSOntology} which stores all
information contained in a MMiSS-Ontology. \tt{emptyMMiSSOntology}
provides a fresh, clean ontology labeld with the delivered name. After
creating an empty ontology, the insertion functions () should be used
to fill the ontology. -}

module Taxonomy.MMiSSOntology
    ( MMiSSOntology
    , ClassName
    , ClassGraph
    , ObjectName
    , SuperClass
    , DefaultText
    , Cardinality
    , SuperRel
    , RelName
    , RelationProperty (..)
    , InsertMode (..)
    , OntoObjectType (..)
    , ClassType (..)
    , weither
    , fromWithError
    , WithError
    , emptyMMiSSOntology
    , insertClass
    , insertObject
    , insertBaseRelation
    , insertRelationType
    , insertLink
    , isComplete
    , exportOWL
    , getOntologyName
    , getRelationNames
    , getClassGraph
    , getRelationGraph
    , hasError
    , hasValue
    , gselName
    , gselType
    , findLNode
    ) where

import Data.List
import Data.Char (toLower)

import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Basic
import Common.Lib.Graph
import qualified Data.Map as Map
import Common.Taxonomy
import qualified Control.Monad.Fail as Fail

type ClassName = String
type ObjectName = String
type SuperClass = String
type DefaultText = String
type Cardinality = String
type SuperRel = String
type RelName = String
type RelationText = String
type AutoInserted = Bool

type WithError = Either String
type ClassGraph = Gr (String, String, OntoObjectType) String

hasError :: String -> WithError a
hasError :: String -> WithError a
hasError = String -> WithError a
forall a b. a -> Either a b
Left

hasValue :: a -> WithError a
hasValue :: a -> WithError a
hasValue = a -> WithError a
forall a b. b -> Either a b
Right

-- | like either
weither :: (String -> b) -> (a -> b) -> WithError a -> b
weither :: (String -> b) -> (a -> b) -> WithError a -> b
weither = (String -> b) -> (a -> b) -> WithError a -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either

-- | convert to another monad
fromWithError :: (Fail.MonadFail m) => WithError a -> m a
fromWithError :: WithError a -> m a
fromWithError = (String -> m a) -> (a -> m a) -> WithError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

data RelationProperty = InversOf String | Functional deriving (RelationProperty -> RelationProperty -> Bool
(RelationProperty -> RelationProperty -> Bool)
-> (RelationProperty -> RelationProperty -> Bool)
-> Eq RelationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelationProperty -> RelationProperty -> Bool
$c/= :: RelationProperty -> RelationProperty -> Bool
== :: RelationProperty -> RelationProperty -> Bool
$c== :: RelationProperty -> RelationProperty -> Bool
Eq, ReadPrec [RelationProperty]
ReadPrec RelationProperty
Int -> ReadS RelationProperty
ReadS [RelationProperty]
(Int -> ReadS RelationProperty)
-> ReadS [RelationProperty]
-> ReadPrec RelationProperty
-> ReadPrec [RelationProperty]
-> Read RelationProperty
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelationProperty]
$creadListPrec :: ReadPrec [RelationProperty]
readPrec :: ReadPrec RelationProperty
$creadPrec :: ReadPrec RelationProperty
readList :: ReadS [RelationProperty]
$creadList :: ReadS [RelationProperty]
readsPrec :: Int -> ReadS RelationProperty
$creadsPrec :: Int -> ReadS RelationProperty
Read, Int -> RelationProperty -> ShowS
[RelationProperty] -> ShowS
RelationProperty -> String
(Int -> RelationProperty -> ShowS)
-> (RelationProperty -> String)
-> ([RelationProperty] -> ShowS)
-> Show RelationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelationProperty] -> ShowS
$cshowList :: [RelationProperty] -> ShowS
show :: RelationProperty -> String
$cshow :: RelationProperty -> String
showsPrec :: Int -> RelationProperty -> ShowS
$cshowsPrec :: Int -> RelationProperty -> ShowS
Show)

{- -
   AutoInsert: When a new class is to be inserted and the given
               SuperClass is not present in the ontology, it is
               automatically inserted with just it's name.  The caller
               can later on insert the missing class without getting
               an error message (the class information is beeing
               updated).  The same happens if a SuperRelation is not
               present when a new relation is inserted.
   ThrowError: The insertClass or insertRelation function calls will
               throw an error instead of performing an autoinsert.
- -}

data InsertMode = AutoInsert | ThrowError deriving (InsertMode -> InsertMode -> Bool
(InsertMode -> InsertMode -> Bool)
-> (InsertMode -> InsertMode -> Bool) -> Eq InsertMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertMode -> InsertMode -> Bool
$c/= :: InsertMode -> InsertMode -> Bool
== :: InsertMode -> InsertMode -> Bool
$c== :: InsertMode -> InsertMode -> Bool
Eq, ReadPrec [InsertMode]
ReadPrec InsertMode
Int -> ReadS InsertMode
ReadS [InsertMode]
(Int -> ReadS InsertMode)
-> ReadS [InsertMode]
-> ReadPrec InsertMode
-> ReadPrec [InsertMode]
-> Read InsertMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InsertMode]
$creadListPrec :: ReadPrec [InsertMode]
readPrec :: ReadPrec InsertMode
$creadPrec :: ReadPrec InsertMode
readList :: ReadS [InsertMode]
$creadList :: ReadS [InsertMode]
readsPrec :: Int -> ReadS InsertMode
$creadsPrec :: Int -> ReadS InsertMode
Read, Int -> InsertMode -> ShowS
[InsertMode] -> ShowS
InsertMode -> String
(Int -> InsertMode -> ShowS)
-> (InsertMode -> String)
-> ([InsertMode] -> ShowS)
-> Show InsertMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsertMode] -> ShowS
$cshowList :: [InsertMode] -> ShowS
show :: InsertMode -> String
$cshow :: InsertMode -> String
showsPrec :: Int -> InsertMode -> ShowS
$cshowsPrec :: Int -> InsertMode -> ShowS
Show)

data ClassType = SubSort | Predicate deriving (ClassType -> ClassType -> Bool
(ClassType -> ClassType -> Bool)
-> (ClassType -> ClassType -> Bool) -> Eq ClassType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassType -> ClassType -> Bool
$c/= :: ClassType -> ClassType -> Bool
== :: ClassType -> ClassType -> Bool
$c== :: ClassType -> ClassType -> Bool
Eq, ReadPrec [ClassType]
ReadPrec ClassType
Int -> ReadS ClassType
ReadS [ClassType]
(Int -> ReadS ClassType)
-> ReadS [ClassType]
-> ReadPrec ClassType
-> ReadPrec [ClassType]
-> Read ClassType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClassType]
$creadListPrec :: ReadPrec [ClassType]
readPrec :: ReadPrec ClassType
$creadPrec :: ReadPrec ClassType
readList :: ReadS [ClassType]
$creadList :: ReadS [ClassType]
readsPrec :: Int -> ReadS ClassType
$creadsPrec :: Int -> ReadS ClassType
Read, Int -> ClassType -> ShowS
[ClassType] -> ShowS
ClassType -> String
(Int -> ClassType -> ShowS)
-> (ClassType -> String)
-> ([ClassType] -> ShowS)
-> Show ClassType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassType] -> ShowS
$cshowList :: [ClassType] -> ShowS
show :: ClassType -> String
$cshow :: ClassType -> String
showsPrec :: Int -> ClassType -> ShowS
$cshowsPrec :: Int -> ClassType -> ShowS
Show)

data MMiSSOntology = MMiSSOntology
    { MMiSSOntology -> String
getOntologyName :: String
    , MMiSSOntology -> Map String ClassDecl
classes :: Map.Map String ClassDecl
    , MMiSSOntology -> Map String ObjectDecl
objects :: Map.Map String ObjectDecl
    , MMiSSOntology -> Map String RelationDecl
relations :: Map.Map String RelationDecl
    , MMiSSOntology -> [ObjectLink]
objectLinks :: [ObjectLink]
    , MMiSSOntology -> InsertMode
mode :: InsertMode
    , MMiSSOntology -> ClassGraph
getClassGraph :: ClassGraph
    , MMiSSOntology -> Gr String String
getRelationGraph :: Gr String String }

data ClassDecl = ClassDecl
    ClassName
    DefaultText
    [SuperClass]
    [(RelName, [ClassName])]
    AutoInserted
    (Maybe ClassType)

data ObjectDecl = ObjectDecl ObjectName DefaultText ClassName

data RelationDecl = RelationDecl
    RelName
    (Maybe Cardinality)
    RelationText
    [RelationTypeDecl]
    (Maybe SuperRel)
    AutoInserted

data RelationTypeDecl = RelationTypeDecl ClassName ClassName

data ObjectLink = ObjectLink ObjectName ObjectName RelName

emptyMMiSSOntology :: String -> InsertMode -> MMiSSOntology
emptyMMiSSOntology :: String -> InsertMode -> MMiSSOntology
emptyMMiSSOntology ontoName :: String
ontoName insertMode :: InsertMode
insertMode = MMiSSOntology :: String
-> Map String ClassDecl
-> Map String ObjectDecl
-> Map String RelationDecl
-> [ObjectLink]
-> InsertMode
-> ClassGraph
-> Gr String String
-> MMiSSOntology
MMiSSOntology
    { getOntologyName :: String
getOntologyName = String
ontoName
    , classes :: Map String ClassDecl
classes = Map String ClassDecl
forall k a. Map k a
Map.empty
    , objects :: Map String ObjectDecl
objects = Map String ObjectDecl
forall k a. Map k a
Map.empty
    , relations :: Map String RelationDecl
relations = Map String RelationDecl
forall k a. Map k a
Map.empty
    , objectLinks :: [ObjectLink]
objectLinks = []
    , mode :: InsertMode
mode = InsertMode
insertMode
    , getClassGraph :: ClassGraph
getClassGraph = ClassGraph
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
    , getRelationGraph :: Gr String String
getRelationGraph = Gr String String
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty }

getRelationNames :: MMiSSOntology -> [String]
getRelationNames :: MMiSSOntology -> [String]
getRelationNames = Map String RelationDecl -> [String]
forall k a. Map k a -> [k]
Map.keys (Map String RelationDecl -> [String])
-> (MMiSSOntology -> Map String RelationDecl)
-> MMiSSOntology
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMiSSOntology -> Map String RelationDecl
relations

insError :: String -> String -> WithError a
insError :: String -> String -> WithError a
insError s :: String
s r :: String
r = String -> WithError a
forall a. String -> WithError a
hasError (String -> WithError a) -> String -> WithError a
forall a b. (a -> b) -> a -> b
$ "Insertion of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r

insErr :: String -> WithError a
insErr :: String -> WithError a
insErr str :: String
str = String -> String -> WithError a
forall a. String -> String -> WithError a
insError String
str " doesn't exist in the Ontology.\n"

mkMsgStr :: String -> String -> String -> WithError a
mkMsgStr :: String -> String -> String -> WithError a
mkMsgStr str :: String
str nam :: String
nam e :: String
e = String -> WithError a
forall a. String -> WithError a
insErr (String -> WithError a) -> String -> WithError a
forall a b. (a -> b) -> a -> b
$
    (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nam String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

writeErr :: String -> String -> WithError a
writeErr :: String -> String -> WithError a
writeErr str :: String
str nam :: String
nam = String -> String -> String -> WithError a
forall a. String -> String -> String -> WithError a
mkMsgStr String
str String
nam
    " is properly defined and can't be overridden. (AutoInsert is on).\n"

dupErr :: String -> String -> WithError a
dupErr :: String -> String -> WithError a
dupErr str :: String
str nam :: String
nam = String -> String -> String -> WithError a
forall a. String -> String -> String -> WithError a
mkMsgStr String
str String
nam
    " is already defined in Ontology.\n"

insertClass :: MMiSSOntology -> ClassName -> DefaultText -> [SuperClass]
            -> Maybe ClassType -> WithError MMiSSOntology
insertClass :: MMiSSOntology
-> String
-> String
-> [String]
-> Maybe ClassType
-> WithError MMiSSOntology
insertClass onto :: MMiSSOntology
onto className :: String
className optText :: String
optText superCs :: [String]
superCs maybeType :: Maybe ClassType
maybeType =
  WithError MMiSSOntology
-> (ClassDecl -> WithError MMiSSOntology)
-> Maybe ClassDecl
-> WithError MMiSSOntology
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String
-> String -> [String] -> Maybe ClassType -> WithError MMiSSOntology
myInsertClass String
className String
optText [String]
superCs Maybe ClassType
maybeType)
    ( \ (ClassDecl _ _ _ _ auto :: Bool
auto _) ->
      case MMiSSOntology -> InsertMode
mode MMiSSOntology
onto of
        AutoInsert ->
          if Bool
auto
            then String
-> String -> [String] -> Maybe ClassType -> WithError MMiSSOntology
myInsertClass String
className String
optText [String]
superCs Maybe ClassType
maybeType
            else String -> String -> WithError MMiSSOntology
forall a. String -> String -> WithError a
writeErr "Class" String
className
        _ -> String -> String -> WithError MMiSSOntology
forall a. String -> String -> WithError a
dupErr "Class" String
className)
    (Maybe ClassDecl -> WithError MMiSSOntology)
-> Maybe ClassDecl -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ String -> Map String ClassDecl -> Maybe ClassDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
className (Map String ClassDecl -> Maybe ClassDecl)
-> Map String ClassDecl -> Maybe ClassDecl
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
onto
  where
    myInsertClass :: String
-> String -> [String] -> Maybe ClassType -> WithError MMiSSOntology
myInsertClass cn :: String
cn opt :: String
opt super :: [String]
super classType :: Maybe ClassType
classType =
      let class1 :: (String, ClassDecl)
class1 = (String
cn, String
-> String
-> [String]
-> [(String, [String])]
-> Bool
-> Maybe ClassType
-> ClassDecl
ClassDecl String
cn String
opt [String]
super [] Bool
False Maybe ClassType
classType)
      in case [String]
super of
           [] -> [(String, ClassDecl)] -> [String] -> WithError MMiSSOntology
addClasses' [(String, ClassDecl)
class1] [String]
super
           superClasses :: [String]
superClasses ->
               let undefSC :: [String]
undefSC =
                       (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ( \ sC :: String
sC -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Map String ClassDecl -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member String
sC (Map String ClassDecl -> Bool) -> Map String ClassDecl -> Bool
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
onto)
                              [String]
superClasses
                   sClassDecls :: [(String, ClassDecl)]
sClassDecls =
                       (String -> (String, ClassDecl))
-> [String] -> [(String, ClassDecl)]
forall a b. (a -> b) -> [a] -> [b]
map ( \ sC :: String
sC -> (String
sC, String
-> String
-> [String]
-> [(String, [String])]
-> Bool
-> Maybe ClassType
-> ClassDecl
ClassDecl String
sC "" [] []
                                              Bool
True Maybe ClassType
forall a. Maybe a
Nothing)) [String]
undefSC
               in if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
undefSC
                then [(String, ClassDecl)] -> [String] -> WithError MMiSSOntology
addClasses' [(String, ClassDecl)
class1] [String]
super
                else case MMiSSOntology -> InsertMode
mode MMiSSOntology
onto of
                      AutoInsert -> [(String, ClassDecl)] -> [String] -> WithError MMiSSOntology
addClasses' ((String, ClassDecl)
class1 (String, ClassDecl)
-> [(String, ClassDecl)] -> [(String, ClassDecl)]
forall a. a -> [a] -> [a]
: [(String, ClassDecl)]
sClassDecls) [String]
super
                      _ -> String -> WithError MMiSSOntology
forall a. String -> WithError a
insErr (String -> WithError MMiSSOntology)
-> String -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ "class: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cn String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     " -> Superclass " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
undefSC
    addClasses' :: [(String, ClassDecl)] -> [SuperClass]
                -> WithError MMiSSOntology
    addClasses' :: [(String, ClassDecl)] -> [String] -> WithError MMiSSOntology
addClasses' cList :: [(String, ClassDecl)]
cList superCls :: [String]
superCls =
       let g :: ClassGraph
g = MMiSSOntology -> ClassGraph
getClassGraph MMiSSOntology
onto
           newgraph :: ClassGraph
newgraph =
               case [(String, ClassDecl)]
cList of
               [] -> ClassGraph
g
               [(classNam :: String
classNam, ClassDecl _ _ _ _ _ cType :: Maybe ClassType
cType)] ->
                     let (g1 :: ClassGraph
g1, node1 :: Int
node1) = ClassGraph -> String -> Maybe ClassType -> (ClassGraph, Int)
getInsNode ClassGraph
g String
classNam Maybe ClassType
cType
                     in (ClassGraph -> String -> ClassGraph)
-> ClassGraph -> [String] -> ClassGraph
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int -> ClassGraph -> String -> ClassGraph
addIsaEdge Int
node1) ClassGraph
g1 [String]
superCls
               (subClass :: String
subClass, ClassDecl _ _ _ _ _ subcType :: Maybe ClassType
subcType) : _ ->
                   let (g1 :: ClassGraph
g1, node1 :: Int
node1) = ClassGraph -> String -> Maybe ClassType -> (ClassGraph, Int)
getInsNode ClassGraph
g String
subClass Maybe ClassType
subcType
                   in (ClassGraph -> String -> ClassGraph)
-> ClassGraph -> [String] -> ClassGraph
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int -> ClassGraph -> String -> ClassGraph
insClass Int
node1) ClassGraph
g1 [String]
superCls
       in MMiSSOntology -> WithError MMiSSOntology
forall a. a -> WithError a
hasValue (MMiSSOntology -> WithError MMiSSOntology)
-> MMiSSOntology -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ (MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addOnlyClasses MMiSSOntology
onto [(String, ClassDecl)]
cList) { getClassGraph :: ClassGraph
getClassGraph = ClassGraph
newgraph }
    getInsNode :: ClassGraph -> String -> Maybe ClassType -> (ClassGraph, Int)
getInsNode g :: ClassGraph
g cl :: String
cl clType :: Maybe ClassType
clType =
        (ClassGraph, Int)
-> (Int -> (ClassGraph, Int)) -> Maybe Int -> (ClassGraph, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (let n :: Int
n : _ = Int -> ClassGraph -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
newNodes 1 ClassGraph
g
               in (LNode (String, String, OntoObjectType) -> ClassGraph -> ClassGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (Int
n, (String
cl, "", Maybe ClassType -> OntoObjectType
getClassNodeType Maybe ClassType
clType)) ClassGraph
g, Int
n))
              (\ node :: Int
node -> (ClassGraph
g, Int
node))
              (ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g String
cl)
    insClass :: Int -> ClassGraph -> String -> ClassGraph
insClass node1 :: Int
node1 g1 :: ClassGraph
g1 sC :: String
sC =
        case ClassGraph -> String -> Maybe ClassType -> (ClassGraph, Int)
getInsNode ClassGraph
g1 String
sC Maybe ClassType
forall a. Maybe a
Nothing of
        {- at this place all autoinserted classes have type
        Nothing (s. def. of sClassDecls) -}
        (g2 :: ClassGraph
g2, node2 :: Int
node2) -> LEdge String -> ClassGraph -> ClassGraph
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (Int
node1, Int
node2, "isa") ClassGraph
g2
    addIsaEdge :: Int -> ClassGraph -> String -> ClassGraph
addIsaEdge node1 :: Int
node1 g1 :: ClassGraph
g1 =
        ClassGraph -> (Int -> ClassGraph) -> Maybe Int -> ClassGraph
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ClassGraph
g1 (\ sNode :: Int
sNode -> LEdge String -> ClassGraph -> ClassGraph
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (Int
node1, Int
sNode, "isa") ClassGraph
g1)
                 (Maybe Int -> ClassGraph)
-> (String -> Maybe Int) -> String -> ClassGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g1
    getClassNodeType :: Maybe ClassType -> OntoObjectType
getClassNodeType = OntoObjectType
-> (ClassType -> OntoObjectType)
-> Maybe ClassType
-> OntoObjectType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OntoObjectType
OntoClass ( \ cType :: ClassType
cType -> case ClassType
cType of
                               Predicate -> OntoObjectType
OntoPredicate
                               _ -> OntoObjectType
OntoClass)

addRelations :: MMiSSOntology -> [(String, RelationDecl)] -> MMiSSOntology
addRelations :: MMiSSOntology -> [(String, RelationDecl)] -> MMiSSOntology
addRelations o :: MMiSSOntology
o rList :: [(String, RelationDecl)]
rList = MMiSSOntology
o
       { relations :: Map String RelationDecl
relations = Map String RelationDecl
-> Map String RelationDecl -> Map String RelationDecl
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (MMiSSOntology -> Map String RelationDecl
relations MMiSSOntology
o) (Map String RelationDecl -> Map String RelationDecl)
-> Map String RelationDecl -> Map String RelationDecl
forall a b. (a -> b) -> a -> b
$ [(String, RelationDecl)] -> Map String RelationDecl
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, RelationDecl)]
rList }

{- | inserts a new Relation into the Ontology. It throws an error if
  the relation name already exists. -}
insertBaseRelation :: MMiSSOntology -> RelName -> DefaultText
                   -> Maybe SuperRel -> Maybe Cardinality
                   -> WithError MMiSSOntology
insertBaseRelation :: MMiSSOntology
-> String
-> String
-> Maybe String
-> Maybe String
-> WithError MMiSSOntology
insertBaseRelation onto :: MMiSSOntology
onto relName :: String
relName defText :: String
defText superRel :: Maybe String
superRel card :: Maybe String
card =
  case String -> Map String RelationDecl -> Maybe RelationDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
relName (MMiSSOntology -> Map String RelationDecl
relations MMiSSOntology
onto) of
    Nothing -> String
-> String
-> Maybe String
-> Maybe String
-> WithError MMiSSOntology
myInsertRel String
relName String
defText Maybe String
superRel Maybe String
card
    Just (RelationDecl _ _ _ _ _ auto :: Bool
auto) ->
      case MMiSSOntology -> InsertMode
mode MMiSSOntology
onto of
        AutoInsert ->
          if Bool
auto
            then String
-> String
-> Maybe String
-> Maybe String
-> WithError MMiSSOntology
myInsertRel String
relName String
defText Maybe String
superRel Maybe String
card
            else String -> String -> WithError MMiSSOntology
forall a. String -> String -> WithError a
writeErr "Relation" String
relName
        _ -> String -> String -> WithError MMiSSOntology
forall a. String -> String -> WithError a
dupErr "Relation" String
relName
  where
    addRels :: [(String, RelationDecl)] -> WithError MMiSSOntology
addRels = MMiSSOntology -> WithError MMiSSOntology
forall a. a -> WithError a
hasValue (MMiSSOntology -> WithError MMiSSOntology)
-> ([(String, RelationDecl)] -> MMiSSOntology)
-> [(String, RelationDecl)]
-> WithError MMiSSOntology
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMiSSOntology -> [(String, RelationDecl)] -> MMiSSOntology
addRelations MMiSSOntology
onto
    myInsertRel :: String
-> String
-> Maybe String
-> Maybe String
-> WithError MMiSSOntology
myInsertRel rn :: String
rn def :: String
def super :: Maybe String
super c :: Maybe String
c =
      let rel1 :: (String, RelationDecl)
rel1 = (String
rn, String
-> Maybe String
-> String
-> [RelationTypeDecl]
-> Maybe String
-> Bool
-> RelationDecl
RelationDecl String
rn Maybe String
c String
def [] Maybe String
super Bool
False)
      in case Maybe String
super of
           Nothing -> [(String, RelationDecl)] -> WithError MMiSSOntology
addRels [(String, RelationDecl)
rel1]
           Just superR :: String
superR ->
             if String -> Map String RelationDecl -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member String
superR (Map String RelationDecl -> Bool)
-> Map String RelationDecl -> Bool
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String RelationDecl
relations MMiSSOntology
onto
               then [(String, RelationDecl)] -> WithError MMiSSOntology
addRels [(String, RelationDecl)
rel1]
               else case MMiSSOntology -> InsertMode
mode MMiSSOntology
onto of
                      AutoInsert ->
                          let rel2 :: (String, RelationDecl)
rel2 = (String
superR, String
-> Maybe String
-> String
-> [RelationTypeDecl]
-> Maybe String
-> Bool
-> RelationDecl
RelationDecl String
superR Maybe String
forall a. Maybe a
Nothing ""
                                               [] Maybe String
forall a. Maybe a
Nothing Bool
True)
                          in [(String, RelationDecl)] -> WithError MMiSSOntology
addRels [(String, RelationDecl)
rel1, (String, RelationDecl)
rel2]
                      _ -> String -> WithError MMiSSOntology
forall a. String -> WithError a
insErr (String -> WithError MMiSSOntology)
-> String -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ "relation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rn String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     " -> Superrelation " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
superR

addOnlyClasses :: MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addOnlyClasses :: MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addOnlyClasses o :: MMiSSOntology
o cList :: [(String, ClassDecl)]
cList =
    MMiSSOntology
o { classes :: Map String ClassDecl
classes = Map String ClassDecl
-> Map String ClassDecl -> Map String ClassDecl
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
o) (Map String ClassDecl -> Map String ClassDecl)
-> Map String ClassDecl -> Map String ClassDecl
forall a b. (a -> b) -> a -> b
$ [(String, ClassDecl)] -> Map String ClassDecl
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, ClassDecl)]
cList }

addClasses :: MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addClasses :: MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addClasses o :: MMiSSOntology
o cList :: [(String, ClassDecl)]
cList = (MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addOnlyClasses MMiSSOntology
o [(String, ClassDecl)]
cList)
    { getClassGraph :: ClassGraph
getClassGraph = (ClassGraph -> (String, ClassDecl) -> ClassGraph)
-> ClassGraph -> [(String, ClassDecl)] -> ClassGraph
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ClassGraph -> (String, ClassDecl) -> ClassGraph
addClassNodeWithoutDecl (MMiSSOntology -> ClassGraph
getClassGraph MMiSSOntology
o) [(String, ClassDecl)]
cList }

insertClasses :: MMiSSOntology -> ClassName -> String
              -> WithError MMiSSOntology
insertClasses :: MMiSSOntology -> String -> String -> WithError MMiSSOntology
insertClasses o :: MMiSSOntology
o className :: String
className str :: String
str = case String -> Map String ClassDecl -> Maybe ClassDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
className (Map String ClassDecl -> Maybe ClassDecl)
-> Map String ClassDecl -> Maybe ClassDecl
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
o of
    Nothing -> case MMiSSOntology -> InsertMode
mode MMiSSOntology
o of
        AutoInsert -> MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return (MMiSSOntology -> WithError MMiSSOntology)
-> MMiSSOntology -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addClasses MMiSSOntology
o
             [(String
className, String
-> String
-> [String]
-> [(String, [String])]
-> Bool
-> Maybe ClassType
-> ClassDecl
ClassDecl String
className "" [] [] Bool
True Maybe ClassType
forall a. Maybe a
Nothing)]
        _ -> String -> WithError MMiSSOntology
forall a. String -> WithError a
insErr (String -> WithError MMiSSOntology)
-> String -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className
    _ -> MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
o

{- | inserts a new RelationType declaration into the Ontology. It
  throws an error if the relation name doesn't exist. -}
insertRelationType :: MMiSSOntology -> RelName -> ClassName -> ClassName
                   -> WithError MMiSSOntology
insertRelationType :: MMiSSOntology
-> String -> String -> String -> WithError MMiSSOntology
insertRelationType onto :: MMiSSOntology
onto relName :: String
relName source :: String
source target :: String
target =
  do MMiSSOntology
o1 <- MMiSSOntology -> String -> WithError MMiSSOntology
lookupClass MMiSSOntology
onto String
source
     MMiSSOntology
o2 <- MMiSSOntology -> String -> WithError MMiSSOntology
lookupClass MMiSSOntology
o1 String
target
     MMiSSOntology
o3 <- case String -> Map String RelationDecl -> Maybe RelationDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
relName (MMiSSOntology -> Map String RelationDecl
relations MMiSSOntology
o2) of
             Nothing -> case MMiSSOntology -> InsertMode
mode MMiSSOntology
o2 of
               AutoInsert -> MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return (MMiSSOntology -> WithError MMiSSOntology)
-> MMiSSOntology -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> [(String, RelationDecl)] -> MMiSSOntology
addRelations MMiSSOntology
o2
                 [(String
relName, String
-> Maybe String
-> String
-> [RelationTypeDecl]
-> Maybe String
-> Bool
-> RelationDecl
RelationDecl String
relName Maybe String
forall a. Maybe a
Nothing "" [] Maybe String
forall a. Maybe a
Nothing Bool
True)]
               _ -> String -> WithError MMiSSOntology
forall a. String -> WithError a
insErr (String -> WithError MMiSSOntology)
-> String -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$ "relation type: Relation " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
relName
             Just (RelationDecl nam :: String
nam card :: Maybe String
card defText :: String
defText typeList :: [RelationTypeDecl]
typeList super :: Maybe String
super inserted :: Bool
inserted) ->
               let newType :: RelationTypeDecl
newType = String -> String -> RelationTypeDecl
RelationTypeDecl String
source String
target
                   newRel :: RelationDecl
newRel = String
-> Maybe String
-> String
-> [RelationTypeDecl]
-> Maybe String
-> Bool
-> RelationDecl
RelationDecl String
nam Maybe String
card String
defText
                             ([RelationTypeDecl]
typeList [RelationTypeDecl] -> [RelationTypeDecl] -> [RelationTypeDecl]
forall a. [a] -> [a] -> [a]
++ [RelationTypeDecl
newType]) Maybe String
super Bool
inserted
               in MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return (MMiSSOntology -> [(String, RelationDecl)] -> MMiSSOntology
addRelations MMiSSOntology
o2 [(String
nam, RelationDecl
newRel)])
     MMiSSOntology
-> ClassGraph
-> String
-> String
-> String
-> WithError MMiSSOntology
forall (m :: * -> *).
Monad m =>
MMiSSOntology
-> ClassGraph -> String -> String -> String -> m MMiSSOntology
addEdge MMiSSOntology
o3 (MMiSSOntology -> ClassGraph
getClassGraph MMiSSOntology
o3) String
relName String
source String
target
  where
    lookupClass :: MMiSSOntology -> String -> WithError MMiSSOntology
lookupClass o :: MMiSSOntology
o className :: String
className =
       case String -> Map String ClassDecl -> Maybe ClassDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
className (Map String ClassDecl -> Maybe ClassDecl)
-> Map String ClassDecl -> Maybe ClassDecl
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
o of
         Nothing -> MMiSSOntology -> String -> String -> WithError MMiSSOntology
insertClasses MMiSSOntology
o String
className "relation type: Class "
         Just (ClassDecl cn :: String
cn defT :: String
defT sup :: [String]
sup typeList :: [(String, [String])]
typeList ai :: Bool
ai classType :: Maybe ClassType
classType) ->
           if String
cn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
source
             then let mayTypeDecl :: Maybe (String, [String])
mayTypeDecl = ((String, [String]) -> Bool)
-> [(String, [String])] -> Maybe (String, [String])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String
relName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> ((String, [String]) -> String) -> (String, [String]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> String
forall a b. (a, b) -> a
fst) [(String, [String])]
typeList
                      newClassList :: [String]
newClassList = case Maybe (String, [String])
mayTypeDecl of
                                       Just (_, clist :: [String]
clist) -> [String]
clist [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
target]
                                       Nothing -> [String
target]
                      newTypeList :: [(String, [String])]
newTypeList = ((String, [String]) -> (String, [String]) -> Bool)
-> (String, [String])
-> [(String, [String])]
-> [(String, [String])]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy (String, [String]) -> (String, [String]) -> Bool
isEqualTypelist (String
relName, [])
                                     [(String, [String])]
typeList [(String, [String])]
-> [(String, [String])] -> [(String, [String])]
forall a. [a] -> [a] -> [a]
++ [(String
relName, [String]
newClassList)]
                  in MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return (MMiSSOntology -> [(String, ClassDecl)] -> MMiSSOntology
addClasses MMiSSOntology
o
                             [(String
className, String
-> String
-> [String]
-> [(String, [String])]
-> Bool
-> Maybe ClassType
-> ClassDecl
ClassDecl String
cn String
defT [String]
sup [(String, [String])]
newTypeList
                                                     Bool
ai Maybe ClassType
classType)])
             else MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
o
    addEdge :: MMiSSOntology
-> ClassGraph -> String -> String -> String -> m MMiSSOntology
addEdge ontol :: MMiSSOntology
ontol g :: ClassGraph
g rel :: String
rel src :: String
src tar :: String
tar =
      case ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g String
src of
        Nothing -> MMiSSOntology -> m MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
ontol
        Just snode :: Int
snode -> case ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g String
tar of
                         Nothing -> MMiSSOntology -> m MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
ontol
                         Just tnode :: Int
tnode -> MMiSSOntology -> m MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
ontol
                             { getClassGraph :: ClassGraph
getClassGraph = LEdge String -> ClassGraph -> ClassGraph
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (Int
snode, Int
tnode, String
rel) ClassGraph
g }

isEqualTypelist :: (RelName, [ClassName]) -> (RelName, [ClassName]) -> Bool
isEqualTypelist :: (String, [String]) -> (String, [String]) -> Bool
isEqualTypelist (r1 :: String
r1, _) (r2 :: String
r2, _) = String
r1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
r2

insertObject :: MMiSSOntology -> ObjectName -> DefaultText -> ClassName
             -> WithError MMiSSOntology
insertObject :: MMiSSOntology
-> String -> String -> String -> WithError MMiSSOntology
insertObject onto :: MMiSSOntology
onto objectName :: String
objectName defText :: String
defText className :: String
className =
  do MMiSSOntology
o1 <- if String -> Map String ObjectDecl -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member String
objectName (MMiSSOntology -> Map String ObjectDecl
objects MMiSSOntology
onto)
             then String -> WithError MMiSSOntology
forall a. String -> WithError a
hasError ("Insertion of object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
objectName
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ " already exists.")
             else MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
onto
     MMiSSOntology
o2 <- MMiSSOntology -> String -> String -> WithError MMiSSOntology
insertClasses MMiSSOntology
o1 String
className (String -> WithError MMiSSOntology)
-> String -> WithError MMiSSOntology
forall a b. (a -> b) -> a -> b
$
           "object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
objectName String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> Class "
     MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
onto
         { classes :: Map String ClassDecl
classes = MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
o2
         , objects :: Map String ObjectDecl
objects = String
-> ObjectDecl -> Map String ObjectDecl -> Map String ObjectDecl
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
objectName
                     (String -> String -> String -> ObjectDecl
ObjectDecl String
objectName String
defText String
className) (Map String ObjectDecl -> Map String ObjectDecl)
-> Map String ObjectDecl -> Map String ObjectDecl
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String ObjectDecl
objects MMiSSOntology
onto
         , getClassGraph :: ClassGraph
getClassGraph = String -> String -> ClassGraph -> ClassGraph
addObjectToGraph String
objectName String
className
                                         (ClassGraph -> ClassGraph) -> ClassGraph -> ClassGraph
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> ClassGraph
getClassGraph MMiSSOntology
onto }
  where
    addObjectToGraph :: String -> String -> ClassGraph -> ClassGraph
addObjectToGraph nam :: String
nam classNam :: String
classNam g :: ClassGraph
g =
       case ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g String
nam of
         Nothing -> let n :: Int
n : _ = Int -> ClassGraph -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
newNodes 1 ClassGraph
g
                    in LNode (String, String, OntoObjectType) -> ClassGraph -> ClassGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (Int
n, ("_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nam String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_", String
classNam,
                                             OntoObjectType
OntoObject)) ClassGraph
g
         Just _ -> ClassGraph
g

{- | inserts a new link of type RelationName between the two given
  objects.  Throws an error if RelationName, SourceObject or
  TargetObject doesn't exist. -}
insertLink :: MMiSSOntology -> String -> String -> String
           -> WithError MMiSSOntology
insertLink :: MMiSSOntology
-> String -> String -> String -> WithError MMiSSOntology
insertLink onto :: MMiSSOntology
onto source :: String
source target :: String
target relName :: String
relName = do
    let objs :: Map String ObjectDecl
objs = MMiSSOntology -> Map String ObjectDecl
objects MMiSSOntology
onto
    case String -> Map String ObjectDecl -> Maybe ObjectDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
source Map String ObjectDecl
objs of
      Just _ -> () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Nothing -> String -> String -> Either String ()
forall a. String -> String -> WithError a
insErr' "Object" String
source
    case String -> Map String ObjectDecl -> Maybe ObjectDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
target Map String ObjectDecl
objs of
      Just _ -> () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Nothing -> String -> String -> Either String ()
forall a. String -> String -> WithError a
insErr' "Object" String
target
    case String -> Map String RelationDecl -> Maybe RelationDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
relName (Map String RelationDecl -> Maybe RelationDecl)
-> Map String RelationDecl -> Maybe RelationDecl
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String RelationDecl
relations MMiSSOntology
onto of
      Just _ -> () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Nothing -> String -> String -> Either String ()
forall a. String -> String -> WithError a
insErr' "Relation" String
relName
    MMiSSOntology -> WithError MMiSSOntology
forall (m :: * -> *) a. Monad m => a -> m a
return MMiSSOntology
onto
      { objectLinks :: [ObjectLink]
objectLinks = MMiSSOntology -> [ObjectLink]
objectLinks MMiSSOntology
onto [ObjectLink] -> [ObjectLink] -> [ObjectLink]
forall a. [a] -> [a] -> [a]
++ [String -> String -> String -> ObjectLink
ObjectLink String
source String
target String
relName]
      , getClassGraph :: ClassGraph
getClassGraph = String -> String -> String -> ClassGraph -> ClassGraph
addObjectLinkToGraph String
source String
target
                                         String
relName (ClassGraph -> ClassGraph) -> ClassGraph -> ClassGraph
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> ClassGraph
getClassGraph MMiSSOntology
onto }
  where
    insErr' :: String -> String -> WithError a
insErr' str :: String
str val :: String
val =
        String -> WithError a
forall a. String -> WithError a
insErr (String -> WithError a) -> String -> WithError a
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ " link: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
val
    addObjectLinkToGraph :: String -> String -> String -> ClassGraph -> ClassGraph
addObjectLinkToGraph src :: String
src tar :: String
tar relNam :: String
relNam g :: ClassGraph
g =
       case ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ "_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
src String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" of
         Nothing -> ClassGraph
g
         Just sNode :: Int
sNode -> case ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ "_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tar String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" of
                          Nothing -> ClassGraph
g
                          Just tNode :: Int
tNode -> LEdge String -> ClassGraph -> ClassGraph
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (Int
sNode, Int
tNode, String
relNam) ClassGraph
g

{- | is checking ontologies which have been created in AutoInsert
      mode.  For these ontologies there could be classes and relations
      that were inserted automatically rather than defined properly
      via insertClass or insertRelation.  If the InsertMode of the
      provided ontology is 'ThrowError' returns an empty list.  If
      there are no classes or relations with AutoInserted mark returns
      also an empty list, otherwise it returns a list of error
      messages stating, which class or which relation definition is
      missing. -}
isComplete :: MMiSSOntology -> [String]
isComplete :: MMiSSOntology -> [String]
isComplete onto :: MMiSSOntology
onto = case MMiSSOntology -> InsertMode
mode MMiSSOntology
onto of
    ThrowError -> []
    _ -> (String -> ClassDecl -> [String] -> [String])
-> [String] -> Map String ClassDecl -> [String]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey String -> ClassDecl -> [String] -> [String]
checkClass [] (MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
onto)
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> RelationDecl -> [String] -> [String])
-> [String] -> Map String RelationDecl -> [String]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey String -> RelationDecl -> [String] -> [String]
checkRel [] (MMiSSOntology -> Map String RelationDecl
relations MMiSSOntology
onto)
  where
    mkMsg :: String -> String -> [String]
mkMsg str :: String
str nam :: String
nam = [String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nam String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not properly defined."]
    checkClass :: String -> ClassDecl -> [String] -> [String]
checkClass className :: String
className (ClassDecl _ _ _ _ inserted :: Bool
inserted _) l :: [String]
l =
      if Bool
inserted then [String]
l [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> String -> [String]
mkMsg "Class " String
className else [String]
l
    checkRel :: String -> RelationDecl -> [String] -> [String]
checkRel relName :: String
relName (RelationDecl _ _ _ _ _ inserted :: Bool
inserted) l :: [String]
l =
      if Bool
inserted then [String]
l [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> String -> [String]
mkMsg "Relation " String
relName else [String]
l

exportOWL :: MMiSSOntology -> String
exportOWL :: MMiSSOntology -> String
exportOWL onto :: MMiSSOntology
onto =
  let startStr :: String
startStr = ShowS
owlStart ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> String
getOntologyName MMiSSOntology
onto
      relationsStr :: String
relationsStr = (String -> RelationDecl -> String)
-> String -> [RelationDecl] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> RelationDecl -> String
writeOWLRelation "" ([RelationDecl] -> String) -> [RelationDecl] -> String
forall a b. (a -> b) -> a -> b
$ Map String RelationDecl -> [RelationDecl]
forall k a. Map k a -> [a]
Map.elems (Map String RelationDecl -> [RelationDecl])
-> Map String RelationDecl -> [RelationDecl]
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String RelationDecl
relations MMiSSOntology
onto
      classesStr :: String
classesStr = (String -> ClassDecl -> String) -> String -> [ClassDecl] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> ClassDecl -> String
writeOWLClass "" ([ClassDecl] -> String) -> [ClassDecl] -> String
forall a b. (a -> b) -> a -> b
$ Map String ClassDecl -> [ClassDecl]
forall k a. Map k a -> [a]
Map.elems (Map String ClassDecl -> [ClassDecl])
-> Map String ClassDecl -> [ClassDecl]
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String ClassDecl
classes MMiSSOntology
onto
      objectsStr :: String
objectsStr = (String -> ObjectDecl -> String)
-> String -> [ObjectDecl] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> ObjectDecl -> String
writeOWLObject "" ([ObjectDecl] -> String) -> [ObjectDecl] -> String
forall a b. (a -> b) -> a -> b
$ Map String ObjectDecl -> [ObjectDecl]
forall k a. Map k a -> [a]
Map.elems (Map String ObjectDecl -> [ObjectDecl])
-> Map String ObjectDecl -> [ObjectDecl]
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> Map String ObjectDecl
objects MMiSSOntology
onto
      linksStr :: String
linksStr = (String -> ObjectLink -> String)
-> String -> [ObjectLink] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> ObjectLink -> String
writeOWLLink "" ([ObjectLink] -> String) -> [ObjectLink] -> String
forall a b. (a -> b) -> a -> b
$ MMiSSOntology -> [ObjectLink]
objectLinks MMiSSOntology
onto
      endStr :: String
endStr = "</rdf:RDF>"
  in String
startStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
classesStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
relationsStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
objectsStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
linksStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
endStr

writeOWLLink :: String -> ObjectLink -> String
writeOWLLink :: String -> ObjectLink -> String
writeOWLLink inStr :: String
inStr (ObjectLink object1 :: String
object1 object2 :: String
object2 relName :: String
relName) =
 let start :: String
start = "<rdf:Description rdf:about=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
object1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\">\n"
     propStr :: String
propStr = "<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
relName String -> ShowS
forall a. [a] -> [a] -> [a]
++ " rdf:resource=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
object2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"/>\n"
     end :: String
end = "</rdf:Description>\n"
 in String
inStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
propStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
end

writeOWLObject :: String -> ObjectDecl -> String
writeOWLObject :: String -> ObjectDecl -> String
writeOWLObject inStr :: String
inStr (ObjectDecl nam :: String
nam defText :: String
defText instanceOf :: String
instanceOf) =
 let start :: String
start = "<rdf:Description" String -> ShowS
forall a. [a] -> [a] -> [a]
++ " rdf:about=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nam String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\">\n"
     defTextStr :: String
defTextStr = "<MPhrase>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
latexToEntity String
defText String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</MPhrase>\n"
     classStr :: String
classStr = "<rdf:type>\n  <owl:Class rdf:about=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
instanceOf
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"/>\n</rdf:type>"
     end :: String
end = "</rdf:Description>"
 in String
inStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
defTextStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
classStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
end

writeOWLClass :: String -> ClassDecl -> String
writeOWLClass :: String -> ClassDecl -> String
writeOWLClass inStr :: String
inStr (ClassDecl nam :: String
nam defText :: String
defText super :: [String]
super relTypes :: [(String, [String])]
relTypes _ _) =
 let start :: String
start = "<owl:Class rdf:ID=\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nam String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\">\n"
     defTextStr :: String
defTextStr = "  <MPhrase>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
latexToEntity String
defText String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</MPhrase>\n"
     superStr :: String
superStr =
         ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ str :: String
str -> "<rdfs:subClassOf rdf:resource=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                             String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"/>\n" ) [String]
super
     propertyRestrictions :: String
propertyRestrictions = (String -> (String, [String]) -> String)
-> String -> [(String, [String])] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> (String, [String]) -> String
writePropRestriction "" [(String, [String])]
relTypes
     end :: String
end = "</owl:Class>\n"
 in String
inStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
defTextStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
superStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
propertyRestrictions String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
end

writePropRestriction :: String -> (RelName, [ClassName]) -> String
writePropRestriction :: String -> (String, [String]) -> String
writePropRestriction inStr :: String
inStr (relName :: String
relName, classList :: [String]
classList) =
  case [String]
classList of
    [] -> String
inStr
    [hd :: String
hd] -> let
             start :: String
start = "<rdfs:subClassOf>\n  <owl:Restriction>\n"
             classStr :: String
classStr = "    <owl:allValuesFrom>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        "      <owl:Class rdf:about=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
hd
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"/>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        "    </owl:allValuesFrom>\n"
             onPropStr :: String
onPropStr = "    <owl:onProperty>\n"
                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ "      <owl:ObjectProperty rdf:about=\"#"
                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
relName String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"/>\n"
                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ "    </owl:onProperty>\n"
             end :: String
end = "  </owl:Restriction>\n</rdfs:subClassOf>\n"
          in String
inStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
onPropStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
classStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
end
    _ -> let start :: String
start = "<rdfs:subClassOf>\n  <owl:Restriction>\n    " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     "<owl:onProperty>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     "        <owl:ObjectProperty rdf:about=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
relName String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     "\"/>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     "    </owl:onProperty>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     "    <owl:allValuesFrom>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     "     <owl:Class>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     "        <owl:unionOf rdf:parseType=\"Collection\">\n"
             restrictions :: String
restrictions = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> ShowS
writeSingleClassRestriction "" [String]
classList
             end :: String
end = "</owl:unionOf>\n</owl:Class>\n</owl:allValuesFrom>\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                   "</owl:Restriction>\n</rdfs:subClassOf>\n"
         in String
inStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
restrictions String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
end

writeSingleClassRestriction :: String -> ClassName -> String
writeSingleClassRestriction :: String -> ShowS
writeSingleClassRestriction inStr :: String
inStr className :: String
className =
    String
inStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ "<owl:Class rdf:about=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"/>\n"

writeOWLRelation :: String -> RelationDecl -> String
writeOWLRelation :: String -> RelationDecl -> String
writeOWLRelation inStr :: String
inStr (RelationDecl relName :: String
relName card :: Maybe String
card relText :: String
relText _ super :: Maybe String
super _) =
 let start :: String
start = "<owl:ObjectProperty rdf:ID=\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
relName String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\">\n"
     propStr :: String
propStr = case Maybe String
card of
       Just "->" -> "  <rdf:type rdf:resource=\"&owl;FunctionalProperty\"/>"
       Just ">" -> "  <rdf:type rdf:resource=\"&owl;TransitiveProperty\"/>"
       Just ">=" -> "  <rdf:type rdf:resource=\"&owl;TransitiveProperty\"/>"
       Just "=" -> "  <rdf:type rdf:resource=\"&owl;TransitiveProperty\"/>"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  <rdf:type rdf:resource=\"&owl;SymmetricProperty\"/>"
       Just "<->" -> "  <rdf:type rdf:resource=\"&owl;FunctionalProperty\"/>"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  <rdf:type rdf:resource=\"&owl;InverseFunctionalProperty\"/>"
       _ -> ""
     cardStr :: String
cardStr = case Maybe String
card of
                 Just str :: String
str -> "  <MCardinality>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
latexToEntity String
str
                              String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</MCardinality>\n"
                 Nothing -> ""
     defText :: String
defText = "  <MPhrase>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
relText String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</MPhrase>\n"
     superStr :: String
superStr = case Maybe String
super of
                  Just str :: String
str -> "  <rdfs:subPropertyOf rdf:resource=\"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"/>\n"
                  Nothing -> ""
     end :: String
end = "</owl:ObjectProperty>\n"
 in String
inStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
propStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cardStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
defText String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
superStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
end

owlStart :: String -> String
owlStart :: ShowS
owlStart nam :: String
nam = [String] -> String
unlines
  [ "<?xml version=\"1.0\"?>"
  , "<!DOCTYPE rdf:RDF ["
  , "    <!ENTITY rdf  \"http://www.w3.org/1999/02/22-rdf-syntax-ns#\">"
  , "    <!ENTITY rdfs \"http://www.w3.org/2000/01/rdf-schema#\" >"
  , "    <!ENTITY xsd  \"http://www.w3.org/2001/XMLSchema#\" >"
  , "    <!ENTITY owl  \"http://www.w3.org/2002/07/owl#\">"
  , "  ]>"
  , "<rdf:RDF"
  , "xmlns:rdf=\"&rdf;\""
  , "xmlns:rdfs=\"&rdfs;\""
  , "xmlns:owl=\"&owl;\""
  , "xmlns:vcard=\"http://www.w3.org/2001/vcard-rdf/3.0#\""
  , "xmlns:daml=\"http://www.daml.org/2001/03/daml+oil#\""
  , "xmlns:dc=\"http://purl.org/dc/elements/1.1/\""
  , "xmlns=\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nam String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".owl\">"
  , "<owl:Ontology rdf:about=\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nam String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\">"
  , "<rdfs:comment>OWL ontology created by MMiSS OntoTool v0.2. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    "For more information about the MMiSS project please visit " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    "http://www.mmiss.de</rdfs:comment>" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    "</owl:Ontology>"
  , "  <owl:AnnotationProperty rdf:ID=\"MPhrase\">"
  , "    <rdfs:range rdf:resource=" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    "\"http://www.w3.org/2001/XMLSchema#string\"/>"
  , "    <rdf:type rdf:resource=" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    "\"http://www.w3.org/2002/07/owl#DatatypeProperty\"/>"
  , "  </owl:AnnotationProperty>"
  , "  <owl:AnnotationProperty rdf:ID=\"MCardinality\">"
  , "    <rdfs:range rdf:resource=" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    "\"http://www.w3.org/2001/XMLSchema#string\"/>"
  , "    <rdf:type rdf:resource=" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    "\"http://www.w3.org/2002/07/owl#DatatypeProperty\"/>"
  , "  </owl:AnnotationProperty>"
  ]

latexToEntityList :: [(String, String)]
latexToEntityList :: [(String, String)]
latexToEntityList = [("<", "&#38;#60;"), (">", "&#62;"), ("&", "&#38;#38;")]
                    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [("'", "&#39;"), ("\"", "&#34;")]

latexToEntity :: String -> String
latexToEntity :: ShowS
latexToEntity inStr :: String
inStr = (String -> (String, String) -> String)
-> String -> [(String, String)] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (String -> String -> (String, String) -> String
applyTranslation "") String
inStr [(String, String)]
latexToEntityList

applyTranslation :: String -> String -> (String, String) -> String
applyTranslation :: String -> String -> (String, String) -> String
applyTranslation outStr :: String
outStr inStr :: String
inStr (search :: String
search, replaceStr :: String
replaceStr)
   | Integer
lenInStr Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
lenSearch = String
outStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inStr
   | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
search String
inStr = String -> String -> (String, String) -> String
applyTranslation (String
outStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
replaceStr)
                     (Integer -> ShowS
forall i a. Integral i => i -> [a] -> [a]
genericDrop Integer
lenSearch String
inStr) (String
search, String
replaceStr)
   | Bool
otherwise = String -> String -> (String, String) -> String
applyTranslation (String
outStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
take 1 String
inStr)
                     (Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 String
inStr) (String
search, String
replaceStr)
   where
   lenInStr :: Integer
lenInStr = String -> Integer
forall i a. Num i => [a] -> i
genericLength String
inStr
   lenSearch :: Integer
lenSearch = String -> Integer
forall i a. Num i => [a] -> i
genericLength String
search :: Integer

gselLab :: ((String, String, OntoObjectType) -> Bool) -> ClassGraph
        -> [Context (String, String, OntoObjectType) String]
gselLab :: ((String, String, OntoObjectType) -> Bool)
-> ClassGraph -> [Context (String, String, OntoObjectType) String]
gselLab f :: (String, String, OntoObjectType) -> Bool
f = (Context (String, String, OntoObjectType) String -> Bool)
-> ClassGraph -> [Context (String, String, OntoObjectType) String]
forall (gr :: * -> * -> *) a b.
Graph gr =>
(Context a b -> Bool) -> gr a b -> [Context a b]
gsel ( \ (_, _, l :: (String, String, OntoObjectType)
l, _) -> (String, String, OntoObjectType) -> Bool
f (String, String, OntoObjectType)
l)

gselName :: String -> ClassGraph
         -> [Context (String, String, OntoObjectType) String]
gselName :: String
-> ClassGraph -> [Context (String, String, OntoObjectType) String]
gselName n :: String
n = ((String, String, OntoObjectType) -> Bool)
-> ClassGraph -> [Context (String, String, OntoObjectType) String]
gselLab ( \ (l :: String
l, _, _) -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
l)

gselType :: (OntoObjectType -> Bool) -> ClassGraph
         -> [Context (String, String, OntoObjectType) String]
gselType :: (OntoObjectType -> Bool)
-> ClassGraph -> [Context (String, String, OntoObjectType) String]
gselType f :: OntoObjectType -> Bool
f = ((String, String, OntoObjectType) -> Bool)
-> ClassGraph -> [Context (String, String, OntoObjectType) String]
gselLab ( \ (_, _, t :: OntoObjectType
t) -> OntoObjectType -> Bool
f OntoObjectType
t)

findLNode :: ClassGraph -> String -> Maybe Node
findLNode :: ClassGraph -> String -> Maybe Int
findLNode gr :: ClassGraph
gr label :: String
label = case String
-> ClassGraph -> [Context (String, String, OntoObjectType) String]
gselName String
label ClassGraph
gr of
    [] -> Maybe Int
forall a. Maybe a
Nothing
    hd :: Context (String, String, OntoObjectType) String
hd : _ -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Context (String, String, OntoObjectType) String -> Int
forall a b. Context a b -> Int
node' Context (String, String, OntoObjectType) String
hd

{- | Insert a class-node into the graph. The ClassDecl doesn't have to
be considered, because classes added here have no Superclass (they are
inserted in AutoInsert-Mode). -}
addClassNodeWithoutDecl :: ClassGraph -> (String, ClassDecl) -> ClassGraph
addClassNodeWithoutDecl :: ClassGraph -> (String, ClassDecl) -> ClassGraph
addClassNodeWithoutDecl g :: ClassGraph
g (cn :: String
cn, _) = case ClassGraph -> String -> Maybe Int
findLNode ClassGraph
g String
cn of
    Just _ -> ClassGraph
g
    Nothing ->
      let node :: Int
node : _ = Int -> ClassGraph -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
newNodes 1 ClassGraph
g
      in LNode (String, String, OntoObjectType) -> ClassGraph -> ClassGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (Int
node, (String
cn, "", OntoObjectType
OntoClass)) ClassGraph
g