Changed the types involved in the control-flow graph so that I can customise the Show implementation

common/FlowGraph.hs

@@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along
 with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-module FlowGraph (EdgeLabel(..), FlowGraph, buildFlowGraph) where
+module FlowGraph (EdgeLabel(..), FNode(..), FlowGraph, buildFlowGraph, makeFlowGraphInstr) where
 
 import Control.Monad.Error
 import Control.Monad.State
@@ -31,15 +31,21 @@ data EdgeLabel = EChoice | ESeq | EPar deriving (Show, Eq, Ord)
 
 data OuterType = None | Seq | Par
 
-type FNode a = (Meta, a)
+newtype FNode a = Node (Meta, a)
 --type FEdge = (Node, EdgeLabel, Node)
 
+instance Show a => Show (FNode a) where
+  show (Node (m,x)) = (filter ((/=) '\"')) $ show m ++ ":" ++ show x
+
 type FlowGraph a = Gr (FNode a) EdgeLabel
 
 type NodesEdges a = ([LNode (FNode a)],[LEdge EdgeLabel])
     
 type GraphMaker m a b = ErrorT String (StateT (Node, NodesEdges a) m) b
 
+-- | Builds the instructions to send to GraphViz
+makeFlowGraphInstr :: Show a => FlowGraph a -> String
+makeFlowGraphInstr = graphviz'
 
 -- The primary reason for having the blank generator take a Meta as an argument is actually for testing.  But other uses can simply ignore it if they want.
 buildFlowGraph :: Monad m => (Meta -> m a) -> (forall t. Data t => t -> m a) -> A.Structured -> m (Either String (FlowGraph a))
@@ -51,9 +57,9 @@ buildFlowGraph blank f s
   where
     -- All the functions return the new graph, and the identifier of the node just added
         
-    addNode :: Monad m => FNode a -> GraphMaker m a Node
+    addNode :: Monad m => (Meta, a) -> GraphMaker m a Node
     addNode x = do (n,(nodes, edges)) <- get
-                   put (n+1, ((n, x):nodes, edges))
+                   put (n+1, ((n, Node x):nodes, edges))
                    return n
     
     addEdge :: Monad m => EdgeLabel -> Node -> Node -> GraphMaker m a ()
@@ -71,7 +77,9 @@ buildFlowGraph blank f s
     buildStructured outer (A.Several m ss) 
       = do nodes <- mapM (buildStructured outer) ss
            case outer of
-             None -> throwError "Cannot handle Several without an outer context"
+             None -> -- If there is no context, they should be left as disconnected graphs.
+                     do n <- addDummyNode m
+                        return (n, n)
              Seq -> do sequence_ $ mapPairs (\(_,s) (e,_) -> addEdge ESeq s e) nodes
                        case nodes of
                          [] -> do n <- addDummyNode m

common/FlowGraphTest.hs

@@ -30,12 +30,13 @@ import Test.HUnit hiding (Node, State)
 import qualified AST as A
 import FlowGraph
 import Metadata
+import TestUtil
 import Utils
 
 makeMeta :: Int -> Meta
 makeMeta n = Meta (Just "FlowGraphTest") n 0
 
--- To make typing the tests as short as possible:
+-- To make typing the tests as short as possible (typing a function call means bracketing is needed, which is a pain):
 m0 = makeMeta 0
 m1 = makeMeta 1
 m2 = makeMeta 2
@@ -84,9 +85,15 @@ testGraph testName nodes edges proc
     -- Checks two graphs are equal by creating a node mapping from the expected graph to the real map (checkNodeEquality),
     -- then mapping the edges across (transformEdge) and checking everything is right (in checkGraphEquality)
     
-    checkGraphEquality :: (Graph g, Show b, Ord b) => ([(Int, Meta)], [(Int, Int, b)]) -> g (Meta, Int) b -> Assertion
+    deNode :: FNode a -> (Meta, a)
+    deNode (Node x) = x
+    
+    mapPair :: (x -> a) -> (y -> b) -> (x,y) -> (a,b)
+    mapPair f g (x,y) = (f x, g y)
+    
+    checkGraphEquality :: (Graph g, Show b, Ord b) => ([(Int, Meta)], [(Int, Int, b)]) -> g (FNode Int) b -> Assertion
     checkGraphEquality (nodes, edges) g
-      = do let (remainingNodes, nodeLookup, ass) = foldl checkNodeEquality (Map.fromList (map revPair nodes),Map.empty, return ()) (labNodes g)
+      = do let (remainingNodes, nodeLookup, ass) = foldl checkNodeEquality (Map.fromList (map revPair nodes),Map.empty, return ()) (map (mapPair id deNode) $ labNodes g)
            ass
            assertBool (testName ++ " Test graph had nodes not found in the real graph: " ++ show remainingNodes ++ ", real graph: " ++ showGraph g) (Map.null remainingNodes)
            edges' <- mapM (transformEdge nodeLookup) edges