Add back pattern nesting in Translate.hs.

app/Rendering.hs

@@ -163,9 +163,9 @@ makeEdge :: (SpecialBackend b n, ING.Graph gr) =>
 makeEdge graph dia rotationMap (node0, node1, edge@(Edge _ _ (namePort0, namePort1))) =
   connectMaybePorts portAngles edge
   where
-    node0label = fromMaybeError ("node0 is not in graph. node0: " ++ show node0) $
+    node0label = fromMaybeError ("makeEdge: node0 is not in graph. node0: " ++ show node0) $
       ING.lab graph node0
-    node1label = fromMaybeError ("node0 is not in graph. node1: " ++ show node1) $
+    node1label = fromMaybeError ("makeEdge: node1 is not in graph. node1: " ++ show node1) $
       ING.lab graph node1
 
     node0Angle = lookupNodeAngle rotationMap node0label

app/Translate.hs

@@ -8,10 +8,11 @@ module Translate(
 
 import Diagrams.Prelude((<>))
 
+import Data.Maybe(catMaybes)
 import Control.Monad(replicateM)
 import Control.Monad.State(State, evalState)
 import Data.Either(partitionEithers)
-import Data.List(unzip4, partition)
+import Data.List(unzip5, unzip4, partition)
 import qualified Language.Haskell.Exts as Exts
 import Language.Haskell.Exts(Decl(..), parseDecl, Name(..), Pat(..), Rhs(..),
   Exp(..), QName(..), fromParseResult, Match(..), QOp(..), GuardedRhs(..),
@@ -20,14 +21,14 @@ import qualified Data.Graph.Inductive.PatriciaTree as FGR
 --import Data.Maybe(catMaybes)
 
 import GraphAlgorithms(collapseNodes)
-import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef,
+import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef, Sink,
   syntaxGraphFromNodes, syntaxGraphFromNodesEdges, getUniqueName, combineExpressions,
   edgesForRefPortList, makeApplyGraph,
   namesInPattern, lookupReference, deleteBindings, makeEdges,
   coerceExpressionResult, makeBox, nTupleString, nListString,
   syntaxGraphToFglGraph, getUniqueString)
 import Types(NameAndPort(..), IDState,
-  initialIdState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..))
+  initialIdState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode)
 import Util(makeSimpleEdge, nameAndPort, justName, mapFst)
 
 -- OVERVIEW --
@@ -114,8 +115,33 @@ evalQName qName _ = fmap Right <$> makeBox (qNameToString qName)
 -- findReferencedIcon (Left str) _ = Nothing
 -- findReferencedIcon (Right (NameAndPort name _)) nameIconMap = (\x -> (name, x)) <$> lookup name nameIconMap
 
+-- TODO Refactor decideIfNested and makePatternGraph
+decideIfNested :: ((SyntaxGraph, t1), t) ->
+  (Maybe ((SyntaxGraph, t1), t), Maybe SgNamedNode, [Sink], [(String, Reference)], [(NodeName, NodeName)])
+decideIfNested ((SyntaxGraph [nameAndIcon] [] sinks bindings eMap, _), _) = (Nothing, Just nameAndIcon, sinks, bindings, eMap)
+decideIfNested valAndPort = (Just valAndPort, Nothing, [], [], [])
+
+-- TODO Consider removing the Int numArgs parameter.
 makePatternGraph :: NodeName -> String -> [(SyntaxGraph, Reference)] -> Int -> (SyntaxGraph, NameAndPort)
-makePatternGraph applyIconName funStr argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName (Port 1))
+makePatternGraph applyIconName funStr argVals _ = nestedApplyResult
+  where
+    argumentPorts = map (nameAndPort applyIconName . Port) [2,3..]
+    (unnestedArgsAndPort, nestedArgs, nestedSinks, nestedBindings, nestedEMaps) = unzip5 $ fmap decideIfNested (zip argVals argumentPorts)
+
+    allSinks = mconcat nestedSinks
+    allBinds = mconcat nestedBindings
+
+    originalPortExpPairs = catMaybes unnestedArgsAndPort
+    portExpressionPairs = originalPortExpPairs
+    combinedGraph = combineExpressions True portExpressionPairs
+    icons = [(applyIconName, NestedPatternApplyNode funStr nestedArgs)]
+    newEMap = ((\(n, _) -> (n, applyIconName))  <$> catMaybes nestedArgs) <> mconcat nestedEMaps
+    
+    newGraph = SyntaxGraph icons [] allSinks allBinds newEMap
+    nestedApplyResult = (newGraph <> combinedGraph, nameAndPort applyIconName (Port 1))
+
+makePatternGraph' :: NodeName -> String -> [(SyntaxGraph, Reference)] -> Int -> (SyntaxGraph, NameAndPort)
+makePatternGraph' applyIconName funStr argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName (Port 1))
   where
     argumentPorts = map (nameAndPort applyIconName . Port) [2,3..]
     combinedGraph = combineExpressions True $ zip argVals argumentPorts

