Use Embedder for case and multi-if.

app/GraphAlgorithms.hs

@@ -6,7 +6,6 @@ module GraphAlgorithms(
   collapseAnnotatedGraph
   ) where
 
-import Control.Arrow(first)
 import qualified Data.Graph.Inductive as ING
 import Data.List(foldl', find)
 import Data.Tuple(swap)
@@ -16,7 +15,7 @@ import Constants(pattern ResultPortConst, pattern InputPortConst)
 import Types(SyntaxNode(..), IngSyntaxGraph, Edge(..),
              CaseOrMultiIfTag(..), Port(..), NameAndPort(..), SgNamedNode
             , AnnotatedGraph, EmbedInfo(..), EmbedDirection(..), NodeInfo(..)
-            , Embedder(..), Named(..), EmbedderSyntaxNode)
+            , Embedder(..), Named(..), EmbedderSyntaxNode, NodeName)
 import Util(fromMaybeError)
 
 {-# ANN module "HLint: ignore Use record patterns" #-}
@@ -91,8 +90,8 @@ syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort
 parentTypeForNode :: SyntaxNode -> ParentType
 parentTypeForNode n = case n of
   (ApplyNode _ _) -> ApplyParent
-  CaseOrMultiIfNode CaseTag _ _ -> CaseParent
+  CaseOrMultiIfNode CaseTag _ -> CaseParent
-  CaseOrMultiIfNode MultiIfTag _ _ -> MultiIfParent
+  CaseOrMultiIfNode MultiIfTag _ -> MultiIfParent
   (FunctionDefNode _ _) -> LambdaParent
   _ -> NotAParent
 
@@ -177,16 +176,10 @@ changeNodeLabel node newLabel graph = case ING.match node graph of
     -> (inEdges, node, newLabel, outEdges) ING.& restOfTheGraph
   (Nothing, _) -> graph
 
--- TODO Change CaseOrMultiIfNode to use Embedder, then simplify the
--- type of children.
 addChildrenToNodeLabel ::
-  [(SgNamedNode, Edge)] -> EmbedderSyntaxNode -> EmbedderSyntaxNode
+  [(NodeName, Edge)] -> EmbedderSyntaxNode -> EmbedderSyntaxNode
 addChildrenToNodeLabel children (Embedder existingNodes oldSyntaxNode)
-  = case oldSyntaxNode of
+  = Embedder (children <> existingNodes) oldSyntaxNode
-      CaseOrMultiIfNode tag x caseExistingNodes
-        -> Embedder [] $ CaseOrMultiIfNode tag x
-           (children <> caseExistingNodes)
-      _ -> Embedder (fmap (first naName) children <> existingNodes) oldSyntaxNode
 
 -- | Change the node label of the parent to be nested.
 embedChildSyntaxNode :: ING.DynGraph gr =>
@@ -209,8 +202,9 @@ embedChildSyntaxNode parentNode childNode oldGraph = newGraph
                $ changeNodeLabel parentNode newNodeLabel oldGraph
             where
               Named nodeName oldSyntaxNode = oldNodeLabel
-              newSyntaxNode
+              newSyntaxNode = addChildrenToNodeLabel
-                = addChildrenToNodeLabel [(childNodeLab, edge)] oldSyntaxNode
+                              [(naName childNodeLab, edge)]
+                              oldSyntaxNode
               newNodeLabel = NodeInfo isChild (Named nodeName newSyntaxNode)
 
 collapseEdge :: (HasCallStack, ING.DynGraph gr)

app/Icons.hs

@@ -105,8 +105,12 @@ iconToDiagram iconInfo icon = case icon of
        ((fmap . fmap) (findIconFromName iconInfo) args)
   NestedPApp constructor args
     -> nestedPAppDia iconInfo (repeat $ patternC colorScheme) constructor args
-  NestedCaseIcon args -> nestedCaseDia iconInfo args
+  NestedCaseIcon args -> nestedCaseDia
-  NestedMultiIfIcon args -> nestedMultiIfDia iconInfo args
+                         iconInfo
+                         ((fmap . fmap) (findIconFromName iconInfo) args)
+  NestedMultiIfIcon args -> nestedMultiIfDia
+                            iconInfo
+                            ((fmap . fmap) (findIconFromName iconInfo) args)
 
 -- BEGIN getPortAngles --
 
@@ -221,9 +225,17 @@ getPortAngles iconInfo icon port maybeNodeName = case icon of
        port
        maybeNodeName
   NestedCaseIcon args
-    -> nestedMultiIfPortAngles iconInfo args port maybeNodeName
+    -> nestedMultiIfPortAngles
+       iconInfo
+       ((fmap . fmap) (findIconFromName iconInfo) args)
+       port
+       maybeNodeName
   NestedMultiIfIcon args
-    -> nestedMultiIfPortAngles iconInfo args port maybeNodeName
+    -> nestedMultiIfPortAngles
+       iconInfo
+       ((fmap . fmap) (findIconFromName iconInfo) args)
+       port
+       maybeNodeName
 
 -- END getPortAngles --
 
@@ -256,7 +268,7 @@ argumentPorts n = case n of
   (ApplyNode _ _) -> defaultPorts
   PatternApplyNode _ _-> defaultPorts
   (FunctionDefNode _ _) -> defaultPorts
-  CaseOrMultiIfNode _ _ _-> defaultPorts
+  CaseOrMultiIfNode _ _ -> defaultPorts
   NameNode _ -> []
   BindNameNode _ -> []
   LiteralNode _ -> []

app/Translate.hs

@@ -458,7 +458,7 @@ evalCaseHelper numAlts caseIconName resultIconNames
   where
     (patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
     combindedAltGraph = mconcat altGraphs
-    caseNode = CaseOrMultiIfNode CaseTag numAlts []
+    caseNode = CaseOrMultiIfNode CaseTag numAlts
     icons = [Named caseIconName (mkEmbedder caseNode)]
     caseGraph = syntaxGraphFromNodes icons
     expEdge = (expRef, nameAndPort caseIconName (inputPort caseNode))

app/TranslateCore.hs

@@ -28,7 +28,6 @@ module TranslateCore(
   initialIdState
 ) where
 
-import Control.Arrow(first)
 import Control.Monad.State(State, state)
 import Data.Either(partitionEithers)
 import qualified Data.Graph.Inductive.Graph as ING
@@ -41,7 +40,7 @@ import Icons(inputPort, resultPort, argumentPorts, multiIfRhsPorts
 import Types(Labeled(..), Icon(..), SyntaxNode(..), Edge(..), EdgeOption(..)
             , NameAndPort(..), IDState, SgNamedNode, NodeName(..), Port
             , LikeApplyFlavor(..), CaseOrMultiIfTag(..), IDState(..)
-            , NamedIcon, Embedder(..), mkEmbedder, Named(..)
+            , Embedder(..), mkEmbedder, Named(..)
             , EmbedderSyntaxNode)
 import Util(nameAndPort, makeSimpleEdge, justName, maybeBoolToBool
            , nodeNameToInt)
@@ -202,7 +201,7 @@ makeMultiIfGraph ::
 makeMultiIfGraph numPairs multiIfName bools exps
   = (newGraph, nameAndPort multiIfName (resultPort multiIfNode))
   where
-    multiIfNode = CaseOrMultiIfNode MultiIfTag numPairs []
+    multiIfNode = CaseOrMultiIfNode MultiIfTag numPairs
     expsWithPorts = zip exps $ map (nameAndPort multiIfName) multiIfRhsPorts
     boolsWithPorts = zip bools $ map (nameAndPort multiIfName) multiIfBoolPorts
     combindedGraph = combineExpressions False $ expsWithPorts <> boolsWithPorts
@@ -292,18 +291,20 @@ nodeToIcon (Embedder embeddedNodes node) = case node of
   (FunctionDefNode labels bodyNodes)
     -> nestedLambdaToIcon labels embeddedNodes bodyNodes
   CaseResultNode -> CaseResultIcon
-  (CaseOrMultiIfNode tag x edges)
+  (CaseOrMultiIfNode tag x)
-    -> nestedCaseOrMultiIfNodeToIcon tag x edges
+    -> nestedCaseOrMultiIfNodeToIcon tag x embeddedNodes
 
-makeArg :: [(SgNamedNode, Edge)] -> Port -> Maybe NamedIcon
+-- | Helper for makeArg
-makeArg args port = case find (findArg port) args of
+findArg :: Port -> (NodeName, Edge) -> Bool
-  Nothing -> Nothing
+findArg currentPort
-  Just (Named argName argSyntaxNode, _)
+  (argName
-    -> Just $ Named argName (nodeToIcon argSyntaxNode)
+  , Edge _ (NameAndPort fromName fromPort, NameAndPort toName toPort))
+  | argName == fromName = maybeBoolToBool $ fmap (== currentPort) toPort
+  | argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort
+  | otherwise = False -- This case should never happen
 
--- TOOD Change all the types so that makeArg' becomes makeArg.
+makeArg :: [(NodeName, Edge)] -> Port -> Maybe NodeName
-makeArg' :: [(NodeName, Edge)] -> Port -> Maybe NodeName
+makeArg args port = fst <$> find (findArg port) args
-makeArg' args port = fst <$> find (findArg' port) args
 
 nestedApplySyntaxNodeToIcon :: LikeApplyFlavor
                             -> Int
@@ -314,8 +315,8 @@ nestedApplySyntaxNodeToIcon flavor numArgs args =
   where
     dummyNode = ApplyNode flavor numArgs
     argPorts = take numArgs (argumentPorts dummyNode)
-    headIcon = makeArg' args (inputPort dummyNode)
+    headIcon = makeArg args (inputPort dummyNode)
-    argList = fmap (makeArg' args) argPorts
+    argList = fmap (makeArg args) argPorts
 
 nestedLambdaToIcon :: [String]  -- labels
                    -> [(NodeName, Edge)]  -- embedded icons
@@ -325,18 +326,18 @@ nestedLambdaToIcon labels embeddedNodes =
   LambdaIcon labels embeddedBodyNode
   where
     dummyNode = FunctionDefNode [] []
-    embeddedBodyNode = makeArg' embeddedNodes (inputPort dummyNode)
+    embeddedBodyNode = makeArg embeddedNodes (inputPort dummyNode)
 
 nestedCaseOrMultiIfNodeToIcon ::
   CaseOrMultiIfTag
   -> Int
-  -> [(SgNamedNode, Edge)]
+  -> [(NodeName, Edge)]
   -> Icon
 nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of
   CaseTag -> NestedCaseIcon argList
   MultiIfTag -> NestedMultiIfIcon argList
   where
-    dummyNode = CaseOrMultiIfNode CaseTag numArgs []
+    dummyNode = CaseOrMultiIfNode CaseTag numArgs
     argPorts = take (2 * numArgs) $ argumentPorts dummyNode
     argList = fmap (makeArg args) (inputPort dummyNode : argPorts)
 
@@ -346,18 +347,6 @@ nestedPatternNodeToIcon str children = NestedPApp
   -- Why so many fmaps?
   ( (fmap . fmap . fmap . fmap) nodeToIcon children)
 
-findArg :: Port -> (SgNamedNode, Edge) -> Bool
-findArg currentPort arg
-  = findArg' currentPort (first naName arg)
-
-findArg' :: Port -> (NodeName, Edge) -> Bool
-findArg' currentPort
-  (argName
-  , Edge _ (NameAndPort fromName fromPort, NameAndPort toName toPort))
-  | argName == fromName = maybeBoolToBool $ fmap (== currentPort) toPort
-  | argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort
-  | otherwise = False -- This case should never happen
-
 makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
 makeLNode namedNode@(Named (NodeName name) _) = (name, namedNode)
 

app/Types.hs

@@ -80,8 +80,8 @@ data Icon = TextBoxIcon String
   | NestedPApp
     (Labeled (Maybe NamedIcon))  -- Data constructor
     [Labeled (Maybe NamedIcon)]  -- Arguments
-  | NestedCaseIcon [Maybe NamedIcon]
+  | NestedCaseIcon [Maybe NodeName]
-  | NestedMultiIfIcon [Maybe NamedIcon]
+  | NestedMultiIfIcon [Maybe NodeName]
   deriving (Show, Eq, Ord)
 
 data LikeApplyFlavor = ApplyNodeFlavor | ComposeNodeFlavor
@@ -116,8 +116,7 @@ data SyntaxNode =
     [String]  -- Parameter labels
     [NodeName]  -- Nodes inside the lambda
   | CaseResultNode -- TODO remove caseResultNode
-  -- TODO Move CaseOrMultiIfNode's embedded nodes to Embedder.
+  | CaseOrMultiIfNode CaseOrMultiIfTag Int
-  | CaseOrMultiIfNode CaseOrMultiIfTag Int [(SgNamedNode, Edge)]
   deriving (Show, Eq, Ord)
 
 newtype Port = Port Int deriving (Typeable, Eq, Ord, Show)

test/VisualRenderingTests.hs

@@ -18,41 +18,50 @@ import Util(iconToPort, tupleToNamed)
 iconToIntPort :: NodeName -> NodeName -> Int -> Edge
 iconToIntPort x y p = iconToPort x y (Port p)
 
-n0, n1, _n2, n3, _n4, n5, _n6, _n7, _n8, _n9, n10 :: NodeName
+n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10 :: NodeName
 nodeNames :: [NodeName]
-nodeNames@[n0, n1, _n2, n3, _n4, n5, _n6, _n7, _n8, _n9, n10]
+nodeNames@[n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10]
   = fmap NodeName [0..10]
 
 ni0, ni1, ni2, ni3, ni4, ni5, ni6, ni7, ni8, ni9, ni10 :: Icon -> NamedIcon
 [ni0, ni1, ni2, ni3, ni4, ni5, ni6, ni7, ni8, ni9, ni10]
   = fmap Named nodeNames
 
+textBoxIcons :: [NamedIcon]
+textBoxIcons =
+  [ ni2 (TextBoxIcon "n2")
+  , ni4 (TextBoxIcon "n4")
+  , ni10 $ TextBoxIcon "n10"
+  , ni6 (TextBoxIcon "n6")
+  , ni7 (TextBoxIcon "n7")
+  , ni8 (TextBoxIcon "n8")
+  , ni9 (TextBoxIcon "n9")]
+
 -- TODO refactor these Drawings
 nestedCaseDrawing :: Drawing
 nestedCaseDrawing = Drawing icons [] where
-  icons = fmap tupleToNamed [
+  icons = textBoxIcons <> fmap tupleToNamed [
     (n0, NestedCaseIcon [Nothing, Nothing, Nothing]),
-    (n1, NestedCaseIcon [Nothing, Just $ ni2 (TextBoxIcon "n2"), Nothing]),
+    (n1, NestedCaseIcon [Nothing, Just n2, Nothing]),
-    (n3, NestedCaseIcon [Nothing, Nothing, Just $ ni4 (TextBoxIcon "n4")]),
+    (n3, NestedCaseIcon [Nothing, Nothing, Just n4]),
     (n5, NestedCaseIcon [Nothing,
-                         Just $ ni6 (TextBoxIcon "n6"),
+                         Just n6,
-                         Just $ ni7 (TextBoxIcon "n7"),
+                         Just n7,
-                         Just $ ni8 (TextBoxIcon "n8"),
+                         Just n8,
-                         Just $ ni9 (TextBoxIcon "n9")])
+                         Just n9])
     ]
 
 nestedMultiIfDrawing :: Drawing
 nestedMultiIfDrawing = Drawing icons edges where
-  icons = [
+  icons = textBoxIcons <>
-    ni10 $ TextBoxIcon "n10"
+    [ ni0 $ NestedMultiIfIcon [Nothing, Nothing, Nothing]
-    , ni0 $ NestedMultiIfIcon [Nothing, Nothing, Nothing]
+    , ni1 $ NestedMultiIfIcon [Nothing, Just n2, Nothing]
-    , ni1 $ NestedMultiIfIcon [Nothing, Just $ ni2 (TextBoxIcon "n2"), Nothing]
+    , ni3 $ NestedMultiIfIcon [Nothing, Nothing, Just n4]
-    , ni3 $ NestedMultiIfIcon [Nothing, Nothing, Just $ ni4 (TextBoxIcon "n4")]
     , ni5 $ NestedMultiIfIcon [Nothing,
-                         Just $ ni6 (TextBoxIcon "n6"),
+                         Just n6,
-                         Just $ ni7 (TextBoxIcon "n7"),
+                         Just n7,
-                         Just $ ni8 (TextBoxIcon "n8"),
+                         Just n8,
-                         Just $ ni9 (TextBoxIcon "n9")]
+                         Just n9]
     ]
   edges = [
     iconToIntPort n10 n5 0