Use State monad for unique ids.

app/Main.hs

@@ -247,4 +247,4 @@ main3 = do
   mainWith ((placedNodes # bgFrame 1 (backgroundC colorScheme)) :: Diagram B)
 
 main :: IO ()
-main = main1
+main = main3

app/Translate.hs

@@ -8,8 +8,10 @@ import Diagrams.Prelude((<>))
 
 import Language.Haskell.Exts(Decl(..), parseDecl,
   Name(..), Pat(..), Rhs(..), Exp(..), QName(..), fromParseResult) --(parseFile, parse, ParseResult, Module)
+import Control.Monad.State(State, evalState)
 
-import Types(Icon, Edge(..), Drawing(..), NameAndPort)
+import Types(Icon, Edge(..), Drawing(..), NameAndPort, IDState,
+  initialIdState, getId)
 import Util(toNames, noEnds, nameAndPort, justName)
 import Icons(Icon(..))
 
@@ -45,32 +47,35 @@ evalQName (UnQual n) = (graph, justName nameString) where
   graph = IconGraph [(DIA.toName nameString, TextBoxIcon nameString)] []
 -- TODO other cases
 
-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
-        ]
+evalApp :: Exp -> Exp -> State IDState (IconGraph, NameAndPort)
+evalApp exp1 exp2 = do -- State Monad
+  (funGr, funNamePort) <- evalExp exp1
+  (argGr, argNamePort) <- evalExp exp2
+  newId <- getId
+  let
+    newGraph = IconGraph icons edges
+    -- TODO figure out unique names for the apply icons
+    applyIconString = "app0" ++ show newId
+    applyIconName = DIA.toName applyIconString
+    icons = [(applyIconName, Apply0Icon)]
+    edges = [
+      Edge (funNamePort, nameAndPort applyIconName 0) noEnds,
+      Edge (argNamePort, nameAndPort applyIconName 1) noEnds
+      ]
+  pure (newGraph <> funGr <> argGr, nameAndPort applyIconName 2)
 
-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)
+evalExp :: Exp -> State IDState (IconGraph, NameAndPort)
+evalExp x = case x of
+  Var n -> pure $ evalQName n
+  App exp1 exp2 -> evalApp exp1 exp2
   -- TODO other cases
 
 evalRhs :: Rhs -> (IconGraph, NameAndPort)
-evalRhs (UnGuardedRhs e) = evalExp 0 e
+evalRhs (UnGuardedRhs e) = evalState (evalExp e) initialIdState
 evalRhs (GuardedRhss _) = error "GuardedRhss not implemented"
 
 evalPatBind :: Decl -> IconGraph
-evalPatBind (PatBind _ pat rhs binds) = graph <> rhsGraph where
+evalPatBind (PatBind _ pat rhs _) = graph <> rhsGraph where
   patName = evalPattern pat
   (rhsGraph, rhsNamePort) = evalRhs rhs
   icons = toNames [

app/Types.hs

@@ -1,8 +1,19 @@
 {-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
 
-module Types where
+module Types (
+  Icon(..),
+  NameAndPort(..),
+  Connection(..),
+  Edge(..),
+  EdgeEnd(..),
+  Drawing(..),
+  IDState,
+  initialIdState,
+  getId
+) where
 
 import Diagrams.Prelude(Name)
+import Control.Monad.State(State, state)
 
 -- TYPES --
 -- | A datatype that represents an icon.
@@ -28,3 +39,12 @@ 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)] deriving (Show)
+
+-- | IDState is an Abstract Data Type that is used as a state whose value is a unique id.
+newtype IDState = IDState Int deriving (Eq, Show)
+
+initialIdState :: IDState
+initialIdState = IDState 0
+
+getId :: State IDState Int
+getId = state (\(IDState x) -> (x, IDState (x + 1)))

glance.cabal

@@ -33,6 +33,7 @@ executable glance-exe
                      , containers
                      , fgl
                      , haskell-src-exts
+                     , mtl
   default-language:    Haskell2010
   Other-modules: Icons, Rendering, Types, Util, Translate