Add SyntaxGraph. Replace IconGraph with SyntaxGraph in Translate.hs.

app/Icons.hs

@@ -23,7 +23,7 @@ import Diagrams.Prelude hiding ((&), (#))
 -- import Diagrams.Backend.SVG(B)
 --import Diagrams.TwoD.Text(Text)
 import Data.Typeable(Typeable)
-import Data.Maybe(fromMaybe)
+--import Data.Maybe(fromMaybe)
 
 import Types(Icon(..), SpecialQDiagram, SpecialBackend)
 import Util(fromMaybeError)

app/Main.hs

@@ -14,6 +14,8 @@ import Translate(drawingsFromModule)
 
 
 -- TODO Now --
+-- Rewrite Translate to generate an abstract computation graph that is then transformed (eg. find tree sections)
+-- - and turned into an Icon graph.
 -- Fix icon nesting if a non-nestable icon (eg. flatLambdaIcon) is part of the expression.
 -- - eg. y = f $ g (\x -> x)
 

app/Translate.hs

@@ -16,17 +16,16 @@ import Control.Monad.State(State, evalState)
 import Data.Either(partitionEithers)
 import Data.List(unzip4, partition)
 import Control.Monad(replicateM)
-import Data.Maybe(catMaybes)
+--import Data.Maybe(catMaybes)
 
 import Types(Drawing(..), NameAndPort(..), IDState,
-  initialIdState, Edge)
+  initialIdState, Edge, SyntaxNode(..))
-import Util(toNames, makeSimpleEdge, nameAndPort, justName, mapFst, eitherToMaybes)
+import Util(toNames, makeSimpleEdge, nameAndPort, justName, mapFst)
-import Icons(Icon(..))
+import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef,
-import TranslateCore(Reference, IconGraph(..), Sink, EvalContext, GraphAndRef,
+  syntaxGraphFromNodes, syntaxGraphFromNodesEdges, getUniqueName, combineExpressions,
-  iconGraphFromIcons, iconGraphFromIconsEdges, getUniqueName, combineExpressions,
   edgesForRefPortList, iconGraphToDrawing, makeApplyGraph,
   namesInPattern, lookupReference, deleteBindings, makeEdges,
-  coerceExpressionResult, makeBox, nTupleString, nListString)
+  coerceExpressionResult, makeBox, nTupleString, nListString, syntaxGraphToIconGraph)
 
 -- OVERVIEW --
 -- The core functions and data types used in this module are in TranslateCore.
@@ -49,17 +48,17 @@ qNameToString (Special Cons) = "(:)"
 -- unboxed singleton tuple constructor
 qNameToString (Special UnboxedSingleCon) = "(# #)"
 
-evalPApp :: QName -> [Pat] -> State IDState (IconGraph, NameAndPort)
+evalPApp :: QName -> [Pat] -> State IDState (SyntaxGraph, NameAndPort)
 evalPApp name [] = makeBox $ qNameToString name
 evalPApp name patterns = do
   patName <- DIA.toName <$> getUniqueName "pat"
   evaledPatterns <- mapM evalPattern patterns
   let
     constructorName = qNameToString name
-    gr = makeTextApplyGraph True patName (Left constructorName) evaledPatterns (length evaledPatterns)
+    gr = makePatternGraph patName constructorName evaledPatterns (length evaledPatterns)
   pure gr
 
-evalPLit :: Exts.Sign -> Exts.Literal -> State IDState (IconGraph, NameAndPort)
+evalPLit :: Exts.Sign -> Exts.Literal -> State IDState (SyntaxGraph, NameAndPort)
 evalPLit Exts.Signless l = evalLit l
 evalPLit Exts.Negative l = makeBox ('-' : showLiteral l)
 
@@ -68,7 +67,7 @@ evalPAsPat n p = do
   (evaledPatGraph, evaledPatRef) <- evalPattern p
   let
     newBind = [(nameToString n, evaledPatRef)]
-    newGraph = IconGraph mempty mempty mempty mempty newBind
+    newGraph = SyntaxGraph mempty mempty mempty newBind
   pure (newGraph <> evaledPatGraph, evaledPatRef)
 
 evalPattern :: Pat -> State IDState GraphAndRef
@@ -89,98 +88,50 @@ evalPattern p = case p of
   -- TODO: Other cases
 
 -- strToGraphRef is not in TranslateCore, since it is only used by evalQName.
-strToGraphRef :: EvalContext -> String -> State IDState (IconGraph, Reference)
+strToGraphRef :: EvalContext -> String -> State IDState (SyntaxGraph, Reference)
 strToGraphRef c str = fmap mapper (makeBox str) where
   mapper gr = if str `elem` c
     then (mempty, Left str)
     else fmap Right gr
 
-evalQName :: QName -> EvalContext -> State IDState (IconGraph, Reference)
+evalQName :: QName -> EvalContext -> State IDState (SyntaxGraph, Reference)
 evalQName qName@(UnQual _) c = strToGraphRef c (qNameToString qName)
 evalQName qName@(Qual _ _) c = strToGraphRef c (qNameToString qName)
 evalQName qName _ = fmap Right <$> makeBox (qNameToString qName)
 
--- evalQOp :: QOp -> EvalContext -> State IDState (IconGraph, Reference)
+-- evalQOp :: QOp -> EvalContext -> State IDState (SyntaxGraph, Reference)
 -- evalQOp (QVarOp n) = evalQName n
 -- evalQOp (QConOp n) = evalQName n
 
