GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-23 01:52:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

PGF web service: switch to the new SVG rendering of word dependency trees

Browse Source 
Also added the function outputText in CGIUtils.
This commit is contained in:
hallgren
2016-06-08 19:10:23 +00:00
parent c9ea17d293
commit a59821eb80
2 changed files with 13 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/server/CGIUtils.hs
View File

@@ -4,7 +4,7 @@ module CGIUtils (throwCGIError, handleCGIErrors,
stderrToFile,logError, stderrToFile,logError,
outputJSONP,outputEncodedJSONP, outputJSONP,outputEncodedJSONP,
outputPNG,outputBinary,outputBinary', outputPNG,outputBinary,outputBinary',
outputHTML,outputPlain) where outputHTML,outputPlain,outputText) where
import Control.Exception(Exception(..),SomeException(..),throw) import Control.Exception(Exception(..),SomeException(..),throw)
import Data.Dynamic(Typeable,cast) import Data.Dynamic(Typeable,cast)
@@ -73,7 +73,7 @@ outputEncodedJSONP json =
Nothing -> ("json",json) Nothing -> ("json",json)
Just c -> ("javascript",c ++ "(" ++ json ++ ")") Just c -> ("javascript",c ++ "(" ++ json ++ ")")
ct = "application/"++ty++"; charset=utf-8" ct = "application/"++ty++"; charset=utf-8"
outputStrict ct $ UTF8.encodeString str outputText ct str
outputPNG :: BS.ByteString -> CGI CGIResult outputPNG :: BS.ByteString -> CGI CGIResult
outputPNG = outputBinary' "image/png" outputPNG = outputBinary' "image/png"
@@ -88,10 +88,12 @@ outputBinary' ct x = do
outputFPS x outputFPS x
outputHTML :: String -> CGI CGIResult outputHTML :: String -> CGI CGIResult
outputHTML = outputStrict "text/html; charset=utf-8" . UTF8.encodeString outputHTML = outputText "text/html; charset=utf-8"
outputPlain :: String -> CGI CGIResult outputPlain :: String -> CGI CGIResult
outputPlain = outputStrict "text/plain; charset=utf-8" . UTF8.encodeString outputPlain = outputText "text/plain; charset=utf-8"
outputText ct = outputStrict ct . UTF8.encodeString
outputStrict :: String -> String -> CGI CGIResult outputStrict :: String -> String -> CGI CGIResult
outputStrict ct x | x == x = do setHeader "Content-Type" ct outputStrict ct x | x == x = do setHeader "Content-Type" ct

9
src/server/PGFService.hs
View File

@@ -7,8 +7,9 @@ import PGF (PGF)
import qualified PGF import qualified PGF
import PGF.Lexing import PGF.Lexing
import Cache import Cache
import CGIUtils(outputJSONP,outputPlain,outputHTML,logError,outputBinary, import CGIUtils(outputJSONP,outputPlain,outputHTML,outputText,
outputBinary',handleCGIErrors,throwCGIError,stderrToFile) outputBinary,outputBinary',
logError,handleCGIErrors,throwCGIError,stderrToFile)
import CGI(CGI,readInput,getInput,getVarWithDefault, import CGI(CGI,readInput,getInput,getVarWithDefault,
CGIResult,requestAcceptLanguage,handleErrors,setHeader, CGIResult,requestAcceptLanguage,handleErrors,setHeader,
Accept(..),Language(..),negotiate,liftIO) Accept(..),Language(..),negotiate,liftIO)
@@ -777,8 +778,10 @@ parseTree pgf lang opts tree = PGF.graphvizParseTree pgf lang opts tree
doDepTree path pgf fmt lang tree = doDepTree path pgf fmt lang tree =
do lbls <- either (const Nothing) Just # liftIO (tryIOError readDepLabels) do lbls <- either (const Nothing) Just # liftIO (tryIOError readDepLabels)
let vis = PGF.graphvizDependencyTree fmt False lbls Nothing pgf lang tree let vis = PGF.graphvizDependencyTree fmt False lbls Nothing pgf lang tree
if fmt `elem` ["png","gif","svg","gv"] if fmt `elem` ["png","gif","gv"]
then outputGraphviz vis then outputGraphviz vis
else if fmt=="svg"
then outputText "image/svg+xml" vis
else outputPlain vis else outputPlain vis
where where
labelsPath = dropExtension path <.> "labels" labelsPath = dropExtension path <.> "labels"