AbstractGraphView.hs revision ba904a15082557e939db689fcfba0c68c9a4f740
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder{- Interface for graph viewing and abstraction.
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder It is possible to hide sets of nodes and edges.
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Using a composition table for edge types,
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder paths through hidden nodes can be displayed.
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Graphs, nodes, and edges are handled via
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder descriptors (here: integers), while node and
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder edge types are handled by user-supplied strings.
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maederimport DaVinciGraph
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maederimport GraphDisp
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maederimport GraphConfigure
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederimport Destructible
4cb215739e9ab13447fa21162482ebe485b47455Christian Maeder{- methods using fetch_graph return a quadruple containing the modified graph, a descriptor of the last modification (e.g. a new node), the descriptor that can be used for the next modification and a possible error message-}
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus Luettich-- Which graph display tool to be used, perhaps make it more tool independent?
74eed04be26f549d2f7ca35c370e1c03879b28b1Christian Maederinstance Eq (DaVinciNode (String, Int, Int)) where
ef9e8535c168d3f774d9e74368a2317a9eda5826Christian Maederinstance Eq (DaVinciArc (String, Int)) where
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maedergraphtool = daVinciSort
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maedertype OurGraph =
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Graph DaVinciGraph
c3053d57f642ca507cdf79512e604437c4546cb9Christian Maeder DaVinciGraphParms
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maeder DaVinciNodeType
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maeder DaVinciNodeTypeParms
05a62e84edac8c64de04f8349dee418598d216b9Christian Maeder DaVinciArcType
1cd4f6541984962658add5cfaa9f28a93879881bChristian Maeder DaVinciArcTypeParms
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder-- Main datastructure for carrying around the graph,
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder-- both internally (nodes as integers), and at the daVinci level
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maedertype CompTable = [(String,String,String)]
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maederdata AbstractionGraph = AbstractionGraph {
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder theGraph :: OurGraph,
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder nodeTypes :: [(String,DaVinciNodeType (String,Int,Int))],
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder edgeTypes :: [(String,DaVinciArcType (String,Int))],
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder nodes :: [(Int,(String,DaVinciNode (String,Int,Int)))],
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder edges :: [(Int,(Int,Int,String,DaVinciArc (String,Int)))],
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder -- probably, also the abstracted graph needs to be stored,
8cacad2a09782249243b80985f28e9387019fe40Christian Maeder -- and a list of hide/abstract events with the hidden nodes/edges (for each event),
6a2dad705deefd1b7a7e09b84fd2d75f2213be47Christian Maeder -- which is used to restore things when showIt is called
a7c27282e71cf4505026645f96d4f5cb8a284e32Christian Maeder edgeComp :: CompTable,
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder eventTable :: [(Int,Entry)]}
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettichtype Descr = Int
6aea82c63ba1d2efc0329bc784a14e521469ec20Christian Maedertype GraphInfo = IORef ([(Descr,AbstractionGraph)],Descr) -- for each graph the descriptor and the graph,
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder -- plus a global counter for new descriptors
feca1d35123d8c31aee238c9ce79947b0bf65494Christian Maederdata Result = Result Descr -- graph, node or edge descriptor
431d34c7007a787331c4e5ec997badb0f8190fc7Christian Maeder (Maybe String) -- a possible error message
db675e8302ddb0d6528088ce68f5e98a00e890e3Christian Maederdata Entry = Entry {newNodes :: [(Descr,(String,DaVinciNode (String,Int,Int)))],
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder oldNodes :: [(Descr,(String,String))],
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder newEdges :: [(Int,(Int,Int,String,DaVinciArc (String,Int)))],
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder oldEdges :: [(Int,(Int,Int,String,String))]
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder-- creates a new entry of the eventTable and fills it with the data contained in its parameters
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaedercreateEntry :: [(Descr,(String,DaVinciNode (String,Int,Int)))] -> [(Descr,(String,String))] -> [(Descr,(Int,Int,String,DaVinciArc (String,Int)))] -> [(Descr,(Int,Int,String,String))] -> Descr -> (Int,Entry)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaedercreateEntry nn on ne oe cnt = (cnt, Entry {newNodes = nn, oldNodes = on, newEdges = ne, oldEdges = oe})
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder-- zips two lists by pairing each element of the first with each element of the second
9e748851c150e1022fb952bab3315e869aaf0214Christian Maederspecialzip :: [a] -> [b] -> [(a,b)]
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederspecialzip [] _ = []
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederspecialzip _ [] = []
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederspecialzip (x:xs) (y:ys) = (x,y):(specialzip [x] ys)++(specialzip xs (y:ys))
a3c6d8e0670bf2aa71bc8e2a3b1f45d56dd65e4cChristian Maeder-- similar to lookup, but also returns the decriptor
dc679edd4ca027663212afdf00926ae2ce19b555Christian Maeder-- should only be used, if lookup will be successful (otherwise an error is thrown)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederget :: Descr -> [(Descr,a)] -> (Descr,a)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maederget d list = case lookup d list of
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Just r -> (d,r)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder Nothing -> error ("get: descriptor unknown: "++(show d)++"\n"++(show (map fst list)))
4017ebc0f692820736d796af3110c3b3018c108aChristian Maeder-- lookup tables and failure handling
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maederremove :: Eq a => a -> [(a,b)] -> [(a,b)]
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichremove x l = filter (\(y,_) -> not (x==y)) l
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederreturn_fail graphs msg =
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder return (Result 0 (Just msg))
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder-- lookup a graph descriptor and execute a command on the graph
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder-- the delete flag specifies if the graph should be removed from the graph list afterwards
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder-- fetch_graph :: Descr -> GraphInfo -> Bool -> a ?
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maederfetch_graph gid gv delete cmd =
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder do (gs,ev_cnt) <- readIORef gv
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder case lookup gid gs of
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder Just g -> do (g',descr,ev_cnt',err) <- cmd (g,ev_cnt)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder let gs'' = if delete then gs' else (gid,g'):gs'
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder writeIORef gv (gs'',ev_cnt')
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder return (Result descr err)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder where gs' = remove gid gs
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Nothing -> return (Result 0 (Just ("Graph id "++show gid++" not found")))
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder-- These are the operations of the interface
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maederinitgraphs :: IO GraphInfo
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maederinitgraphs = do newRef <- newIORef ([],0)
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder return newRef
363939beade943a02b31004cea09dec34fa8a6d9Christian Maedermakegraph :: String -> [GlobalMenu] ->
e4f4d096e5e6d60dd91c746d0e833d0ac7a29c50Christian Maeder [(String,DaVinciNodeTypeParms (String,Descr,Descr))] ->
eb74267cf39e4e95f9eeb5c765f4c8dac33971b4Christian Maeder [(String,DaVinciArcTypeParms (String,Descr))] ->
eb74267cf39e4e95f9eeb5c765f4c8dac33971b4Christian Maeder CompTable -> GraphInfo -> IO Result
e4f4d096e5e6d60dd91c746d0e833d0ac7a29c50Christian Maedermakegraph title menus nodetypeparams edgetypeparams comptable gv = do
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder (gs,ev_cnt) <- readIORef gv
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let graphParms =
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder foldr ($$) (GraphTitle title $$
8d178ae08a52d61379e6b8074f61646499bc88bbChristian Maeder OptimiseLayout True $$
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder emptyGraphParms)
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder abstractNodetypeparams = LocalMenu
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder Button "Unhide abstracted nodes" (
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder \ (name, descr, gid) -> do oldGv <- readIORef gv
b2ac5a92cf36382e8deea5661c1964566caf72b3Christian Maeder (Result descr error) <- showIt gid descr gv
59138b404f12352d103eeffbeaeb3957b90e75fdChristian Maeder case error of
b2ac5a92cf36382e8deea5661c1964566caf72b3Christian Maeder Just _ -> do writeIORef gv oldGv
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder Nothing -> do redisplay gid gv
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder ValueTitle ( \ (name,descr,gid) -> return name) $$$
0e5b095a19790411e5352fa7cf57cb0388e70472Christian Maeder emptyNodeTypeParms :: DaVinciNodeTypeParms (String,Int,Int)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (nodetypenames,nodetypeparams1) = unzip (("ABSTRACT",abstractNodetypeparams):nodetypeparams)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder (edgetypenames,edgetypeparams1) = unzip edgetypeparams
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder graph <- GraphDisp.newGraph graphtool graphParms
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder nodetypes <- sequence (map (newNodeType graph) nodetypeparams1)
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder edgetypes <- sequence (map (newArcType graph) edgetypeparams1)
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder let g = AbstractionGraph {
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder theGraph = graph,
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder nodeTypes = zip nodetypenames nodetypes,
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder edgeTypes = zip edgetypenames edgetypes,
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder edgeComp = comptable,
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder eventTable = [] }
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder writeIORef gv ((ev_cnt,g):gs,ev_cnt+1)
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder return (Result ev_cnt Nothing)
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maederdelgraph :: Descr -> GraphInfo -> IO Result
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblettdelgraph gid gv =
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder fetch_graph gid gv True
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder (\(g,ev_cnt) -> do destroy (theGraph g)
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder return (g,0,ev_cnt+1,Nothing))
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederdelallgraphs :: GraphInfo -> IO ()
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maederdelallgraphs gv = do
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder (gs,ev_cnt) <- readIORef gv
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder destroy_all gs ev_cnt
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder destroy_all [] _ = return ()
0d0278c34a374b29c2d6c58b39b8b56e283d48e8Christian Maeder destroy_all ((gid,_):gs) ev_cnt = do
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder writeIORef gv (gs,ev_cnt)
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian Maeder Result _ _ <- GUI.AbstractGraphView.delgraph gid gv
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers (_,ev_cnt') <- readIORef gv
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder destroy_all gs ev_cnt'
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederaddnode :: Descr -> String -> String -> GraphInfo -> IO Result
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maederaddnode gid nodetype name gv =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder do case lookup nodetype (nodeTypes g) of
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder Nothing -> return (g,0,ev_cnt,Just ("addnode: illegal node type: "++nodetype))
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder do existingNodesOfSameType <- sequence [(getNodeValue (theGraph g) davinciNode)|(descr,(tp,davinciNode)) <- (nodes g), tp == nodetype]
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder case elem name [existingName| (existingName, _,_) <- existingNodesOfSameType] of
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder _ -> do node <- newNode (theGraph g) nt (name,ev_cnt,gid)
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder return (g{nodes = (ev_cnt,(nodetype,node)):nodes g},ev_cnt,ev_cnt+1,Nothing)
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder True -> do return (g,0,ev_cnt, Just("addnode: node \"" ++ name ++ "\" of type " ++ nodetype ++ " already exists in graph " ++ (show gid)))
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maederdelnode :: Descr -> Descr -> GraphInfo -> IO Result
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maederdelnode gid node gv =
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder case lookup node (nodes g) of
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder Just n -> do deleteNode (theGraph g) (snd n)
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder return (g{nodes = remove node (nodes g)},0,ev_cnt+1,Nothing)
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder Nothing -> return (g,0,ev_cnt,Just ("delnode: illegal node: "++show node))
54ea981a0503c396c2923a1c06421c6235baf27fChristian Maederchangenodetype
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maederunclear how to implement, ask George
f9e0b18852b238ddb649d341194e05d7200d1bbeChristian Maederaddlink :: Descr -> String -> String -> Descr -> Descr -> GraphInfo -> IO Result
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maederaddlink gid edgetype name src tar gv =
f9e0b18852b238ddb649d341194e05d7200d1bbeChristian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder case (lookup edgetype (edgeTypes g),
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder lookup src (nodes g),
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder lookup tar (nodes g)) of
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder (Just et, Just src_node, Just tar_node) ->
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder do existingEdgesOfSameTypeAndPosition <- sequence [(getArcValue (theGraph g) davinciArc)|(descr,(srcId, tgtId, tp, davinciArc)) <- (edges g), tp == edgetype && srcId == src && tgtId == tar]
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder case lookup name existingEdgesOfSameTypeAndPosition of
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder do edge <- newArc (theGraph g) et (name,ev_cnt) (snd src_node) (snd tar_node)
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder return (g{edges = (ev_cnt,(src,tar,edgetype,edge)):edges g},ev_cnt,ev_cnt+1,Nothing)
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder Just _ -> do srcToString <- getNodeNameAndTypeAsString g src
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder tarToString <- getNodeNameAndTypeAsString g tar
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder return (g,0,ev_cnt,Just("addlink: edge \""++name++"\" from node "++(show src)++(srcToString)++" to node "++(show tar)++(tarToString)++" of type "++edgetype++" already exists in graph "++(show gid)))
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder (Nothing,_,_) -> return (g,0,ev_cnt,Just ("addlink: illegal edge type: "++edgetype))
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder (_,Nothing,_) -> return (g,0,ev_cnt,Just ("addlink: illegal source node id: "++show src))
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder (_,_,Nothing) -> return (g,0,ev_cnt,Just ("addlink: illegal target node id: "++show tar))
aded505f9b42cc38975559c2a5d175ae95de436bChristian MaedergetNodeNameAndTypeAsString :: AbstractionGraph -> Descr -> IO String
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian MaedergetNodeNameAndTypeAsString g descr = case lookup descr (nodes g) of
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder Just (tp, davinciNode) ->
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder do (name, i, j) <- getNodeValue (theGraph g) davinciNode
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder return (" (\""++name++"\" of type "++tp++")")
0d0278c34a374b29c2d6c58b39b8b56e283d48e8Christian Maeder Nothing -> error ("getNodeNameAndTypeAsString: unknown node: "++(show descr))
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maederdellink :: Descr -> Descr -> GraphInfo -> IO Result
0d0278c34a374b29c2d6c58b39b8b56e283d48e8Christian Maederdellink gid edge gv =
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder case lookup edge (edges g) of
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Just (_,_,_,e) ->
986d3f255182539098a97ac86da9eeee5b7a72e3Christian Maeder do deleteArc (theGraph g) e
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder return (g{edges = remove edge (edges g)},0,ev_cnt+1,Nothing)
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Nothing -> return (g,0,ev_cnt,Just ("dellink: illegal edge: "++show edge))
5ad5dffe06818a13e1632b1119fbca7881085fc1Dominik Lueckeredisplay :: Descr -> GraphInfo -> IO Result
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maederredisplay gid gv =
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder do redraw (theGraph g)
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu return (g,0,ev_cnt+1,Nothing)
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder-- determines from the types of two edges the type of the path replacing them (using the edgeComp table of the graph)
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroederdetermineedgetype :: AbstractionGraph -> (String,String) -> Maybe String
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroederdetermineedgetype g (t1,t2) = case result of
05a206508bc898f87fe6ab6e069814df3c29d303Dominik Luecke x:xs -> Just x
05a206508bc898f87fe6ab6e069814df3c29d303Dominik Luecke where result = [t| (tp1,tp2,t) <- (edgeComp g), (tp1==t1)&&(tp2==t2)]
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder-- returns a pair of lists: one list of all in- and one of all out-going edges of the node
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian MaederfetchEdgesOfNode :: AbstractionGraph -> Descr -> Maybe ([Descr],[Descr])
3b06e23643a9f65390cb8c1caabe83fa7e87a708Till MossakowskifetchEdgesOfNode g node = case sequence (map ((flip lookup) (edges g)) (map fst (edges g))) of
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder Just el -> Just ([descr|ed@(descr,(_,t,_,_)) <- (edges g), t == node],[descr|ed@(descr,(s,_,_,_)) <- (edges g), s == node])
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Nothing -> Nothing
5afff1a0f62394414c33b06141175b3ab0b117a5Christian Maederhidenodes :: Descr -> [Descr] -> GraphInfo -> IO Result
5afff1a0f62394414c33b06141175b3ab0b117a5Christian Maederhidenodes gid node_list gv =
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
1b3a2f98d1cd01fc9e0591f69507e20526727559Dominik Luecke case sequence (map (\node -> lookup node (nodes g)) node_list) of
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettich Just nl -> do -- try to determine the path to add and the edges to remove
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder case makepathsMain g node_list of
f8e1a1eca871a26a535a4ee7d51902ba94b1db1eChristian Maeder -- try to create the paths
ea3bff3e547a1ac714d4db39c5efef95e02b2e7dChristian Maeder Just (newEdges,delEdges) -> do -- save the old edges...
dd6f22b9dcff2695181b86372e4df03d5b96e92dKristina Sojakova let oeDescr = nub ((concat (map fst delEdges))++(concat (map snd delEdges)))
005e0f0c6b0cc898003b03801158c208f3071fc5Kristina Sojakova oe = map (\ed -> get ed (edges g)) oeDescr
abf2487c3aece95c371ea89ac64319370dcb6483Klaus Luettich oldEdges <- saveOldEdges g oe
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder -- ... then try to remove them from the graph
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder (gs,_) <- readIORef gv
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder writeIORef gv (gs,ev_cnt+1)
76b9b2974795a6fb31f242fd032de3ff66df6204Christian Maeder deletedEdges@(Result de1 error1) <- hideedgesaux gid oeDescr gv
76b9b2974795a6fb31f242fd032de3ff66df6204Christian Maeder info1 <- readIORef gv
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder case error1 of
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst Schulz Nothing -> do -- determine the _new_ edges...
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst Schulz let existingEdges = [(src,tgt,tp)|(descr,(src,tgt,tp,daVinci)) <- (edges (snd (get gid (fst info1))))]
c2e192ace9ef7cfb0e59563f1b24477b2b65cff3Dominik Dietrich filteredNewEdges = [path| path@(src,tgt,tp) <- newEdges, notElem (src,tgt,tp) existingEdges]
6b75c206b317eb30a08d88a8f27e0295ffeb1546Christian Maeder -- ... and try to add them
9a4b469ca0a7f44a598e551a973c75195207db58Eugen Kuksa paths@(Result de2 error2) <- addpaths gid filteredNewEdges gv --info1
48aa0645e25883048369afc02aac3f49b14a50daChristian Maeder case error2 of
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder Nothing -> do -- save the old nodes...
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder let on = map (\nd -> get nd (nodes g)) node_list
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder oldNodes <- saveOldNodes g on
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder -- ... then try to remove them from the graph
7dc37844730a8b23973139e9720574382de109e7Alexis Tsogias deletedNodes@(Result de3 error3) <- hidenodesaux gid node_list gv --info2
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogias info3 <- readIORef gv
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz case error3 of
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz Nothing -> do -- save the changes in an entry
a604cbad8e2202147b5c6bb9f2e06ae61162d654Felix Gabriel Mance let g' = snd (get gid (fst info3))
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder newEdges = [edge| edge <- (edges g'), notElem edge (edges g)]
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder newEvent = createEntry [] oldNodes newEdges oldEdges ev_cnt
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder return (g'{eventTable = newEvent:eventTable g'},ev_cnt,(snd info3)+1,Nothing)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just t -> return (g,0,ev_cnt,Just ("hidenodes: error hiding nodes: "++t))
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just text -> return (g,0,ev_cnt,Just ("hidenodes: error adding paths: "++text))
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just text -> return (g,0,ev_cnt,Just ("hidenodes: error deleting edges: "++text))
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> return (g,0,ev_cnt,Just "hidenodes: error making paths\n(possible reasons: an error occured getting the edges of the nodes\nor a pathtype could not be determined (missing entry in edgeComp table))")
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> return (g,0,ev_cnt,Just "hidenodes: unknown node(s)")
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- auxiliary function, which removes the nodes from the graph
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederhidenodesaux :: Descr -> [Descr] -> GraphInfo -> IO Result
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroederhidenodesaux gid [] gv = do (gs,ev_cnt) <- readIORef gv
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder return (Result ev_cnt Nothing)
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroederhidenodesaux gid (d:delNodes) gv = do deletedNode@(Result de error) <- delnode gid d gv
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu case error of
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu Nothing -> do hidenodesaux gid delNodes gv
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu Just t -> return deletedNode
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- returns the paths to add and the edges to remove
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedermakepathsMain :: AbstractionGraph -> [Descr] -> Maybe ([(Descr,Descr,String)],[([Descr],[Descr])])
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedermakepathsMain g node_list =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- try to determine the in- and outgoing edges of the nodes
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder case sequence (map (fetchEdgesOfNode g) node_list) of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- try to make paths of these edges
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just edgelistPairs -> case sequence (map (makepaths g node_list) edgelistPairs) of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- return the paths to add and the edges to remove
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just paths -> Just (nub (concat paths),edgelistPairs)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> Nothing
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> Nothing
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- returns a list of paths (ie source, target and type) to be added
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedermakepaths :: AbstractionGraph -> [Descr] -> ([Descr],[Descr]) -> Maybe [(Descr,Descr,String)]
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedermakepaths g node_list (inEdges,outEdges) =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- try to lookup the edges of the node
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder case (sequence (map (\ed -> lookup ed (edges g)) inEdges),sequence (map (\ed -> lookup ed (edges g)) outEdges)) of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (Just ie, Just oe) ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- try to make paths out of them
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder case sequence (map (makepathsaux g node_list []) (specialzip ie oe)) of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- return the paths
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just paths -> Just (concat paths)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> Nothing
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (Nothing,_) -> Nothing
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (_,Nothing) -> Nothing
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- determines source, target and type of the path to be added and checks it using method checkpath
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedermakepathsaux :: AbstractionGraph -> [Descr] -> [Descr] -> ((Descr,Descr,String,DaVinciArc(String,Int)),(Descr,Descr,String,DaVinciArc(String,Int))) -> Maybe [(Descr,Descr,String)]
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedermakepathsaux g node_list alreadyPassedNodes ((s1,t1,ty1,ed1),(s2,t2,ty2,ed2)) =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- try to determine the type of the path
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder case determineedgetype g (ty1,ty2) of
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian Maeder -- return the checked path
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just ty -> checkpath g node_list alreadyPassedNodes (s1,t2,ty,ed1) -- ed1 is just a dummy value (Dummiewert)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> Nothing
9f85afecbd79b3df5a0bb17bd28cd0b288dc3213Kristina Sojakova-- check, if the source or the target of an edge are element of the list of nodes that are to be hidden
48aa0645e25883048369afc02aac3f49b14a50daChristian Maeder-- if so, find out the "next" sources/targets and check again
9f85afecbd79b3df5a0bb17bd28cd0b288dc3213Kristina Sojakova-- remember which nodes have been passed to avoid infinite loops
79834070d6d3c63a098e570b12fa3405c607dc70Kristina Sojakovacheckpath :: AbstractionGraph -> [Descr] -> [Descr] -> (Descr,Descr,String,DaVinciArc(String,Int)) -> Maybe [(Descr,Descr,String)]
79834070d6d3c63a098e570b12fa3405c607dc70Kristina Sojakovacheckpath g node_list alreadyPassedNodes path@(src,tgt,ty,ed)
79834070d6d3c63a098e570b12fa3405c607dc70Kristina Sojakova | elem src alreadyPassedNodes || elem tgt alreadyPassedNodes = Just []
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder | elem src node_list = -- try to determine the in- and outgoing edges of the source node
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder case fetchEdgesOfNode g src of
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder -- try to lookup ingoing edges
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder Just (inEdges,outEdges) -> case sequence (map (\ed -> lookup ed (edges g)) inEdges) of
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder -- try to make paths of these edges and the "tail" of the path (and recursively check them)
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder Just el -> case sequence (map (makepathsaux g node_list (src:alreadyPassedNodes)) (specialzip el [path])) of
624e6701e0deb7ac6c03c0cba0190fbc5033cf93Ewaryst Schulz Just p -> Just (concat p)
624e6701e0deb7ac6c03c0cba0190fbc5033cf93Ewaryst Schulz Nothing -> Nothing
c2e192ace9ef7cfb0e59563f1b24477b2b65cff3Dominik Dietrich Nothing -> Nothing
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl Luc | elem tgt node_list = -- try to determine the in- and outgoing edges of the target node
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl Luc case fetchEdgesOfNode g tgt of
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder -- try to lookup the outgoing edges
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder Just (inEdges,outEdges) -> case sequence (map (\ed -> lookup ed (edges g)) outEdges) of
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder -- try to make paths of these edges and the "init" of the path (and recursively check them)
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder Just el -> case sequence (map (makepathsaux g node_list (tgt:alreadyPassedNodes)) (specialzip [path] el)) of
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder Just p -> Just (concat p)
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder Nothing -> Nothing
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogias Nothing -> Nothing
fc09e0a6af734edbd944dd8082bb51985c233b43Alexis Tsogias Nothing -> Nothing
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogias | otherwise = -- nothing to be done
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz Just [(src,tgt,ty)]
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder-- adds the paths (given source, target and type)
18d370f8341357f5d6a4068f4bb6981173ece70fFelix Gabriel Manceaddpaths :: Descr -> [(Descr,Descr,String)] -> GraphInfo -> IO Result
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulzaddpaths gid [] gv = do (gs,ev_cnt) <- readIORef gv
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder return (Result ev_cnt Nothing)
c70ef4c3b3a62764f715510c9fd67dde3acfe454Christian Maederaddpaths gid ((src,tgt,ty):newEdges) gv = do edge@(Result de error) <- addlink gid ty "" src tgt gv
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder case error of
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder Nothing -> do addpaths gid newEdges gv
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers Just t -> return edge
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- fetches all the nodes of the given type and hides them using hidenodes
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederhidenodetype :: Descr -> String -> GraphInfo -> IO Result
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maederhidenodetype gid nodetype gv = fetch_graph gid gv False (\(g,ev_cnt) ->
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder -- check if the node type is valid
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do case lookup nodetype (nodeTypes g) of
8b29b9f8066d0825088a039c0952b30cad0295f1Christian Maeder do let nodelist = [descr|(descr,(tp,_)) <- (nodes g), tp == nodetype]
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder case nodelist of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder [] -> do return (g,0,ev_cnt,Just ("hidenodetype: no nodes of type "++nodetype++" found in graph "++(show gid)))
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder node_list -> do (Result de error) <- hidenodes gid nodelist gv
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder info <- readIORef gv
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich return (snd (get gid (fst info)), de, (snd info), error)
b446bf54c1dc78690aa12e86aadc49cdd8585847Christian Maeder Nothing -> return (g,0,ev_cnt,Just ("hidenodetype: illegal node type: "++nodetype))
7c99e334446bb97120e30e967baeeddfdd1278deKlaus Luettich-- like hidenodes, but replaces the hidden nodes by a new node
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder-- with a menu to unhide the nodes (not yet implemented)
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maederabstractnodes :: Descr -> [Descr] -> GraphInfo -> IO Result
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maederabstractnodes gid [] gv = fetch_graph gid gv False (\(g,ev_cnt) -> return (g,0,ev_cnt,Nothing))
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maederabstractnodes gid node_list gv =
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
33d042fe6a9eb27a4c48f840b80838f3e7d98e34Christian Maeder -- try to lookup the nodes of the list
83394c6b6e6de128e71b67c9251ed7a84485d082Christian Maeder case sequence (map (\nd -> lookup nd (nodes g)) node_list) of
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maeder Just nl -> -- try to lookup the in- and outgoing edges of the nodes
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maeder case sequence (map (fetchEdgesOfNode g) node_list) of
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Just el -> do -- save the old edges
0c355dd0b739631ee472f9a656e266be27fa4e64Christian Maeder let oeDescr = nub ((concat (map fst el))++(concat (map snd el)))
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maeder oe = map (\edge -> get edge (edges g)) oeDescr
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder oldEdges <- saveOldEdges g oe
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich -- save the old nodes
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich let on = map (\node -> get node (nodes g)) node_list
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder oldNodes <- saveOldNodes g on
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich -- try to create the new abstract node and add its in- and outgoing paths
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich (Result de1 error1) <- replaceByAbstractNode gid node_list nl oeDescr gv --(gs,ev_cnt+1)
810746aea00b81c1eec27dae84d73a43599ff056Christian Maeder case error1 of
a883cd4d01fe39d23219cf5333425f195be24d8bChristian Maeder Nothing -> do -- try to remove the in- and outgoing edges of the nodes to be hidden
b905126bab9454b89041f92b3c50bb9efc85e427Klaus Luettich (Result de2 error2) <- hideedgesaux gid oeDescr gv
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder case error2 of
33d042fe6a9eb27a4c48f840b80838f3e7d98e34Christian Maeder Nothing -> do -- try to remove the nodes of the list
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder (Result de3 error3) <- hidenodesaux gid node_list gv --info2
0a5571c8adeddd27548445546491725beb224dddChristian Maeder info3 <- readIORef gv
0a5571c8adeddd27548445546491725beb224dddChristian Maeder case error3 of
0a5571c8adeddd27548445546491725beb224dddChristian Maeder Nothing -> do -- save the changes in an entry
0a5571c8adeddd27548445546491725beb224dddChristian Maeder let g' = snd (get gid (fst info3))
0a5571c8adeddd27548445546491725beb224dddChristian Maeder newNodes = [nd| nd <- nodes g', notElem nd (nodes g)]
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder newEdges = [ed| ed <- edges g', notElem ed (edges g)]
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maeder newEntry = createEntry newNodes oldNodes newEdges oldEdges ev_cnt
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder return (g'{eventTable=newEntry:eventTable g'},ev_cnt,snd info3,Nothing)
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder Just t -> return (g,0,ev_cnt,Just ("abstractnodes: error hiding nodes: "++t))
0a5571c8adeddd27548445546491725beb224dddChristian Maeder Just t -> return (g,0,ev_cnt,Just ("abstractnodes: error hiding edges: " ++ t))
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder Just t -> return (g,0,ev_cnt,Just ("abstractnodes: error making abstract node: "++ t))
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder Nothing -> return (g,0,ev_cnt,Just "abstractnodes: error fetching the edges of the nodes")
74d27713392cbbe39ecd72d0ddb0caad16e84555Christian Maeder Nothing -> return (g,0,ev_cnt,Just "abstractnodes: unknown nodes")
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder-- adds an abstract node, determines and adds its in- and outgoing paths
e05fd774e0181e93963d4302303b20698603a505Christian MaederreplaceByAbstractNode :: Descr -> [Descr] -> [(String,DaVinciNode(String,Int,Int))] -> [Descr] -> GraphInfo -> IO Result
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian MaederreplaceByAbstractNode gid node_list nl edge_list gv =
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder -- try to lookup the in- and outgoing edges of the nodes that are to be hidden
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder case sequence (map (\ed -> lookup ed (edges g)) edge_list) of
e05fd774e0181e93963d4302303b20698603a505Christian Maeder Just el -> do -- try to add an abstract node
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder (Result de1 error1) <- addnode gid "ABSTRACT" (show ev_cnt) gv
f2d9352f2999f82c36b4b65535d14a6a40ae5a82Christian Maeder case error1 of
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maeder Nothing -> do -- determine its in- and outgoing paths...
483333cb1e873b6d55f5ef0bfbf061861f0493abChristian Maeder let newEdges = [(src,de1,tp)| (src,tgt,tp,_) <- el, ((notElem src node_list) && (elem tgt node_list))]
483333cb1e873b6d55f5ef0bfbf061861f0493abChristian Maeder ++ [(de1,tgt,tp)| (src,tgt,tp,_) <- el, ((elem src node_list) && (notElem tgt node_list))]
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowski -- ... and try to add them
1dfba1f850f6a43094962b459998d1ea11472461Christian Maeder (Result de2 error2) <- addpaths gid (nub newEdges) gv
1dfba1f850f6a43094962b459998d1ea11472461Christian Maeder info2 <- readIORef gv
1dfba1f850f6a43094962b459998d1ea11472461Christian Maeder case error2 of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> do -- return the modified graph
fa0f3519d71f719d88577b716b1579776b4a2535Christian Maeder let g' = snd (get gid (fst info2))
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder return (g',de2,snd info2,Nothing)
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder Just t -> return (g,0,ev_cnt,error2)
fa0f3519d71f719d88577b716b1579776b4a2535Christian Maeder Just text -> return (g,0,ev_cnt,Just ("replaceByAbstractNode: error creating abstract node: "++text))
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder Nothing -> return (g,0,ev_cnt,Just "replaceByAbstractNode: error looking up the edges of the nodes")
c59d1c38ef94b4fb1c8d9fda9573bc1e1d2801e7Christian Maederhideedges :: Descr -> [Descr] -> GraphInfo -> IO Result
cd36bffee51c77cdadcb9f916b34fa512e311946Christian Maederhideedges gid edge_list gv = fetch_graph gid gv False (\(g,ev_cnt) ->
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder -- check if all of the edges exist
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder case sequence (map (\edge -> lookup edge (edges g)) edge_list) of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just el -> do -- save the old edges ...
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich let oe = map (\edge -> get edge (edges g)) edge_list
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich oldEdges <- saveOldEdges g oe
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich -- ... then try to remove them from the graph
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich (gs,_) <- readIORef gv
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich writeIORef gv (gs,ev_cnt+1)
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich (Result de error) <- hideedgesaux gid edge_list gv
36f63902db2b3463faa9f59912ad106e2d5aaa24Klaus Luettich info <- readIORef gv
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich case error of
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Nothing -> do -- save the changes in an entry
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich let g' = snd (get gid (fst info))
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich newEntry = createEntry [] [] [] oldEdges ev_cnt
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich return (g'{eventTable = newEntry:eventTable g'},ev_cnt,snd info,Nothing)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just text -> return (g,0,ev_cnt,Just ("hideedges: error hiding edges: "++text))
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Nothing -> return (g,0,ev_cnt,Just "hideedges: unknown edges")
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers-- an auxiliary function, which removes the edges from the graph
1365c420ef71be3d52796ebd369dc2defdedc822Christian Maederhideedgesaux :: Descr -> [Descr] -> GraphInfo -> IO Result
a80c28bb8b7a23ccdf7e08d0fe216fc19cc97273Klaus Luettichhideedgesaux gid [] gv = do (gs,ev_cnt) <- readIORef gv
82e29b77f0ef4cccd7ed734692c5e1e93dbbc645Christian Maeder return (Result ev_cnt Nothing)
a80c28bb8b7a23ccdf7e08d0fe216fc19cc97273Klaus Luettichhideedgesaux gid (d:delEdges) gv = do dle@(Result descr error) <- dellink gid d gv
5f0e3e4cb7dd31033c9682cafa712d2a66b2f3bcChristian Maeder case error of
5f0e3e4cb7dd31033c9682cafa712d2a66b2f3bcChristian Maeder Nothing -> do hideedgesaux gid delEdges gv --info
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Just t -> return dle
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder-- fetches all the edges of the given type and hides them using hideedges
d0652648f9879c67a194f8b03baafe2700c68eb4Christian Maederhideedgetype :: Descr -> String -> GraphInfo -> IO Result
210aa1071465039588fa9e38c10e343631c34655Christian Maederhideedgetype gid edgetype gv =
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder fetch_graph gid gv False (\(g,ev_cnt) ->
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder -- check if the edge type is valid
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder case lookup edgetype (edgeTypes g) of
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Just et -> do let edgelist = [descr|(descr,(_,_,tp,_)) <- (edges g), tp == edgetype]
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich case edgelist of
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder [] -> do return (g,0,ev_cnt,Just ("hideedgetype: no edges of type "++edgetype++" found in graph "++(show gid)))
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder edge_list -> do (Result de error) <- hideedges gid edge_list gv
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder info <- readIORef gv
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder return (snd (get gid (fst info)), de, snd info,error)
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder Nothing -> return (g,0,ev_cnt,Just ("hideedgetype: illegal edge type: "++edgetype))
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder-- function to undo hide-events
1365c420ef71be3d52796ebd369dc2defdedc822Christian MaedershowIt :: Descr -> Descr -> GraphInfo -> IO Result
83394c6b6e6de128e71b67c9251ed7a84485d082Christian MaedershowIt gid hide_event gv =
36f63902db2b3463faa9f59912ad106e2d5aaa24Klaus Luettich fetch_graph gid gv False (\(g,ev_cnt) ->
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder -- try to lookup the hide-event
83394c6b6e6de128e71b67c9251ed7a84485d082Christian Maeder case lookup hide_event (eventTable g) of
68d10d143f29fcff3c637ba24f90e983995ceae6Christian Maeder Just entry -> do -- try to remove the paths that had been added
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder (Result de1 error1) <- hideedgesaux gid (map fst (newEdges entry)) gv
c5e3fc166373b0d90f6e36e8aa234396a1dcd879Christian Maeder case error1 of
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maeder Nothing -> do -- try to add the nodes that had been hidden
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich (Result de2 error2) <- shownodes gid (oldNodes entry) gv
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder case error2 of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Nothing -> do -- try to remove the nodes that had been added
b446bf54c1dc78690aa12e86aadc49cdd8585847Christian Maeder (Result de3 error3) <- hidenodesaux gid (map fst (newNodes entry)) gv
e1559d046eb2c6dde0e6e272b37b6756eac0e8adChristian Maeder case error3 of
68d10d143f29fcff3c637ba24f90e983995ceae6Christian Maeder Nothing -> do -- try to add the edges that had been hidden
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder (Result de4 error4) <- showedges gid (oldEdges entry) gv
2c619a4dfdc1df27573eba98e81ed1ace906941dChristian Maeder info4 <- readIORef gv
5580ab3e64410186ccd36cde8a94282d8757ac0dChristian Maeder case error4 of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Nothing -> do -- remove the event from the eventTable
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl let g' = snd (get gid (fst info4))
b446bf54c1dc78690aa12e86aadc49cdd8585847Christian Maeder return (g'{eventTable = remove hide_event (eventTable g')},0,ev_cnt+1,Nothing)
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl Just t4 -> return (g,0,ev_cnt,Just ("showIt: error restoring old edges:\n-> "++t4))
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl Just t3 -> return (g,0,ev_cnt,Just ("showIt: error removing nodes:\n-> "++t3))
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just t2 -> return (g,0,ev_cnt,Just ("showIt: error restoring nodes:\n-> "++t2))
50515239e7e190f4a34ca581dd685d002148fbddChristian Maeder Just t1 -> return (g,0,ev_cnt,Just ("showIt: error removing edges:\n-> "++t1))
50515239e7e190f4a34ca581dd685d002148fbddChristian Maeder Nothing -> return (g,0,ev_cnt,Just ("showIt: invalid event descriptor: "++(show hide_event)))
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder-- adds nodes that had been hidden
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedershownodes :: Descr -> [(Descr,(String,String))] -> GraphInfo -> IO Result
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedershownodes gid [] gv = do (gs,ev_cnt) <- readIORef gv
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder return (Result ev_cnt Nothing)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedershownodes gid ((node@(d,(tp,name))):list) gv =
8b4c68db8b465107cabef8b9cd5b6bc216e1b156Till Mossakowski do (gs,_) <- readIORef gv
8b4c68db8b465107cabef8b9cd5b6bc216e1b156Till Mossakowski let g = snd (get gid gs)
8b4c68db8b465107cabef8b9cd5b6bc216e1b156Till Mossakowski -- try to add the first node
bcaf979d9babe6346aa343687aa7d596e2894cccPaolo Torrini writeIORef gv (gs,d)
df29370ae8d8b41587957f6bcdcb43a3f1927e47Christian Maeder nd@(Result de error) <- addnode gid tp name gv
bcaf979d9babe6346aa343687aa7d596e2894cccPaolo Torrini case error of
5ce19352a9cc47d982819cc889a71cd0a61ac171Christian Maeder Nothing -> do -- try to add the rest
5ce19352a9cc47d982819cc889a71cd0a61ac171Christian Maeder shownodes gid list gv
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder Just _ -> return nd
df29370ae8d8b41587957f6bcdcb43a3f1927e47Christian Maeder-- adds edges that had been hidden
23ab8855c58adfbd03a0730584b917b24c603901Christian Maedershowedges :: Descr -> [(Int,(Int,Int,String,String))] -> GraphInfo -> IO Result
e50e41135ece589f7202bd4ef8d6b97531c2a56eKlaus Luettichshowedges gid [] gv = do (gs,ev_cnt) <- readIORef gv
47b0e9f3cb008cb7997f4e3bae26e4d62dcc887aChristian Maeder return (Result ev_cnt Nothing)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedershowedges gid ((edge@(d,(src,tgt,tp,davinciarc))):list) gv =
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder do (gs,_) <- readIORef gv
431d34c7007a787331c4e5ec997badb0f8190fc7Christian Maeder let g = snd (get gid gs)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder -- try to add the first edge
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder writeIORef gv (gs,d)
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder ed@(Result de err) <- addlink gid tp davinciarc src tgt gv
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder Nothing -> do -- try to add the rest
d5d349836d8b1fa93ea49a59d977b106c6e9233bKlaus Luettich showedges gid list gv
d5d349836d8b1fa93ea49a59d977b106c6e9233bKlaus Luettich Just _ -> return ed
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder-- creates a list of the nodes that will be hidden (ie descriptor,type and name)
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaedersaveOldNodes :: AbstractionGraph -> [(Int,(String,DaVinciNode(String,Int,Int)))] -> IO [(Int,(String,String))]
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaedersaveOldNodes g [] = return []
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus LuettichsaveOldNodes g ((node@(de,(tp,davincinode))):list) = do (name,descr,gid) <- getNodeValue (theGraph g) davincinode
9096f6c6aaded6cd8288656ceccd4c7b3bd0747eChristian Maeder restOfList <- saveOldNodes g list
9096f6c6aaded6cd8288656ceccd4c7b3bd0747eChristian Maeder return ((de,(tp,name)):restOfList)
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettich-- creates a list of the edges that will be hidden (ie descriptor,source,target,type and name)
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus LuettichsaveOldEdges :: AbstractionGraph -> [(Int,(Int,Int,String,DaVinciArc(String,Int)))] -> IO [(Int,(Int,Int,String,String))]
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus LuettichsaveOldEdges g [] = return []
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedersaveOldEdges g (edge@(de,(src,tgt,tp,davinciarc)):list) = do value <- getArcValue (theGraph g) davinciarc
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maeder restOfList <- saveOldEdges g list
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder return ((de,(src,tgt,tp,(fst value))):restOfList)