Use customRenderSVG in Main.hs. Change font to monospace. Use optparse-applicative for Main.

README.md

@@ -9,9 +9,14 @@ First install Graphviz. For instance, in Ubuntu run:
 Then build and execute glance:
 ```
 stack build
-stack exec glance-exe -- -o images/fact.svg -w 500 examples/fact.hs -
+stack exec glance-exe -- examples/fact.hs images/fact.svg 500
 ```
-and display the SVG
+To see the command line options run
+```
+stack exec glance-exe -- --help
+```
+
+Now display the SVG image
 ```
 firefox --new-window images/fact.svg
 ```
@@ -26,7 +31,7 @@ Glance is still in development, so for the time being, layout, routing, and icon
 ## Getting started
 Below is a getting started guide for Glance rendered by Glance itself ([source here](examples/tutorial.hs)). To generate this image run
 
-`stack exec glance-exe -- -o examples/tutorial.svg -w 873 examples/tutorial.hs c`
+`stack exec glance-exe -- examples/tutorial.hs examples/tutorial.svg 873 -c`
 
 Also, the [Glance wiki](../../wiki) has a brief introduction to the code architecture.
 

app/Icons.hs

@@ -361,10 +361,15 @@ nestedApplyDia flavor = case flavor of
 -- Text constants --
 textBoxFontSize :: (Num a) => a
 textBoxFontSize = 1
+
 monoLetterWidthToHeightFraction :: (Fractional a) => a
 monoLetterWidthToHeightFraction = 0.61
+
 textBoxHeightFactor :: (Fractional a) => a
-textBoxHeightFactor = 1.1
+textBoxHeightFactor = 1.4
+
+textFont :: String
+textFont = "monospace"
 
 -- BEGIN Text helper functions --
 
@@ -379,15 +384,15 @@ textBoxHeightFactor = 1.1
 rectForText :: (InSpace V2 n t, TrailLike t) => Int -> t
 rectForText n = rect rectangleWidth (textBoxFontSize * textBoxHeightFactor)
   where
-    rectangleWidth = fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction
-      + (textBoxFontSize * 0.2)
+    rectangleWidth = (fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction)
+      + (textBoxFontSize * 0.3)
 
 -- END Text helper functions
 
 commentTextArea :: SpecialBackend b n =>
   Colour Double -> String -> SpecialQDiagram b n
 commentTextArea textColor t =
-  alignL $ fontSize (local textBoxFontSize) (font "freemono" $ fc textColor $ topLeftText t)
+  alignL $ fontSize (local textBoxFontSize) (font textFont $ fc textColor $ topLeftText t)
   <>  alignTL (lw none $ rectForText (length t))
 
 multilineComment :: SpecialBackend b n =>
@@ -403,7 +408,7 @@ coloredTextBox :: SpecialBackend b n =>
   Colour Double
   -> AlphaColour Double -> String -> SpecialQDiagram b n
 coloredTextBox textColor boxColor t =
-  fontSize (local textBoxFontSize) (bold $ font "freemono" $ fc textColor $ text t)
+  fontSize (local textBoxFontSize) (bold $ font textFont $ fc textColor $ text t)
   <>  lwG (0.6 * defaultLineWidth) (lcA boxColor $ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t))
 
 transformCorrectedTextBox :: SpecialBackend b n =>

app/Main.hs

