Upgrade to lts-4.0. Test using diagrams-graphviz for layout.

app/Main.hs

@@ -3,10 +3,19 @@ module Main where
 
 import Diagrams.Prelude
 import Diagrams.Backend.SVG.CmdLine
+import Diagrams.TwoD.GraphViz
+
+import Data.GraphViz
+import qualified Data.GraphViz.Attributes.Complete as GVA
+import Data.GraphViz.Commands
+import Data.Map((!))
+import Data.Maybe (fromMaybe)
 
 import Lib
 import Icons
 
+-- todo: refactor and clean up
+
 ex1 = drawIconAndPorts apply0Icon
 ex2 = drawIconsAndPortNumbers apply0Icon
 
@@ -14,12 +23,34 @@ applyDia = iconDia apply0Icon
 --apply0A = "A" .>> applyDia
 apply0A = applyDia # nameDiagram "A"
 apply0B = applyDia # nameDiagram "B"
+result = resultIcon # named "res"
+fooBox = textBox "foo" # named "foo"
+barBox = textBox "bar" # named "bar"
+
+graph = mkGraph ["A", "B", "res", "foo", "bar"]
+  [("A", "B", ()),
+  ("res", "A", ()),
+  ("bar", "B", ()),
+  ("foo", "B", ())
+  ]
+
+labelToDiagram =
+  [("A", apply0A),
+  ("B", apply0B),
+  ("res", result),
+  ("foo", fooBox),
+  ("bar", barBox)
+  ]
+
 ex3 = atPoints (map p2 [(0,0), (3,0)]) [apply0A, apply0B]
+
 fromAtoB = ex3 # connectPorts "A" (PortName 0) "B" (PortName 2)
 ex4 = apply0A ||| textBox "hello world" === textBox "1" === textBox "gpq" === textBox ['A'..'Z']
+
 ex5 = resultIcon # named "res"||| hrule 1 ||| fromAtoB ||| hrule 1 ||| textBox "foo" # named "foo" === vrule 1 === textBox "bar" # named "bar"
 ex6 = ex5 # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0)
   # connectIconToPort "bar" "B" (PortName 3) # centerXY
+
 ex7 = ex6 # center # showOrigin # showEnvelope
 ex8 = enclosure ex6
 ex9 = lambdaRegion 3 ex6 # nameDiagram "lam0"
@@ -27,5 +58,26 @@ ex10 = ex9 # connectPorts ("lam0" .> "A") (PortName 1) "lam0" (PortName 0)
   # connectPorts ("lam0" .> "B") (PortName 1) "lam0" (PortName 2)
 ex11 = connectIcons "lam0" "y" $ ex10 === vrule 2 === textBox "y" # named "y"
 
+
+placeNodes layoutResult = mconcat placedNodes
+  where
+    (positionMap, _) = getGraph layoutResult
+    placedNodes = map (\label -> place (fromMaybe mempty $ lookup label labelToDiagram) (0.04 * positionMap ! label)) $ map fst labelToDiagram
+
+connectNodes g =
+  g # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0)
+  # connectIconToPort "bar" "B" (PortName 3) # connectPorts "A" (PortName 0) "B" (PortName 2)
+
+doGraphLayout :: IO (Diagram B)
+doGraphLayout = do
+  layoutResult <- layoutGraph Neato graph
+  return $ placeNodes layoutResult # connectNodes
+
+main1 = mainWith (ex11 # bgFrame 0.1 black)
+
+main0 = do
+  placedNodes <- doGraphLayout
+  mainWith (placedNodes # bgFrame 0.1 black)
+
 main :: IO ()
-main = mainWith (ex11 # bgFrame 0.1 black)
+main = main0

glance.cabal

@@ -28,6 +28,8 @@ executable glance-exe
                      , diagrams
                      , diagrams-lib
                      , diagrams-svg
+                     , diagrams-graphviz
+                     , graphviz
   default-language:    Haskell2010
   Other-modules: Icons
 

stack.yaml

@@ -1,14 +1,17 @@
 # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-3.20
+resolver: lts-4.0
 
 # Local packages, usually specified by relative directory name
 packages:
 - '.'
 
 # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
-extra-deps: []
+extra-deps: [
+"diagrams-graphviz-1.3.0.0",
+"graphviz-2999.18.0.2"
+]
 
 # Override default flag values for local packages and extra-deps
 flags: {}