For SyntaxGraph, use a data type (SgSink) for sinks.

app/Translate.hs

@@ -20,12 +20,12 @@ import Language.Haskell.Exts(Decl(..), parseDecl, Name(..), Pat(..), Rhs(..),
   Stmt(..), Binds(..), Alt(..), Module(..), SpecialCon(..), prettyPrint)
 
 import GraphAlgorithms(collapseNodes)
-import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef, Sink, SgBind(..),
+import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef, SgSink(..), SgBind(..),
   syntaxGraphFromNodes, syntaxGraphFromNodesEdges, getUniqueName, combineExpressions,
   edgesForRefPortList, makeApplyGraph,
   namesInPattern, lookupReference, deleteBindings, makeEdges,
   makeBox, nTupleString, nListString,
-  syntaxGraphToFglGraph, getUniqueString)
+  syntaxGraphToFglGraph, getUniqueString, bindsToSyntaxGraph)
 import Types(NameAndPort(..), IDState,
   initialIdState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode,
   LikeApplyFlavor(..))
@@ -48,9 +48,6 @@ qOpToExp :: QOp -> Exp
 qOpToExp (QVarOp n) = Var n
 qOpToExp (QConOp n) = Con n
 
-bindsToSyntaxGraph :: [SgBind] -> SyntaxGraph
-bindsToSyntaxGraph binds = SyntaxGraph mempty mempty mempty binds mempty
-
 -- | Make a syntax graph that has the bindings for a list of "as pattern" (@) names.
 makeAsBindGraph :: Reference -> [Maybe String] -> SyntaxGraph
 makeAsBindGraph ref asNames = bindsToSyntaxGraph $ catMaybes $ fmap makeBind asNames where
@@ -106,7 +103,7 @@ evalLit (Exts.PrimString x) = makeLiteral x
 -- BEGIN evalPApp
 -- TODO Refactor decideIfNested and makePatternGraph
 decideIfNested :: ((SyntaxGraph, t1), t) ->
-  (Maybe ((SyntaxGraph, t1), t), Maybe SgNamedNode, [Sink], [SgBind], [(NodeName, NodeName)])
+  (Maybe ((SyntaxGraph, t1), t), Maybe SgNamedNode, [SgSink], [SgBind], [(NodeName, NodeName)])
 decideIfNested ((SyntaxGraph [nameAndIcon] [] sinks bindings eMap, _), _) = (Nothing, Just nameAndIcon, sinks, bindings, eMap)
 decideIfNested valAndPort = (Just valAndPort, Nothing, [], [], [])
 
@@ -561,7 +558,7 @@ generalEvalLambda context patterns rhsEvalFun = do
     icons = [(lambdaName, FunctionDefNode (length patterns))]
     returnPort = nameAndPort lambdaName (Port 0)
     (newEdges, newSinks) = case rhsRef of
-      Left s -> (patternEdges, [(s, returnPort)])
+      Left s -> (patternEdges, [SgSink s returnPort])
       Right rhsPort ->  (makeSimpleEdge (rhsPort, returnPort) : patternEdges, mempty)
     finalGraph = SyntaxGraph icons newEdges newSinks newBinds mempty
 
@@ -669,7 +666,7 @@ evalPatBind c (PatBind _ pat rhs maybeWhereBinds) = do
       (Left s) -> (mempty, mempty, [SgBind s rhsRef])
       (Right patPort) -> case rhsRef of
         -- TODO This edge/sink should have a special arrow head to indicate an input to a pattern.
-        (Left rhsStr) -> (mempty, [(rhsStr, patPort)], mempty)
+        (Left rhsStr) -> (mempty, [SgSink rhsStr patPort], mempty)
         (Right rhsPort) -> ([makeSimpleEdge (rhsPort, patPort)], mempty, mempty)
     asBindGraph = makeAsBindGraph rhsRef [patAsName]
     gr = asBindGraph <> SyntaxGraph mempty newEdges newSinks bindings mempty

app/TranslateCore.hs