-qOpToString :: QOp -> String
+-- qOpToString :: QOp -> String
-qOpToString (QVarOp n) = qNameToString n
+-- qOpToString (QVarOp n) = qNameToString n
-qOpToString (QConOp n) = qNameToString n
+-- qOpToString (QConOp n) = qNameToString n
 
-decideIfNested :: ((IconGraph, t1), t) ->
+--findReferencedIcon :: Reference -> [(DIA.Name, Icon)] -> Maybe (Name, Icon)
-  (Maybe ((IconGraph, t1), t), Maybe (DIA.Name, Icon), [Sink], [(String, Reference)])
+-- findReferencedIcon :: Either t NameAndPort -> [(DIA.Name, t1)] -> Maybe (DIA.Name, t1)
-decideIfNested ((IconGraph [nameAndIcon] [] [] sinks bindings, _), _) = (Nothing, Just nameAndIcon, sinks, bindings)
+-- findReferencedIcon (Left str) _ = Nothing
-decideIfNested valAndPort = (Just valAndPort, Nothing, [], [])
+-- findReferencedIcon (Right (NameAndPort name _)) nameIconMap = (\x -> (name, x)) <$> lookup name nameIconMap
 
-makeTextApplyGraph :: Bool -> DIA.Name -> Either String GraphAndRef-> [GraphAndRef] -> Int -> (IconGraph, NameAndPort)
+makePatternGraph :: DIA.Name -> String -> [(SyntaxGraph, Reference)] -> Int -> (SyntaxGraph, NameAndPort)
-makeTextApplyGraph inPattern applyIconName funStrOrVal argVals numArgs = result
+makePatternGraph applyIconName funStr argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName 1)
-  where
-    (funStr, maybeFunVal) = eitherToMaybes funStrOrVal
-    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
-
-    functionPort = nameAndPort applyIconName 0
-
-    originalPortExpPairs = (catMaybes unnestedArgsAndPort)
-    portExpressionPairs = case maybeFunVal of
-      Just funVal -> (funVal, functionPort) : originalPortExpPairs
-      Nothing -> originalPortExpPairs
-    combinedGraph = combineExpressions inPattern portExpressionPairs
-    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
+    combinedGraph = combineExpressions True $ zip argVals argumentPorts
-    icon = if inPattern
+    icons = [(applyIconName, PatternApplyNode funStr numArgs)]
-      then PAppIcon
+    newGraph = syntaxGraphFromNodes icons
-      else TextApplyAIcon
-    icons = [(applyIconName, icon numArgs funStr)]
-    newGraph = iconGraphFromIcons icons
 
-evalApp :: EvalContext -> (Exp, [Exp]) -> State IDState (IconGraph, NameAndPort)
+evalApp :: EvalContext -> (Exp, [Exp]) -> State IDState (SyntaxGraph, NameAndPort)
-evalApp c exps@(funExp, argExps) = case funExp of
+evalApp c exps@(funExp, argExps) = do
-  (Var n) -> makeTextApp n
-  (Con n) -> makeTextApp n
-  _ -> evalAppNoText c exps
-  where
-    makeTextApp funName = let funStr = qNameToString funName in
-      if funStr `elem` c
-      then evalAppNoText c exps
-      else do
-        argVals <- mapM (evalExp c) argExps
-        applyIconName <- DIA.toName <$> getUniqueName "app0"
-        pure $ makeTextApplyGraph False applyIconName (Left funStr) argVals (length argExps)
-
-evalAppNoText :: EvalContext -> (Exp, [Exp]) -> State IDState (IconGraph, NameAndPort)
-evalAppNoText c (funExp, argExps) = do
   funVal <- evalExp c funExp
   argVals <- mapM (evalExp c) argExps
   applyIconName <- DIA.toName <$> getUniqueName "app0"
-  pure $ makeTextApplyGraph False applyIconName (Right funVal) argVals (length argExps)
+  pure $ makeApplyGraph False applyIconName funVal argVals (length argExps)
 
 qOpToExp :: QOp -> Exp
 qOpToExp (QVarOp n) = Var n
 qOpToExp (QConOp n) = Con n
 
-evalInfixApp :: EvalContext -> Exp -> QOp -> Exp -> State IDState (IconGraph, Reference)
+evalInfixApp :: EvalContext -> Exp -> QOp -> Exp -> State IDState (SyntaxGraph, Reference)
 evalInfixApp c e1 (QVarOp (UnQual (Symbol "$"))) e2 = evalExp c (App e1 e2)
 evalInfixApp c e1 op e2 = fmap Right <$> evalApp c (qOpToExp op, [e1, e2])
 
@@ -191,17 +142,17 @@ simplifyApp (App exp1 exp2) = (funExp, args <> [exp2])
     (funExp, args) = simplifyApp exp1
 simplifyApp e = (e, [])
 
-evalIf :: EvalContext -> Exp -> Exp -> Exp -> State IDState (IconGraph, NameAndPort)
+evalIf :: EvalContext -> Exp -> Exp -> Exp -> State IDState (SyntaxGraph, NameAndPort)
 evalIf c e1 e2 e3 = do
   e1Val <- evalExp c e1
   e2Val <- evalExp c e2
   e3Val <- evalExp c e3
   guardName <- DIA.toName <$> getUniqueName "if"
   let
