Translate now uses Apply0N

app/Icons.hs

@@ -156,9 +156,10 @@ apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams
 apply0PortLocations :: Floating a => [P2 a]
 apply0PortLocations = map p2 [
   (circleRadius + defaultLineWidth + triangleWidth, 0),
-  (lineCenter,circleRadius),
   (-circleRadius,0),
-  (lineCenter,-circleRadius)]
+  (lineCenter,-circleRadius)
+  --(lineCenter,circleRadius),
+  ]
   where
     triangleWidth = circleRadius * sqrt 3
     lineCenter = circleRadius + (defaultLineWidth / 2.0)
@@ -172,6 +173,7 @@ apply0NDia ::
    (RealFloat n, Typeable n, Monoid m, Semigroup m,
       TrailLike (QDiagram b V2 n m)) =>
      Int -> QDiagram b V2 n m
+apply0NDia 1 = apply0Dia
 apply0NDia n = finalDia # centerXY where
   seperation = circleRadius * 1.5
   trianglePortsCircle = hcat [

app/Main.hs

@@ -12,12 +12,13 @@ import Types(Icon(..), Drawing(..), EdgeEnd(..))
 import Translate(translateString)
 
 -- TODO Now --
--- Refactor evalApp.
+-- Update Apply0Icon ports in Main
 -- Unique names for evalMatch.
 -- Increase domain of translate.
 -- Handle duplicate names correctly.
 
 -- TODO Later --
+-- Let lines connect to ports in multiple locations (eg. argument for Apply0Dia)
 -- Add a small black border to lines to help distinguish line crossings.
 -- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
 -- todo: Find out and fix why connectinos to sub-icons need to be qualified twice (eg. "lam0" .> "arg" .> "arg")

app/Rendering.hs

@@ -13,7 +13,7 @@ import qualified Data.GraphViz as GV
 import qualified Data.GraphViz.Attributes.Complete as GVA
 --import Data.GraphViz.Commands
 import qualified Data.Map as Map
-import Data.Maybe(fromMaybe, isJust)
+import Data.Maybe(isJust)
 --import qualified Debug.Trace
 import Data.List(minimumBy)
 import Data.Function(on)

app/Translate.hs

@@ -9,7 +9,6 @@ import Diagrams.Prelude((<>))
 import Language.Haskell.Exts(Decl(..), parseDecl,
   Name(..), Pat(..), Rhs(..), Exp(..), QName(..), fromParseResult, Match(..)) --(parseFile, parse, ParseResult, Module)
 import Control.Monad.State(State, evalState)
-import Data.List(elemIndex)
 
 import Types(Icon, Edge(..), Drawing(..), NameAndPort(..), IDState,
   initialIdState, getId)
@@ -46,36 +45,46 @@ evalQName (UnQual n) context = result where
     else Right (graph, justName nameString)
 -- TODO other cases
 
-evalApp :: Exp -> Exp -> EvalContext -> State IDState (Either String (IconGraph, NameAndPort))
-evalApp exp1 exp2 c = do -- State Monad
-  funVal <- evalExp exp1 c
-  argVal <- evalExp exp2 c
+evalApp :: (Exp, [Exp]) -> EvalContext -> State IDState (Either String (IconGraph, NameAndPort))
+evalApp (funExp, argExps) c = do -- State Monad
+  funVal <- evalExp c funExp
+  argVals <- mapM (evalExp c) argExps
   newId <- getId
   let
+    -- TODO this can be refactored to return just a new graph with the added boundVar, or edge.
+    getGraph :: (Monoid str, Monoid gr) => NameAndPort -> Either str (gr, NameAndPort) -> (gr, [Edge], [(str, NameAndPort)])
     getGraph port val = case val of
       Left s -> (mempty, mempty, [(s, port)])
       Right (gr, p) -> (gr, [Edge (p, port) noEnds], mempty)
 
     functionPort = nameAndPort applyIconName 0
     (funGr, funEdges, funBoundVars) = getGraph functionPort funVal
-    argumentPort = nameAndPort applyIconName 1
-    (argGr, argEdges, argBoundVars) = getGraph argumentPort argVal
-    newGraph = IconGraph icons (funEdges <> argEdges) mempty (funBoundVars <> argBoundVars)
+    argumentPorts = map (nameAndPort applyIconName) [2,3..]
+    (argGraphList, argEdgeList, argBoundVarList) = unzip3 $ zipWith getGraph argumentPorts argVals
+    (argGraphs, argEdges, argBoundVars) = (mconcat argGraphList, mconcat argEdgeList, mconcat argBoundVarList)
     applyIconName = DIA.toName $ "app0" ++ show newId
-    icons = [(applyIconName, Apply0Icon)]
-  pure $ Right (newGraph <> funGr <> argGr, nameAndPort applyIconName 2)
+    icons = [(applyIconName, Apply0NIcon (length argExps))]
+    newGraph = IconGraph icons (funEdges <> argEdges) mempty (funBoundVars <> argBoundVars)
+  pure $ Right (newGraph <> funGr <> argGraphs, nameAndPort applyIconName 1)
 
-evalExp :: Exp  -> EvalContext -> State IDState (Either String (IconGraph, NameAndPort))
-evalExp x c = case x of
+-- TODO add test for this function
+simplifyApp :: Exp -> (Exp, [Exp])
+simplifyApp (App exp1 exp2) = (funExp, args <> [exp2])
+  where
+    (funExp, args) = simplifyApp exp1
+simplifyApp e = (e, [])
+
+evalExp :: EvalContext  -> Exp -> State IDState (Either String (IconGraph, NameAndPort))
+evalExp c x = case x of
   Var n -> pure $ evalQName n c
-  App exp1 exp2 -> evalApp exp1 exp2 c
-  Paren e -> evalExp e c
+  e@App{} -> evalApp (simplifyApp e) c
+  Paren e -> evalExp c e
   -- TODO other cases
 
 -- | First argument is the right hand side.
 -- The second arugement is a list of strings that are bound in the environment.
 evalRhs :: Rhs -> EvalContext -> (IconGraph, NameAndPort)
-evalRhs (UnGuardedRhs e) scope = case evalState (evalExp e scope) initialIdState of
+evalRhs (UnGuardedRhs e) scope = case evalState (evalExp scope e) initialIdState of
   Left _ -> error "rhs result expression is a bound var."
   Right x -> x
 -- TODO implement other cases.