Simplify types.

app/Icons.hs

@@ -22,9 +22,12 @@ import Diagrams.Prelude
 import Diagrams.TwoD.Text(Text)
 import Data.Typeable(Typeable)
 
-import Types(Icon(..), Edge)
+import Types(Icon(..), SpecialQDiagram, SpecialBackend)
 import Util(fromMaybeError)
 
+-- TYPES --
+type TransformableDia b = (Bool -> Double -> SpecialQDiagram b)
+
 -- COLO(U)RS --
 colorScheme :: (Floating a, Ord a) => ColorStyle a
 colorScheme = colorOnBlackScheme
@@ -109,19 +112,12 @@ randomColorScheme = ColorStyle {
 lineCol :: (Floating a, Ord a) => Colour a
 lineCol = lineC colorScheme
 
-type TransformableDia a b c d = (Bool -> Double -> QDiagram a b c d)
-
 -- FUNCTIONS --
 -- Optimization: The apply0NDia's can be memoized.
--- iconToDiagram ::
+iconToDiagram :: SpecialBackend b => Icon -> [(Name, SpecialQDiagram b)] -> Bool -> Double -> SpecialQDiagram b
---    (RealFloat n, Typeable n, Renderable (Path V2 n) b,
---       Renderable (Text n) b) =>
---      Icon -> [(Name, QDiagram b V2 n Any)] -> TransformableDia b V2 n Any
-iconToDiagram ::_ =>
-  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 (PAppIcon n str) _ = pAppDia n str
-iconToDiagram (TextApplyAIcon n str) _ = diaFunc $ textApplyADia n str
+iconToDiagram (TextApplyAIcon n str) _ = textApplyADia n str
 iconToDiagram ResultIcon _ = identDiaFunc resultIcon
 iconToDiagram BranchIcon _ = identDiaFunc branchIcon
 iconToDiagram (TextBoxIcon s) _ = identDiaFunc $ textBox s
@@ -135,41 +131,22 @@ iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
   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)
-
 -- Make an identity TransformableDia
-identDiaFunc :: _ => QDiagram b V2 n m -> TransformableDia b V2 n m
+identDiaFunc :: SpecialQDiagram b -> TransformableDia b
 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
-
-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
+nameDiagram :: (SpecialBackend b, IsName nm) => nm -> SpecialQDiagram b -> SpecialQDiagram b
 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.
-makePort :: (Floating n, Ord n, Semigroup m, Metric v) => Int -> QDiagram b v n m
+makePort :: Int -> SpecialQDiagram b
 makePort x = mempty # named x
 --makePort x = circle 0.2 # fc green # named x
 -- Note, the version of makePort below seems to have a different type.
 --makePort x = textBox (show x) # fc green # named x
 
-
---makePortDiagrams :: [P2 Double] -> Diagram B
---makePortDiagrams ::(Monoid a, Semigroup a, HasOrigin a, b ~ N a) => [P2 b] -> GeneralDiagram a
-makePortDiagrams ::
-   (Floating n, Ord n, Semigroup m, Metric v) =>
-     [Point v n] -> QDiagram b v n m
-makePortDiagrams points =
-  atPoints points (map makePort ([0,1..] :: [Int]))
-
 -- CONSTANTS --
 defaultLineWidth :: (Fractional a) => a
 defaultLineWidth = 0.15
@@ -178,54 +155,23 @@ defaultLineWidth = 0.15
 circleRadius :: (Fractional a) => a
 circleRadius = 0.5
 
-type GeneralDiagram b = (Transformable b, RealFloat (N b), Typeable (N b), HasStyle b, TrailLike b, V b ~ V2) => b
-
-resultCircle ::
-   (RealFloat (N b), Typeable (N b), Transformable b, HasStyle b,
-      TrailLike b, V b ~ V2) =>
-     b
-resultCircle = circle circleRadius # fc (apply0C colorScheme) # lw none
-
 apply0Triangle ::
    (Typeable (N b), Transformable b, HasStyle b, TrailLike b,
       V b ~ V2) =>
      b
 apply0Triangle = eqTriangle (2 * circleRadius) # rotateBy (-1/12) # lw none
 
