Change icon transformation to make it more composable.

app/Icons.hs

@@ -109,7 +109,7 @@ randomColorScheme = ColorStyle {
 lineCol :: (Floating a, Ord a) => Colour a
 lineCol = lineC colorScheme
 
-type TransformableDia a b c d = (Bool -> Float -> QDiagram a b c d)
+type TransformableDia a b c d = (Bool -> Double -> QDiagram a b c d)
 
 -- FUNCTIONS --
 -- Optimization: The apply0NDia's can be memoized.
@@ -118,35 +118,36 @@ type TransformableDia a b c d = (Bool -> Float -> QDiagram a b c d)
 --       Renderable (Text n) b) =>
 --      Icon -> [(Name, QDiagram b V2 n Any)] -> TransformableDia b V2 n Any
 iconToDiagram ::_ =>
-  Icon -> [(Name, QDiagram b V2 Double Any)] -> nm -> Bool -> Double -> QDiagram b V2 Double Any
-iconToDiagram (ApplyAIcon n) _ = makeSymmetricTransDia $ applyADia n
-iconToDiagram (PAppIcon n str) _ = makeRotateSymmetricTransDia $ pAppDia n str
-iconToDiagram (TextApplyAIcon n str) _ = makeRotateSymmetricTransDia $ textApplyADia n str
-iconToDiagram ResultIcon _ = makeSymmetricTransDia resultIcon
-iconToDiagram BranchIcon _ = makeSymmetricTransDia branchIcon
-iconToDiagram (TextBoxIcon s) _ = makeSymmetricTransDia $ textBox s
-iconToDiagram (BindTextBoxIcon s) _ = makeSymmetricTransDia $ bindTextBox s
-iconToDiagram (GuardIcon n) _ = makeTransformableDia $ guardIcon n
-iconToDiagram (CaseIcon n) _ = makeTransformableDia $ caseIcon n
-iconToDiagram CaseResultIcon _ = makeSymmetricTransDia caseResult
-iconToDiagram (FlatLambdaIcon n) _ = makeSymmetricTransDia $ flatLambda n
+  Icon -> [(Name, QDiagram b V2 Double Any)] -> Bool -> Double -> QDiagram b V2 Double Any
+iconToDiagram (ApplyAIcon n) _ = identDiaFunc $ applyADia n
+iconToDiagram (PAppIcon n str) _ = diaFunc $ pAppDia n str
+iconToDiagram (TextApplyAIcon n str) _ = diaFunc $ textApplyADia n str
+iconToDiagram ResultIcon _ = identDiaFunc resultIcon
+iconToDiagram BranchIcon _ = identDiaFunc branchIcon
+iconToDiagram (TextBoxIcon s) _ = identDiaFunc $ textBox s
+iconToDiagram (BindTextBoxIcon s) _ = identDiaFunc $ bindTextBox s
+iconToDiagram (GuardIcon n) _ = identDiaFunc $ guardIcon n
+iconToDiagram (CaseIcon n) _ = identDiaFunc $ caseIcon n
+iconToDiagram CaseResultIcon _ = identDiaFunc caseResult
+iconToDiagram (FlatLambdaIcon n) _ = identDiaFunc $ flatLambda n
 iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
-  makeTransformableDia $ lambdaRegion n dia
+  identDiaFunc $ lambdaRegion n dia
   where
     dia = fromMaybeError "iconToDiagram: subdiagram not found" $ lookup diagramName nameToSubdiagramMap
 
 --Get the decimal part of a float
 --reduceAngleRange :: Double -> Double
 reduceAngleRange :: Double -> Double
-reduceAngleRange x = x - (fromInteger (floor x))
+reduceAngleRange x = x - fromInteger (floor x)
 
-makeTransformableDia :: _ => QDiagram b V2 n m -> nm -> Bool -> n -> QDiagram b V2 n m
-makeTransformableDia dia nm reflect angle = nameDiagram nm $ rotateBy angle (if reflect then reflectX dia else dia)
+-- Make an identity TransformableDia
+identDiaFunc :: _ => QDiagram b V2 n m -> TransformableDia b V2 n m
+identDiaFunc dia _ _ = dia
 
 --makeSymmetricTransDia :: _ => QDiagram b V2 n m -> nm -> Bool -> n -> QDiagram b V2 n m
-makeSymmetricTransDia dia nm reflect angle = nameDiagram nm $ rotateBy (if reflect then angle + (1/2) else angle) dia
+--makeSymmetricTransDia dia nm reflect angle = nameDiagram nm $ rotateBy (if reflect then angle + (1/2) else angle) dia
 
-makeRotateSymmetricTransDia dia nm reflect angle = nameDiagram nm $ dia (if reflect then angle + (1/2) else angle)
+diaFunc dia reflect angle = dia reflect angle
 
 -- | 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
@@ -200,7 +201,7 @@ applyA0Dia ::
    (RealFloat n, Typeable n, Monoid m, Semigroup m,
       TrailLike (QDiagram b V2 n m)) =>
      QDiagram b V2 n m
