From 69589f7d24dd57f0c9ccab538dfa6fcca60fbabe Mon Sep 17 00:00:00 2001
From: Robbie Gleichman <rgleichman@gmail.com>
Date: Tue, 3 Jan 2017 18:43:33 -0800
Subject: [PATCH] Make a custom version of renderSVG that includes the
 xml:space=preserve attribute. This preveres whitespace in svg text.

---
 app/Util.hs                  | 13 ++++++++++++-
 glance.cabal                 |  4 ++++
 test/AllTests.hs             |  3 ++-
 test/VisualTranslateTests.hs |  4 +++-
 todo.md                      |  2 +-
 5 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/app/Util.hs b/app/Util.hs
index de4833d..060bb95 100644
--- a/app/Util.hs
+++ b/app/Util.hs
@@ -18,13 +18,18 @@ module Util (
   maybeBoolToBool,
   mapNodeInNamedNode,
   sgNamedNodeToSyntaxNode,
-  nodeNameToInt
+  nodeNameToInt,
+  customRenderSVG
 )where
 
+import Diagrams.Backend.SVG(renderSVG', Options(..))
+import Graphics.Svg.Attributes(bindAttr, AttrTag(..))
+
 import Control.Arrow(first)
 -- import Diagrams.Prelude(IsName, toName, Name)
 import Data.Maybe(fromMaybe)
 import qualified Debug.Trace
+import Data.Text(pack)
 
 import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection, NodeName(..), Port,
              SyntaxNode, SgNamedNode(..))
@@ -90,3 +95,9 @@ sgNamedNodeToSyntaxNode (SgNamedNode _ n) = n
 
 nodeNameToInt :: NodeName -> Int
 nodeNameToInt (NodeName x) = x
+
+customRenderSVG outputFilename size = renderSVG' outputFilename svgOptions where
+  -- This xml:space attribute preserves the whitespace in the svg text.
+  attributes = [bindAttr XmlSpace_ (pack "preserve")]
+  -- TODO Look at the source of renderSVG to see what the 3rd argument to SVGOptions should be
+  svgOptions = SVGOptions size Nothing (pack "") attributes True
diff --git a/glance.cabal b/glance.cabal
index 4360834..6c0fb4d 100644
--- a/glance.cabal
+++ b/glance.cabal
@@ -37,6 +37,8 @@ executable glance-exe
                      , mtl
                      , semigroups
                      , diagrams-rasterific
+                     , text
+                     , svg-builder
   default-language:    Haskell2010
   Other-modules: Icons, Rendering, Types, Util, Translate, TranslateCore, DrawingColors, GraphAlgorithms
 
@@ -58,6 +60,8 @@ test-suite glance-test
                      , haskell-src-exts
                      , mtl
                      , semigroups
+                     , text
+                     , svg-builder
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
   Other-modules: Icons
diff --git a/test/AllTests.hs b/test/AllTests.hs
index 8900b6e..3786663 100644
--- a/test/AllTests.hs
+++ b/test/AllTests.hs
@@ -7,6 +7,7 @@ import Diagrams.Prelude hiding ((#), (&))
 import Test.HUnit
 
 import Icons(colorScheme, ColorStyle(..))
+import Util(customRenderSVG)
 
 import UnitTests(allUnitTests)
 import VisualGraphAlgorithmTests(visualCollapseTests)
@@ -26,7 +27,7 @@ renderDrawings = mapM_ saveDrawing where
   saveDrawing (name, drawingMaker) = do
     dia <- drawingMaker
     -- TODO Replace string concatenation with proper path manipulation functions.
-    renderSVG ("test/test-output/" ++ name ++ ".svg") (mkWidth 700) (bgFrame 1 (backgroundC colorScheme) dia)
+    customRenderSVG ("test/test-output/" ++ name ++ ".svg") (mkWidth 700) (bgFrame 1 (backgroundC colorScheme) dia)
 
 main :: IO ()
 --main = print "Hello world"
diff --git a/test/VisualTranslateTests.hs b/test/VisualTranslateTests.hs
index 2c69bfc..3210782 100644
--- a/test/VisualTranslateTests.hs
+++ b/test/VisualTranslateTests.hs
@@ -231,7 +231,9 @@ otherTests = [
   "y = f (g x1 x2) x3",
   "y = (f x1 x2) (g x1 x2)",
   "y = Foo.bar",
-  "y x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 = f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10"
+  "y x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 = f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10",
+  -- test that whitespace is preserved
+  "y = \" foo  bar   baz    \""
   ]
 
 testDecls :: [String]
diff --git a/todo.md b/todo.md
index 7c3e6fc..0d4c33e 100644
--- a/todo.md
+++ b/todo.md
@@ -1,7 +1,7 @@
 # Todo
 
 ## Todo Now
-* Fix whitspace being stripped in comments.
+* Use customRenderSVG in app/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..