-apply0Line ::
+portCircle :: (SpecialBackend b) => SpecialQDiagram b
-   (Typeable (N b), HasStyle b, TrailLike b, V b ~ V2) => b
-apply0Line = rect defaultLineWidth (2 * circleRadius) # fc lineCol # lw none
-
---apply0Dia :: (Juxtaposable a, Semigroup a) => GeneralDiagram a
-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
-
-apply0PortLocations :: Floating a => [P2 a]
-apply0PortLocations = map p2 [
-  (circleRadius + defaultLineWidth + triangleWidth, 0),
-  (-circleRadius,0),
-  (lineCenter,-circleRadius)
-  --(lineCenter,circleRadius),
-  ]
-  where
-    triangleWidth = circleRadius * sqrt 3
-    lineCenter = circleRadius + (defaultLineWidth / 2.0)
-
 portCircle = circle (circleRadius * 0.5) # fc lineCol # lw none
 
--- apply0N Icon--
+-- applyA Icon--
 -- | apply0N port locations:
 -- Port 0: Function
 -- Port 1: Result
 -- Ports 2,3..: Arguments
 coloredApplyADia ::
-   (RealFloat n, Typeable n, Monoid m, Semigroup m,
+  (SpecialBackend b) =>
-      TrailLike (QDiagram b V2 n m)) =>
+  Colour Double -> Int -> SpecialQDiagram b
-     Colour Double -> Int -> QDiagram b V2 n m
---applyADia 1 = applyA0Dia
 coloredApplyADia appColor n = finalDia # centerXY where
   seperation = circleRadius * 1.5
   trianglePortsCircle = hcat [
@@ -238,18 +184,23 @@ coloredApplyADia appColor n = finalDia # centerXY where
   topAndBottomLine = hrule topAndBottomLineWidth # lc appColor # lwG defaultLineWidth # alignL
   finalDia = topAndBottomLine === allPorts === topAndBottomLine
 
+applyADia :: SpecialBackend b => Int -> SpecialQDiagram b
 applyADia = coloredApplyADia (apply0C colorScheme)
 
---textApplyADia :: _ => Int -> String -> QDiagram b V2 n m
+textApplyADia :: SpecialBackend b =>
-textApplyADia :: _ =>
+  Int -> String -> TransformableDia b
-  Int -> String -> TransformableDia b V2 Double Any
 textApplyADia = generalTextAppDia (textBoxTextC colorScheme) (apply0C colorScheme)
 
-pAppDia :: _ =>
+pAppDia :: SpecialBackend b =>
-  Int -> String -> TransformableDia b V2 Double Any
+  Int -> String -> TransformableDia b
 pAppDia = generalTextAppDia (patternTextC colorScheme) (patternC colorScheme)
 
-generalTextAppDia :: _ => Colour Double -> Colour Double -> Int -> String -> Bool -> Double -> QDiagram b V2 n Any
+--Get the decimal part of a float
+reduceAngleRange :: Double -> Double
+reduceAngleRange x = x - fromInteger (floor x)
+
+generalTextAppDia :: SpecialBackend b =>
+  Colour Double -> Colour Double -> Int -> String -> Bool -> Double -> SpecialQDiagram b
 generalTextAppDia textCol borderCol numArgs str reflect angle = rotateDia where
   rotateDia = rotateBy textBoxRotation (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str)) |||
     coloredApplyADia borderCol numArgs
@@ -265,25 +216,19 @@ monoLetterWidthToHeightFraction = 0.61
 textBoxHeightFactor :: (Fractional a) => a
 textBoxHeightFactor = 1.1
 
-textBox ::
+textBox :: SpecialBackend b =>
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b,
+  String -> SpecialQDiagram b
-      Renderable (Text n) b) =>
-      String -> QDiagram b V2 n Any
 textBox = coloredTextBox (textBoxTextC colorScheme) $ opaque (textBoxC colorScheme)
 