app/TranslateCore.hs

@@ -25,6 +25,7 @@ module TranslateCore(
   nodeToIcon
 ) where
 
+import Control.Arrow(second)
 import Control.Monad.State(State)
 import Data.Either(partitionEithers)
 import qualified Data.Graph.Inductive.PatriciaTree as FGR
@@ -179,7 +180,8 @@ nodeToIcon :: SyntaxNode -> Icon
 nodeToIcon (ApplyNode n) = ApplyAIcon n
 nodeToIcon (NestedApplyNode x edges) = nestedApplySyntaxNodeToIcon x edges
 nodeToIcon (PatternApplyNode s n) = PAppIcon n s
-nodeToIcon (NestedPatternApplyNode s n children) = nestedPatternNodeToIcon s n children
+-- nodeToIcon (NestedPatternApplyNode s n children) = nestedPatternNodeToIcon s n children
+nodeToIcon (NestedPatternApplyNode s children) = nestedPatternNodeToIcon s children
 nodeToIcon (NameNode s) = TextBoxIcon s
 nodeToIcon (BindNameNode s) = BindTextBoxIcon s
 nodeToIcon (LiteralNode s) = TextBoxIcon s
@@ -201,8 +203,14 @@ nestedApplySyntaxNodeToIcon numArgs args = NestedApply argList where
   -- TODO Don't use hardcoded port numbers
   argList = fmap (makeArg args) (0:[2..numArgs + 1])
 
-nestedPatternNodeToIcon :: String -> Int -> [(SgNamedNode, Edge)] -> Icon
-nestedPatternNodeToIcon str numArgs args = NestedPApp argList where
+nestedPatternNodeToIcon :: String -> [Maybe SgNamedNode] -> Icon
+nestedPatternNodeToIcon str children = NestedPApp $
+  Just (NodeName (-1), TextBoxIcon str)
+  :
+  fmap (fmap (second nodeToIcon)) children
+
+nestedPatternNodeToIcon' :: String -> Int -> [(SgNamedNode, Edge)] -> Icon
+nestedPatternNodeToIcon' str numArgs args = NestedPApp argList where
   -- TODO Don't use NodeName (-1)
   -- TODO Don't use hardcoded port numbers
   argList = Just (NodeName (-1), TextBoxIcon str) : fmap (makeArg args) [2..numArgs + 1]
@@ -217,11 +225,11 @@ makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
 makeLNode namedNode@(NodeName name, _) = (name, namedNode)
 
 lookupInEmbeddingMap :: NodeName -> [(NodeName, NodeName)] -> NodeName
-lookupInEmbeddingMap origName map = lookupHelper origName where
-  lookupHelper name = case lookup name map of
+lookupInEmbeddingMap origName eMap = lookupHelper origName where
+  lookupHelper name = case lookup name eMap of
     Nothing -> name
     Just parent -> if parent == origName
-      then error $ "lookupInEmbeddingMap: Found cycle. Node = " ++ show origName ++ "\nEmbedding Map = " ++ show map
+      then error $ "lookupInEmbeddingMap: Found cycle. Node = " ++ show origName ++ "\nEmbedding Map = " ++ show eMap
       else lookupHelper parent
 
 syntaxGraphToFglGraph :: SyntaxGraph -> FGR.Gr SgNamedNode Edge

app/Types.hs

@@ -50,7 +50,8 @@ data SyntaxNode =
   ApplyNode Int-- Function application
   | NestedApplyNode Int [(SgNamedNode, Edge)]
   | PatternApplyNode String Int -- Destructors as used in patterns
-  | NestedPatternApplyNode String Int [(SgNamedNode, Edge)]
+  -- | NestedPatternApplyNode String Int [(SgNamedNode, Edge)]
+  | NestedPatternApplyNode String [Maybe SgNamedNode]
   | NameNode String -- Identifiers or symbols
   | BindNameNode String
   | LiteralNode String -- Literal values like the string "Hello World"

test/AllTests.hs

@@ -237,6 +237,8 @@ nestedTests = [
   "Foo x = 1",
   "Foo 1 x = 2",
   "Foo (Bar x) = 1",
+  "Foo (Bar (Baz x)) = 1",
+  "Foo (Bar (Baz (Foot x))) = 1",
   "Foo (Bar x) (Baz y) = 1",
   "Foo (Bar x) = f 2",
   "Foo (Bar x) = f x",