-    icons = [(guardName, GuardIcon 2)]
+    icons = [(guardName, GuardNode 2)]
     combinedGraph =
       combineExpressions False $ zip [e1Val, e2Val, e3Val] (map (nameAndPort guardName) [3, 2, 4])
-    newGraph = iconGraphFromIcons icons <> combinedGraph
+    newGraph = syntaxGraphFromNodes icons <> combinedGraph
   pure (newGraph, NameAndPort guardName (Just 0))
 
 evalStmt :: EvalContext -> Stmt -> State IDState GraphAndRef
@@ -216,7 +167,7 @@ evalGuaredRhs c (GuardedRhs _ stmts e) = do
   stmtsVal <- evalStmts c stmts
   pure (stmtsVal, expVal)
 
-evalGuardedRhss :: EvalContext -> [GuardedRhs] -> State IDState (IconGraph, NameAndPort)
+evalGuardedRhss :: EvalContext -> [GuardedRhs] -> State IDState (SyntaxGraph, NameAndPort)
 evalGuardedRhss c rhss = do
   guardName <- DIA.toName <$> getUniqueName "guard"
   evaledRhss <- mapM (evalGuaredRhs c) rhss
@@ -225,15 +176,15 @@ evalGuardedRhss c rhss = do
     expsWithPorts = zip exps $ map (nameAndPort guardName) [2,4..]
     boolsWithPorts = zip bools $ map (nameAndPort guardName) [3,5..]
     combindedGraph = combineExpressions False $ expsWithPorts <> boolsWithPorts
-    icons = [(guardName, GuardIcon (length rhss))]
+    icons = [(guardName, GuardNode (length rhss))]
-    newGraph = iconGraphFromIcons icons <> combindedGraph
+    newGraph = syntaxGraphFromNodes icons <> combindedGraph
   pure (newGraph, NameAndPort guardName (Just 1))
 
 -- This is in Translate and not Translate core since currently it is only used by evalLit.
-makeLiteral :: (Show x) => x -> State IDState (IconGraph, NameAndPort)
+makeLiteral :: (Show x) => x -> State IDState (SyntaxGraph, NameAndPort)
 makeLiteral = makeBox. show
 
-evalLit :: Exts.Literal -> State IDState (IconGraph, NameAndPort)
+evalLit :: Exts.Literal -> State IDState (SyntaxGraph, NameAndPort)
 evalLit (Exts.Int x) = makeLiteral x
 evalLit (Exts.Char x) = makeLiteral x
 evalLit (Exts.String x) = makeLiteral x
@@ -270,7 +221,7 @@ getBoundVarName (TypeSig _ _ _) = []
 getBoundVarName decl = error $ "getBoundVarName: No pattern in case for " ++ show decl
 
 --TODO: Should this call makeEdges?
-evalBinds :: EvalContext -> Binds -> State IDState (IconGraph, EvalContext)
+evalBinds :: EvalContext -> Binds -> State IDState (SyntaxGraph, EvalContext)
 evalBinds c (BDecls decls) = do
   let
     boundNames = concatMap getBoundVarName decls
@@ -278,21 +229,21 @@ evalBinds c (BDecls decls) = do
   evaledDecl <- mconcat <$> mapM (evalDecl augmentedContext) decls
   pure (evaledDecl, augmentedContext)
 
-evalGeneralLet :: (EvalContext -> State IDState (IconGraph, Reference)) -> EvalContext -> Binds -> State IDState (IconGraph, Reference)
+evalGeneralLet :: (EvalContext -> State IDState (SyntaxGraph, Reference)) -> EvalContext -> Binds -> State IDState (SyntaxGraph, Reference)
 evalGeneralLet expOrRhsEvaler c bs = do
   (bindGraph, bindContext) <- evalBinds c bs
   expVal <- expOrRhsEvaler bindContext
   let
     (expGraph, expResult) = expVal
     newGraph = deleteBindings . makeEdges $ expGraph <> bindGraph
-    (IconGraph _ _ _ _ bindings) = bindGraph
+    (SyntaxGraph _ _ _ bindings) = bindGraph
   pure (newGraph, lookupReference bindings expResult)
 
-evalLet :: EvalContext -> Binds -> Exp -> State IDState (IconGraph, Reference)
+evalLet :: EvalContext -> Binds -> Exp -> State IDState (SyntaxGraph, Reference)
 evalLet context binds e = evalGeneralLet (`evalExp` e) context binds
 
 -- TODO: Refactor this with evalPatBind
-evalPatAndRhs :: EvalContext -> Pat -> Rhs -> Maybe Binds -> State IDState (Bool, IconGraph, Reference, NameAndPort)
+evalPatAndRhs :: EvalContext -> Pat -> Rhs -> Maybe Binds -> State IDState (Bool, SyntaxGraph, Reference, NameAndPort)
 evalPatAndRhs c pat rhs maybeWhereBinds = do
   patternNames <- namesInPattern <$> evalPattern pat
   let rhsContext = patternNames <> c
@@ -303,14 +254,14 @@ evalPatAndRhs c pat rhs maybeWhereBinds = do
     grWithEdges = makeEdges (rhsGraph <> patGraph)
     -- The pattern and rhs are conneted if makeEdges added extra edges.
     patRhsAreConnected =
-      length (igEdges grWithEdges) > (length (igEdges rhsGraph) + length (igEdges patGraph))
+      length (sgEdges grWithEdges) > (length (sgEdges rhsGraph) + length (sgEdges patGraph))
   pure (patRhsAreConnected, deleteBindings grWithEdges, patRef, rhsRef)
 
 -- returns (combined graph, pattern reference, rhs reference)
