MMiSSOntologyGraph.hs revision a6f3aafabdb36f0bb079e09de67818fde83f2c92
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke displayClassGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -- MMiSSOntology -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeimport DaVinciGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeimport GraphDisp
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeimport GraphConfigure
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeimport qualified HTk as H
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeimport qualified SimpleForm as S
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeimport qualified Taxonomy.AbstractGraphView as A
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkedisplayClassGraph :: MMiSSOntology -> Maybe String -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkedisplayClassGraph onto startClass =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- emptyRelViewSpec <- return(map (\(relname) -> RelViewSpec relname False False)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- (getRelations onto))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke classGraph <- case startClass of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return (getPureClassGraph (getClassGraph onto))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(className) -> case (gsel (\(p,v,(l,_,_),s) -> l == className) (getClassGraph onto)) of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [] -> return (getPureClassGraph (getClassGraph onto))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ((p,v,l,s):_) -> return(([],v,l,[]) & empty)
edf037c0435876acc993b362eecb0abd6179f31fKlaus Luettich A.makegraph (getOntologyName onto)
edf037c0435876acc993b362eecb0abd6179f31fKlaus Luettich [GlobalMenu (Button "Knopf2" (putStrLn "Knopf2 wurde gedr�ckt"))]
36e4a797a291b300784d23f103882200d36c83e5Achim Mahnke [("class", Box $$$ Color "#e0eeee" $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createLocalMenu onto ginfo main
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ ValueTitle ( \ (name,descr,gid) -> return name) $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke emptyNodeTypeParms :: DaVinciNodeTypeParms (String,Int,Int)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ("predicate", Box $$$ Color "#ffd300" $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createLocalMenu onto ginfo main
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ ValueTitle ( \ (name,descr,gid) -> return name) $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke emptyNodeTypeParms :: DaVinciNodeTypeParms (String,Int,Int)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ("object", Box $$$ Color "#ffffA0" $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createLocalMenu onto ginfo main
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ ValueTitle ( \ (name,descr,gid) -> return name) $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke emptyNodeTypeParms :: DaVinciNodeTypeParms (String,Int,Int)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (createEdgeTypes (getClassGraph onto))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph classGraph gid ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke setEmptyRelationSpecs gid ginfo onto
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- A.Result eid err2 <- addlink gid "relation" "RelationTitle" nid1 nid2 ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- putStr (show ontology)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- delgraph gid ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeemptyNodeMap = emptyFM
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkesetEmptyRelationSpecs :: A.Descr -> A.GraphInfo -> MMiSSOntology -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkesetEmptyRelationSpecs gid gv onto =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,_) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do A.Result gid err <- A.writeRelViewSpecs gid emptyRelViewSpecs gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke emptyRelViewSpecs = map (\(relname) -> (A.RelViewSpec relname False False))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (getRelationNames onto)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateDaVinciGraph :: A.NodeMapping -> Gr (String, String, OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> String -> A.Descr -> A.GraphInfo -> IO (A.NodeMapping)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateDaVinciGraph nodeMap classGraph nodeType gid ginfo =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do nodeMap1 <- foldM (createNode gid ginfo) nodeMap (labNodes classGraph)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nodeMap2 <- foldM (createLink gid ginfo) nodeMap1 (labEdges classGraph)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- A.Result _ _ <- A.writeOntoGraph gid classGraph ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke return nodeMap2
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createNode :: Int -> A.GraphInfo -> A.NodeMapping -> LNode (String, String, OntoObjectType) -> IO (A.NodeMapping)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createNode gid ginfo nMap (nodeID, (label, _, _)) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (A.Result nid _) <- A.addnode gid nodeType label ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke return (addToFM nMap nodeID nid)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createLink :: A.Descr -> A.GraphInfo -> A.NodeMapping -> LEdge String -> IO (A.NodeMapping)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createLink gid ginfo nMap (node1, node2, edgeLabel) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do dNodeID_1 <- case lookupFM nMap node1 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return (-1)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(n) -> return(n)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke dNodeID_2 <- case lookupFM nMap node2 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return (-1)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(n) -> return(n)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke if ((dNodeID_1 == -1) || (dNodeID_2 == -1))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then return nMap
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else do A.Result eid _ <- if (edgeLabel == "isa")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then A.addlink gid edgeLabel edgeLabel dNodeID_2 dNodeID_1 ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else A.addlink gid edgeLabel edgeLabel dNodeID_1 dNodeID_2 ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Klassengraph -> Objekte dazu (mit Links auf Klasse)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Klassengraph vorhanden -> Objektgraph als Input -> Objekte und Links sowie 'instanceOf' einf�gen
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Klassen vorhanden -> Objekte hinzu:
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeupdateDaVinciGraph :: Gr (String,String,OntoObjectType) String ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeupdateDaVinciGraph newGraph gid gv =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,_) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGraph <- return(A.ontoGraph g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nMap <- return(A.nodeMap g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nodeMap1 <- foldM (createNode gid gv oldGraph) nMap (labNodes newGraph)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nodeMap2 <- foldM (createLink gid gv) nodeMap1 (labEdges newGraph)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke A.Result gid err <- A.writeOntoGraph gid newGraph gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke A.Result gid err2 <- A.writeNodeMap gid nodeMap2 gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(str) -> putStr str
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke getTypeLabel OntoClass = "class"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke getTypeLabel OntoObject = "object"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke getTypeLabel OntoPredicate = "predicate"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createNode :: Int -> A.GraphInfo -> Gr (String,String,OntoObjectType) String ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke A.NodeMapping -> LNode (String, String, OntoObjectType) -> IO (A.NodeMapping)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createNode gid ginfo oldGraph nMap (nodeID, (name, className, objectType)) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookupFM nMap nodeID of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(_) -> return nMap
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (A.Result nid err) <- A.addnode gid (getTypeLabel objectType) name ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return (addToFM nMap nodeID nid)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(str) -> do putStr str
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke return (addToFM nMap nodeID nid)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createLink :: A.Descr -> A.GraphInfo -> A.NodeMapping -> LEdge String -> IO (A.NodeMapping)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createLink gid ginfo nMap (node1, node2, edgeLabel) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do dNodeID_1 <- case lookupFM nMap node1 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return (-1)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(n) -> return(n)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke dNodeID_2 <- case lookupFM nMap node2 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return (-1)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(n) -> return(n)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke if ((dNodeID_1 == -1) || (dNodeID_2 == -1))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then return nMap
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else do A.Result eid err <-
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke if (edgeLabel == "isa") || (edgeLabel == "instanceOf") || (edgeLabel == "livesIn") || (edgeLabel == "proves")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then A.addlink gid edgeLabel edgeLabel dNodeID_2 dNodeID_1 ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- else A.addlink gid edgeLabel edgeLabel dNodeID_2 dNodeID_1 ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else A.addlink gid edgeLabel edgeLabel dNodeID_1 dNodeID_2 ginfo
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(str) -> putStr str
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowRelationsForVisible :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowRelationsForVisible onto gv (name,descr,gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,_) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGraph <- return(A.ontoGraph g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let nodesInOldGraph = map (\(nodeID,(_,_,_)) -> nodeID) (labNodes oldGraph)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newGr = nfilter (`elem` nodesInOldGraph) (getClassGraph onto)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (A.Result descr error) <- purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph newGr gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowObjectsForVisible :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowObjectsForVisible onto gv (name,descr,gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,_) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGraph <- return(A.ontoGraph g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let classesInOldGraph = map (\(_,_,(className,_,_),_) -> className)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (filter (\(_,_,(_,_,objectType),_) -> objectType == OntoClass)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (map (context oldGraph) (nodes oldGraph)))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke objectList = map (\(nid,_) -> nid)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (filter (findObjectsOfClass classesInOldGraph)
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich (getTypedNodes (getClassGraph onto) [OntoObject]))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke objectGr = nfilter (`elem` objectList) (getClassGraph onto)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph (makeObjectGraph oldGraph (getPureClassGraph (getClassGraph onto)) objectGr) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke findObjectsOfClass classList (_,(_,className,_)) = className `elem` classList
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowWholeObjectGraph :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowWholeObjectGraph onto gv (name,descr,gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (A.Result descr error) <- purgeGraph gid gv
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich let objectList = map (\(nid,_) -> nid) (getTypedNodes (getClassGraph onto) [OntoObject])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke objectGraph = nfilter (`elem` objectList) (getClassGraph onto)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph (makeObjectGraph empty (getClassGraph onto) objectGraph) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case error of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just _ -> do writeIORef gv oldGv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> do A.redisplay gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke{-- makeObjectGraph bekommt den alten Graphen, in den die Objekte und deren Klassen einzubeziehen sind, den Klassen-Graphen, in dem alle Klassen vorhanden sein sollten, sowie den Graphen mit den einzuf�genden Objekten und deren Links �bergeben. Die Funktion geht den Objektgraphen durch, f�gt die Objekt-Knoten in den alten Graphen ein.
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeF�r jeden eingef�gten Objekt-Knoten sucht die Funktion im Klassengraphen dessen Klasse und f�gt diese als Klassen-Knoten ebenfalls in den alten Graphen ein. Zwischen Klasse und Objekt wird eine InstanceOf-Kante eingef�gt. Bei allen Einf�ge-Operationen wird vorher gepr�ft, ob der Knoten schon drin war oder nicht.
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemakeObjectGraph :: Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemakeObjectGraph oldGr classGr objectGr =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let newGr = insNodes (labNodes objectGr) oldGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newGr2 = foldl insEdgeSecurely newGr (labEdges objectGr)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newGr3 = foldl (insInstanceOfEdge classGr) newGr2 (labNodes objectGr)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insEdgeSecurely gr (node1,node2,label) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match node1 gr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match node2 gr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) -> insEdge (node1,node2,label) gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insInstanceOfEdge classGr gr (_,(objectName, className,_)) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode gr className of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> case findLNode classGr className of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(classNodeID) -> insInstanceOfEdge1 (insNode (classNodeID,(className, "", OntoClass)) gr)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke classNodeID objectName
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(classNodeID) -> insInstanceOfEdge1 gr classNodeID objectName
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insInstanceOfEdge1 gr classNodeID objectName =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode gr objectName of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(objectNodeID) -> insEdge (objectNodeID, classNodeID, "instanceOf") gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowWholeClassGraph :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowWholeClassGraph onto gv (name, descr, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (A.Result descr error) <- purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph (getPureClassGraph (getClassGraph onto)) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case error of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just _ -> do writeIORef gv oldGv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> do A.redisplay gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowRelationsToNeighbors :: MMiSSOntology -> A.GraphInfo -> Bool -> [String] -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowRelationsToNeighbors onto gv withIncoming rels (name, _, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- (A.Result descr error) <- purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph (reduceToNeighbors (getClassGraph onto) withIncoming name rels) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke writeIORef gv oldGv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- case error of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Just _ -> do writeIORef gv oldGv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Nothing -> do A.redisplay gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToNeighbors :: Gr (String,String,OntoObjectType) String -> Bool -> String -> [String]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToNeighbors g withIncoming name forbiddenRels =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode g name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(node) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let (p,v,l,s) = context g node
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke p' = filter (\(edgeLabel,_) -> mynotElem forbiddenRels edgeLabel) p
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke s' = filter (\(edgeLabel,_) -> mynotElem forbiddenRels edgeLabel) s
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nodes = (map (\(l,v') -> v') p') ++ (map (\(l1,v1') -> v1') s')
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newGr = foldl (myInsNode g) empty nodes
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in (p',v,l,s') & newGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke mynotElem l a = notElem a l
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke myInsNode gr newGr nodeID =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match nodeID newGr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> ([],nodeID, lab' (context gr nodeID),[]) & newGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) -> newGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowAllRelations :: MMiSSOntology -> A.GraphInfo -> Bool -> [String] -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowAllRelations onto gv withIncoming rels (name, _, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- (A.Result descr error) <- purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newGr <- return(reduceToRelations (getClassGraph onto) empty withIncoming rels name)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph newGr gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke writeIORef gv oldGv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- case error of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Just _ -> do writeIORef gv oldGv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Nothing -> do A.redisplay gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToRelations bekommt den aktuellen Graph, einen Klassenknoten darin sowie eine Liste mit Relationsnamen,
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkedie _nicht_ angezeigt werden sollen, �bergeben. Ausgehend von dem Klassenknoten werden aus dem Ontologiegraphen
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnketransitiv alle Klassenknoten ermittelt, die �ber eine der nicht-ausgeblendeten Relationen erreicht werden
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkek�nnen. Diese werden (mit ihren Relationen zu ebenfalls neu hinzugef�gten Knoten) in den aktuellen Graphen
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeeingef�gt. Bez�ge zwischen neu eingef�gten Knoten uns alten????
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeIm ersten Schritt werden transitiv alle Knoten ermittelt, die mit dem ausgew�hlten Knoten in einer der
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkenicht verbotenen Beziehungen stehen. Dann wird rekursiv f�r jeden dieser gefunden Knoten dessen direkte
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeSubklassen ermittelt und f�r diese wiederum die direkten Nachbarn ermittelt und aufgenommen.
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeg1 = Gesamter Ontologiegraph nach erlaubten Relationen gefiltert
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkenodeList = Alle Knoten der transitiven H�lle des ausgew�hlten Knotens (selectedNode)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke(delNodes toDelete g1) = Ontologiegraph reduziert auf die Knoten (und Kanten) der transitiven H�lle
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkeg2 = Merge aus dem aktuellen Graphen g und der transitiven H�lle von selectedNode
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkenewNodesList = Zu g neu hinzugekommene Knoten.
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToRelations :: Gr (String,String,OntoObjectType) String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Bool -> [String] -> String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToRelations wholeGraph g withIncoming forbiddenRels name =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let g1 = elfilter (mynotElem forbiddenRels) wholeGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in case findLNode g1 name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(selectedNode) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let nodeList = if (withIncoming == True)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then udfs [selectedNode] g1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else dfs [selectedNode] g1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke toDelete = ((nodes g1) \\ nodeList)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke g1' = (delNodes toDelete g1)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke g2 = mergeGraphs g1' g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newNodesList = (nodeList \\ (nodes g))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in if (newNodesList == [])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else foldl (followRelationOverSubClasses wholeGraph withIncoming forbiddenRels) g2 newNodesList
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke mynotElem l a = notElem a l
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkefollowRelationOverSubClasses :: Gr (String,String,OntoObjectType) String -> Bool -> [String] ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Gr (String,String,OntoObjectType) String -> Node -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkefollowRelationOverSubClasses wholeGraph withIncoming forbiddenRels g selectedNode =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let g1 = elfilter (== "isa") wholeGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in case match selectedNode g1 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let subclasses = rdfs [selectedNode] g1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newNodes = subclasses \\ (nodes g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in if (newNodes == [])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke toDelete = (nodes g1) \\ subclasses
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke g2 = mergeGraphs (delNodes toDelete g1) g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in foldl (transClosureForNode wholeGraph withIncoming forbiddenRels) g2 newNodes
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke transClosureForNode wGraph withIncoming forbiddenRels g node =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let (name,_,_) = lab' (context wGraph node)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in reduceToRelations wholeGraph g withIncoming forbiddenRels name
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insEdgeSecurely gr (node1,node2,label) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match node1 gr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match node2 gr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) -> insEdge (node1,node2,label) gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insNodeSecurely gr (node, label) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match node gr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> insNode (node,label) gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) -> gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemergeGraphs :: Gr (String,String,OntoObjectType) String -> Gr (String,String,OntoObjectType) String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemergeGraphs g1 g2 =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insEdges (labEdges g2) (insNodes ((labNodes g2) \\ (labNodes g1)) g1)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowSuperSubClassesForVisible :: MMiSSOntology -> A.GraphInfo -> Bool -> Bool -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowSuperSubClassesForVisible onto gv showSuper transitive (name, descr, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do nodeList <- myGetNodes gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke if transitive
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then updateDaVinciGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (foldl (getSubSuperClosure (getClassGraph onto) showSuper) empty nodeList)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else updateDaVinciGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (foldl (getSubSuperSingle (getClassGraph onto) showSuper) empty nodeList)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToThisNode :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToThisNode onto gv (name, descr, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke A.Result _ _ <- purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case (gsel (\(p,v,(l,_,_),s) -> l == name) (getClassGraph onto)) of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [] -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ((p,v,l,s):_) -> do
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph (([],v,l,[]) & empty) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkepurgeThisNode :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkepurgeThisNode onto gv (name, descr, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,_) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGraph <- return(A.ontoGraph g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nMap <- return(A.nodeMap g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (newGraph,mayNodeID) <-
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode oldGraph name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return(oldGraph, Nothing)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(nodeID) -> return((delNode nodeID oldGraph), Just(nodeID))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case mayNodeID of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(nodeID) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookupFM nMap nodeID of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(node) -> do A.delnode gid node gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowSuperSubClasses :: MMiSSOntology -> A.GraphInfo -> Bool -> Bool -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowSuperSubClasses onto gv showSuper transitive (name, descr, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke if transitive
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then updateDaVinciGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (getSubSuperClosure (getClassGraph onto) showSuper empty name) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else updateDaVinciGraph (getSubSuperSingle (getClassGraph onto) showSuper empty name) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkegetSubSuperSingle :: Gr (String,String,OntoObjectType) String -> Bool -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkegetSubSuperSingle g showSuper newGr name =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode g name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(nodeID) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let subClassEdges = filter ((== "isa"). (\(_,_,a) -> a)) (inn g nodeID)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ng = foldl (insPredecessorAndEdge g) (insertInitialNode nodeID name newGr) subClassEdges
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in if showSuper
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then let superClassEdges = filter ((== "isa").(\(_,_,a) -> a)) (out g nodeID)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in foldl (insSuccessorAndEdge g) ng superClassEdges
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insertInitialNode :: Node -> String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insertInitialNode nodeID name gr =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match nodeID gr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> ([], nodeID, (name,"",OntoClass),[]) & gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke otherwise -> gr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insPredecessorAndEdge :: Gr (String,String,OntoObjectType) String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> LEdge String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insPredecessorAndEdge oldGr newGr (fromNode, toNode, edgeLabel) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match fromNode oldGr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> newGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just ((_,_,nodeLabel,_)),_) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match fromNode newGr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> ([], fromNode, nodeLabel, [(edgeLabel, toNode)]) & newGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just((p,fromNodeID,nodeLabel,s)), newGr2) -> (p,fromNodeID,nodeLabel, ((edgeLabel,toNode):s)) & newGr2
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insSuccessorAndEdge :: Gr (String,String,OntoObjectType) String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> LEdge String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insSuccessorAndEdge oldGr newGr (fromNode, toNode, edgeLabel) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match toNode oldGr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> newGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just ((_,_,(nodeLabel,_,_),_)),_) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match toNode newGr of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing,_) -> ([(edgeLabel, fromNode)], toNode, (nodeLabel,"",OntoClass), []) & newGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just((p, toNodeID, nodeLabel, s)), newGr2) -> (((edgeLabel, fromNode):p), toNodeID, nodeLabel, s) & newGr2
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkegetSubSuperClosure :: Gr (String,String,OntoObjectType) String -> Bool
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String -> String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkegetSubSuperClosure g showSuper newGr name =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode g name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just(nodeID) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let ng = foldl (subClassClosure g) newGr [nodeID]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in if showSuper
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then foldl (superClassClosure g nodeID) ng [nodeID]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke superClassClosure :: Gr (String,String,OntoObjectType) String -> Node
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String -> Node
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke superClassClosure g specialNodeID ng nodeID =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match nodeID g of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> ng
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just((_,_,(label,_,_),outAdj)), _) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let isaAdj = filter ((== "isa") . fst) outAdj
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ng1 = foldl (superClassClosure g specialNodeID) ng (map snd isaAdj)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in if (nodeID == specialNodeID)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then case match specialNodeID ng1 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -- This should never be the case, but we somehow have to deal with it
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> (isaAdj, nodeID, (label,"",OntoClass), []) & ng1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just((inAdj,_,_,_)), ng2) -> (inAdj, nodeID, (label, "",OntoClass), isaAdj) & ng2
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else case match nodeID ng1 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> ([], nodeID, (label,"",OntoClass), isaAdj) & ng1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just((inAdj,_,_,outAdj)), ng2) -> (inAdj ++ isaAdj,nodeID,(label,"",OntoClass),outAdj) & ng2
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke{-- subClassClosure hunts transitively all isa-Ajacencies that goes into the given node (nodeID).
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke For all nodes collected, their outgoing adjacencies are ignored because we only want to
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke show the isa-Relation to the superclass. The given specialNodeID is the ID of the node from
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke which the search for subclasses startet. Because this node is already in the graph, we
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke have to delete and reinsert it with its outgoing adjacencies (which consists of the
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke isa-relations to it's superclasses, build by superClassClosure beforehand).
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke subClassClosure :: Gr (String,String,OntoObjectType) String -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke -> Node -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke subClassClosure g ng nodeID =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match nodeID g of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> ng
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just((inAdj,_,(label,_,_), outAdj)), _) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let isaAdj = filter ((== "isa") . fst) inAdj
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ng1 = foldl (subClassClosure g) ng (map snd isaAdj)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in case match nodeID ng1 of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Nothing, _) -> (isaAdj, nodeID, (label,"",OntoClass), []) & ng1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Just(_),_) -> ng1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkehideObjectsForVisible :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkehideObjectsForVisible onto gv (name,descr,gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,_) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGraph <- return(A.ontoGraph g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let objectNodeIDs = map (\(_,v,_,_) -> v) (gsel (\(_,_,(_,_,t),_) -> t == OntoObject) oldGraph)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke A.Result _ _ <- purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph (nfilter (`notElem` objectNodeIDs) oldGraph) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateEdgeTypes :: Gr (String,String,OntoObjectType) String -> [(String,DaVinciArcTypeParms (String,A.Descr))]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateEdgeTypes g = map createEdgeType ((nub (map (\(_,_,l) -> l) (labEdges g))) ++ ["instanceOf"])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createEdgeType str =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Head "oarrow"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Dir "first"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ emptyArcTypeParms :: DaVinciArcTypeParms (String,Int))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke "instanceOf" ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ("instanceOf",
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Dir "first"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ emptyArcTypeParms :: DaVinciArcTypeParms (String,Int))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke "contains" ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Head "arrow"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ ValueTitle (\ (name, _) -> return name)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ emptyArcTypeParms :: DaVinciArcTypeParms (String,Int))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke otherwise ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Head "arrow"
33d0744ecc9761831a649fbab26690f28088cb40Achim Mahnke-- $$$ Dir "first"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ ValueTitle (\ (name, _) -> return name)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- $$$ TitleFunc (\ (name, _) -> name)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ emptyArcTypeParms :: DaVinciArcTypeParms (String,Int))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateLocalMenu onto ginfo mainWindow =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke LocalMenu (Menu Nothing
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ([(Menu (Just "For this node")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [ (Menu (Just "Show transitively")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [Button "Subclasses" (showSuperSubClasses onto ginfo False True),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Sub/Superclasses" (showSuperSubClasses onto ginfo True True),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Menu (Just "Show relations")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [(Menu (Just "Outgoing")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ([Button "All relations" (showAllRelations onto ginfo False ["isa"]),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Blank] ++ (createRelationMenuButtons False (getRelationNames onto) onto ginfo)))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ,(Menu (Just "Out + In")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ([Button "All relations" (showAllRelations onto ginfo True ["isa"]),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Blank] ++ (createRelationMenuButtons True (getRelationNames onto) onto ginfo)))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ,(Menu (Just "Show adjacent")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [Button "Subclasses" (showSuperSubClasses onto ginfo False False),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Sub/Superclasses" (showSuperSubClasses onto ginfo True False),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Menu (Just "Show relations")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [(Menu (Just "Outgoing")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ([Button "All relations" (showRelationsToNeighbors onto ginfo False ["isa"]),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Blank] ++ (createRelationMenuButtons False (getRelationNames onto) onto ginfo)))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ,(Menu (Just "Out + In")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ([Button "All relations" (showRelationsToNeighbors onto ginfo True ["isa"]),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Blank] ++ (createRelationMenuButtons True (getRelationNames onto) onto ginfo)))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (Menu (Just "For visible nodes")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [ (Menu (Just "Show transitively")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [Button "Subclasses" (showSuperSubClassesForVisible onto ginfo False True),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Sub/Superclasses" (showSuperSubClassesForVisible onto ginfo True True)])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ,(Menu (Just "Show adjacent")
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [Button "Subclasses" (showSuperSubClassesForVisible onto ginfo False False),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Sub/Superclasses" (showSuperSubClassesForVisible onto ginfo True False)])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ,Button "Show relations" (showRelationsForVisible onto ginfo)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ,Button "Show objects" (showObjectsForVisible onto ginfo)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ,Button "Hide objects" (hideObjectsForVisible onto ginfo)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Show whole class graph" (showWholeClassGraph onto ginfo),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Show whole object graph" (showWholeObjectGraph onto ginfo),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Show relations" (showRelationDialog mainWindow onto ginfo),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Reduce to this node" (reduceToThisNode onto ginfo),
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Button "Delete this node" (purgeThisNode onto ginfo)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateRelationMenuButtons withIncomingRels relNames onto ginfo = map createButton relNames
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createButton name = (Button (name)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (showAllRelations onto ginfo withIncomingRels (delete name (relNames ++ ["isa"]))))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkefindLNode :: Gr (String,String,OntoObjectType) String -> String -> Maybe Node
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkefindLNode gr label = case (gsel (\(p,v,(l,_,_),s) -> l == label) gr) of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke [] -> Nothing
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke conList -> Just(node' (head conList))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemyDeleteNode :: A.Descr -> A.GraphInfo -> A.Result -> (Int,(String,DaVinciNode (String,Int,Int))) -> IO (A.Result)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemyDeleteNode gid gv _ node = A.delnode gid (fst node) gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkepurgeGraph :: Int -> A.GraphInfo -> IO (A.Result)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkepurgeGraph gid gv =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,ev_cnt) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just g -> do A.Result _ _ <- A.writeOntoGraph gid empty gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke foldM (myDeleteNode gid gv) (A.Result 0 Nothing) (A.nodes g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return (A.Result 0 (Just ("Graph id "++show gid++" not found")))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemyGetNodes :: Int -> A.GraphInfo -> IO ([String])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemyGetNodes gid gv =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,ev_cnt) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Just g -> return(map (\(_,(name,_,_)) -> name) (labNodes (A.ontoGraph g)))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- Just g -> return (map (\(_,(name,_)) -> name) (A.nodes g))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return([])
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus LuettichgetPureClassGraph :: Gr (String,String,OntoObjectType) String
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich -> Gr (String,String,OntoObjectType) String
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- getPureClassGraph g = efilter (\(_,_,edgeType) -> edgeType == "isa") g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkegetPureClassGraph g =
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich let classNodeList = map (\(nid,_) -> nid)
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich (getTypedNodes g [OntoClass,OntoPredicate])
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich in nfilter (`elem` classNodeList) g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkenfilter :: DynGraph gr => (Node -> Bool) -> gr a b -> gr a b
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnkenfilter f = ufold cfilter empty
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke where cfilter (p,v,l,s) g = if (f v)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then (p',v,l,s') & g
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke where p' = filter (\(b,u)->f u) p
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke s' = filter (\(b,w)->f w) s
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus LuettichgetTypedNodes :: Gr (String,String,OntoObjectType) String
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich -> [OntoObjectType]
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich -> [LNode (String, String, OntoObjectType)]
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus LuettichgetTypedNodes g ts =
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich map labNode' (gsel (\(_,_,(_,_,objType),_) -> objType `elem` ts) g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateRelationDialog :: H.HTk -> [A.RelationViewSpec] -> IO()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkecreateRelationDialog parentContainer rvs =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do relations <- map
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke H.height ((genericLength relations) * 23)]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke foldM (myNewRelationEntry w) 1 relations
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- click <- H.clicked (fst (head realtionEntries))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke-- (click H.>>> do b H.# H.text "Test"))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke myNewRelationEntry w lineNr relname =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke H.grid lab [H.GridPos (0,lineNr), H.Sticky H.W]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke H.grid cb1 [H.GridPos (1,lineNr), H.Sticky H.E]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke H.grid cb2 [H.GridPos (2,lineNr), H.Sticky H.E]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke return(lineNr + 1)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowRelationDialog :: H.HTk -> MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowRelationDialog parentContainer onto gv (name,descr,gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do (gs,_) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do rvs <- return(A.relViewSpecs g)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke specEntries <- return(S.row (map relSpecToFormEntry rvs))
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke form <- return(firstRow S.// specEntries)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke valueOpt <- S.doForm "Show relations" form
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (S.newFormEntry "Show" ()) S.\\
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (S.newFormEntry "Transitive" ())
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke relSpecToFormEntry (A.RelViewSpec relname b1 b2) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (S.newFormEntry relname ()) S.\\