@@ -4,18 +4,34 @@ import Prelude hiding (return)
 
 -- Note: (#) and (&) are hidden in all Glance source files, since they would require
 -- - an special case when translating when Glance is run on its own source code.
-import Diagrams.Prelude hiding ((#), (&))
-import Diagrams.Backend.SVG.CmdLine
---import Diagrams.Backend.Rasterific.CmdLine
+import qualified Diagrams.Prelude as Dia hiding ((#), (&))
+
 import qualified Language.Haskell.Exts as Exts
 
+-- Options.Applicative does not seem to work qualified
+import Options.Applicative
+
 import Icons(ColorStyle(..), colorScheme, multilineComment)
 import Rendering(renderIngSyntaxGraph)
 import Translate(translateModuleToCollapsedGraphs)
+import Util(customRenderSVG)
 
+data CmdLineOptions = CmdLineOptions {
+  cmdInputFilename :: String,
+  cmdOutputFilename :: String,
+  cmdImageWidth :: Double,
+  cmdIncludeComments :: Bool
+  }
 
-renderFile :: String -> String -> IO (Diagram B)
-renderFile inputFilename includeComments = do
+optionParser :: Parser CmdLineOptions
+optionParser = CmdLineOptions
+  <$> argument str (metavar "INPUT_FILE" <> help "Input .hs filename")
+  <*> argument str (metavar "OUTPUT_FILE" <> help "Output .svg filename")
+  <*> argument auto (metavar "IMAGE_WIDTH" <> help "Output image width")
+  <*> switch (short 'c' <> help "Include comments between top level declarations.")
+
+renderFile :: CmdLineOptions -> IO ()
+renderFile (CmdLineOptions inputFilename outputFilename imageWidth includeComments) = do
   putStrLn $ "Translating file " ++ inputFilename ++ " into a Glance image."
   parseResult <- Exts.parseFileWithComments
     (Exts.defaultParseMode
@@ -32,16 +48,30 @@ renderFile inputFilename includeComments = do
 
   diagrams <- traverse renderIngSyntaxGraph drawings
   let
-    commentsInBoxes = fmap (\(Exts.Comment _ _ c) -> alignL $ multilineComment white (opaque white) c) comments
-    diagramsAndComments = vsep 2 $ zipWith (\x y -> x === strutY 0.4 === y) commentsInBoxes (fmap alignL diagrams)
-    justDiagrams = vsep 1 $ fmap alignL diagrams
-    diagramsAndMaybeComments = if includeComments == "c" then diagramsAndComments else justDiagrams
+    commentsInBoxes = fmap (\(Exts.Comment _ _ c) -> Dia.alignL $ multilineComment Dia.white (Dia.opaque Dia.white) c) comments
+    diagramsAndComments = Dia.vsep 2 $ zipWith (\x y -> x Dia.=== Dia.strutY 0.4 Dia.=== y) commentsInBoxes (fmap Dia.alignL diagrams)
+    justDiagrams = Dia.vsep 1 $ fmap Dia.alignL diagrams
+    diagramsAndMaybeComments = if includeComments then diagramsAndComments else justDiagrams
   --print comments
 
-  pure (bgFrame 1 (backgroundC colorScheme) diagramsAndMaybeComments :: Diagram B)
+    finalDia = Dia.bgFrame 1 (backgroundC colorScheme) diagramsAndMaybeComments
+  customRenderSVG outputFilename (Dia.mkWidth imageWidth) finalDia
+  putStrLn $ "Successfully wrote " ++ outputFilename
 
+translateFileMain :: IO ()
+translateFileMain = customExecParser parserPrefs  opts >>= renderFile where
+
+  parserPrefs = defaultPrefs{
+    prefShowHelpOnError = True
+
+    -- TODO enable this option when optparse-applicative has been upgraded
+    --prefShowHelpOnEmpty = True
+    }
+  
+  opts = info (helper <*> optionParser)
+    (fullDesc
+    <> progDesc "Translate a Haskell source file (.hs) into an SVG image."
+    <> header "Glance - a visual representation of Haskell")
 
 main :: IO ()
-main = do
-  mainWith renderFile
-  putStrLn "Successfully translated file."
+main = translateFileMain

app/Translate.hs

@@ -769,9 +769,13 @@ evalPatBind c (PatBind _ pat rhs maybeWhereBinds) = do
 -- TODO May want to trim whitespace from (prettyPrint typeForNames)
 evalTypeSig :: Decl -> State IDState (SyntaxGraph, NameAndPort)
 evalTypeSig (TypeSig _ names typeForNames) = makeBox
-  (intercalate "," (fmap prettyPrint names)
+  (intercalate "," (fmap prettyPrintWithoutNewlines names)
    ++ " :: "
-   ++ prettyPrint typeForNames)
+   ++ prettyPrintWithoutNewlines typeForNames)
+  where
+    -- TODO Make custom version of prettyPrint for type signitures.
+    -- Use (unwords . words) to convert consecutive whitspace characters to one space
+    prettyPrintWithoutNewlines = unwords . words . prettyPrint
 
 evalDecl :: EvalContext -> Decl -> State IDState SyntaxGraph
 evalDecl c d = case d of

app/Util.hs

@@ -22,14 +22,16 @@ module Util (
   customRenderSVG
 )where
 
-import Diagrams.Backend.SVG(renderSVG', Options(..))
+import Diagrams.Backend.SVG(renderSVG', Options(..), SVG)
 import Graphics.Svg.Attributes(bindAttr, AttrTag(..))
+import qualified Diagrams.Prelude as Dia
 
 import Control.Arrow(first)
 -- import Diagrams.Prelude(IsName, toName, Name)
 import Data.Maybe(fromMaybe)
 import qualified Debug.Trace
 import Data.Text(pack)
+import Data.Typeable(Typeable)
 
 import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection, NodeName(..), Port,
              SyntaxNode, SgNamedNode(..))
@@ -96,6 +98,12 @@ sgNamedNodeToSyntaxNode (SgNamedNode _ n) = n
 nodeNameToInt :: NodeName -> Int
 nodeNameToInt (NodeName x) = x
 
+
+customRenderSVG :: (Typeable n, Show n, RealFloat n) =>
+  FilePath
+  -> Dia.SizeSpec Dia.V2 n
+  -> Dia.QDiagram SVG Dia.V2 n Dia.Any
+  -> IO ()
 customRenderSVG outputFilename size = renderSVG' outputFilename svgOptions where
   -- This xml:space attribute preserves the whitespace in the svg text.
   attributes = [bindAttr XmlSpace_ (pack "preserve")]

glance.cabal

@@ -39,6 +39,7 @@ executable glance-exe
                      , diagrams-rasterific
                      , text
                      , svg-builder
+                     , optparse-applicative
   default-language:    Haskell2010
   Other-modules: Icons, Rendering, Types, Util, Translate, TranslateCore, DrawingColors, GraphAlgorithms
 

test/AllTests.hs

@@ -1,6 +1,5 @@
 import Prelude hiding (return)
 
-import Diagrams.Backend.SVG (renderSVG)
 import Diagrams.Backend.SVG.CmdLine(B)
 import Diagrams.Prelude hiding ((#), (&))
 

todo.md

@@ -1,7 +1,9 @@
 # Todo
 
 ## Todo Now
-* Use customRenderSVG in app/Main.hs.
+* Update tutorial code formatting.
+
+* Update Stackage lts (see todo in Main.hs)
 
 * Add wiki pages discussing: Why a visual language?, Glance design goals, History of Glance, FAQ's, How to contribute, Code guide [code style, ...], Related projects, examples demonstrating the utility of Glance etc..
 
@@ -31,3 +33,6 @@
 * Add proper RecConstr, and RecUpdate support.
 
 * Special case for otherwise.
+
+### Command line todos
+* Tab completion