From e3a279e457c8159c07db2db652dbe151afb51f36 Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Thu, 22 Apr 2010 14:01:08 +0000
Subject: [PATCH] now the PGF service communicates with Graphviz using UTF8 for
 the input and binary for the output

---
 src/server/FastCGIUtils.hs       |  5 ++--
 src/server/PGFService.hs         | 45 +++++++++++++++++++++++++++-----
 src/server/gf-server.cabal       |  3 ++-
 src/server/gwt/Translate-compile |  2 ++
 4 files changed, 46 insertions(+), 9 deletions(-)

diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs
index 8d90c9fa7..43b16eea0 100644
--- a/src/server/FastCGIUtils.hs
+++ b/src/server/FastCGIUtils.hs
@@ -27,6 +27,7 @@ import Network.FastCGI
 
 import Text.JSON
 import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString)
+import qualified Data.ByteString.Lazy as BS
 
 
 initFastCGI :: IO ()
@@ -168,10 +169,10 @@ outputJSONP x =
        setHeader "Content-Type" "text/json; charset=utf-8"
        outputStrict $ UTF8.encodeString str
 
-outputPNG :: String -> CGI CGIResult
+outputPNG :: BS.ByteString -> CGI CGIResult
 outputPNG x = do
        setHeader "Content-Type" "image/png"
-       outputStrict x
+       outputFPS x
 
 outputHTML :: String -> CGI CGIResult
 outputHTML x = do
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index 0ee7391e2..7a57bba81 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -9,8 +9,10 @@ import URLEncoding
 import Network.FastCGI
 import Text.JSON
 import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString)
+import qualified Data.ByteString.Lazy as BS
 
 import Control.Concurrent
+import Control.Exception
 import Control.Monad
 import Data.Char
 import Data.Function (on)
@@ -20,6 +22,8 @@ import Data.Maybe
 import System.Directory
 import System.FilePath
 import System.Process
+import System.Exit
+import System.IO
 
 logFile :: FilePath
 logFile = "pgf-error.log"
@@ -206,16 +210,45 @@ doGrammar pgf macc = showJSON $ toJSObject
         functions  = [PGF.showCId fun | fun <- PGF.functions pgf]
 
 doGraphvizAbstrTree pgf tree = do
-  let dot = PGF.graphvizAbstractTree pgf (True,True) tree
-  readProcess "dot" ["-T","png"] dot
+  pipeIt2graphviz $  PGF.graphvizAbstractTree pgf (True,True) tree
 
 doGraphvizParseTree pgf lang tree = do
-  let dot = PGF.graphvizParseTree pgf lang tree
-  readProcess "dot" ["-T","png"] (UTF8.encodeString dot)
+  pipeIt2graphviz $ PGF.graphvizParseTree pgf lang tree
 
 doGraphvizAlignment pgf tree = do
-  let dot = PGF.graphvizAlignment pgf tree
-  readProcess "dot" ["-T","png"] (UTF8.encodeString dot)
+  pipeIt2graphviz $ PGF.graphvizAlignment pgf tree
+
+pipeIt2graphviz :: String -> IO BS.ByteString
+pipeIt2graphviz code = do
+    (Just inh, Just outh, _, pid) <-
+        createProcess (proc "dot" ["-T","png"])
+                      { std_in  = CreatePipe,
+                        std_out = CreatePipe,
+                        std_err = Inherit }
+
+    hSetEncoding outh latin1
+    hSetEncoding inh  utf8
+
+    -- fork off a thread to start consuming the output
+    output  <- BS.hGetContents outh
+    outMVar <- newEmptyMVar
+    _ <- forkIO $ evaluate (BS.length output) >> putMVar outMVar ()
+
+    -- now write and flush any input
+    hPutStr inh code
+    hFlush inh
+    hClose inh -- done with stdin
+
+    -- wait on the output
+    takeMVar outMVar
+    hClose outh
+
+    -- wait on the process
+    ex <- waitForProcess pid
+
+    case ex of
+     ExitSuccess   -> return output
+     ExitFailure r -> fail ("pipeIt2graphviz: (exit " ++ show r ++ ")")
 
 doBrowse pgf id cssClass href =
   case PGF.browse pgf id of
diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal
index cdd61d933..bba60ceec 100644
--- a/src/server/gf-server.cabal
+++ b/src/server/gf-server.cabal
@@ -17,7 +17,8 @@ executable pgf-server
                  cgi >= 3001.1.7.0,
                  fastcgi >= 3001.0.2.1,
                  json >= 0.3.3,
-                 utf8-string >= 0.3.1.1
+                 utf8-string >= 0.3.1.1,
+                 bytestring
   if !os(windows)
     build-depends: unix
   main-is: PGFService.hs
diff --git a/src/server/gwt/Translate-compile b/src/server/gwt/Translate-compile
index 42c02da33..a2c6faaf0 100644
--- a/src/server/gwt/Translate-compile
+++ b/src/server/gwt/Translate-compile
@@ -1,6 +1,8 @@
 #!/bin/sh
 
 APPDIR=`dirname $0`;
+export GWT_DIR="/home/angelov/gwt-linux-1.5.3"
+export GWT_CLASSPATH="$GWT_DIR/gwt-user.jar:$GWT_DIR/gwt-dev-linux.jar"
 
 if [ -z "$GWT_CLASSPATH" ]; then
   echo 'ERROR: $GWT_CLASSPATH is not set'