-evalAlt :: EvalContext -> Exts.Alt -> State IDState (Bool, IconGraph, Reference, NameAndPort)
+evalAlt :: EvalContext -> Exts.Alt -> State IDState (Bool, SyntaxGraph, Reference, NameAndPort)
 evalAlt c (Exts.Alt _ pat rhs maybeBinds) = evalPatAndRhs c pat rhs maybeBinds
 
-evalCase :: EvalContext -> Exp -> [Alt] -> State IDState (IconGraph, NameAndPort)
+evalCase :: EvalContext -> Exp -> [Alt] -> State IDState (SyntaxGraph, NameAndPort)
 evalCase c e alts = do
   evaledAlts <- mapM (evalAlt c) alts
   (expGraph, expRef) <- evalExp c e
@@ -319,17 +270,17 @@ evalCase c e alts = do
     (patRhsConnected, altGraphs, patRefs, rhsRefs) = unzip4 evaledAlts
     combindedAltGraph = mconcat altGraphs
     numAlts = length alts
-    icons = toNames [(caseIconName, CaseIcon numAlts)]
+    icons = toNames [(caseIconName, CaseNode numAlts)]
-    caseGraph = iconGraphFromIcons icons
+    caseGraph = syntaxGraphFromNodes icons
     expEdge = (expRef, nameAndPort caseIconName 0)
     patEdges = zip patRefs $ map (nameAndPort caseIconName ) [2,4..]
     rhsEdges = zip patRhsConnected $ zip rhsRefs $ map (nameAndPort caseIconName) [3,5..]
     (connectedRhss, unConnectedRhss) = partition fst rhsEdges
   resultIconNames <- replicateM numAlts (getUniqueName "caseResult")
   let
-    makeCaseResult resultIconName rhsPort = iconGraphFromIconsEdges rhsNewIcons rhsNewEdges
+    makeCaseResult resultIconName rhsPort = syntaxGraphFromNodesEdges rhsNewIcons rhsNewEdges
       where
-        rhsNewIcons = toNames [(resultIconName, CaseResultIcon)]
+        rhsNewIcons = toNames [(resultIconName, CaseResultNode)]
         rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
     caseResultGraphs = mconcat $ zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
     filteredRhsEdges = mapFst Right $ fmap snd unConnectedRhss
@@ -338,32 +289,34 @@ evalCase c e alts = do
     finalGraph = mconcat [patternEdgesGraph, caseResultGraphs, expGraph, caseEdgeGraph, caseGraph, combindedAltGraph]
   pure (finalGraph, nameAndPort caseIconName 1)
 
-evalTuple :: EvalContext -> [Exp] -> State IDState (IconGraph, NameAndPort)
+evalTuple :: EvalContext -> [Exp] -> State IDState (SyntaxGraph, NameAndPort)
 evalTuple c exps = do
   argVals <- mapM (evalExp c) exps
+  funVal <- makeBox $ nTupleString (length exps)
   applyIconName <- DIA.toName <$> getUniqueName "tupleApp"
-  pure $ makeTextApplyGraph False applyIconName (Left $ nTupleString (length exps)) argVals (length exps)
+  pure $ makeApplyGraph False applyIconName (fmap Right funVal) argVals (length exps)
 
 makeVarExp :: String -> Exp
 makeVarExp = Var . UnQual . Ident
 
-evalListExp :: EvalContext -> [Exp] -> State IDState (IconGraph, NameAndPort)
+evalListExp :: EvalContext -> [Exp] -> State IDState (SyntaxGraph, NameAndPort)
 evalListExp _ [] = makeBox "[]"
 evalListExp c exps = evalApp c (makeVarExp . nListString . length $ exps, exps)
 
-evalLeftSection :: EvalContext -> Exp -> QOp -> State IDState (IconGraph, NameAndPort)
+evalLeftSection :: EvalContext -> Exp -> QOp -> State IDState (SyntaxGraph, NameAndPort)
 evalLeftSection c e op = evalApp c (qOpToExp op, [e])
 
-evalRightSection:: EvalContext -> QOp -> Exp -> State IDState (IconGraph, NameAndPort)
+evalRightSection:: EvalContext -> QOp -> Exp -> State IDState (SyntaxGraph, NameAndPort)
 evalRightSection c op e = do
   expVal <- evalExp c e
+  funVal <- evalExp c (qOpToExp op)
   applyIconName <- DIA.toName <$> getUniqueName "tupleApp"
   -- TODO: A better option would be for makeApplyGraph to take the list of expressions as Maybes.
   neverUsedPort <- Left <$> getUniqueName "unusedArgument"
-  pure $ makeTextApplyGraph False applyIconName (Left $ qOpToString op) [(mempty, neverUsedPort), expVal] 2
+  pure $ makeApplyGraph False applyIconName funVal [(mempty, neverUsedPort), expVal] 2
 
 -- evalEnums is only used by evalExp
-evalEnums :: EvalContext -> String -> [Exp] -> State IDState (IconGraph, Reference)
+evalEnums :: EvalContext -> String -> [Exp] -> State IDState (SyntaxGraph, Reference)
 evalEnums c s exps = fmap Right <$> evalApp c (Var . UnQual . Ident $ s, exps)
 
 makeQVarOp :: String -> QOp
