Tue Nov 15 17:34:40 WET 2005 Malcolm.Wallace@cs.york.ac.uk
* merge module Node into module Network
This patch incorporates two improvements from Arjan.
* First, the module Node.hs has been removed, with its contents merged
into Network.hs.
* Secondly, the types for Node and Edge have been made fully abstract.
Their internals are no longer available, only getters and setters.
{
hunk ./Makefile 16
- src/Network.hs src/Node.hs src/NetworkFile.hs \
+ src/Network.hs src/NetworkFile.hs \
hunk ./Makefile 93
-src/Main.o : src/Node.hi
hunk ./Makefile 126
+src/Network.o : src/Shape.hi
hunk ./Makefile 128
-src/Network.o : src/Node.hi
hunk ./Makefile 130
-src/Node.o : src/Node.hs
-src/Node.o : src/InfoKind.hi
-src/Node.o : src/Constants.hi
-src/Node.o : src/Shape.hi
-src/Node.o : src/Math.hi
hunk ./Makefile 136
-src/NetworkFile.o : src/Node.hi
hunk ./Makefile 172
-src/NetworkView.o : src/Node.hi
hunk ./Makefile 182
-src/NetworkControl.o : src/Node.hi
hunk ./Makefile 195
-src/ContextMenu.o : src/Node.hi
hunk ./Makefile 214
-src/Analysis.o : src/Node.hi
hunk ./src/Analysis.hs 5
-import Node
hunk ./src/ContextMenu.hs 6
-import qualified Node
hunk ./src/ContextMenu.hs 84
- labelAbove = Node.getNameAbove theNode
+ labelAbove = getNameAbove theNode
hunk ./src/Main.hs 8
-import Node
hunk ./src/Main.hs 35
- (g, nodemap, IntMap.map (\e-> e{edgeInfo=[]}) edgemap)
+ (g, nodemap, IntMap.map (setEdgeInfo []) edgemap)
hunk ./src/Main.hs 38
-push nodemap edge = edge { edgeInfo = nub (n:edgeInfo edge) }
- where n = (Node.getInfo . fromJust . flip IntMap.lookup nodemap . edgeFrom)
- edge
+push nodemap edge = setEdgeInfo (nub (n: getEdgeInfo edge)) edge
+ where n = (getInfo . fromJust . flip IntMap.lookup nodemap . getEdgeFrom)
+ edge
hunk ./src/Network.hs 4
- Network, Edge(..)
+ Network, Node, Edge
hunk ./src/Network.hs 6
- , networkNodes -- dangerous
- , networkEdges -- dangerous
+ , networkNodes -- dangerous
+ , networkEdges -- dangerous
hunk ./src/Network.hs 39
+
+ , constructNode
+ , getNodeInfo, getNodeName, getNodePosition, getNodeNameAbove, getNodeShape
+ , setNodeInfo, setNodeName, setNodePosition, setNodeNameAbove, setNodeShape
+ , getInfo, getName, getPosition, getNameAbove, getShape
+ , setInfo, setName, setPosition, setNameAbove, setShape
+
+ , constructEdge
+ , getEdgeFrom, getEdgeTo, getEdgeVia, getEdgeInfo
+ , setEdgeFrom, setEdgeTo, setEdgeVia, setEdgeInfo
hunk ./src/Network.hs 53
-import qualified Node
hunk ./src/Network.hs 54
+import Shape
hunk ./src/Network.hs 59
- { networkNodes :: !(IntMap (Node.Node n)) -- ^ maps node numbers to nodes
+ { networkNodes :: !(IntMap (Node n)) -- ^ maps node numbers to nodes
hunk ./src/Network.hs 68
- , edgeVia :: [DoublePoint] -- ^ intermediate vertices when drawing
+ , edgeVia :: [DoublePoint] -- ^ intermediate vertices when drawing
hunk ./src/Network.hs 72
+data Node n = Node
+ { nodePosition :: DoublePoint -- ^ the position of the node on screen
+ , nodeName :: !String
+ , nodeNameAbove :: Bool -- ^ should the name be displayed above (True) of below (False)
+ , nodeShape :: Shape
+ , nodeInfo :: n
+ } deriving (Show, Read)
+
hunk ./src/Network.hs 96
-mapNodeNetwork :: (Node.Node n->Node.Node m) -> Network g n e -> Network g m e
+mapNodeNetwork :: (Node n->Node m) -> Network g n e -> Network g m e
hunk ./src/Network.hs 107
+constructEdge :: NodeNr -> NodeNr -> [DoublePoint] -> e -> Edge e
+constructEdge fromNr toNr via info =
+ Edge
+ { edgeFrom = fromNr
+ , edgeTo = toNr
+ , edgeVia = via
+ , edgeInfo = info
+ }
+
+getEdgeFrom :: Edge e -> NodeNr
+getEdgeFrom = edgeFrom
+
+getEdgeTo :: Edge e -> NodeNr
+getEdgeTo = edgeTo
+
+getEdgeVia :: Edge e -> [DoublePoint]
+getEdgeVia = edgeVia
+
+getEdgeInfo :: Edge e -> e
+getEdgeInfo = edgeInfo
+
+setEdgeFrom :: NodeNr -> Edge e -> Edge e
+setEdgeFrom fromNr edge = edge { edgeFrom = fromNr }
+
+setEdgeTo :: NodeNr -> Edge e -> Edge e
+setEdgeTo toNr edge = edge { edgeTo = toNr }
+
+setEdgeVia :: [DoublePoint] -> Edge e -> Edge e
+setEdgeVia via edge = edge { edgeVia = via }
+
+setEdgeInfo :: e -> Edge oldInfo -> Edge e
+setEdgeInfo info edge =
+ constructEdge (getEdgeFrom edge) (getEdgeTo edge)
+ (getEdgeVia edge) info
+
+constructNode :: (InfoKind n g) => String -> DoublePoint -> Bool -> Shape -> n -> Node n
+constructNode name position nameAbove shape info =
+ Node
+ { nodeName = name
+ , nodePosition = position
+ , nodeNameAbove = nameAbove
+ , nodeShape = shape
+ , nodeInfo = info
+ }
+
+getNodeName :: Network g n e -> NodeNr -> String
+getNodeName network nodeNr = nodeName (networkNodes network ! nodeNr)
+
+setNodeName :: NodeNr -> String -> Network g n e -> Network g n e
+setNodeName nodeNr name network =
+ network { networkNodes = insert nodeNr (node { nodeName = name }) (networkNodes network) }
+ where node = networkNodes network ! nodeNr
+
+getNodePosition :: Network g n e -> NodeNr -> DoublePoint
+getNodePosition network nodeNr = nodePosition (networkNodes network ! nodeNr)
+
+setNodePosition :: NodeNr -> DoublePoint -> Network g n e -> Network g n e
+setNodePosition nodeNr position network =
+ network { networkNodes = insert nodeNr (node { nodePosition = position }) (networkNodes network) }
+ where node = networkNodes network ! nodeNr
+
+getNodeNameAbove :: Network g n e -> NodeNr -> Bool
+getNodeNameAbove network nodeNr = nodeNameAbove (networkNodes network ! nodeNr)
+
+setNodeNameAbove :: NodeNr -> Bool -> Network g n e -> Network g n e
+setNodeNameAbove nodeNr nameAbove network =
+ network { networkNodes = insert nodeNr (node { nodeNameAbove = nameAbove }) (networkNodes network) }
+ where node = networkNodes network ! nodeNr
+
+getNodeShape :: Network g n e -> NodeNr -> Shape
+getNodeShape network nodeNr = nodeShape (networkNodes network ! nodeNr)
+
+setNodeShape :: NodeNr -> Shape -> Network g n e -> Network g n e
+setNodeShape nodeNr shape network =
+ network { networkNodes = insert nodeNr (node { nodeShape = shape }) (networkNodes network) }
+ where node = networkNodes network ! nodeNr
+
+getNodeInfo :: Network g n e -> NodeNr -> n
+getNodeInfo network nodeNr = nodeInfo (networkNodes network ! nodeNr)
+
+setNodeInfo :: NodeNr -> n -> Network g n e -> Network g n e
+setNodeInfo nodeNr info network =
+ network { networkNodes = insert nodeNr (node { nodeInfo = info }) (networkNodes network) }
+ where node = networkNodes network ! nodeNr
+
+getNameAbove :: Node a -> Bool
+getNameAbove node = nodeNameAbove node
+
+getName :: Node a -> String
+getName node = nodeName node
+
+getShape :: Node a -> Shape
+getShape node = nodeShape node
+
+getPosition :: Node a -> DoublePoint
+getPosition node = nodePosition node
+
+getInfo :: Node a -> a
+getInfo node = nodeInfo node
+
+-- | Set whether the name should appear above (True) or below (False) the node
+setNameAbove :: Bool -> Node a -> Node a
+setNameAbove above node = node { nodeNameAbove = above }
+
+setName :: String -> Node a -> Node a
+setName name node = node { nodeName = name }
+
+setShape :: Shape -> Node a -> Node a
+setShape s node = node { nodeShape = s }
+
+setPosition :: DoublePoint -> Node a -> Node a
+setPosition position node = node { nodePosition = position }
+
+setInfo :: a -> Node a -> Node a
+setInfo info node = node { nodeInfo = info }
+
hunk ./src/Network.hs 268
-getNode :: NodeNr -> Network g n e -> Node.Node n
+getNode :: NodeNr -> Network g n e -> Node n
hunk ./src/Network.hs 280
-getNodes :: Network g n e -> [Node.Node n]
+getNodes :: Network g n e -> [Node n]
hunk ./src/Network.hs 313
- let nodes = getNodeAssocs network in
- [ nodeNr
- | (nodeNr, node) <- nodes
- , Node.getName node == theNodeName
- ]
+ [ nodeNr
+ | nodeNr <- getNodeNrs network
+ , getNodeName network nodeNr == theNodeName
+ ]
hunk ./src/Network.hs 319
-getNodeAssocs :: Network g n e -> [(NodeNr, Node.Node n)]
+getNodeAssocs :: Network g n e -> [(NodeNr, Node n)]
hunk ./src/Network.hs 322
-setNodeAssocs :: [(NodeNr, Node.Node n)] -> Network g n e -> Network g n e
+setNodeAssocs :: [(NodeNr, Node n)] -> Network g n e -> Network g n e
hunk ./src/Network.hs 360
+ True
+ Shape.circle
+ blank
hunk ./src/Network.hs 374
-addNodeEx :: InfoKind n g => String -> DoublePoint -> Network g n e
- -> (NodeNr, Network g n e)
-addNodeEx name position network =
+addNodeEx :: InfoKind n g => String -> DoublePoint -> Bool -> Shape -> n
+ -> Network g n e -> (NodeNr, Network g n e)
+addNodeEx name position labelAbove shape info network =
hunk ./src/Network.hs 382
- node = Node.create name position True
+ node = constructNode name position labelAbove shape info
+
hunk ./src/Network.hs 468
-updateNode :: NodeNr -> (Node.Node n -> Node.Node n) -> Network g n e
+updateNode :: NodeNr -> (Node n -> Node n) -> Network g n e
hunk ./src/NetworkControl.hs 16
-import Network(getNode, updateNode, addEdge, removeEdge
- , newViaEdge, removeVia, Edge(..), getEdge, updateVia
- , removeNode, addNode, getGlobalInfo, setGlobalInfo)
+import Network
hunk ./src/NetworkControl.hs 18
-import qualified Node
hunk ./src/NetworkControl.hs 39
- (Node.setNameAbove above))) pDoc
+ (setNameAbove above))) pDoc
hunk ./src/NetworkControl.hs 54
- (Node.setInfo info . Node.setShape shape))) pDoc
+ (setInfo info . setShape shape))) pDoc
hunk ./src/NetworkControl.hs 94
- doc3 = updateNetwork (updateNode nodeNr [_$_]
- (Node.setPosition mousePoint)) doc2
+ doc3 = updateNetwork (updateNode nodeNr (setPosition mousePoint)) doc2
hunk ./src/NetworkControl.hs 149
- viaPos = (edgeVia (getEdge edgeNr network))!!viaNr
+ viaPos = (getEdgeVia (getEdge edgeNr network))!!viaNr
hunk ./src/NetworkControl.hs 166
- nodePos = Node.getPosition (getNode nodeNr network)
+ nodePos = getNodePosition network nodeNr
hunk ./src/NetworkControl.hs 177
- oldPosition = Node.getPosition (getNode nodeNr (getNetwork doc))
+ oldPosition = getNodePosition (getNetwork doc) nodeNr
hunk ./src/NetworkControl.hs 184
- (Node.setPosition newPosition))) [_$_]
+ (setPosition newPosition))) [_$_]
hunk ./src/NetworkControl.hs 199
- (Node.setPosition newPosition))) pDoc
+ (setPosition newPosition))) pDoc
hunk ./src/NetworkControl.hs 212
- oldPosition = (edgeVia (getEdge edgeNr (getNetwork doc)))!!viaNr
+ oldPosition = (getEdgeVia (getEdge edgeNr (getNetwork doc)))!!viaNr
hunk ./src/NetworkControl.hs 247
- do{ let oldName = Node.getName (getNode nodeNr network)
+ do{ let oldName = getNodeName network nodeNr
hunk ./src/NetworkControl.hs 253
- (updateNode nodeNr (Node.setName newName))) pDoc
+ (updateNode nodeNr (setName newName))) pDoc
hunk ./src/NetworkControl.hs 267
- do{ let oldInfo = Node.getInfo (getNode nodeNr network)
+ do{ let oldInfo = getNodeInfo network nodeNr
hunk ./src/NetworkControl.hs 277
- ; case check (Node.getName (getNode nodeNr network))
+ ; case check (getNodeName network nodeNr)
hunk ./src/NetworkControl.hs 285
- (updateNode nodeNr (Node.setInfo x))) pDoc
+ (updateNode nodeNr (setInfo x))) pDoc
hunk ./src/NetworkFile.hs 4
-import Node
hunk ./src/NetworkFile.hs 171
- ; return ( Node.setShape s
- . Node.setInfo i
- $ Node.create n p a)
+ ; return (constructNode n p a s i)
hunk ./src/NetworkFile.hs 193
- [ simpleString "From" (show (edgeFrom edge))
- , simpleString "To" (show (edgeTo edge))
- , makeTag "Via" (concatMap toContents (edgeVia edge))
- , makeTag "Info" (toContents (edgeInfo edge))
+ [ simpleString "From" (show (getEdgeFrom edge))
+ , simpleString "To" (show (getEdgeTo edge))
+ , makeTag "Via" (concatMap toContents (getEdgeVia edge))
+ , makeTag "Info" (toContents (getEdgeInfo edge))
hunk ./src/NetworkFile.hs 205
- ; return (Edge { edgeFrom=f, edgeTo=t, edgeVia=v, edgeInfo=i })
+ ; return (constructEdge f t v i)
hunk ./src/NetworkFile.hs 343
- ; let multipleEdges = duplicatesBy semiEq (map sortEdge edges)
+ ; let multipleEdges = duplicatesBy betweenSameNodes edges
hunk ./src/NetworkFile.hs 346
- commasAnd [ "(" ++ show f ++ ", "++ show t ++ ")"
- | Edge f t _ _ <- multipleEdges
+ commasAnd [ "(" ++ show (getEdgeFrom e) ++ ", "
+ ++ show (getEdgeTo e) ++ ")"
+ | e <- multipleEdges
hunk ./src/NetworkFile.hs 359
-checkEdge nodeNrs (AssocE edgeNr (Edge fromNr toNr _ _))
+checkEdge nodeNrs (AssocE edgeNr edge)
hunk ./src/NetworkFile.hs 366
+ fromNr = getEdgeFrom edge
+ toNr = getEdgeTo edge
hunk ./src/NetworkFile.hs 375
--- Funny function that possibly flips an edge so that the from-node number
--- is the lowest number
-sortEdge :: Edge e -> Edge e
-sortEdge (Edge f t v i) | f < t = Edge f t v i
- | otherwise = Edge t f v i
-
hunk ./src/NetworkFile.hs 376
-semiEq :: Edge e -> Edge e -> Bool
-semiEq (Edge f t _ _) (Edge f' t' _ _) = f==f' && t==t'
+betweenSameNodes :: Edge e -> Edge e -> Bool
+betweenSameNodes e1 e2 =
+ (getEdgeFrom e1 == getEdgeFrom e2 && getEdgeTo e1 == getEdgeTo e2)
+ ||
+ (getEdgeFrom e1 == getEdgeTo e2 && getEdgeTo e1 == getEdgeFrom e1)
hunk ./src/NetworkView.hs 11
-import qualified Node
hunk ./src/NetworkView.hs 90
- drawLabel (offset above) False (Node.getName node) center
+ drawLabel (offset above) False (getName node) center
hunk ./src/NetworkView.hs 94
- drawLabel (offset (not above)) False (show (Node.getInfo node))
+ drawLabel (offset (not above)) False (show (getInfo node))
hunk ./src/NetworkView.hs 100
- above = Node.getNameAbove node
- center = Node.getPosition node
- shape = Node.getShape node
+ above = getNameAbove node
+ center = getPosition node
+ shape = getShape node
hunk ./src/NetworkView.hs 129
- drawEdge (Edge { edgeFrom = fromNodeNr, edgeTo = toNodeNr
- , edgeVia = via, edgeInfo = info })
- options =
+ drawEdge edge options =
hunk ./src/NetworkView.hs 137
- drawLabel 0 False (show info) (middle via)
+ drawLabel 0 False (show (getEdgeInfo edge)) (middle via)
hunk ./src/NetworkView.hs 142
- fromNode = getNode fromNodeNr network
- toNode = getNode toNodeNr network
+ fromNode = getNode (getEdgeFrom edge) network
+ toNode = getNode (getEdgeTo edge) network
hunk ./src/NetworkView.hs 145
- fromPoint = Node.getPosition fromNode
- toPoint = Node.getPosition toNode
+ fromPoint = getPosition fromNode
+ toPoint = getPosition toNode
+ via = getEdgeVia edge
hunk ./src/NetworkView.hs 172
- let pt = (edgeVia e)!!n in
+ let pt = (getEdgeVia e)!!n in
hunk ./src/NetworkView.hs 191
-nodeContains :: Node.Node n -> DoublePoint -> Bool
+nodeContains :: Node n -> DoublePoint -> Bool
hunk ./src/NetworkView.hs 193
- distancePointPoint (Node.getPosition node) clickedPoint
+ distancePointPoint (getPosition node) clickedPoint
hunk ./src/NetworkView.hs 205
-edgeContains
- (Edge { edgeFrom = fromNodeNr, edgeTo = toNodeNr, edgeVia = via })
- clickedPoint network =
- let p0 = Node.getPosition (getNode fromNodeNr network)
- p1 = Node.getPosition (getNode toNodeNr network)
+edgeContains edge clickedPoint network =
+ let p0 = getNodePosition network (getEdgeFrom edge)
+ p1 = getNodePosition network (getEdgeTo edge)
+ via= getEdgeVia edge
hunk ./src/NetworkView.hs 222
- [0..] (edgeVia e))
+ [0..] (getEdgeVia e))
hunk ./src/Node.hs 1
-module Node
- ( Node
- , create
- , getNameAbove, setNameAbove
- , getName, setName
- , getPosition, setPosition
- , getShape, setShape
- , getInfo, setInfo
- ) where
-
-import Math
-import Shape
-import Constants
-import InfoKind
-
-data Node n = Node
- { nodePoint :: DoublePoint -- ^ the position of the node on screen
- , nodeName :: !String
- , nodeNameAbove :: Bool -- ^ should the name be displayed above (True) of below (False)
- , nodeShape :: Shape
- , nodeInfo :: n
- } deriving (Show, Read)
-
-create :: (InfoKind n g) => String -> DoublePoint -> Bool -> Node n
-create name position nameAbove =
- Node
- { nodeName = name
- , nodePoint = position
- , nodeNameAbove = nameAbove
- , nodeShape = Circle { shapeStyle = defaultShapeStyle
- , shapeRadius = kNODE_RADIUS }
- , nodeInfo = blank
- }
-
-getNameAbove :: Node a -> Bool
-getNameAbove node = nodeNameAbove node
-
-getName :: Node a -> String
-getName node = nodeName node
-
-getShape :: Node a -> Shape
-getShape node = nodeShape node
-
-getPosition :: Node a -> DoublePoint
-getPosition node = nodePoint node
-
-getInfo :: Node a -> a
-getInfo node = nodeInfo node
-
--- | Set whether the name should appear above (True) or below (False) the node
-setNameAbove :: Bool -> Node a -> Node a
-setNameAbove above node = node { nodeNameAbove = above }
-
-setName :: String -> Node a -> Node a
-setName name node = node { nodeName = name }
-
-setShape :: Shape -> Node a -> Node a
-setShape s node = node { nodeShape = s }
-
-setPosition :: DoublePoint -> Node a -> Node a
-setPosition position node = node { nodePoint = position }
-
-setInfo :: a -> Node a -> Node a
-setInfo info node = node { nodeInfo = info }
rmfile ./src/Node.hs
}