Translate nested icons. Fix nested icons missing edges in GraphViz graph.

app/Icons.hs

@@ -43,13 +43,14 @@ iconToDiagram (PAppIcon n str) _ = pAppDia n str
 iconToDiagram (TextApplyAIcon n str) _ = textApplyADia n str
 iconToDiagram ResultIcon _ = identDiaFunc resultIcon
 iconToDiagram BranchIcon _ = identDiaFunc branchIcon
-iconToDiagram (TextBoxIcon s) _ = identDiaFunc $ textBox s
+iconToDiagram (TextBoxIcon s) _ = textBox s
 iconToDiagram (BindTextBoxIcon s) _ = identDiaFunc $ bindTextBox s
 iconToDiagram (GuardIcon n) _ = identDiaFunc $ guardIcon n
 iconToDiagram (CaseIcon n) _ = identDiaFunc $ caseIcon n
 iconToDiagram CaseResultIcon _ = identDiaFunc caseResult
 iconToDiagram (FlatLambdaIcon n) _ = identDiaFunc $ flatLambda n
 iconToDiagram (NestedApply s args) _ = nestedApplyDia s args
+iconToDiagram (NestedPApp s args) _ = nestedPAppDia s args
 iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
   identDiaFunc $ lambdaRegion n dia
   where
@@ -138,24 +139,31 @@ transformCorrectedTextBox str textCol borderCol reflect angle =
     textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0
     reflectIfTrue shouldReflect dia = if shouldReflect then reflectX dia else dia
 
-
 nestedApplyDia :: SpecialBackend b =>
   String -> [Maybe (Name, Icon)] -> TransformableDia b
-nestedApplyDia funText args reflect angle = transformedText ||| centerY finalDia
+nestedApplyDia = generalNestedDia (textBoxC colorScheme) (apply0C colorScheme)
+
+nestedPAppDia :: SpecialBackend b =>
+  String -> [Maybe (Name, Icon)] -> TransformableDia b
+nestedPAppDia = generalNestedDia (patternTextC colorScheme) (patternC colorScheme)
+
+generalNestedDia :: SpecialBackend b =>
+  Colour Double -> Colour Double-> String -> [Maybe (Name, Icon)] -> TransformableDia b
+generalNestedDia textCol borderCol funText args reflect angle = centerXY $  transformedText ||| centerY finalDia
   where
-    transformedText = transformCorrectedTextBox funText (textBoxTextC colorScheme) (apply0C colorScheme) reflect angle
+    transformedText = transformCorrectedTextBox funText textCol borderCol reflect angle
     seperation = circleRadius * 1.5
     verticalSeperation = circleRadius
     appColor = apply0C colorScheme
     n = length args
     trianglePortsCircle = hsep seperation $
-      reflectX (fc appColor apply0Triangle) :
+      reflectX (fc borderCol apply0Triangle) :
       zipWith makeInnerIcon [2,3..] args ++
