Fix diagram naming and qualification. Remove Apply0Icon.

app/Icons.hs

@@ -2,7 +2,7 @@
 module Icons
     (
     Icon(..),
-    apply0Dia,
+    apply0NDia,
     iconToDiagram,
     nameDiagram,
     textBox,
@@ -10,7 +10,6 @@ module Icons
     lambdaRegion,
     resultIcon,
     guardIcon,
-    apply0NDia,
     defaultLineWidth,
     ColorStyle(..),
     colorScheme
@@ -19,10 +18,10 @@ module Icons
 import Diagrams.Prelude
 -- import Diagrams.Backend.SVG(B)
 import Diagrams.TwoD.Text(Text)
-import Data.Maybe (fromMaybe)
 import Data.Typeable(Typeable)
 
 import Types(Icon(..))
+import Util(fromMaybeError)
 
 -- COLO(U)RS --
 colorScheme :: (Floating a, Ord a) => ColorStyle a
@@ -89,7 +88,6 @@ iconToDiagram ::
    (RealFloat n, Typeable n, Renderable (Path V2 n) b,
       Renderable (Text n) b) =>
      Icon -> [(Name, QDiagram b V2 n Any)] -> QDiagram b V2 n Any
-iconToDiagram Apply0Icon _ = apply0Dia
 iconToDiagram (Apply0NIcon n) _ = apply0NDia n
 iconToDiagram ResultIcon _ = resultIcon
 iconToDiagram BranchIcon _ = branchIcon
@@ -98,11 +96,11 @@ iconToDiagram (GuardIcon n) _ = guardIcon n
 iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
   lambdaRegion n dia
   where
-    dia = fromMaybe (error "iconToDiagram: subdiagram not found") $ lookup diagramName nameToSubdiagramMap
+    dia = fromMaybeError "iconToDiagram: subdiagram not found" $ lookup diagramName nameToSubdiagramMap
 
 -- | Names the diagram and puts all sub-names in the namespace of the top level name.
 nameDiagram :: (Floating n, Ord n, Semigroup m, Metric v, IsName nm) => nm -> QDiagram b v n m -> QDiagram b v n m
-nameDiagram name dia = name .>> (dia # named name)
+nameDiagram name dia = named name (name .>> dia)
 
 -- | Make an port with an integer name. Always use <> to add a ports (not === or |||)
 --- since mempty has no size and will not be placed where you want it.
@@ -176,9 +174,10 @@ apply0NDia ::
 apply0NDia 1 = apply0Dia
 apply0NDia n = finalDia # centerXY where
   seperation = circleRadius * 1.5
+  portCircle = circle (circleRadius * 0.5) # fc lineCol # lw none
   trianglePortsCircle = hcat [
     reflectX apply0Triangle,
-    hcat $ take n $ map (\x -> makePort x <> circle (circleRadius * 0.5) # fc lineCol  <> strutX seperation) [2,3..],
+    hcat $ take n $ map (\x -> makePort x <> portCircle <> strutX seperation) [2,3..],
     makePort 1 <> alignR (circle circleRadius # fc (apply0C colorScheme) # lwG defaultLineWidth # lc (apply0C colorScheme))
     ]
   allPorts = makePort 0 <> alignL trianglePortsCircle
@@ -209,7 +208,7 @@ coloredTextBox ::
      -> AlphaColour Double -> String -> QDiagram b V2 n Any
 coloredTextBox textColor boxColor t =
   text t # fc textColor # font "freemono" # bold # fontSize (local textBoxFontSize)
-  <> rect rectangleWidth (textBoxFontSize * textBoxHeightFactor) # lcA boxColor
+  <> rect rectangleWidth (textBoxFontSize * textBoxHeightFactor) # lcA boxColor # lwG (0.6 * defaultLineWidth)
   where
     rectangleWidth = textBoxFontSize * monoLetterWidthToHeightFraction
       * fromIntegral (length t)

app/Main.hs

@@ -12,10 +12,9 @@ import Types(Icon(..), Drawing(..), EdgeEnd(..))
 import Translate(translateString)
 
 -- TODO Now --
--- Update Apply0Icon ports in Main
+-- Make arrows scale variant. They are too big for large diagrams.
 -- Unique names for evalMatch.
 -- Handle duplicate names correctly.
--- Fix BranchIcon name being duplicated.
 
 -- TODO Later --
 -- Eliminate BranchIcon for the identity funciton "y x = x"
@@ -29,8 +28,8 @@ import Translate(translateString)
 
 (d0A, d0B, d0Res, d0Foo, d0Bar) = ("A", "B", "res", "foo", "bar")
 d0Icons = toNames
-  [(d0A, Apply0Icon),
+  [(d0A, Apply0NIcon 1),
-  (d0B, Apply0Icon),
+  (d0B, Apply0NIcon 1),
   (d0Res, ResultIcon),
   (d0Foo, TextBoxIcon d0Foo),
   (d0Bar, TextBoxIcon d0Bar)
@@ -38,12 +37,12 @@ d0Icons = toNames
 
 d0Edges =
   [
-  portToPort d0A 0 d0B 2,
+  portToPort d0A 0 d0B 1,
   iconToPort d0Foo d0B 0,
-  iconToPort d0Res d0A 2,
+  iconToPort d0Res d0A 1,
   iconToPort d0Foo d0B 0,
-  iconToPort d0Bar d0B 3,
+  iconToPort d0Bar d0B 2,
-  iconToPort d0Bar d0A 3
+  iconToPort d0Bar d0A 2
   ]
 
 drawing0 = Drawing d0Icons d0Edges []
@@ -108,10 +107,10 @@ fact0Icons = toNames
   (fOne, TextBoxIcon "1"),
   (fEq0, TextBoxIcon "== 0"),
   (fMinus1, TextBoxIcon fMinus1),
-  (fEq0Ap, Apply0Icon),
+  (fEq0Ap, Apply0NIcon 1),
-  (fMinus1Ap, Apply0Icon),
+  (fMinus1Ap, Apply0NIcon 1),
   (fTimes, TextBoxIcon fTimes),
-  (fRecurAp, Apply0Icon),
+  (fRecurAp, Apply0NIcon 1),
   (fTimesAp, Apply0NIcon 2),
   (fArg, BranchIcon),
   (fRes, ResultIcon)
@@ -119,16 +118,16 @@ fact0Icons = toNames
 
 fact0Edges = [
     iconToPort fEq0 fEq0Ap 0,
-    portToPort fEq0Ap 2 fG0 3,
+    portToPort fEq0Ap 1 fG0 3,
     iconToPort fMinus1 fMinus1Ap 0,
     iconToPort fTimes fTimesAp 0,
     iconToPort fOne fG0 2,
-    portToPort fTimesAp 1 fG0 4,
+    portToPort fTimesAp 2 fG0 4,
-    portToPort fRecurAp 2 fTimesAp 3,
+    portToPort fRecurAp 1 fTimesAp 3,
-    iconToPort fArg fEq0Ap 1,
+    iconToPort fArg fEq0Ap 2,
-    iconToPort fArg fMinus1Ap 1,
+    iconToPort fArg fMinus1Ap 2,
-    iconToPort fArg fTimesAp 2,
+    iconToPort fArg fTimesAp 1,
-    portToPort fMinus1Ap 2 fRecurAp 1,
+    portToPort fMinus1Ap 1 fRecurAp 2,
     iconToPort fRes fG0 0
   ]
 
@@ -141,7 +140,7 @@ factLam0Icons = toNames [
   ]
 
 factLam0Edges = [
-  iconToPort ("lam0" .> fArg .> fArg) "lam0" 0,
+  iconToPort ("lam0" .> fArg) "lam0" 0,
   iconToPort "lam0" ("lam0" .> fRecurAp) 0,
   iconToIcon "lam0" "fac"
   ]
@@ -155,7 +154,7 @@ fact1Icons = toNames
   (fEq0, TextBoxIcon "== 0"),
   (fMinus1, TextBoxIcon fMinus1),
   (fTimes, TextBoxIcon fTimes),
-  (fRecurAp, Apply0Icon),
+  (fRecurAp, Apply0NIcon 1),
   (fTimesAp, Apply0NIcon 2),
   (fArg, BranchIcon),
   (fRes, ResultIcon)
@@ -165,11 +164,11 @@ fact1Edges = [
   iconToIconEnds fArg EndNone fEq0 EndAp1Arg,
   iconTailToPort fEq0 EndAp1Result fG0 3,
   iconToIconEnds fArg EndNone fMinus1 EndAp1Arg,
-  iconTailToPort fMinus1 EndAp1Result fRecurAp 1,
+  iconTailToPort fMinus1 EndAp1Result fRecurAp 2,
   iconToPort fTimes fTimesAp 0,
   iconToPort fOne fG0 2,
   portToPort fTimesAp 1 fG0 4,
-  portToPort fRecurAp 2 fTimesAp 3,
+  portToPort fRecurAp 1 fTimesAp 3,
   iconToPort fArg fTimesAp 2,
   iconToPort fRes fG0 0
   ]
@@ -187,7 +186,7 @@ fact2Icons = toNames
   (fEq0, TextBoxIcon "== 0"),
   (fMinus1, TextBoxIcon fMinus1),
   (fTimes, TextBoxIcon fTimes),
-  (fRecurAp, Apply0Icon),
+  (fRecurAp, Apply0NIcon 1),
   (fTimesAp, Apply0NIcon 2),
   --(fArg, BranchIcon),
   (fRes, ResultIcon)
@@ -199,11 +198,11 @@ fact2Edges = [
   iconTailToPort fEq0 EndAp1Result fG0 3,
   --iconToIconEnds fArg EndNone fMinus1 EndAp1Arg,
   iconTailToPort fMinus1 EndAp1Arg fTimesAp 2,
-  iconTailToPort fMinus1 EndAp1Result fRecurAp 1,
+  iconTailToPort fMinus1 EndAp1Result fRecurAp 2,
   iconToPort fTimes fTimesAp 0,
   iconToPort fOne fG0 2,
   portToPort fTimesAp 1 fG0 4,
-  portToPort fRecurAp 2 fTimesAp 3,
+  portToPort fRecurAp 1 fTimesAp 3,
   --iconToPort fArg fTimesAp 2,
   iconToPort fRes fG0 0
   ]
@@ -237,11 +236,31 @@ arrowTestDrawing = Drawing arrowTestIcons arrowTestEdges []
 
 main1 :: IO ()
 main1 = do
-  placedNodes <- renderDrawing factLam1Drawing
+  placedNodes <- renderDrawing factLam0Drawing
   mainWith ((placedNodes # bgFrame 1 (backgroundC colorScheme)) :: Diagram B)
 
 main2 = mainWith ((apply0NDia 3 # bgFrame 0.1 black)  :: Diagram B)
 
+main3 :: IO ()
+main3 = do
+  renderedDiagrams <- mapM renderDrawing allDrawings
+  let vCattedDrawings = vcat' (with & sep .~ 0.5) renderedDiagrams
+  mainWith ((vCattedDrawings # bgFrame 1 (backgroundC colorScheme)) :: Diagram B)
+  where
+    allDrawings = [
+      drawing0,
+      superDrawing,
+      super2Drawing,
+      super3Drawing,
+      fact0Drawing,
+      factLam0Drawing,
+      fact1Drawing,
+      factLam1Drawing,
+      fact2Drawing,
+      factLam2Drawing,
+      arrowTestDrawing
+      ]
+
 testDecls = [
   --"y = (\x -> x)",
   "y x = x",
@@ -270,11 +289,11 @@ translateStringToDrawing s = do
   putStr "\n\n"
   renderDrawing drawing
 
-main3 :: IO ()
+main4 :: IO ()
-main3 = do
+main4 = do
   drawings <- mapM translateStringToDrawing testDecls
   let vCattedDrawings = vcat' (with & sep .~ 0.5) drawings
   mainWith ((vCattedDrawings # bgFrame 1 (backgroundC colorScheme)) :: Diagram B)
 
 main :: IO ()
-main = main3
+main = main4

app/Rendering.hs

@@ -188,7 +188,7 @@ rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
           getPortPoint :: Int -> P2 Double
           getPortPoint x =
             -- TODO remove partial function head.
-            head $ fromMaybeError "port not found" (lookup (name .> x) ports)
+            head $ fromMaybeError ("port not found. Port: " ++ show name ++ ".> " ++ show x ++ ". Valid ports: " ++ show ports) (lookup (name .> x) ports)
 
           makePortEdge :: (Int, Name, Maybe Int) -> (P2 Double, P2 Double)
           makePortEdge (portInt, otherIconName, _) =

app/Translate.hs

@@ -84,8 +84,7 @@ evalExp c x = case x of
 -- | This is used by the rhs for identity (eg. y x = x)
 makeDummyRhs :: String -> (IconGraph, NameAndPort)
 makeDummyRhs s = (graph, port) where
-  -- TODO fix BranchIcon naming such that (s DIA..> s) can be s.
+  graph = IconGraph icons [] [] [(s, justName s)]
-  graph = IconGraph icons [] [] [(s, NameAndPort (s DIA..> s) Nothing)]
   icons = [(DIA.toName s, BranchIcon)]
   port = justName s
 

app/Types.hs

@@ -21,7 +21,7 @@ import Control.Monad.State(State, state)
 -- The TextBoxIcon's data is the text that appears in the text box.
 -- The LambdaRegionIcon's data is the number of lambda ports, and the name of it's
 -- subdrawing.
-data Icon = Apply0Icon | ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
+data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
   | LambdaRegionIcon Int Name | Apply0NIcon Int
   deriving (Show)