Add NameAndPort data type. Translate works with simple functions.

app/Main.hs

@@ -240,8 +240,9 @@ main2 = mainWith ((apply0NDia 3 # bgFrame 0.1 black)  :: Diagram B)
 main3 :: IO ()
 main3 = do
   let
-    (drawing, decl) = translateString "y2 = x1"
+    (drawing, decl) = translateString "y2 = f x1 x2 x3 x4"
   print decl
+  print drawing
   placedNodes <- renderDrawing drawing
   mainWith ((placedNodes # bgFrame 1 (backgroundC colorScheme)) :: Diagram B)
 

app/Rendering.hs

@@ -21,7 +21,7 @@ import Data.Graph.Inductive.PatriciaTree (Gr)
 import Data.Typeable(Typeable)
 
 import Icons(colorScheme, Icon(..), iconToDiagram, nameDiagram, defaultLineWidth, ColorStyle(..))
-import Types(Edge(..), Connection, Drawing(..), EdgeEnd(..))
+import Types(Edge(..), Connection, Drawing(..), EdgeEnd(..), NameAndPort(..))
 
 -- If the inferred types for these functions becomes unweildy,
 -- try using PartialTypeSignitures.
@@ -45,10 +45,10 @@ makeNamedMap subDiagramMap =
   map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap # nameDiagram name))
 
 -- | Make an inductive Graph from a list of node names, and a list of Connections.
-edgesToGraph :: (Ord v) => [v] -> [(v, t, v , t1)] -> Gr v ()
+edgesToGraph :: [Name] -> [(NameAndPort, NameAndPort)] -> Gr Name ()
 edgesToGraph iconNames edges = mkGraph iconNames simpleEdges
   where
-    simpleEdges = map (\(a, _, c, _) -> (a, c, ())) edges
+    simpleEdges = map (\(NameAndPort a _, NameAndPort c _) -> (a, c, ())) edges
 
 -- | Custom arrow tail for the arg1 result circle.
 -- The ArrowHT type does not seem to be documented.
@@ -87,16 +87,16 @@ getArrowOpts (t, h) = arrowOptions
 connectMaybePorts ::
    (RealFloat n, Typeable n, Renderable (Path V2 n) b) =>
      Edge -> QDiagram b V2 n Any -> QDiagram b V2 n Any
-connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) ends) =
+connectMaybePorts (Edge (NameAndPort icon0 (Just port0), NameAndPort icon1 (Just port1)) ends) =
   connect'
   (getArrowOpts ends)
   (icon0 .> port0)
   (icon1 .> port1)
-connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) ends) =
+connectMaybePorts (Edge (NameAndPort icon0 Nothing, NameAndPort icon1 (Just port1)) ends) =
   connectOutside' (getArrowOpts ends) icon0 (icon1 .> port1)
-connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) ends) =
+connectMaybePorts (Edge (NameAndPort icon0 (Just port0), NameAndPort icon1 Nothing) ends) =
   connectOutside' (getArrowOpts ends) (icon0 .> port0) icon1
-connectMaybePorts (Edge (icon0, Nothing, icon1, Nothing) ends) =
+connectMaybePorts (Edge (NameAndPort icon0 Nothing, NameAndPort icon1 Nothing) ends) =
   connectOutside' (getArrowOpts ends) icon0 icon1
 
 makeConnections ::
@@ -152,8 +152,8 @@ connectedPorts :: [Connection] -> Name -> [(Int, Name, Maybe Int)]
 connectedPorts edges name = map edgeToPort $ filter nameInEdge edges
   where
     isPort = isJust
-    nameInEdge (name1, port1, name2, port2) = (name == name1 && isPort port1) || (name == name2 && isPort port2)
-    edgeToPort (name1, port1, name2, port2) =
+    nameInEdge (NameAndPort name1 port1, NameAndPort name2 port2) = (name == name1 && isPort port1) || (name == name2 && isPort port2)
+    edgeToPort (NameAndPort name1 port1, NameAndPort name2 port2) =
       if name == name1
         then (fromMaybeError "connectedPorts: port is Nothing" port1, name2, port2)
         else (fromMaybeError "connectedPorts: port is Nothing" port2, name1, port1)

app/Translate.hs

@@ -4,48 +4,86 @@ module Translate(
 ) where
 
 import qualified Diagrams.Prelude as DIA
+import Diagrams.Prelude((<>))
 