-applyA0Dia = ((resultCircle ||| apply0Line ||| (fc (apply0C colorScheme) apply0Triangle)) <> makePortDiagrams apply0PortLocations) # reflectX # centerXY
+applyA0Dia = ((resultCircle ||| apply0Line ||| fc (apply0C colorScheme) apply0Triangle) <> makePortDiagrams apply0PortLocations) # reflectX # centerXY
 
 apply0PortLocations :: Floating a => [P2 a]
 apply0PortLocations = map p2 [
@@ -241,18 +242,20 @@ applyADia = coloredApplyADia (apply0C colorScheme)
 
 --textApplyADia :: _ => Int -> String -> QDiagram b V2 n m
 textApplyADia :: _ =>
-  Int -> String -> Double -> QDiagram b V2 Double Any
+  Int -> String -> TransformableDia b V2 Double Any
 textApplyADia = generalTextAppDia (textBoxTextC colorScheme) (apply0C colorScheme)
 
 pAppDia :: _ =>
-  Int -> String -> Double -> QDiagram b V2 Double Any
+  Int -> String -> TransformableDia b V2 Double Any
 pAppDia = generalTextAppDia (patternTextC colorScheme) (patternC colorScheme)
 
-generalTextAppDia textCol borderCol numArgs str angle = rotateDia where
-  rotateDia = rotateBy angle $ (rotateBy textBoxRotation (coloredTextBox textCol (opaque borderCol) str)) |||
+generalTextAppDia :: _ => Colour Double -> Colour Double -> Int -> String -> Bool -> Double -> QDiagram b V2 n Any
+generalTextAppDia textCol borderCol numArgs str reflect angle = rotateDia where
+  rotateDia = rotateBy textBoxRotation (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str)) |||
     coloredApplyADia borderCol numArgs
   reducedAngle = reduceAngleRange angle
-  textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then (1/2) else 0
+  textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0
+  reflectIfTrue shouldReflect dia = if shouldReflect then reflectX dia else dia
 
 -- TEXT ICON --
 textBoxFontSize :: (Num a) => a

app/Main.hs

@@ -15,7 +15,7 @@ import Translate(translateString, drawingsFromModule)
 
 -- TODO Now --
 -- Clean up Rendering and Icons.
--- Test case x of {0 -> 1; y -> y}, see if the second match forms a loop.
+
 -- Refactor Translate
 -- Add documentation.
 -- Update readme.
@@ -31,6 +31,11 @@ import Translate(translateString, drawingsFromModule)
 -- Give lines a black border to make line crossings easier to see.
 -- Give lines that cross the border of a lambda function a special color.
 
+-- Translate todos:
+-- Fix test case x of {0 -> 1; y -> y}.
+
+-- Have icon rotation just rotate internal items, not the entire diagram.
+-- Use a nested tree layout. A graph can take an optional (name, Icon) as filling a port.
 -- Use clustered graphs. Make a test project.
 -- Consider making lines between patterns Pattern Color when the line is a reference.
 -- Consider using seperate parameter icons in functions.
@@ -338,7 +343,8 @@ caseTests = [
   "y = case x of {Foo a -> a}",
   "y = case x of {Foo a -> f a; Bar a -> f a}",
   "y = case x of {F x -> x; G x -> x}",
-  "y = case x of {F -> 0; G -> 1}"
+  "y = case x of {F -> 0; G -> 1}",
+  "z = case x of {0 -> 1; y -> y}"
   ]
 
 guardTests = [

app/Rendering.hs

@@ -60,7 +60,7 @@ drawingToGraphvizScaleFactor = 0.15
 --       Renderable (Diagrams.TwoD.Text.Text n) b, IsName nm) =>
 --      [(Name, QDiagram b V2 n Any)]-> [(nm, Icon)] -> [(nm, QDiagram b V2 n Any)]
 makeNamedMap subDiagramMap =
-  map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap name))
+  map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap))
 
 -- | Make an inductive Graph from a list of node names, and a list of Connections.
 edgesToGraph :: [Name] -> [(NameAndPort, NameAndPort)] -> Gr Name ()
@@ -187,13 +187,13 @@ rotateNodes ::
      -> [(Name, QDiagram b V2 Double m)]
 rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
   where
-    rotateDiagram (name, originalDia) = (name, transformedDia)
+    rotateDiagram (name, originalDia) = (name, nameDiagram name transformedDia)
       where
         transformedDia = if flippedDist < unflippedDist
-          then originalDia True flippedAngle
-          else originalDia False unflippedAngle
+          then rotateBy flippedAngle . reflectX $ originalDia True flippedAngle
+          else rotateBy unflippedAngle $ originalDia False unflippedAngle
         (unflippedAngle, unflippedDist) = minAngleForDia (originalDia False 0)
-        (flippedAngle, flippedDist) = minAngleForDia (originalDia True 0)
+        (flippedAngle, flippedDist) = minAngleForDia (reflectX $ originalDia True 0)
         --minAngleForDia :: QDiagram b V2 Double m -> (Double, Double)
         minAngleForDia dia = minAngle where
         --ports = Debug.Trace.trace ((show $ names dia) ++ "\n") $ names dia
@@ -206,7 +206,9 @@ rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
           getPortPoint :: Int -> P2 Double
           getPortPoint x =
             -- TODO remove partial function head.
-            head $ fromMaybeError ("port not found. Port: " ++ show name ++ ".> " ++ show x ++ ". Valid ports: " ++ show ports) (lookup (name .> x) ports)
+            head $ fromMaybeError
+              ("rotateNodes: port not found. Port: " ++ show x ++ ". Valid ports: " ++ show ports)
+              (lookup (toName x) ports)
 
           makePortEdge :: (Int, Name, Maybe Int) -> (P2 Double, P2 Double)
           makePortEdge (portInt, otherIconName, _) =