-bindTextBox ::
+bindTextBox :: SpecialBackend b =>
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b,
+  String -> SpecialQDiagram b
-      Renderable (Text n) b) =>
-      String -> QDiagram b V2 n Any
 bindTextBox = coloredTextBox (bindTextBoxTextC colorScheme) $ opaque (bindTextBoxC colorScheme)
 
 -- Since the normal SVG text has no size, some hackery is needed to determine
 -- the size of the text's bounding box.
-coloredTextBox ::
+coloredTextBox :: SpecialBackend b =>
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b,
+  Colour Double
-      Renderable (Diagrams.TwoD.Text.Text n) b) =>
+  -> AlphaColour Double -> String -> SpecialQDiagram b
-     Colour Double
-     -> 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 # lwG (0.6 * defaultLineWidth)
@@ -293,67 +238,57 @@ coloredTextBox textColor boxColor t =
       + (textBoxFontSize * 0.2)
 
 -- ENCLOSING REGION --
-enclosure ::
+enclosure :: SpecialBackend b =>
-   (Floating n, Ord n, Typeable n, Monoid m, Semigroup m,
+  SpecialQDiagram b -> SpecialQDiagram b
-      TrailLike (QDiagram b V2 n m)) =>
-     QDiagram b V2 n m -> QDiagram b V2 n m
 enclosure dia = dia <> boundingRect (dia # frame 0.5) # lc (regionPerimC colorScheme) # lwG defaultLineWidth
 
 -- LAMBDA ICON --
 -- Don't use === here to put the port under the text box since mempty will stay
 -- at the origin of the text box.
 lambdaIcon ::
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b,
+  SpecialBackend b =>
-      Renderable (Diagrams.TwoD.Text.Text n) b) =>
+  Int -> SpecialQDiagram b
-     Int -> QDiagram b V2 n Any
 lambdaIcon x = coloredTextBox (lamArgResC colorScheme) transparent "λ" # alignB <> makePort x
 
 -- LAMBDA REGION --
 
 -- | lambdaRegion takes as an argument the numbers of parameters to the lambda,
 -- and draws the diagram inside a region with the lambda icons on top.
-lambdaRegion ::
+lambdaRegion :: SpecialBackend b =>
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b,
+  Int -> SpecialQDiagram b -> SpecialQDiagram b
-      Renderable (Diagrams.TwoD.Text.Text n) b) =>
-     Int -> QDiagram b V2 n Any -> QDiagram b V2 n Any
 lambdaRegion n dia =
   centerXY $ lambdaIcons # centerX === (enclosure dia # centerX)
   where lambdaIcons = hsep 0.4 (take n (map lambdaIcon [0,1..]))
 
 -- RESULT ICON --
-resultIcon ::
+resultIcon :: SpecialBackend b => SpecialQDiagram b
-   (Typeable (N b), HasStyle b, TrailLike b, V b ~ V2) => b
 resultIcon = unitSquare # lw none # fc (lamArgResC colorScheme)
 
 -- BRANCH ICON --
-branchIcon :: GeneralDiagram a
+branchIcon :: SpecialBackend b => SpecialQDiagram b
 branchIcon = circle circleRadius # fc lineCol # lc lineCol # lw none
 
 -- GUARD ICON --
 guardSize :: (Fractional a) => a
 guardSize = 0.7
 
-guardTriangle ::
+guardTriangle :: SpecialBackend b =>
-   (Floating n, Ord n, Typeable n, Monoid m, Semigroup m,
+  Int -> SpecialQDiagram b
-      TrailLike (QDiagram b V2 n m)) =>
-     Int -> QDiagram b V2 n m
 guardTriangle x =
   ((triangleAndPort ||| (hrule (guardSize * 0.8) # lwG defaultLineWidth)) # alignR) <> makePort x # alignL
   where
     triangleAndPort = polygon (with & polyType .~ PolySides [90 @@ deg, 45 @@ deg] [guardSize, guardSize])
       # rotateBy (1/8) # lwG defaultLineWidth # alignT # alignR
 
-guardLBracket ::
+guardLBracket :: SpecialBackend b =>
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b) =>
+  Int -> SpecialQDiagram b
-     Int -> QDiagram b V2 n Any
 guardLBracket x = ell # alignT # alignL <> makePort x
   where
     ellShape = fromOffsets $ map r2 [(0, guardSize), (-guardSize,0)]
     ell = ellShape # strokeLine # lc (boolC colorScheme) # lwG defaultLineWidth # lineJoin LineJoinRound
 
-generalGuardIcon ::
+generalGuardIcon :: SpecialBackend b =>
-  (RealFloat n, Typeable n, Renderable (Path V2 n) b) =>
+  Colour Double -> (Int -> SpecialQDiagram b) -> SpecialQDiagram b -> Int -> SpecialQDiagram b
-  Colour Double -> (Int -> QDiagram b V2 n Any) -> QDiagram b V2 n Any -> Int -> QDiagram b V2 n Any
 generalGuardIcon triangleColor lBracket bottomDia n = centerXY $ alignT (bottomDia <> makePort 1) <> alignB (bigVerticalLine <> guardDia <> makePort 0)
   where
     --guardTriangles = vsep 0.4 (take n (map guardTriangle [0,1..]))
@@ -372,21 +307,18 @@ generalGuardIcon triangleColor lBracket bottomDia n = centerXY $ alignT (bottomD
 -- Port 1: Bottom result port
 -- Ports 3,5...: The left ports for the booleans
 -- Ports 2,4...: The right ports for the values
-guardIcon ::
+guardIcon :: SpecialBackend b =>
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b) =>
+  Int -> SpecialQDiagram b
-     Int -> QDiagram b V2 n Any
 guardIcon = generalGuardIcon lineCol guardLBracket mempty
 
 -- TODO Improve design to be more than a circle.
-caseResult :: (RealFloat n,
+caseResult :: SpecialBackend b =>
-           Typeable n,
+  SpecialQDiagram b
-           Renderable (Path V2 n) b) => QDiagram b V2 n Any
 caseResult = circle (circleRadius * 0.7) # fc caseCColor # lc caseCColor # lw none where
   caseCColor = caseRhsC colorScheme
 
-caseC :: (RealFloat n,
+caseC :: SpecialBackend b =>
-           Typeable n,
+  Int -> SpecialQDiagram b
-           Renderable (Path V2 n) b) => Int -> QDiagram b V2 n Any
 caseC n = caseResult <> makePort n
 
 
@@ -395,15 +327,15 @@ caseC n = caseResult <> makePort n
 -- Port 1: Bottom result port
 -- Ports 3,5...: The left ports for the results
 -- Ports 2,4...: The right ports for the patterns
-caseIcon ::(RealFloat n,
+caseIcon :: SpecialBackend b =>
-           Typeable n,
+  Int -> SpecialQDiagram b
-           Renderable (Path V2 n) b) => Int -> QDiagram b V2 n Any
 caseIcon = generalGuardIcon (patternC colorScheme) caseC caseResult
 
 -- | The ports of flatLambdaIcon are:
 -- 0: Result icon
 -- 1: The lambda function value
 -- 2,3.. : The parameters
+flatLambda :: SpecialBackend b => Int -> SpecialQDiagram b
 flatLambda n = finalDia where
   lambdaCircle = circle circleRadius # fc (regionPerimC colorScheme) # lc (regionPerimC colorScheme) # lwG defaultLineWidth
   lambdaParts = (makePort 0 <> resultIcon) : (portIcons ++  [makePort 1 <> alignR lambdaCircle])

app/Main.hs

@@ -18,40 +18,31 @@ import Translate(translateString, drawingsFromModule)
 
 -- Refactor Translate
 -- Add documentation.
--- Update readme.
--- Test reference lookup in case rhs.
 -- Have the file be a command line argument to main.
--- In evalPatBind, give the edge from the rhs to the pattern a special arrowhead.
+
--- Line intersections should have a small circle. This could probably be done with
--- a line ending.
 -- Move tests out of main.
 
 -- TODO Later --
--- Visual todos
+-- Visual todos:
 -- 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.
+-- Line intersections should have a small circle. This could probably be done with
+-- a line ending.
+-- Let each bool, value pair in Guard icon be flipped to reduce line crossings. Do the same for case.
+-- Let lines connect to ports in multiple locations (eg. case value, or guard result)
+-- Rotate icons based on the outgoing line's difference from ideal angle, not line distance.
+-- Improve line routing. Draw curved lines with outgoing lines at fixed angles.
+--  - connectPerim might be useful for this.
 
 -- 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.
--- Add function name and type to LambdaIcons.
 -- Add proper RecConstr, and RecUpdate support.
--- Let each bool, value pair in Guard icon be flipped to reduce line crossings. Do the same for case.
 -- Eliminate BranchIcon in Alts.
 -- Eliminate BranchIcon for the identity funciton "y x = x"
 -- otherwise Guard special case
--- Let lines connect to ports in multiple locations (eg. argument for Apply0Dia)
+
--- Add a small black border to lines to help distinguish line crossings.
+--Other todos:
--- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
+-- Use a nested tree layout. A graph can take an optional (name, Icon) instead of a port.
--- todo: Find out and fix why connectinos to sub-icons need to be qualified twice (eg. "lam0" .> "arg" .> "arg")
--- todo: Rotate based on difference from ideal tangent angle, not line distance.
--- todo: Try using connectPerim for port to port connections. Hopefully this will draw a spline.
--- todo: layout and rotate considering external connections.
 
 (d0A, d0B, d0Res, d0Foo, d0Bar) = ("A", "B", "res", "foo", "bar")
 d0Icons = toNames

app/Rendering.hs

@@ -6,7 +6,6 @@ module Rendering (
 
 import Diagrams.Prelude
 import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph')
-import Diagrams.TwoD.Text(Text)
 --import Diagrams.Backend.SVG(B)
 
 import qualified Data.GraphViz as GV
@@ -22,8 +21,9 @@ import Data.Graph.Inductive.PatriciaTree (Gr)
 import Data.Typeable(Typeable)
 --import Data.Word(Word16)
 
-import Icons(colorScheme, Icon(..), iconToDiagram, nameDiagram, defaultLineWidth, ColorStyle(..))
+import Icons(colorScheme, iconToDiagram, nameDiagram, defaultLineWidth, ColorStyle(..))
-import Types(Edge(..), EdgeOption(..), Connection, Drawing(..), EdgeEnd(..), NameAndPort(..))
+import Types(Edge(..), Icon, EdgeOption(..), Connection, Drawing(..), EdgeEnd(..),
+  NameAndPort(..), SpecialQDiagram, SpecialBackend)
 import Util(fromMaybeError)
 
 -- If the inferred types for these functions becomes unweildy,
@@ -52,13 +52,7 @@ drawingToGraphvizScaleFactor = 0.15
 -- | Convert a map of names and icons, to a list of names and diagrams.
 -- The first argument is the subdiagram map used for the inside of lambdaIcons
 -- The second argument is the map of icons that should be converted to diagrams.
---makeNamedMap :: IsName name => [(Name, Diagram B)] -> [(name, Icon)] -> [(name, Diagram B)]
+makeNamedMap :: SpecialBackend b => [(Name, SpecialQDiagram b)] -> [(t, Icon)] -> [(t, Bool -> Double -> SpecialQDiagram b)]
-
---
--- makeNamedMap ::
---    (RealFloat n, Typeable n, Renderable (Path V2 n) b,
---       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))
 
@@ -179,12 +173,11 @@ connectedPorts edges name = map edgeToPort $ filter nameInEdge edges
 -- are minimized.
 -- Precondition: the diagrams are already centered
 -- todo: confirm precondition (or use a newtype)
-rotateNodes ::
+rotateNodes :: SpecialBackend b =>
-   Semigroup m =>
+  Map.Map Name (Point V2 Double)
-     Map.Map Name (Point V2 Double)
+  -> [(Name, Bool -> Double -> SpecialQDiagram b)]
-     -> [(Name, Bool -> Double -> QDiagram b V2 Double m)]
+  -> [Connection]
-     -> [Connection]
+  -> [(Name, SpecialQDiagram b)]
-     -> [(Name, QDiagram b V2 Double m)]
 rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
   where
     rotateDiagram (name, originalDia) = (name, nameDiagram name transformedDia)
@@ -219,12 +212,11 @@ rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
           minAngle = angleWithMinDist (getFromMapAndScale positionMap name) portEdges
 
 type LayoutResult a = Gr (GV.AttributeNode Name) (GV.AttributeNode a)
-placeNodes ::
+placeNodes :: SpecialBackend b =>
-   (Monoid m, Semigroup m) =>
+   LayoutResult a
-     LayoutResult a
+   -> [(Name, Bool -> Double -> SpecialQDiagram b)]
-     -> [(Name, Bool -> Double -> QDiagram b V2 Double m)]
+   -> [Connection]
-     -> [Connection]
+   -> SpecialQDiagram b
-     -> QDiagram b V2 Double m
 placeNodes layoutResult nameDiagramMap edges = mconcat placedNodes
   where
     (positionMap, _) = getGraph layoutResult
@@ -234,12 +226,11 @@ placeNodes layoutResult nameDiagramMap edges = mconcat placedNodes
     -- todo: Not sure if the diagrams should already be centered at this point.
     placeNode (name, diagram) = place (diagram # centerXY) (scaleFactor *^ (positionMap Map.! name))
 
-doGraphLayout ::
+doGraphLayout :: SpecialBackend b =>
-   _ =>
+   Gr Name e
-     Gr Name e
+   -> [(Name, Bool -> Double -> SpecialQDiagram b)]
-     -> [(Name, Bool -> Double -> QDiagram b V2 Double m)]
+   -> [Connection]
-     -> [Connection]
+   -> IO (SpecialQDiagram b)
-     -> IO (QDiagram b V2 Double m)
 doGraphLayout graph nameDiagramMap edges = do
   layoutResult <- layoutGraph' layoutParams GVA.Neato graph
   --  layoutResult <- layoutGraph' layoutParams GVA.Fdp graph
@@ -272,19 +263,18 @@ doGraphLayout graph nameDiagramMap edges = do
       where
         --todo: Hack! Using (!!) here relies upon the implementation of Diagrams.TwoD.GraphViz.mkGraph
         -- to name the nodes in order
-        (_, unTransformedDia) = (nameDiagramMap !! nodeInt)
+        (_, unTransformedDia) = nameDiagramMap !! nodeInt
         dia = unTransformedDia False 0
 
-        diaWidth = drawingToGraphvizScaleFactor * (width dia)
+        diaWidth = drawingToGraphvizScaleFactor * width dia
-        diaHeight = drawingToGraphvizScaleFactor * (height dia)
+        diaHeight = drawingToGraphvizScaleFactor * height dia
         circleDiameter' = max diaWidth diaHeight
         circleDiameter = if circleDiameter' <= 0.01 then error ("circleDiameter too small: " ++ show circleDiameter') else circleDiameter'
 
 
 -- | Given a Drawing, produce a Diagram complete with rotated/flipped icons and
 -- lines connecting ports and icons. IO is needed for the GraphViz layout.
-renderDrawing ::
+renderDrawing :: SpecialBackend b =>
-  _ =>
   Drawing -> IO (QDiagram b V2 Double Any)
 renderDrawing (Drawing nameIconMap edges subDrawings) = do
   subDiagramMap <- traverse renderSubDrawing subDrawings

app/Translate.hs

@@ -23,8 +23,8 @@ import Util(toNames, makeSimpleEdge, nameAndPort, justName, mapFst)
 import Icons(Icon(..))
 import TranslateCore(Reference, IconGraph(..), EvalContext, GraphAndRef,
   iconGraphFromIcons, iconGraphFromIconsEdges, getUniqueName, combineExpressions,
-  edgesForRefPortList, iconGraphToDrawing, qualifyNameAndPort, makeApplyGraph,
+  edgesForRefPortList, iconGraphToDrawing, makeApplyGraph,
-  namesInPattern, lookupReference, deleteBindings, makeEdges, makeEdgesCore,
+  namesInPattern, lookupReference, deleteBindings, makeEdges,
   coerceExpressionResult, makeBox, nTupleString, nListString)
 
 -- OVERVIEW --
@@ -100,9 +100,9 @@ evalQName qName@(UnQual _) c = strToGraphRef c (qNameToString qName)
 evalQName qName@(Qual _ _) c = strToGraphRef c (qNameToString qName)
 evalQName qName _ = fmap Right <$> makeBox (qNameToString qName)
 
-evalQOp :: QOp -> EvalContext -> State IDState (IconGraph, Reference)
+-- evalQOp :: QOp -> EvalContext -> State IDState (IconGraph, Reference)
-evalQOp (QVarOp n) = evalQName n
+-- evalQOp (QVarOp n) = evalQName n
-evalQOp (QConOp n) = evalQName n
+-- evalQOp (QConOp n) = evalQName n
 
 qOpToString :: QOp -> String
 qOpToString (QVarOp n) = qNameToString n
@@ -308,10 +308,11 @@ evalTuple c exps = do
   applyIconName <- DIA.toName <$> getUniqueName "tupleApp"
   pure $ makeTextApplyGraph False applyIconName (nTupleString (length exps)) argVals (length exps)
 
+makeVarExp :: String -> Exp
 makeVarExp = Var . UnQual . Ident
 
 evalListExp :: EvalContext -> [Exp] -> State IDState (IconGraph, NameAndPort)
-evalListExp c [] = makeBox "[]"
+evalListExp _ [] = makeBox "[]"
 evalListExp c exps = evalApp c (makeVarExp . nListString . length $ exps, exps)
 
 evalLeftSection :: EvalContext -> Exp -> QOp -> State IDState (IconGraph, NameAndPort)
@@ -329,6 +330,7 @@ evalRightSection c op e = do
 evalEnums :: EvalContext -> String -> [Exp] -> State IDState (IconGraph, Reference)
 evalEnums c s exps = fmap Right <$> evalApp c (Var . UnQual . Ident $ s, exps)
 
+makeQVarOp :: String -> QOp
 makeQVarOp = QVarOp . UnQual . Ident
 
 desugarDo :: [Stmt] -> Exp
@@ -341,7 +343,7 @@ desugarDo (LetStmt binds : stmts) = Let binds (desugarDo stmts)
 
 -- TODO: Finish evalRecConstr
 evalRecConstr :: EvalContext -> QName -> [Exts.FieldUpdate] -> State IDState (IconGraph, Reference)
-evalRecConstr c qName updates = evalQName qName c
+evalRecConstr c qName _ = evalQName qName c
 
 evalExp :: EvalContext  -> Exp -> State IDState (IconGraph, Reference)
 evalExp c x = case x of
@@ -364,7 +366,7 @@ evalExp c x = case x of
   RightSection op e -> fmap Right <$> evalRightSection c op e
   RecConstr n updates -> evalRecConstr c n updates
   -- TODO: Do RecUpdate correcly
-  RecUpdate e updates -> evalExp c e
+  RecUpdate e _ -> evalExp c e
   EnumFrom e -> evalEnums c "enumFrom" [e]
   EnumFromTo e1 e2 -> evalEnums c "enumFromTo" [e1, e2]
   EnumFromThen e1 e2 -> evalEnums c "enumFromThen" [e1, e2]
@@ -412,7 +414,7 @@ generalEvalLambda context patterns rhsEvalFun = do
     patternGraph = mconcat $ map fst patternVals
 
     (patternEdges, newBinds) =
-      partitionEithers $ zipWith (makePatternEdges lambdaName) patternVals lambdaPorts
+      partitionEithers $ zipWith makePatternEdges patternVals lambdaPorts
     numParameters = length patterns
   -- TODO remove coerceExpressionResult here
   (rhsRawGraph, rhsResult) <- rhsEvalFun rhsContext >>= coerceExpressionResult
@@ -425,10 +427,10 @@ generalEvalLambda context patterns rhsEvalFun = do
   where
     -- TODO Like evalPatBind, this edge should have an indicator that it is the input to a pattern.
     -- makePatternEdges creates the edges between the patterns and the parameter ports.
-    makePatternEdges :: String -> GraphAndRef -> NameAndPort -> Either Edge (String, Reference)
+    makePatternEdges :: GraphAndRef -> NameAndPort -> Either Edge (String, Reference)
-    makePatternEdges lambdaName (_, Right patPort) lamPort =
+    makePatternEdges (_, Right patPort) lamPort =
       Left $ makeSimpleEdge (lamPort, patPort)
-    makePatternEdges _ (_, Left str) lamPort = Right (str, Right lamPort)
+    makePatternEdges (_, Left str) lamPort = Right (str, Right lamPort)
 
 
 evalLambda :: EvalContext -> [Pat] -> Exp -> State IDState (IconGraph, NameAndPort)

app/TranslateCore.hs

@@ -9,14 +9,14 @@ module TranslateCore(
   getUniqueName,
   edgesForRefPortList,
   combineExpressions,
-  qualifyNameAndPort,
+  --qualifyNameAndPort,
   iconGraphToDrawing,
   makeApplyGraph,
   namesInPattern,
   lookupReference,
   deleteBindings,
   makeEdges,
-  makeEdgesCore,
+  --makeEdgesCore,
   coerceExpressionResult,
   makeBox,
   nTupleString,
@@ -91,8 +91,8 @@ combineExpressions inPattern portExpPairs = mconcat $ fmap mkGraph portExpPairs
       else IconGraph mempty mempty mempty [(str, port)] mempty
     Right resultPort -> IconGraph mempty [Edge edgeOpts noEnds (resultPort, port)] mempty mempty mempty
 
-qualifyNameAndPort :: String -> NameAndPort -> NameAndPort
+-- qualifyNameAndPort :: String -> NameAndPort -> NameAndPort
-qualifyNameAndPort s (NameAndPort n p) = NameAndPort (s DIA..> n) p
+-- qualifyNameAndPort s (NameAndPort n p) = NameAndPort (s DIA..> n) p
 
 iconGraphToDrawing :: IconGraph -> Drawing
 iconGraphToDrawing (IconGraph icons edges subDrawings _ _) = Drawing icons edges subDrawings

app/Types.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies, ConstraintKinds #-}
 
 module Types (
   Icon(..),
@@ -9,11 +9,14 @@ module Types (
   EdgeEnd(..),
   Drawing(..),
   IDState,
+  SpecialQDiagram,
+  SpecialBackend,
   initialIdState,
   getId
 ) where
 
-import Diagrams.Prelude(Name)
+import Diagrams.Prelude(Name, QDiagram, V2, Any, Renderable, Path)
+import Diagrams.TwoD.Text(Text)
 import Control.Monad.State(State, state)
 
 -- TYPES --
@@ -48,6 +51,11 @@ 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)
 
+-- Note that SpecialBackend is a constraint synonym, not a type synonym.
+type SpecialBackend b = (Renderable (Path V2 Double) b, Renderable (Text Double) b)
+
+type SpecialQDiagram b = QDiagram b V2 Double Any
+
 initialIdState :: IDState
 initialIdState = IDState 0