-import Language.Haskell.Exts(Match(..), Decl(..), parseDecl, ParseResult(..),
+import Language.Haskell.Exts(Decl(..), parseDecl,
   Name(..), Pat(..), Rhs(..), Exp(..), QName(..), fromParseResult) --(parseFile, parse, ParseResult, Module)
 
-import Types(Icon, Edge, Drawing(..))
-import Util(toNames, iconToIcon)
+import Types(Icon, Edge(..), Drawing(..), NameAndPort)
+import Util(toNames, noEnds, nameAndPort, justName)
 import Icons(Icon(..))
 
+data IconGraph = IconGraph [(DIA.Name, Icon)] [Edge]
+
+instance DIA.Semigroup IconGraph where
+  (IconGraph x1 y1) <> (IconGraph x2 y2) = IconGraph (x1 <> x2) (y1 <> y2)
+
+instance Monoid IconGraph where
+  mempty = IconGraph [] []
+  mappend = (<>)
+
+--instance
+
+nameToString :: Language.Haskell.Exts.Name -> String
 nameToString (Ident s) = s
 nameToString (Symbol s) = s
 
+evalPattern :: Pat -> String
 evalPattern p = case p of
   PVar n -> nameToString n
   -- TODO other cases
 
-evalMatch (Match _ name patterns _ _ _) = res where
-  patternStrings = map evalPattern patterns
-  matchName = nameToString name
-  res = (matchName, patternStrings)
+-- evalMatch :: Match -> (String, [String])
+-- evalMatch (Match _ name patterns _ _ _) = res where
+--   patternStrings = map evalPattern patterns
+--   matchName = nameToString name
+--   res = (matchName, patternStrings)
 
-evalQName (UnQual n) = nameToString n
+evalQName :: QName -> (IconGraph, NameAndPort)
+evalQName (UnQual n) = (graph, justName nameString) where
+  nameString = nameToString n
+  graph = IconGraph [(DIA.toName nameString, TextBoxIcon nameString)] []
 -- TODO other cases
 
-evalVar x = case x of
+evalApp :: Int -> (IconGraph, NameAndPort) -> (IconGraph, NameAndPort) -> (IconGraph, NameAndPort)
+evalApp uniqueInt (funGr, funNamePort) (argGr, argNamePort) =
+  (newGraph <> funGr <> argGr, nameAndPort applyIconName 2)
+    where
+      newGraph = IconGraph icons edges
+      -- TODO figure out unique names for the apply icons
+      applyIconString = "app0" ++ show uniqueInt
+      applyIconName = DIA.toName applyIconString
+      icons = [(applyIconName, Apply0Icon)]
+      edges = [
+        Edge (funNamePort, nameAndPort applyIconName 0) noEnds,
+        Edge (argNamePort, nameAndPort applyIconName 1) noEnds
+        ]
+
+evalExp :: Int -> Exp -> (IconGraph, NameAndPort)
+evalExp uniqueInt x = case x of
   Var n -> evalQName n
+  App exp1 exp2 -> evalApp uniqueInt (evalExp (uniqueInt + 1) exp1) (evalExp 0 exp2)
   -- TODO other cases
 
-evalRhs (UnGuardedRhs e) = evalVar e
+evalRhs :: Rhs -> (IconGraph, NameAndPort)
+evalRhs (UnGuardedRhs e) = evalExp 0 e
 evalRhs (GuardedRhss _) = error "GuardedRhss not implemented"
 
-evalPatBind :: Decl -> ([(DIA.Name, Icon)], [Edge])
-evalPatBind (PatBind _ pat rhs binds) = (icons, edges) where
+evalPatBind :: Decl -> IconGraph
+evalPatBind (PatBind _ pat rhs binds) = graph <> rhsGraph where
   patName = evalPattern pat
-  rhsName = evalRhs rhs
+  (rhsGraph, rhsNamePort) = evalRhs rhs
   icons = toNames [
-    (patName, TextBoxIcon patName),
-    (rhsName, TextBoxIcon rhsName)
+    (patName, TextBoxIcon patName)
+    --(rhsName, TextBoxIcon rhsName)
     ]
   edges = [
-    iconToIcon patName rhsName
-    ]
+    -- TODO use port here
+     Edge (justName patName, rhsNamePort) noEnds
+     ]
+  graph = IconGraph icons edges
 
+evalDecl :: Decl -> IconGraph
 evalDecl d = case d of
   pat@PatBind{} -> evalPatBind pat
   -- TODO other cases
@@ -54,5 +92,5 @@ translateString :: String -> (Drawing, Decl)
 translateString s = (drawing, decl) where
   parseResult = parseDecl s -- :: ParseResult Module
   decl = fromParseResult parseResult