@@ -3,10 +3,11 @@ module TranslateCore(
   SyntaxGraph(..),
   EvalContext,
   GraphAndRef,
-  Sink,
+  SgSink(..),
   SgBind(..),
   syntaxGraphFromNodes,
   syntaxGraphFromNodesEdges,
+  bindsToSyntaxGraph,
   getUniqueName,
   getUniqueString,
   edgesForRefPortList,
@@ -48,13 +49,15 @@ type Reference = Either String NameAndPort
 
 data SgBind = SgBind String Reference deriving (Eq, Show, Ord)
 
+data SgSink = SgSink String NameAndPort deriving (Eq, Ord, Show)
+
 -- TODO Replace lists with sets
 -- | SyntaxGraph is an abstract representation for Haskell syntax. SyntaxGraphs are
 -- generated from the Haskell syntax tree, and are used to generate Drawings
 data SyntaxGraph = SyntaxGraph {
   sgNodes :: [SgNamedNode],
   sgEdges :: [Edge],
-  sgSinks :: [(String, NameAndPort)],
+  sgSinks :: [SgSink],
   sgBinds :: [SgBind],
   -- sgEmbedMap keeps track of nodes embedded in other nodes. If (child, parent) is in the Map, then child is embedded inside parent.
   sgEmbedMap :: [(NodeName, NodeName)]
@@ -70,7 +73,6 @@ instance Monoid SyntaxGraph where
 
 type EvalContext = [String]
 type GraphAndRef = (SyntaxGraph, Reference)
-type Sink = (String, NameAndPort)
 
 sgBindToString :: SgBind -> String
 sgBindToString (SgBind s _) = s
@@ -84,6 +86,9 @@ syntaxGraphFromNodes icons = SyntaxGraph icons mempty mempty mempty mempty
 syntaxGraphFromNodesEdges :: [(NodeName, SyntaxNode)] -> [Edge] -> SyntaxGraph
 syntaxGraphFromNodesEdges icons edges = SyntaxGraph icons edges mempty mempty mempty
 
+bindsToSyntaxGraph :: [SgBind] -> SyntaxGraph
+bindsToSyntaxGraph binds = SyntaxGraph mempty mempty mempty binds mempty
+
 -- TODO Remove string parameter
 getUniqueName :: String -> State IDState NodeName
 getUniqueName _ = fmap NodeName getId
@@ -98,7 +103,7 @@ edgesForRefPortList inPattern portExpPairs = mconcat $ fmap makeGraph portExpPai
   makeGraph (ref, port) = case ref of
     Left str -> if inPattern
       then SyntaxGraph mempty mempty mempty [SgBind str (Right port)] mempty
-      else SyntaxGraph mempty mempty [(str, port)] mempty mempty
+      else SyntaxGraph mempty mempty [SgSink str port] mempty mempty
     Right resultPort -> SyntaxGraph mempty [Edge edgeOpts noEnds connection] mempty mempty mempty where
       connection = if inPattern
         -- If in a pattern, then the port on the case icon is the data source.
@@ -111,7 +116,7 @@ combineExpressions inPattern portExpPairs = mconcat $ fmap makeGraph portExpPair
   makeGraph ((graph, ref), port) = graph <> case ref of
     Left str -> if inPattern
       then SyntaxGraph mempty mempty mempty [SgBind str (Right port)] mempty
-      else SyntaxGraph mempty mempty [(str, port)] mempty mempty
+      else SyntaxGraph mempty mempty [SgSink str port] mempty mempty
     Right resultPort -> SyntaxGraph mempty [Edge edgeOpts noEnds (resultPort, port)] mempty mempty mempty
 
 -- qualifyNameAndPort :: String -> NameAndPort -> NameAndPort
@@ -153,14 +158,14 @@ lookupReference bindings ref@(Left originalS) = lookupHelper ref where
 deleteBindings :: SyntaxGraph -> SyntaxGraph
 deleteBindings (SyntaxGraph a b c _ e) = SyntaxGraph a b c mempty e
 
-makeEdgesCore :: [Sink] -> [SgBind] -> ([Sink], [Edge])
+makeEdgesCore :: [SgSink] -> [SgBind] -> ([SgSink], [Edge])
 makeEdgesCore sinks bindings = partitionEithers $ fmap renameOrMakeEdge sinks
   where
-    renameOrMakeEdge :: (String, NameAndPort) -> Either (String, NameAndPort) Edge
-    renameOrMakeEdge orig@(s, destPort) = case lookup s (fmap sgBindToTuple bindings) of
+    renameOrMakeEdge :: SgSink -> Either SgSink Edge
+    renameOrMakeEdge orig@(SgSink s destPort) = case lookup s (fmap sgBindToTuple bindings) of
       Just ref -> case lookupReference bindings ref of
         (Right sourcePort) -> Right $ makeSimpleEdge (sourcePort, destPort)
-        (Left newStr) -> Left (newStr, destPort)
+        (Left newStr) -> Left $ SgSink newStr destPort
       Nothing -> Left orig
 
 makeEdges :: SyntaxGraph -> SyntaxGraph