From 1962574941f8d009578dbc9bb92ea28e86c71afa Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Tue, 26 Mar 2013 14:17:24 +0000
Subject: [PATCH] PGF service: support all parse tree visualziation options in
 the web API

The new options are

  * noleaves, nofun, nocat (booleans, false by default)
  * nodefont, leaffont, nodecolor, leafcolor, nodeedgestyle, leafedgestyle
    (strings, empty by default)
---
 src/server/PGFService.hs | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index c537fc0f8..3a43d4589 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -72,7 +72,8 @@ pgfMain command pgf =
       "alignment"      -> outputGraphviz =<< alignment pgf # tree % to
       "parsetree"      -> do t <- tree
                              Just l <- from
-                             outputGraphviz (parseTree pgf l t)
+                             opts <- graphvizOptions
+                             outputGraphviz (parseTree pgf l opts t)
       "abstrjson"      -> out . jsonExpr =<< tree
       "browse"         -> join $ doBrowse pgf # optId % cssClass % href % format "html" % getIncludePrintNames
       "external"       -> do cmd <- getInput "external"
@@ -147,6 +148,20 @@ pgfMain command pgf =
     getIncludePrintNames :: CGI Bool
     getIncludePrintNames = maybe False (const True) # getInput "printnames"
 
+    graphvizOptions =
+        PGF.GraphvizOptions # bool "noleaves"
+                            % bool "nofun"
+                            % bool "nocat"
+                            % string "nodefont"
+                            % string "leaffont"
+                            % string "nodecolor"
+                            % string "leafcolor"
+                            % string "nodeedgestyle"
+                            % string "leafedgestyle"
+      where
+        string name = maybe "" id # getInput name
+        bool name = maybe False toBool # getInput name
+        toBool s = s `elem` ["","yes","true","True"]
 
 errorMissingId = throwCGIError 400 "Missing identifier" []
 
@@ -342,9 +357,9 @@ outputGraphviz code =
     -- ...
         _     -> "application/binary"
 
-abstrTree pgf tree      = PGF.graphvizAbstractTree pgf (True,True) tree
-parseTree pgf lang tree = PGF.graphvizParseTree pgf lang PGF.graphvizDefaults tree
-alignment pgf tree tos  = PGF.graphvizAlignment pgf tos' tree
+abstrTree pgf tree           = PGF.graphvizAbstractTree pgf (True,True) tree
+parseTree pgf lang opts tree = PGF.graphvizParseTree pgf lang opts tree
+alignment pgf tree tos       = PGF.graphvizAlignment pgf tos' tree
   where tos' = if null tos then PGF.languages pgf else tos
 
 pipeIt2graphviz :: String -> String -> IO BS.ByteString