From 2d74cb2fd1a989f1b42b266545f0730ba13d7ef7 Mon Sep 17 00:00:00 2001
From: Robbie Gleichman <rgleichman@gmail.com>
Date: Tue, 12 Mar 2019 22:43:58 -0700
Subject: [PATCH] Embed lambda nodes in apply parents.

---
 app/GraphAlgorithms.hs |  9 ++++-----
 app/Rendering.hs       | 30 ++++++++++++++++++------------
 todo.md                |  1 -
 3 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/app/GraphAlgorithms.hs b/app/GraphAlgorithms.hs
index 47b0865..e2d5fbd 100644
--- a/app/GraphAlgorithms.hs
+++ b/app/GraphAlgorithms.hs
@@ -41,13 +41,12 @@ syntaxNodeIsEmbeddable :: ParentType
                        -> Maybe Port
                        -> Maybe Port
                        -> Bool
-syntaxNodeIsEmbeddable parentType n mParentPort _mChildPort
-  = case (parentType, n) of
+syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort
+  = case (parentType, syntaxNode) of
       (ApplyParent, ApplyNode _ _ _) -> parentPortNotResult
       (ApplyParent, LiteralNode _) -> parentPortNotResult
-      -- TODO Embedded FunctionDefNodes are missing their enclosures.
-      -- (ApplyParent, FunctionDefNode _ _)
-      --   -> isInput mParentPort && isResult mChildPort
+      (ApplyParent, FunctionDefNode _ _)
+        -> isInput mParentPort && isResult mChildPort
 
       (CaseParent, LiteralNode _) -> parentPortNotResult
       (CaseParent, ApplyNode _ _ _)
diff --git a/app/Rendering.hs b/app/Rendering.hs
index 85be5ab..efd519a 100644
--- a/app/Rendering.hs
+++ b/app/Rendering.hs
@@ -6,6 +6,7 @@ module Rendering (
   renderIngSyntaxGraph
 ) where
 
+import qualified Diagrams.Prelude as DIA
 import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail
                        , arrowTail, arrowHead, scale, r2, bezier3
                        , fromSegments, Angle, P2, V2, Point, Name, ArrowOpts, N
@@ -17,7 +18,6 @@ import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail
                        , connectOutside', connect', with, (%~), lengths, (^+^)
                        , (.~))
 import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph')
-import qualified Diagrams.Prelude as DIA
 
 import qualified Data.GraphViz as GV
 import qualified Data.GraphViz.Attributes.Complete as GVA
@@ -27,7 +27,7 @@ import Data.Function(on)
 import qualified Data.Graph.Inductive as ING
 import Data.Graph.Inductive.PatriciaTree (Gr)
 import Data.List(find, minimumBy)
-import Data.Maybe(isNothing, fromMaybe)
+import Data.Maybe(catMaybes, isNothing, fromMaybe)
 import Data.Typeable(Typeable)
 
 --import qualified Data.GraphViz.Types
@@ -353,20 +353,26 @@ rotateNodes positionMap graph
 
 -- END rotateNodes --
 
-drawLambdaRegions :: SpecialBackend b Double =>
+drawLambdaRegions :: forall b . SpecialBackend b Double =>
   [(NamedIcon, SpecialQDiagram b Double)]
   -> SpecialQDiagram b Double
 drawLambdaRegions placedNodes
-  = mconcat $ fmap (drawRegion . niIcon . fst) placedNodes
+  = mconcat $ fmap (drawRegion [] . fst) placedNodes
   where
-    drawRegion (FlatLambdaIcon _ enclosedNames)
-      = regionRect enclosedDias
-      where
-        enclosedDias = fmap findDia enclosedNames
-        findDia n1
-          = maybe mempty snd
-            (find (\(NamedIcon n2 _, _) -> n1 == n2) placedNodes)
-    drawRegion _ = mempty
+    findDia :: NodeName -> SpecialQDiagram b Double
+    findDia n1
+      = maybe mempty snd
+        (find (\(NamedIcon n2 _, _) -> n1 == n2) placedNodes)
+
+    -- Also draw the region around the icon the lambda is in.
+    drawRegion :: [NodeName] -> NamedIcon -> SpecialQDiagram b Double
+    drawRegion parentNames icon = case icon of
+      NamedIcon _ (FlatLambdaIcon _ enclosedNames)
+        -> regionRect $ fmap findDia (parentNames <> enclosedNames)
+      NamedIcon parentName (NestedApply _ headIcon icons)
+        -> mconcat
+           $ drawRegion (parentName:parentNames) <$> catMaybes (headIcon:icons)
+      _ -> mempty
 
     -- TODO Use something better than a rectangle
     regionRect dias
diff --git a/todo.md b/todo.md
index 0c1e617..b6b5a81 100644
--- a/todo.md
+++ b/todo.md
@@ -2,7 +2,6 @@
 
 ## Todo Now
 * Remove port number magic numbers in GraphAlgorithms.hs.
-* Fix embedded lambdas missing their enclosures.
 * Add command line flags for color style, embedding, and whether to draw arrowheads.
 * Add wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc..