Refactor the NestedApply Icon.

app/Icons.hs

@@ -57,8 +57,10 @@ lineCol = lineC colorScheme
 
 iconToDiagram :: SpecialBackend b n => Icon -> TransformableDia b n
 iconToDiagram icon = case icon of
-  ApplyAIcon n -> nestedApplyDia ApplyNodeFlavor $ replicate (1 + n) Nothing
+  ApplyAIcon n ->
-  ComposeIcon n -> nestedApplyDia ComposeNodeFlavor $ replicate (1 + n) Nothing
+    nestedApplyDia ApplyNodeFlavor Nothing $ replicate (1 + n) Nothing
+  ComposeIcon n ->
+    nestedApplyDia ComposeNodeFlavor Nothing $ replicate (1 + n) Nothing
   PAppIcon n str -> generalTextAppDia (patternTextC colorScheme) (patternC colorScheme) n str
   TextBoxIcon s -> textBox s
   BindTextBoxIcon s -> identDiaFunc $ bindTextBox s
@@ -66,7 +68,7 @@ iconToDiagram icon = case icon of
   CaseIcon n -> nestedCaseDia $ replicate (1 + (2 * n)) Nothing
   CaseResultIcon -> identDiaFunc caseResult
   FlatLambdaIcon x -> flatLambda x
-  NestedApply flavor args -> nestedApplyDia flavor args
+  NestedApply flavor headIcon args -> nestedApplyDia flavor headIcon args
   NestedPApp args -> nestedPAppDia (repeat $ patternC colorScheme) args
   NestedCaseIcon args -> nestedCaseDia args
   NestedGuardIcon args -> nestedGuardDia args
@@ -96,7 +98,7 @@ guardPortAngles (Port port) = case port of
 
 findNestedIcon :: NodeName -> Icon -> Maybe Icon
 findNestedIcon name icon = case icon of
-  NestedApply _ args -> snd <$> findIcon name args
+  NestedApply _ headIcon args -> snd <$> findIcon name (headIcon : args)
   NestedPApp args -> snd <$> findIcon name (fmap fst args)
   _ -> Nothing
 
@@ -113,13 +115,17 @@ findIcon name args = icon where
         Nothing -> Nothing
         Just x -> Just (argNum, x)
 
-generalNestedPortAngles :: SpecialNum n =>
+generalNestedPortAngles :: SpecialNum n
-  (Port -> [Angle n]) -> [Maybe NamedIcon] -> Port -> Maybe NodeName -> [Angle n]
+                        => (Port -> [Angle n])
-generalNestedPortAngles defaultAngles args port maybeNodeName = case maybeNodeName of
+                        -> Maybe NamedIcon
-  Nothing -> defaultAngles port
+                        -> [Maybe NamedIcon]
-  Just name -> case findIcon name args of
+                        -> Port -> Maybe NodeName -> [Angle n]
-    Nothing -> []
+generalNestedPortAngles defaultAngles headIcon args port maybeNodeName =
-    Just (_, icon) -> getPortAngles icon port Nothing
+  case maybeNodeName of
+    Nothing -> defaultAngles port
+    Just name -> case findIcon name (headIcon : args) of
+      Nothing -> []
+      Just (_, icon) -> getPortAngles icon port Nothing
 
 reflectXAngle :: SpecialNum n => Angle n -> Angle n
 reflectXAngle x = reflectedAngle where
@@ -152,8 +158,11 @@ getPortAngles icon port maybeNodeName = case icon of
   CaseIcon _ -> guardPortAngles port
   CaseResultIcon -> []
   FlatLambdaIcon _ -> applyPortAngles port
-  NestedApply _ args -> generalNestedPortAngles applyPortAngles args port maybeNodeName
+  NestedApply _ headIcon args ->
-  NestedPApp args -> generalNestedPortAngles pAppPortAngles (fmap fst args) port maybeNodeName
+    generalNestedPortAngles applyPortAngles headIcon args port maybeNodeName
+  NestedPApp (headIcon : args) ->
+    generalNestedPortAngles
+    pAppPortAngles (fst headIcon) (fmap fst args) port maybeNodeName
   NestedCaseIcon args -> nestedGuardPortAngles args port maybeNodeName
   NestedGuardIcon args -> nestedGuardPortAngles args port maybeNodeName
 
@@ -322,12 +331,15 @@ nestedPAppDia borderCols funcNodeNameAndArgs name nestingLevel reflect angle = n
       makeInnerIcon func _ (Just (NamedIcon iconNodeName icon), _) = iconToDiagram icon iconNodeName innerLevel reflect angle where
         innerLevel = if func then nestingLevel else nestingLevel + 1
 
-
+generalNestedDia :: SpecialBackend b n
-generalNestedDia :: SpecialBackend b n =>
+                 => (Colour Double -> SpecialQDiagram b n)
-  (Colour Double -> SpecialQDiagram b n) -> [Colour Double] -> [Maybe NamedIcon] -> TransformableDia b n
+                 -> [Colour Double]
-generalNestedDia dia borderCols funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of
+                 -> Maybe NamedIcon
+                 -> [Maybe NamedIcon]
+                 -> TransformableDia b n
+generalNestedDia dia borderCols maybeFunText funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of
   [] -> mempty
-  (maybeFunText:args) -> centerXY $  transformedText ||| centerY finalDia
+  args -> centerXY $  transformedText ||| centerY finalDia
     where
       borderCol = borderCols !! nestingLevel
 
