Wed Nov 16 15:47:59 WET 2005 Malcolm.Wallace@cs.york.ac.uk
* remove class Analysis, replacing it with datatype Operations
The class Analysis was too restrictive, defining only a single
graph-altering operation (and its reversion) per application.
Replace it with a datatype storing many possible graph operations.
These operations are added to a new title-bar menu.
{
hunk ./Makefile 24
- src/DisplayOptions.hs src/Analysis.hs \
+ src/DisplayOptions.hs src/Operations.hs \
hunk ./Makefile 91
-src/Main.o : src/Analysis.hi
+src/Main.o : src/Operations.hi
hunk ./Makefile 146
-src/NetworkUI.o : src/Analysis.hi
+src/NetworkUI.o : src/Operations.hi
hunk ./Makefile 209
-src/Analysis.o : src/Analysis.hs
-src/Analysis.o : lib/DData/IntMap.hi
-src/Analysis.o : src/PersistentDocument.hi
-src/Analysis.o : src/Document.hi
-src/Analysis.o : src/State.hi
-src/Analysis.o : src/Network.hi
-src/Analysis.o : src/InfoKind.hi
+src/Operations.o : src/Operations.hs
+src/Operations.o : lib/DData/IntMap.hi
+src/Operations.o : src/PersistentDocument.hi
+src/Operations.o : src/Document.hi
+src/Operations.o : src/State.hi
+src/Operations.o : src/Network.hi
+src/Operations.o : src/InfoKind.hi
hunk ./src/Analysis.hs 1
-module Analysis where
-
-import InfoKind
-import Network
-import State
-import Document
-import qualified PersistentDocument as PD
-
-import IntMap
-
--- | An @Analysis@ class links two InfoKind types together (one for nodes,
--- one for edges). A blobs graph is passed in and a fresh one received
--- back again. Currently, the analysis method can choose to update
--- any of the info labels on nodes or edges, or indeed the edge/node
--- connection topology (by adding/deleting edges or nodes).
--- There is also a method for reverting the analysis (which may not be
--- possible for all kinds of analysis, I suppose).
-class (InfoKind n g, InfoKind e g) => Analysis g n e where
- -- n = node info type
- -- e = edge info type
- -- g = global info type
- analyse :: (g, IntMap (Node n), IntMap (Edge e)) ->
- (g, IntMap (Node n), IntMap (Edge e))
- revert :: (g, IntMap (Node n), IntMap (Edge e)) ->
- (g, IntMap (Node n), IntMap (Edge e))
-
-callAnalysis :: Analysis g n e => State g n e -> IO ()
-callAnalysis state = [_$_]
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
- g = getGlobalInfo network
- n = networkNodes network
- e = networkEdges network
- (g',n',e') = analyse (g,n,e)
- network' = setNodeAssocs (assocs n')
- $ setEdgeAssocs (assocs e')
- $ setGlobalInfo g'
- $ network
- ; PD.updateDocument "perform analysis" (setNetwork network') pDoc
- }
-
-revertAnalysis :: Analysis g n e => State g n e -> IO ()
-revertAnalysis state =
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
- g = getGlobalInfo network
- n = networkNodes network
- e = networkEdges network
- (g',n',e') = revert (g,n,e)
- network' = setNodeAssocs (assocs n')
- $ setEdgeAssocs (assocs e')
- $ setGlobalInfo g'
- $ network
- ; PD.updateDocument "revert analysis" (setNetwork network') pDoc
- }
rmfile ./src/Analysis.hs
hunk ./src/Main.hs 9
-import Analysis
+import Operations
hunk ./src/Main.hs 18
- ; NetworkUI.create state ()
- ([]::[Int])
- ([]::[Int])
- -- trailing args used only to monomorphise InfoKind field of State.
+ ; NetworkUI.create state () undefined undefined graphOps
hunk ./src/Main.hs 28
-instance Analysis () [Int] [Int] where
- analyse (g, nodemap, edgemap) =
+
+-- A simple range of operations on a graph network.
+graphOps :: GraphOps () [Int] [Int]
+graphOps = GraphOps { pureOps = [ ("push numbers one step", onePush)
+ , ("clear all numbers", revert) ]
+ , ioOps = [] }
+ where
+ onePush (g, nodemap, edgemap) =
hunk ./src/NetworkUI.hs 23
-import Analysis
+import Operations
hunk ./src/NetworkUI.hs 52
-create :: (Analysis g n e, XmlContent g, Parse g, Show g) =>
- State g n e -> g -> n -> e -> IO ()
-create state g n e =
+create :: (InfoKind n g, InfoKind e g, XmlContent g, Parse g, Show g) =>
+ State g n e -> g -> n -> e -> GraphOps g n e -> IO ()
+create state g n e ops =
hunk ./src/NetworkUI.hs 173
- ; menuLine editMenu
- ; menuItem editMenu
- [ text := "Perform analysis"
- , on command := safetyNet theFrame $ do
- { callAnalysis state; repaintAll state }
- ]
- ; menuItem editMenu
- [ text := "Revert analysis"
- , on command := safetyNet theFrame $ do
- { revertAnalysis state; repaintAll state }
- ]
hunk ./src/NetworkUI.hs 196
+ -- Operations menu
+ ; opsMenu <- menuPane [ text := "&Operations" ]
+ ; mapM_ (\ (name,_)->
+ menuItem opsMenu
+ [ text := name [_$_]
+ , on command := safetyNet theFrame $ do
+ { callPureGraphOp name ops state
+ ; repaintAll state }
+ ]
+ ) (pureOps ops)
+ ; menuLine opsMenu
+ ; mapM_ (\ (name,_)->
+ menuItem opsMenu
+ [ text := name [_$_]
+ , on command := safetyNet theFrame $ do
+ { callIOGraphOp name ops state
+ ; repaintAll state }
+ ]
+ ) (ioOps ops)
+
hunk ./src/NetworkUI.hs 234
- [ menuBar := [ fileMenu, editMenu, viewMenu ]
+ [ menuBar := [ fileMenu, editMenu, viewMenu, opsMenu ]
addfile ./src/Operations.hs
hunk ./src/Operations.hs 1
+module Operations where
+
+import InfoKind
+import Network
+import State
+import Document
+import qualified PersistentDocument as PD
+
+import IntMap
+
+-- | @GraphOps@ is a data structure holding a bunch of named operations
+-- on the graph network. The operations are classified into pure and
+-- IO variants. A pure operation takes a graph and returns a new
+-- graph, which is stored into the current document (can be reverted
+-- with the standard 'undo' menu item), and displayed immediately. An
+-- IO operation is simply executed taking the graph as argument - it
+-- is up to the IO action to do any state updates it wants to.
+data GraphOps g n e = GraphOps
+ { pureOps :: [ (String, PureOp g n e) ]
+ , ioOps :: [ (String, IOOp g n e) ]
+ }
+type PureOp g n e = -- (InfoKind n g, InfoKind e g)
+ (g, IntMap (Node n), IntMap (Edge e))
+ -> (g, IntMap (Node n), IntMap (Edge e))
+type IOOp g n e = -- (InfoKind n g, InfoKind e g) =>
+ (g, IntMap (Node n), IntMap (Edge e))
+ -> IO ()
+
+callPureGraphOp :: String -> GraphOps g n e -> State g n e -> IO ()
+callPureGraphOp opName allGraphOps state = [_$_]
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; let network = getNetwork doc
+ g = getGlobalInfo network
+ n = networkNodes network
+ e = networkEdges network
+ operation = maybe id id (Prelude.lookup opName (pureOps allGraphOps))
+ (g',n',e') = operation (g,n,e)
+ network' = setNodeAssocs (assocs n')
+ $ setEdgeAssocs (assocs e')
+ $ setGlobalInfo g'
+ $ network
+ ; PD.updateDocument opName (setNetwork network') pDoc
+ }
+
+callIOGraphOp :: String -> GraphOps g n e -> State g n e -> IO ()
+callIOGraphOp opName allGraphOps state =
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; let network = getNetwork doc
+ g = getGlobalInfo network
+ n = networkNodes network
+ e = networkEdges network
+ ; maybe (return ()) (\op->op (g,n,e))
+ (Prelude.lookup opName (ioOps allGraphOps))
+ }
+
}