Upgrade to LTS-5.0, start on using haskell-src-exts to generate drawings from text.

app/Main.hs

@@ -9,8 +9,10 @@ import Rendering(renderDrawing)
 import Util(toNames, portToPort, iconToPort, iconToIcon,
   iconToIconEnds, iconTailToPort)
 import Types(Icon(..), Drawing(..), EdgeEnd(..))
+import Translate(translateString)
 
 -- TODO Now --
+-- Work on Translate.
 
 -- TODO Later --
 -- Add a small black border to lines to help distinguish line crossings.
@@ -235,5 +237,13 @@ main1 = do
 
 main2 = mainWith ((apply0NDia 3 # bgFrame 0.1 black)  :: Diagram B)
 
+main3 :: IO ()
+main3 = do
+  let
+    (drawing, decl) = translateString "y2 = x1"
+  print decl
+  placedNodes <- renderDrawing drawing
+  mainWith ((placedNodes # bgFrame 1 (backgroundC colorScheme)) :: Diagram B)
+
 main :: IO ()
 main = main1

app/Rendering.hs

@@ -23,6 +23,9 @@ import Data.Typeable(Typeable)
 import Icons(colorScheme, Icon(..), iconToDiagram, nameDiagram, defaultLineWidth, ColorStyle(..))
 import Types(Edge(..), Connection, Drawing(..), EdgeEnd(..))
 
+-- If the inferred types for these functions becomes unweildy,
+-- try using PartialTypeSignitures.
+
 -- CONSTANT
 scaleFactor :: (Fractional a) => a
 scaleFactor = 0.02

app/Translate.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
+module Translate(
+  translateString
+) where
+
+import qualified Diagrams.Prelude as DIA
+
+import Language.Haskell.Exts(Match(..), Decl(..), parseDecl, ParseResult(..),
+  Name(..), Pat(..), Rhs(..), Exp(..), QName(..), fromParseResult) --(parseFile, parse, ParseResult, Module)
+
+import Types(Icon, Edge, Drawing(..))
+import Util(toNames, iconToIcon)
+import Icons(Icon(..))
+
+nameToString (Ident s) = s
+nameToString (Symbol s) = s
+
+evalPattern p = case p of
+  PVar n -> nameToString n
+  -- TODO other cases
+
+evalMatch (Match _ name patterns _ _ _) = res where
+  patternStrings = map evalPattern patterns
+  matchName = nameToString name
+  res = (matchName, patternStrings)
+
+evalQName (UnQual n) = nameToString n
+-- TODO other cases
+
+evalVar x = case x of
+  Var n -> evalQName n
+  -- TODO other cases
+
+evalRhs (UnGuardedRhs e) = evalVar e
+evalRhs (GuardedRhss _) = error "GuardedRhss not implemented"
+
+evalPatBind :: Decl -> ([(DIA.Name, Icon)], [Edge])
+evalPatBind (PatBind _ pat rhs binds) = (icons, edges) where
+  patName = evalPattern pat
+  rhsName = evalRhs rhs
+  icons = toNames [
+    (patName, TextBoxIcon patName),
+    (rhsName, TextBoxIcon rhsName)
+    ]
+  edges = [
+    iconToIcon patName rhsName
+    ]
+
+evalDecl d = case d of
+  pat@PatBind{} -> evalPatBind pat
+  -- TODO other cases
+
+translateString :: String -> (Drawing, Decl)
+translateString s = (drawing, decl) where
+  parseResult = parseDecl s -- :: ParseResult Module
+  decl = fromParseResult parseResult
+  (icons, edges) = evalDecl decl
+  drawing = Drawing icons edges []

glance.cabal

@@ -32,8 +32,9 @@ executable glance-exe
                      , graphviz
                      , containers
                      , fgl
+                     , haskell-src-exts
   default-language:    Haskell2010
-  Other-modules: Icons, Rendering, Types, Util
+  Other-modules: Icons, Rendering, Types, Util, Translate
 
 test-suite glance-test
   type:                exitcode-stdio-1.0

stack.yaml

@@ -1,7 +1,7 @@
 # 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-4.0
+resolver: lts-5.0
 
 # Local packages, usually specified by relative directory name
 packages:
@@ -9,8 +9,7 @@ packages:
 
 # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
 extra-deps: [
-"diagrams-graphviz-1.3.0.0",
-"graphviz-2999.18.0.2"
+"diagrams-graphviz-1.3.0.0"
 ]
 
 # Override default flag values for local packages and extra-deps