@@ -351,8 +363,11 @@ generalNestedDia dia borderCols funcNodeNameAndArgs name nestingLevel reflect an
       makeInnerIcon func _ (Just (NamedIcon iconNodeName icon)) = iconToDiagram icon iconNodeName innerLevel reflect angle where
         innerLevel = if func then nestingLevel else nestingLevel + 1
 
-nestedApplyDia :: SpecialBackend b n =>
+nestedApplyDia :: SpecialBackend b n
-  LikeApplyFlavor -> [Maybe NamedIcon] -> TransformableDia b n
+  => LikeApplyFlavor
+  -> Maybe NamedIcon
+  -> [Maybe NamedIcon]
+  -> TransformableDia b n
 nestedApplyDia flavor = case flavor of
   ApplyNodeFlavor -> generalNestedDia apply0Triangle (nestingC colorScheme)
   ComposeNodeFlavor -> generalNestedDia composeSemiCircle (repeat $ apply1C colorScheme)

app/TranslateCore.hs

@@ -265,12 +265,17 @@ makeArg args port = case find (findArg port) args of
   Nothing -> Nothing
   Just (SgNamedNode argName argSyntaxNode, _) -> Just $ NamedIcon argName (nodeToIcon argSyntaxNode)
 
-nestedApplySyntaxNodeToIcon :: LikeApplyFlavor -> Int -> [(SgNamedNode, Edge)] -> Icon
+nestedApplySyntaxNodeToIcon :: LikeApplyFlavor
-nestedApplySyntaxNodeToIcon flavor numArgs args = NestedApply flavor argList where
+                            -> Int
-  -- argList should be of length numArgs + 1, since argList includes the function expression
+                            -> [(SgNamedNode, Edge)]
-  dummyNode = LikeApplyNode flavor numArgs
+                            -> Icon
-  argPorts = take numArgs (argumentPorts dummyNode)
+nestedApplySyntaxNodeToIcon flavor numArgs args =
-  argList = fmap (makeArg args) (inputPort dummyNode : argPorts)
+  NestedApply flavor headIcon argList
+  where
+    dummyNode = LikeApplyNode flavor numArgs
+    argPorts = take numArgs (argumentPorts dummyNode)
+    headIcon = makeArg args (inputPort dummyNode)
+    argList = fmap (makeArg args) argPorts
 
 nestedCaseOrGuardNodeToIcon :: CaseOrGuardTag -> Int -> [(SgNamedNode, Edge)] -> Icon
 nestedCaseOrGuardNodeToIcon tag numArgs args = case tag of

app/Types.hs

@@ -39,9 +39,9 @@ data Icon = TextBoxIcon String | GuardIcon Int
   | FlatLambdaIcon [String] | ApplyAIcon Int | ComposeIcon Int
   | PAppIcon Int String | CaseIcon Int | CaseResultIcon
   | BindTextBoxIcon String
-  -- TODO: NestedApply should have the type NestedApply (Maybe NamedIcon) [Maybe NamedIcon]
   | NestedApply
     LikeApplyFlavor  -- apply or compose
+    (Maybe NamedIcon)  -- The function for apply, or the argument for compose
     [Maybe NamedIcon]  -- list of arguments or functions
   | NestedPApp [(Maybe NamedIcon, String)]
   | NestedCaseIcon [Maybe NamedIcon]

test/VisualRenderingTests.hs

@@ -158,39 +158,6 @@ arrowTestDrawing = Drawing arrowTestIcons arrowTestEdges where
     iconToIconEnds arr1 EndAp1Arg arr4 EndAp1Arg
     ]
 
-nestedTextDrawing :: Drawing
-nestedTextDrawing = Drawing nestedTestIcons nestedTestEdges where
-  [n1, t1, t2, inner, t, n2, n3, foo, in1, n4] = fmap NodeName [0..9]
-  nestedTestIcons = fmap tupleToNamedIcon [
-    (n1, NestedApply ApplyNodeFlavor args),
-    (t1, TextBoxIcon "T1"),
-    (t2, TextBoxIcon "t2")
-    ]
-    where
-      innerArgs = fmap (fmap tupleToNamedIcon) [
-        Just (inner, TextBoxIcon "inner"),
-        Just (t, TextBoxIcon "t"),
-        Nothing,
-        Just (n2,
-              NestedApply
-              ApplyNodeFlavor
-              (fmap (fmap tupleToNamedIcon) [Just (n4, TextBoxIcon "N4"), Nothing]))
-        ]
-      args = fmap (fmap tupleToNamedIcon) [
-        Just (n3, TextBoxIcon "n3"),
-        Nothing,
-        Just (foo, TextBoxIcon "3"),
-        Just (in1, NestedApply ApplyNodeFlavor innerArgs)
-        ]
-  nestedTestEdges = [
-    iconToIntPort t1 n1 2,
-    --iconToIntPort "t1" "in" 1,
-    --iconToIntPort "t2" ("n1" .> "in") 3,
-    --iconToIntPort "t2" ("n1" .> "in" .> "n2") 2
-    -- TODO This edge is not drawn currently. See todo in drawingToIconGraph in Rendering.
-    iconToIntPort t2 n2 2
-    ]
-
 -- TODO refactor these Drawings
 nestedCaseDrawing :: Drawing
 nestedCaseDrawing = Drawing icons [] where
@@ -255,7 +222,6 @@ renderTests = do
       fact1Drawing,
       fact2Drawing,
       arrowTestDrawing,
-      nestedTextDrawing,
       nestedCaseDrawing,
       nestedGuardDrawing,
       flatCaseDrawing,