@@ -378,10 +331,10 @@ desugarDo (Generator srcLoc pat e : stmts) =
 desugarDo (LetStmt binds : stmts) = Let binds (desugarDo stmts)
 
 -- TODO: Finish evalRecConstr
-evalRecConstr :: EvalContext -> QName -> [Exts.FieldUpdate] -> State IDState (IconGraph, Reference)
+evalRecConstr :: EvalContext -> QName -> [Exts.FieldUpdate] -> State IDState (SyntaxGraph, Reference)
 evalRecConstr c qName _ = evalQName qName c
 
-evalExp :: EvalContext  -> Exp -> State IDState (IconGraph, Reference)
+evalExp :: EvalContext  -> Exp -> State IDState (SyntaxGraph, Reference)
 evalExp c x = case x of
   Var n -> evalQName n c
   Con n -> evalQName n c
@@ -414,16 +367,16 @@ evalExp c x = case x of
 
 -- | First argument is the right hand side.
 -- The second arugement is a list of strings that are bound in the environment.
-evalRhs :: EvalContext -> Rhs -> State IDState (IconGraph, Reference)
+evalRhs :: EvalContext -> Rhs -> State IDState (SyntaxGraph, Reference)
 evalRhs c (UnGuardedRhs e) = evalExp c e
 evalRhs c (GuardedRhss rhss) = fmap Right <$> evalGuardedRhss c rhss
 
-rhsWithBinds :: Maybe Binds -> Rhs -> EvalContext -> State IDState (IconGraph, Reference)
+rhsWithBinds :: Maybe Binds -> Rhs -> EvalContext -> State IDState (SyntaxGraph, Reference)
 rhsWithBinds maybeWhereBinds rhs rhsContext = case maybeWhereBinds of
   Nothing -> evalRhs rhsContext rhs
   Just b -> evalGeneralLet (`evalRhs` rhs) rhsContext b
 
-evalPatBind :: EvalContext -> Decl -> State IDState IconGraph
+evalPatBind :: EvalContext -> Decl -> State IDState SyntaxGraph
 evalPatBind c (PatBind _ pat rhs maybeWhereBinds) = do
   patternNames <- namesInPattern <$> evalPattern pat
   let rhsContext = patternNames <> c
@@ -436,10 +389,10 @@ evalPatBind c (PatBind _ pat rhs maybeWhereBinds) = do
         -- TODO This edge/sink should have a special arrow head to indicate an input to a pattern.
         (Left rhsStr) -> (mempty, [(rhsStr, patPort)], mempty)
         (Right rhsPort) -> ([makeSimpleEdge (rhsPort, patPort)], mempty, mempty)
-    gr = IconGraph mempty newEdges mempty newSinks bindings
+    gr = SyntaxGraph mempty newEdges newSinks bindings
   pure . makeEdges $ (gr <> rhsGraph <> patGraph)
 
-generalEvalLambda :: EvalContext -> [Pat] -> (EvalContext -> State IDState GraphAndRef) -> State IDState (IconGraph, NameAndPort)
+generalEvalLambda :: EvalContext -> [Pat] -> (EvalContext -> State IDState GraphAndRef) -> State IDState (SyntaxGraph, NameAndPort)
 generalEvalLambda context patterns rhsEvalFun = do
   lambdaName <- getUniqueName "lam"
   patternVals <- mapM evalPattern patterns
@@ -455,9 +408,9 @@ generalEvalLambda context patterns rhsEvalFun = do
   -- TODO remove coerceExpressionResult here
   (rhsRawGraph, rhsResult) <- rhsEvalFun rhsContext >>= coerceExpressionResult
   let
-    icons = toNames [(lambdaName, FlatLambdaIcon numParameters)]
+    icons = toNames [(lambdaName, FunctionDefNode numParameters)]
     resultIconEdge = makeSimpleEdge (rhsResult, nameAndPort lambdaName 0)
-    finalGraph = IconGraph icons (resultIconEdge:patternEdges) mempty
+    finalGraph = SyntaxGraph icons (resultIconEdge:patternEdges)
       mempty newBinds
   pure (deleteBindings . makeEdges $ (rhsRawGraph <> patternGraph <> finalGraph), nameAndPort lambdaName 1)
   where
@@ -469,10 +422,10 @@ generalEvalLambda context patterns rhsEvalFun = do
     makePatternEdges (_, Left str) lamPort = Right (str, Right lamPort)
 
 
-evalLambda :: EvalContext -> [Pat] -> Exp -> State IDState (IconGraph, NameAndPort)
+evalLambda :: EvalContext -> [Pat] -> Exp -> State IDState (SyntaxGraph, NameAndPort)
 evalLambda c patterns e = generalEvalLambda c patterns (`evalExp` e)
 
-evalMatch :: EvalContext -> Match -> State IDState IconGraph
+evalMatch :: EvalContext -> Match -> State IDState SyntaxGraph
 evalMatch c (Match _ name patterns _ rhs maybeWhereBinds) = do
   let
     matchFunNameString = nameToString name
@@ -480,7 +433,7 @@ evalMatch c (Match _ name patterns _ rhs maybeWhereBinds) = do
   (lambdaGraph, lambdaPort) <-
     generalEvalLambda newContext patterns (rhsWithBinds maybeWhereBinds rhs)
   let
-    newBinding = IconGraph mempty mempty mempty mempty [(matchFunNameString, Right lambdaPort)]
+    newBinding = SyntaxGraph mempty mempty mempty [(matchFunNameString, Right lambdaPort)]
   pure $ makeEdges (newBinding <> lambdaGraph)
 
 -- Only used by matchesToCase
