Remove coerceExpressionResult from evalPatAndRhs. This removes branch icons from cases.

app/Translate.hs

@@ -364,22 +364,23 @@ evalLet :: EvalContext -> Binds -> Exp -> State IDState (SyntaxGraph, Reference)
 evalLet context binds e = evalGeneralLet (`evalExp` e) context binds
 
 -- TODO: Refactor this with evalPatBind
-evalPatAndRhs :: EvalContext -> Pat -> Rhs -> Maybe Binds -> State IDState (Bool, SyntaxGraph, Reference, NameAndPort)
+evalPatAndRhs :: EvalContext -> Pat -> Rhs -> Maybe Binds -> State IDState (Bool, SyntaxGraph, Reference, Reference)
 evalPatAndRhs c pat rhs maybeWhereBinds = do
   patternNames <- namesInPattern <$> evalPattern pat
   let rhsContext = patternNames <> c
-  -- TODO: remove coerceExpressionResult
-  (rhsGraph, rhsRef) <- rhsWithBinds maybeWhereBinds rhs rhsContext >>= coerceExpressionResult
+  (rhsGraph, rhsRef) <- rhsWithBinds maybeWhereBinds rhs rhsContext
   (patGraph, patRef) <- evalPattern pat
   let
     grWithEdges = makeEdges (rhsGraph <> patGraph)
-    -- The pattern and rhs are conneted if makeEdges added extra edges.
-    patRhsAreConnected =
+    lookedUpRhsRef = lookupReference (sgSources grWithEdges) rhsRef
+    -- The pattern and rhs are conneted if makeEdges added extra edges, or if the rhsRef refers to a source
+    -- in the pattern
+    patRhsAreConnected = (rhsRef /= lookedUpRhsRef) ||
       length (sgEdges grWithEdges) > (length (sgEdges rhsGraph) + length (sgEdges patGraph))
-  pure (patRhsAreConnected, deleteBindings grWithEdges, patRef, rhsRef)
+  pure (patRhsAreConnected, deleteBindings grWithEdges, patRef, lookedUpRhsRef)
 
 -- returns (combined graph, pattern reference, rhs reference)
-evalAlt :: EvalContext -> Exts.Alt -> State IDState (Bool, SyntaxGraph, Reference, NameAndPort)
+evalAlt :: EvalContext -> Exts.Alt -> State IDState (Bool, SyntaxGraph, Reference, Reference)
 evalAlt c (Exts.Alt _ pat rhs maybeBinds) = evalPatAndRhs c pat rhs maybeBinds
 
 evalCase :: EvalContext -> Exp -> [Alt] -> State IDState (SyntaxGraph, NameAndPort)
@@ -399,12 +400,15 @@ evalCase c e alts = do
     (connectedRhss, unConnectedRhss) = partition fst rhsEdges
   resultIconNames <- replicateM numAlts (getUniqueName "caseResult")
   let
-    makeCaseResult resultIconName rhsPort = syntaxGraphFromNodesEdges rhsNewIcons rhsNewEdges
-      where
-        rhsNewIcons = [(resultIconName, CaseResultNode)]
-        rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
+    makeCaseResult :: NodeName -> Reference -> SyntaxGraph
+    makeCaseResult resultIconName rhsRef = case rhsRef of
+      Left _ -> mempty
+      Right rhsPort -> syntaxGraphFromNodesEdges rhsNewIcons rhsNewEdges
+        where
+          rhsNewIcons = [(resultIconName, CaseResultNode)]
+          rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
     caseResultGraphs = mconcat $ zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
-    filteredRhsEdges = mapFst Right $ fmap snd unConnectedRhss
+    filteredRhsEdges = fmap snd unConnectedRhss
     patternEdgesGraph = edgesForRefPortList True patEdges
     caseEdgeGraph = edgesForRefPortList False (expEdge : filteredRhsEdges)
     finalGraph = mconcat [patternEdgesGraph, caseResultGraphs, expGraph, caseEdgeGraph, caseGraph, combindedAltGraph]

app/Types.hs

@@ -48,7 +48,6 @@ data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
 data LikeApplyFlavor = ApplyNodeFlavor | ComposeNodeFlavor deriving (Show, Eq, Ord)
 
 -- TODO remove Ints from SyntaxNode data constructors.
--- TODO Add NestedApplyNode, and NestedPatternApplyNode
 data SyntaxNode =
   LikeApplyNode LikeApplyFlavor Int -- Function application, composition, and applying to a composition
   | NestedApplyNode LikeApplyFlavor Int [(SgNamedNode, Edge)]

test/VisualTranslateTests.hs

@@ -115,7 +115,8 @@ caseTests = [
   "y = case x of {Foo a -> f a; Bar a -> f a}",
   "y = case x of {F x -> x; G x -> x}",
   "y = case x of {F -> 0; G -> 1}",
-  "z = case x of {0 -> 1; y -> y}"
+  "z = case x of {0 -> 1; y -> y}",
+  "y x = case f x of {0 -> x; Foo x -> x}"
   ]
 
 guardTests :: [String]