-      [makePort 1 <> alignR (circle circleRadius # fc appColor # lwG defaultLineWidth # lc appColor)]
+      [makePort 1 <> alignR (circle circleRadius # fc borderCol # lwG defaultLineWidth # lc borderCol)]
 
     allPorts = makePort 0 <> alignL trianglePortsCircle
     topAndBottomLineWidth = width allPorts - circleRadius
-    argBox = rect topAndBottomLineWidth (height allPorts + verticalSeperation)# lc appColor # lwG defaultLineWidth # alignL
+    argBox = rect topAndBottomLineWidth (height allPorts + verticalSeperation)# lc borderCol # lwG defaultLineWidth # alignL
     finalDia = argBox <> allPorts
 
     makeInnerIcon portNum Nothing = makePort portNum <> portCircle
@@ -171,8 +179,8 @@ textBoxHeightFactor :: (Fractional a) => a
 textBoxHeightFactor = 1.1
 
 textBox :: SpecialBackend b =>
-  String -> SpecialQDiagram b
-textBox = coloredTextBox (textBoxTextC colorScheme) $ opaque (textBoxC colorScheme)
+  String -> TransformableDia b
+textBox t = transformCorrectedTextBox t (textBoxTextC colorScheme) $ textBoxC colorScheme
 
 bindTextBox :: SpecialBackend b =>
   String -> SpecialQDiagram b

app/Rendering.hs

@@ -6,6 +6,7 @@ module Rendering (
 
 import Diagrams.Prelude
 import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph')
+import Diagrams.Core.Names(Name(..))
 --import Diagrams.Backend.SVG(B)
 
 import qualified Data.GraphViz as GV
@@ -57,11 +58,18 @@ makeNamedMap :: SpecialBackend b =>
 makeNamedMap subDiagramMap =
   map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap))
 
+-- Note that the name type alias is different from the Name constructor.
+getTopLevelName :: Name -> Name
+getTopLevelName (Name []) = Name []
+getTopLevelName (Name (x:_)) = Name [x]
+
+
+-- TODO: Not sure if using getTopLevelName here will break the old nested lambda icon.
 -- | Make an inductive Graph from a list of node names, and a list of Connections.
 edgesToGraph :: [Name] -> [(NameAndPort, NameAndPort)] -> Gr Name ()
 edgesToGraph iconNames edges = mkGraph iconNames simpleEdges
   where
-    simpleEdges = map (\(NameAndPort a _, NameAndPort c _) -> (a, c, ())) edges
+    simpleEdges = map (\(NameAndPort a _, NameAndPort c _) -> (getTopLevelName a, getTopLevelName c, ())) edges
 
 -- | Custom arrow tail for the arg1 result circle.
 -- The ArrowHT type does not seem to be documented.

app/Translate.hs

@@ -16,6 +16,7 @@ import Control.Monad.State(State, evalState)
 import Data.Either(partitionEithers)
 import Data.List(unzip4, partition)
 import Control.Monad(replicateM)
+import Data.Maybe(catMaybes)
 
 import Types(Drawing(..), NameAndPort(..), IDState,
   initialIdState, Edge)
@@ -108,8 +109,34 @@ qOpToString :: QOp -> String
 qOpToString (QVarOp n) = qNameToString n
 qOpToString (QConOp n) = qNameToString n
 
+--decideIfNested :: ((IconGraph, r), p) -> (Maybe ((IconGraph, r), p), Maybe (DIA.Name, Icon))
+decideIfNested valAndPort@((IconGraph [nameAndIcon] [] [] sinks bindings, _), _) = (Nothing, Just nameAndIcon, sinks, bindings)
+decideIfNested valAndPort = (Just valAndPort, Nothing, [], [])
+
 makeTextApplyGraph :: Bool -> DIA.Name -> String -> [(IconGraph, Reference)] -> Int -> (IconGraph, NameAndPort)
-makeTextApplyGraph inPattern applyIconName funStr argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName 1)
+makeTextApplyGraph inPattern applyIconName funStr argVals numArgs = result
+  where
+    result = nestedApplyResult
+    argumentPorts = map (nameAndPort applyIconName) [2,3..]
+    (unnestedArgsAndPort, nestedArgs, nestedSinks, nestedBindings) = unzip4 $ map decideIfNested (zip argVals argumentPorts)
+    qualifiedSinks = map qualifySink (mconcat nestedSinks)
+    qualifySink (str, (NameAndPort n p)) = (str, NameAndPort (applyIconName DIA..> n) p)
+
+    qualifiedBinds = map qualifyBinds (mconcat nestedBindings)
+    qualifyBinds (str, ref) = (str, qualifiedRef) where
+      qualifiedRef = case ref of
+        Left _ -> ref
+        Right (NameAndPort n p) -> Right $ NameAndPort (applyIconName DIA..> n) p
+
+    combinedGraph = combineExpressions inPattern $ catMaybes unnestedArgsAndPort
+    icon = if inPattern then NestedPApp else NestedApply
+    icons = [(applyIconName, icon funStr nestedArgs)]
+    newGraph = IconGraph icons [] [] qualifiedSinks qualifiedBinds
+    nestedApplyResult = (newGraph <> combinedGraph, nameAndPort applyIconName 1)
+
+
+makeTextApplyGraph' :: Bool -> DIA.Name -> String -> [(IconGraph, Reference)] -> Int -> (IconGraph, NameAndPort)
+makeTextApplyGraph' inPattern applyIconName funStr argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName 1)
   where
     argumentPorts = map (nameAndPort applyIconName) [2,3..]
     combinedGraph = combineExpressions inPattern $ zip argVals argumentPorts

app/Types.hs

@@ -31,6 +31,7 @@ data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
   | BindTextBoxIcon String
   -- TODO: NestedApply should have the type NestedApply (Maybe (Name, Icon)) [Maybe (Name, Icon)]
   | NestedApply String [Maybe (Name, Icon)]
+  | NestedPApp String [Maybe (Name, Icon)]
   deriving (Show)
 
 data NameAndPort = NameAndPort Name (Maybe Int) deriving (Show)

glance.cabal

@@ -26,6 +26,7 @@ executable glance-exe
   build-depends:       base
                      , glance
                      , diagrams
+                     , diagrams-core
                      , diagrams-lib
                      , diagrams-svg
                      , diagrams-graphviz