@@ -509,11 +462,11 @@ matchesToCase firstMatch@(Match srcLoc funName pats mType _ _) restOfMatches = d
     alts = fmap matchToAlt allMatches
 
 
-evalMatches :: EvalContext -> [Match] -> State IDState IconGraph
+evalMatches :: EvalContext -> [Match] -> State IDState SyntaxGraph
 evalMatches _ [] = pure mempty
 evalMatches c (firstMatch:restOfMatches) = matchesToCase firstMatch restOfMatches >>= evalMatch c
 
-evalDecl :: EvalContext -> Decl -> State IDState IconGraph
+evalDecl :: EvalContext -> Decl -> State IDState SyntaxGraph
 evalDecl c d = evaluatedDecl where
   evaluatedDecl = case d of
     pat@(PatBind _ _ _ _) -> evalPatBind c pat
@@ -522,19 +475,19 @@ evalDecl c d = evaluatedDecl where
     _ -> pure mempty
 
 drawingFromDecl :: Decl -> Drawing
-drawingFromDecl d = iconGraphToDrawing $ evalState evaluatedDecl initialIdState
+drawingFromDecl d = iconGraphToDrawing $ syntaxGraphToIconGraph $ evalState evaluatedDecl initialIdState
   where
     evaluatedDecl = evalDecl mempty d >>= showTopLevelBinds
-    showTopLevelBinds :: IconGraph -> State IDState IconGraph
+    showTopLevelBinds :: SyntaxGraph -> State IDState SyntaxGraph
-    showTopLevelBinds gr@(IconGraph _ _ _ _ binds) = do
+    showTopLevelBinds gr@(SyntaxGraph _ _ _ binds) = do
       let
         addBind (_, Left _) = pure mempty
         addBind (patName, Right port) = do
           uniquePatName <- getUniqueName patName
           let
-            icons = toNames [(uniquePatName, BindTextBoxIcon patName)]
+            icons = toNames [(uniquePatName, NameNode patName)]
             edges = [makeSimpleEdge (justName uniquePatName, port)]
-            edgeGraph = iconGraphFromIconsEdges icons edges
+            edgeGraph = syntaxGraphFromNodesEdges icons edges
           pure edgeGraph
       newGraph <- mconcat <$> mapM addBind binds
       pure $ newGraph <> gr

app/TranslateCore.hs