-  (icons, edges) = evalDecl decl
+  IconGraph icons edges = evalDecl decl
   drawing = Drawing icons edges []

app/Types.hs

@@ -12,15 +12,19 @@ import Diagrams.Prelude(Name)
 -- subdrawing.
 data Icon = Apply0Icon | ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
   | LambdaRegionIcon Int Name | Apply0NIcon Int
+  deriving (Show)
 
-type Connection = (Name, Maybe Int, Name, Maybe Int)
+data NameAndPort = NameAndPort Name (Maybe Int) deriving (Show)
+
+type Connection = (NameAndPort, NameAndPort)
 
 -- | An Edge has an name of the source icon, and its optional port number,
 -- and the name of the destination icon, and its optional port number.
 data Edge = Edge {edgeConnection :: Connection, edgeEnds :: (EdgeEnd, EdgeEnd)}
+  deriving (Show)
 
-data EdgeEnd = EndAp1Result | EndAp1Arg | EndNone
+data EdgeEnd = EndAp1Result | EndAp1Arg | EndNone deriving (Show)
 
 -- | A drawing is a map from names to Icons, a list of edges,
 -- and a map of names to subDrawings
-data Drawing = Drawing [(Name, Icon)] [Edge] [(Name, Drawing)]
+data Drawing = Drawing [(Name, Icon)] [Edge] [(Name, Drawing)] deriving (Show)

app/Util.hs

@@ -5,15 +5,18 @@ module Util (
   iconToPort,
   iconToIcon,
   iconToIconEnds,
-  iconHeadToPort,
+  --iconHeadToPort,
   iconTailToPort,
-  toNames
+  toNames,
+  noEnds,
+  nameAndPort,
+  justName
 )where
 
 import Control.Arrow(first)
 import Diagrams.Prelude(IsName, toName, Name)
 
-import Types(EdgeEnd(..), Edge(..))
+import Types(EdgeEnd(..), Edge(..), NameAndPort(..))
 
 mapFst :: (a -> b) -> [(a, c)] -> [(b, c)]
 mapFst f = map (first f)
@@ -24,24 +27,30 @@ toNames = mapFst toName
 noEnds :: (EdgeEnd, EdgeEnd)
 noEnds = (EndNone, EndNone)
 
+nameAndPort :: IsName a => a -> Int -> NameAndPort
+nameAndPort n p = NameAndPort (toName n) (Just p)
+
+justName :: IsName a => a -> NameAndPort
+justName n = NameAndPort (toName n) Nothing
+
 -- Edge constructors --
 portToPort :: (IsName a, IsName b) => a -> Int -> b -> Int -> Edge
-portToPort a b c d = Edge (toName a, Just b, toName c, Just d) noEnds
+portToPort a b c d = Edge (nameAndPort a b, nameAndPort c d) noEnds
 
 iconToPort :: (IsName a, IsName b) => a -> b -> Int -> Edge
-iconToPort a   c d = Edge (toName a, Nothing, toName c, Just d) noEnds
+iconToPort a   c d = Edge (justName a, nameAndPort c d) noEnds
 
 iconToIcon :: (IsName a, IsName b) => a -> b -> Edge
-iconToIcon a   c   = Edge (toName a, Nothing, toName c, Nothing) noEnds
+iconToIcon a   c   = Edge (justName a, justName c) noEnds
 
 
 -- If there are gaps between the arrow and the icon, try switching the first two arguments
 -- with the last two arguments
 iconToIconEnds :: (IsName a, IsName b) => a -> EdgeEnd -> b -> EdgeEnd -> Edge
-iconToIconEnds a b c d = Edge (toName a, Nothing, toName c, Nothing) (b, d)
+iconToIconEnds a b c d = Edge (justName a, justName c) (b, d)
 
-iconHeadToPort :: (IsName a, IsName b) => a -> EdgeEnd -> b -> Int -> Edge
-iconHeadToPort a endHead c d = Edge (toName a, Nothing, toName c, Just d) (EndNone, endHead)
+-- iconHeadToPort :: (IsName a, IsName b) => a -> EdgeEnd -> b -> Int -> Edge
+-- iconHeadToPort a endHead c d = Edge (justName a, nameAndPort c d) (EndNone, endHead)
 
 iconTailToPort :: (IsName a, IsName b) => a -> EdgeEnd -> b -> Int -> Edge
-iconTailToPort a endTail c d = Edge (toName a, Nothing, toName c, Just d) (endTail, EndNone)
+iconTailToPort a endTail c d = Edge (justName a, nameAndPort c d) (endTail, EndNone)