@@ -1,11 +1,12 @@
 module TranslateCore(
   Reference,
   IconGraph(..),
+  SyntaxGraph(..),
   EvalContext,
   GraphAndRef,
   Sink,
-  iconGraphFromIcons,
+  syntaxGraphFromNodes,
-  iconGraphFromIconsEdges,
+  syntaxGraphFromNodesEdges,
   getUniqueName,
   edgesForRefPortList,
   combineExpressions,
@@ -20,15 +21,17 @@ module TranslateCore(
   coerceExpressionResult,
   makeBox,
   nTupleString,
-  nListString
+  nListString,
+  syntaxGraphToIconGraph
 ) where
 
 import Data.Semigroup(Semigroup, (<>))
 import qualified Diagrams.Prelude as DIA
 import Control.Monad.State(State)
 import Data.Either(partitionEithers)
+import Control.Arrow(second)
 
-import Types(Icon, Edge(..), EdgeOption(..), Drawing(..), NameAndPort(..), IDState,
+import Types(Icon, SyntaxNode(..), Edge(..), EdgeOption(..), Drawing(..), NameAndPort(..), IDState,
   getId)
 import Util(noEnds, nameAndPort, makeSimpleEdge, justName)
 import Icons(Icon(..))
@@ -41,6 +44,25 @@ import Icons(Icon(..))
 -- used in Translate.
 
 type Reference = Either String NameAndPort
+
+-- | SyntaxGraph is an abstract representation for Haskell syntax. SyntaxGraphs are
+-- generated from the Haskell syntax tree, and are used to generate IconGraphs
+data SyntaxGraph = SyntaxGraph {
+  sgNodes :: [(DIA.Name, SyntaxNode)],
+  sgEdges :: [Edge],
+  sgSinks :: [(String, NameAndPort)],
+  sgSources :: [(String, Reference)]
+  } deriving (Show)
+
+instance Semigroup SyntaxGraph where
+  (SyntaxGraph icons1 edges1 sinks1 sources1) <> (SyntaxGraph icons2 edges2 sinks2 sources2) =
+    SyntaxGraph (icons1 <> icons2) (edges1 <> edges2) (sinks1 <> sinks2) (sources1 <> sources2)
+
+instance Monoid SyntaxGraph where
+  mempty = SyntaxGraph mempty mempty mempty mempty
+  mappend = (<>)
+
+-- TODO remove / change due to SyntaxGraph
 -- | An IconGraph is a normal Drawing (Icons, Edges, and sub Drawings) with two additional fields:
 -- unconected sink ports (varible usage), and unconnected source ports (varible definition).
 data IconGraph = IconGraph {
@@ -51,45 +73,45 @@ data IconGraph = IconGraph {
   igBindings :: [(String, Reference)]}
   deriving (Show)
 
-type EvalContext = [String]
-type GraphAndRef = (IconGraph, Reference)
-type Sink = (String, NameAndPort)
-
 instance Semigroup IconGraph where
   (IconGraph icons1 edges1 subDrawings1 sinks1 sources1) <> (IconGraph icons2 edges2 subDrawings2 sinks2 sources2) =
     IconGraph (icons1 <> icons2) (edges1 <> edges2) (subDrawings1 <> subDrawings2) (sinks1 <> sinks2) (sources1 <> sources2)
 
+type EvalContext = [String]
+type GraphAndRef = (SyntaxGraph, Reference)
+type Sink = (String, NameAndPort)
+
 instance Monoid IconGraph where
   mempty = IconGraph mempty mempty mempty mempty mempty
   mappend = (<>)
 
-iconGraphFromIcons :: [(DIA.Name, Icon)] -> IconGraph
+syntaxGraphFromNodes :: [(DIA.Name, SyntaxNode)] -> SyntaxGraph
-iconGraphFromIcons icons = IconGraph icons mempty mempty mempty mempty
+syntaxGraphFromNodes icons = SyntaxGraph icons mempty mempty mempty
 
-iconGraphFromIconsEdges :: [(DIA.Name, Icon)] -> [Edge] -> IconGraph
+syntaxGraphFromNodesEdges :: [(DIA.Name, SyntaxNode)] -> [Edge] -> SyntaxGraph
-iconGraphFromIconsEdges icons edges = IconGraph icons edges mempty mempty mempty
+syntaxGraphFromNodesEdges icons edges = SyntaxGraph icons edges mempty mempty
 
 getUniqueName :: String -> State IDState String
 getUniqueName base = fmap ((base ++). show) getId
 
 -- TODO: Refactor with combineExpressions
-edgesForRefPortList :: Bool -> [(Reference, NameAndPort)] -> IconGraph
+edgesForRefPortList :: Bool -> [(Reference, NameAndPort)] -> SyntaxGraph
 edgesForRefPortList inPattern portExpPairs = mconcat $ fmap mkGraph portExpPairs where
   edgeOpts = if inPattern then [EdgeInPattern] else []
   mkGraph (ref, port) = case ref of
     Left str -> if inPattern
-      then IconGraph mempty mempty mempty mempty [(str, Right port)]
+      then SyntaxGraph mempty mempty mempty [(str, Right port)]
-      else IconGraph mempty mempty mempty [(str, port)] mempty
+      else SyntaxGraph mempty mempty [(str, port)] mempty
-    Right resultPort -> IconGraph mempty [Edge edgeOpts noEnds (resultPort, port)] mempty mempty mempty
+    Right resultPort -> SyntaxGraph mempty [Edge edgeOpts noEnds (resultPort, port)] mempty mempty
 
-combineExpressions :: Bool -> [(GraphAndRef, NameAndPort)] -> IconGraph
+combineExpressions :: Bool -> [(GraphAndRef, NameAndPort)] -> SyntaxGraph
 combineExpressions inPattern portExpPairs = mconcat $ fmap mkGraph portExpPairs where
   edgeOpts = if inPattern then [EdgeInPattern] else []
   mkGraph ((graph, ref), port) = graph <> case ref of
     Left str -> if inPattern
-      then IconGraph mempty mempty mempty mempty [(str, Right port)]
+      then SyntaxGraph mempty mempty mempty [(str, Right port)]
-      else IconGraph mempty mempty mempty [(str, port)] mempty
+      else SyntaxGraph mempty mempty [(str, port)] mempty
-    Right resultPort -> IconGraph mempty [Edge edgeOpts noEnds (resultPort, port)] mempty mempty mempty
+    Right resultPort -> SyntaxGraph mempty [Edge edgeOpts noEnds (resultPort, port)] mempty mempty
 
 -- qualifyNameAndPort :: String -> NameAndPort -> NameAndPort
 -- qualifyNameAndPort s (NameAndPort n p) = NameAndPort (s DIA..> n) p
@@ -97,18 +119,18 @@ combineExpressions inPattern portExpPairs = mconcat $ fmap mkGraph portExpPairs
 iconGraphToDrawing :: IconGraph -> Drawing
 iconGraphToDrawing (IconGraph icons edges subDrawings _ _) = Drawing icons edges subDrawings
 
-makeApplyGraph :: Bool -> DIA.Name -> GraphAndRef -> [GraphAndRef] -> Int -> (IconGraph, NameAndPort)
+makeApplyGraph :: Bool -> DIA.Name -> GraphAndRef -> [GraphAndRef] -> Int -> (SyntaxGraph, NameAndPort)
 makeApplyGraph inPattern applyIconName funVal argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName 1)
   where
     argumentPorts = map (nameAndPort applyIconName) [2,3..]
     functionPort = nameAndPort applyIconName 0
     combinedGraph = combineExpressions inPattern $ zip (funVal:argVals) (functionPort:argumentPorts)
-    icons = [(applyIconName, ApplyAIcon numArgs)]
+    icons = [(applyIconName, ApplyNode numArgs)]
-    newGraph = iconGraphFromIcons icons
+    newGraph = syntaxGraphFromNodes icons
 
 namesInPattern :: GraphAndRef -> [String]
 namesInPattern (_, Left str) = [str]
-namesInPattern (IconGraph _ _ _ _ bindings, Right _) = fmap fst bindings
+namesInPattern (SyntaxGraph _ _ _ bindings, Right _) = fmap fst bindings
 
 -- | Recursivly find the matching reference in a list of bindings.
 -- TODO: Might want to present some indication if there is a reference cycle.
@@ -123,8 +145,8 @@ lookupReference bindings ref@(Left originalS) = lookupHelper ref where
       failIfCycle r@(Left newStr) res = if newStr == originalS then r else res
       failIfCycle _ res = res
 
-deleteBindings :: IconGraph -> IconGraph
+deleteBindings :: SyntaxGraph -> SyntaxGraph
-deleteBindings (IconGraph a b c d _) = IconGraph a b c d mempty
+deleteBindings (SyntaxGraph a b c _) = SyntaxGraph a b c mempty
 
 makeEdgesCore :: [Sink] -> [(String, Reference)] -> ([Sink], [Edge])
 makeEdgesCore sinks bindings = partitionEithers $ fmap renameOrMakeEdge sinks
@@ -136,28 +158,30 @@ makeEdgesCore sinks bindings = partitionEithers $ fmap renameOrMakeEdge sinks
         (Left newStr) -> Left (newStr, destPort)
       Nothing -> Left orig
 
-makeEdges :: IconGraph -> IconGraph
+makeEdges :: SyntaxGraph -> SyntaxGraph
-makeEdges (IconGraph icons edges c sinks bindings) = newGraph where
+makeEdges (SyntaxGraph icons edges sinks bindings) = newGraph where
   (newSinks, newEdges) = makeEdgesCore sinks bindings
-  newGraph = IconGraph icons (newEdges <> edges) c newSinks bindings
+  newGraph = SyntaxGraph icons (newEdges <> edges) newSinks bindings
 
+-- TODO: Remove BranchNode
 -- | This is used by the rhs for identity (eg. y x = x)
-coerceExpressionResult :: (IconGraph, Reference) -> State IDState (IconGraph, NameAndPort)
+coerceExpressionResult :: (SyntaxGraph, Reference) -> State IDState (SyntaxGraph, NameAndPort)
 coerceExpressionResult (_, Left str) = makeDummyRhs str where
-  makeDummyRhs :: String -> State IDState (IconGraph, NameAndPort)
+  makeDummyRhs :: String -> State IDState (SyntaxGraph, NameAndPort)
   makeDummyRhs s = do
     iconName <- getUniqueName s
     let
-      graph = IconGraph icons mempty mempty [(s, port)] mempty
+      graph = SyntaxGraph icons mempty [(s, port)] mempty
-      icons = [(DIA.toName iconName, BranchIcon)]
+      icons = [(DIA.toName iconName, BranchNode)]
       port = justName iconName
     pure (graph, port)
 coerceExpressionResult (g, Right x) = pure (g, x)
 
-makeBox :: String -> State IDState (IconGraph, NameAndPort)
+-- TODO: remove / change due toSyntaxGraph
+makeBox :: String -> State IDState (SyntaxGraph, NameAndPort)
 makeBox str = do
   name <- DIA.toName <$> getUniqueName str
-  let graph = iconGraphFromIcons [(DIA.toName name, TextBoxIcon str)]
+  let graph = syntaxGraphFromNodes [(DIA.toName name, LiteralNode str)]
   pure (graph, justName name)
 
 nTupleString :: Int -> String
@@ -167,3 +191,19 @@ nListString :: Int -> String
 -- TODO: Use something better than [_]
 nListString 1 = "[_]"
 nListString n = '[' : replicate (n -1) ',' ++ "]"
+
+nodeToIcon :: SyntaxNode -> Icon
+nodeToIcon (ApplyNode n) = ApplyAIcon n
+nodeToIcon (PatternApplyNode s n) = PAppIcon n s
+nodeToIcon (NameNode s) = TextBoxIcon s
+nodeToIcon (LiteralNode s) = TextBoxIcon s
+nodeToIcon (FunctionDefNode n) = FlatLambdaIcon n
+nodeToIcon (GuardNode n) = GuardIcon n
+nodeToIcon (CaseNode n) = CaseIcon n
+nodeToIcon BranchNode = BranchIcon
+nodeToIcon CaseResultNode = CaseResultIcon
+
+syntaxGraphToIconGraph :: SyntaxGraph -> IconGraph
+syntaxGraphToIconGraph (SyntaxGraph nodes edges sources sinks) =
+  IconGraph icons edges mempty sources sinks where
+    icons = fmap (second nodeToIcon) nodes

app/Types.hs

@@ -2,6 +2,7 @@
 
 module Types (
   Icon(..),
+  SyntaxNode(..),
   NameAndPort(..),
   Connection,
   Edge(..),
@@ -34,6 +35,17 @@ data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
   | NestedPApp (Maybe String) [Maybe (Name, Icon)]
   deriving (Show, Eq)
 
+data SyntaxNode = ApplyNode Int-- Function application
+  | PatternApplyNode String Int -- Destructors as used in patterns
+  | NameNode String -- Identifiers or symbols
+  | LiteralNode String -- Literal values like the string "Hello World"
+  | FunctionDefNode Int-- Function definition (ie. lambda expression)
+  | GuardNode Int
+  | CaseNode Int
+  | BranchNode -- TODO remove BranchNode
+  | CaseResultNode -- TODO remove caseResultNode
+  deriving (Show, Eq)
+
 data NameAndPort = NameAndPort Name (Maybe Int) deriving (Show, Eq)
 
 type Connection = (NameAndPort, NameAndPort)

notes.txt

@@ -15,3 +15,6 @@ stack ghci glance:test:glance-test
 For all warnings (some warnings duplicated):
 stack clean
 stack build --test --no-run-tests --ghc-options -Wall
+
+To open documentation for other libraries:
+stack haddock --open <package-name>