gfse: added a button to go directly from the editor to the minibar

If there is an error in the grammar, the error message is shown below the
grammar instead.
Also: GFServer.hs now returns compiler output in a JSON structure instead of
as a HTML page.
This commit is contained in:
hallgren
2012-02-13 15:24:05 +00:00
parent 73827b9bf7
commit fc897a909a
3 changed files with 69 additions and 16 deletions

View File

@@ -10,7 +10,8 @@ import System.IO.Error(try,ioError,isAlreadyExistsError)
import System.Directory(doesDirectoryExist,doesFileExist,createDirectory, import System.Directory(doesDirectoryExist,doesFileExist,createDirectory,
setCurrentDirectory,getCurrentDirectory, setCurrentDirectory,getCurrentDirectory,
getDirectoryContents,removeFile,removeDirectory) getDirectoryContents,removeFile,removeDirectory)
import System.FilePath(takeExtension,takeFileName,takeDirectory,(</>)) import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory,
(</>))
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink, import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink,
createSymbolicLink) createSymbolicLink)
@@ -23,6 +24,7 @@ import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments,
--import qualified Data.ByteString.Char8 as BS(pack,unpack,length) --import qualified Data.ByteString.Char8 as BS(pack,unpack,length)
import Network.CGI(handleErrors,liftIO) import Network.CGI(handleErrors,liftIO)
import FastCGIUtils(outputJSONP,handleCGIErrors,stderrToFile) import FastCGIUtils(outputJSONP,handleCGIErrors,stderrToFile)
import Text.JSON(encode,showJSON,toJSObject)
import System.IO.Silently(hCapture) import System.IO.Silently(hCapture)
import System.Process(readProcessWithExitCode) import System.Process(readProcessWithExitCode)
import System.Exit(ExitCode(..)) import System.Exit(ExitCode(..))
@@ -107,7 +109,7 @@ handle state0 cache execute1
'/':rpath -> '/':rpath ->
case (takeDirectory path,takeFileName path,takeExtension path) of case (takeDirectory path,takeFileName path,takeExtension path) of
(_ ,_ ,".pgf") -> wrapCGI $ PS.cgiMain' cache path (_ ,_ ,".pgf") -> wrapCGI $ PS.cgiMain' cache path
(dir,"grammars.cgi",_ ) -> wrapCGI $ grammarList dir (dir,"grammars.cgi",_ ) -> grammarList dir
(dir ,"exb.fcgi" ,_ ) -> wrapCGI $ ES.cgiMain' root dir cache (dir ,"exb.fcgi" ,_ ) -> wrapCGI $ ES.cgiMain' root dir cache
_ -> do resp <- serveStaticFile path _ -> do resp <- serveStaticFile path
return (state,resp) return (state,resp)
@@ -171,7 +173,7 @@ handle state0 cache execute1
cmd = unwords ("gf":args) cmd = unwords ("gf":args)
out <- readProcessWithExitCode "gf" args "" out <- readProcessWithExitCode "gf" args ""
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
return (state,html200 (resultpage cwd ('/':dir++"/") cmd out files)) return (state,json200 (jsonresult cwd ('/':dir++"/") cmd out files))
upload files = upload files =
do let update (name,contents)= updateFile name contents do let update (name,contents)= updateFile name contents
@@ -180,7 +182,7 @@ handle state0 cache execute1
jsonList = jsonList =
do jsons <- ls_ext "." ".json" do jsons <- ls_ext "." ".json"
return (state,ok200 (unwords jsons)) return (state,json200 jsons)
rm path _ | takeExtension path==".json" = rm path _ | takeExtension path==".json" =
do b <- doesFileExist path do b <- doesFileExist path
@@ -213,7 +215,9 @@ handle state0 cache execute1
link_directories olddir newdir _ = link_directories olddir newdir _ =
return (state,resp400 $ "unacceptable directories "++olddir++" "++newdir) return (state,resp400 $ "unacceptable directories "++olddir++" "++newdir)
grammarList dir = outputJSONP =<< liftIO (ls_ext dir ".pgf") grammarList dir =
do pgfs <- ls_ext dir ".pgf"
return (state,json200 pgfs)
ls_ext dir ext = ls_ext dir ext =
do paths <- getDirectoryContents dir do paths <- getDirectoryContents dir
@@ -221,6 +225,26 @@ handle state0 cache execute1
-- * Dynamic content -- * Dynamic content
jsonresult cwd dir cmd (ecode,stdout,stderr) files =
toJSObject [
field "errorcode" (if ecode==ExitSuccess then "OK" else "Error"),
field "command" cmd,
field "output" (unlines [rel stderr,rel stdout]),
field "minibar_url" ("/minibar/minibar.html?"++dir++pgf)]
where
field n v = (n,showJSON v)
pgf = case files of
(abstract,_):_ -> "%20"++dropExtension abstract++".pgf"
_ -> ""
rel = unlines . map relative . lines
-- remove absolute file paths from error messages:
relative s = case stripPrefix cwd s of
Just ('/':rest) -> rest
_ -> s
{-
resultpage cwd dir cmd (ecode,stdout,stderr) files = resultpage cwd dir cmd (ecode,stdout,stderr) files =
unlines $ unlines $
"<!DOCTYPE html>": "<!DOCTYPE html>":
@@ -239,7 +263,7 @@ resultpage cwd dir cmd (ecode,stdout,stderr) files =
[] []
pgf = case files of pgf = case files of
(abstract,_):_ -> "%20"++take (length abstract-3) abstract++".pgf" (abstract,_):_ -> "%20"++dropExtension abstract++".pgf"
_ -> "" _ -> ""
listing = concatMap listfile files listing = concatMap listfile files
@@ -267,7 +291,7 @@ escape = concatMap escape1
escape1 '<' = "&lt;" escape1 '<' = "&lt;"
escape1 '&' = "&amp;" escape1 '&' = "&amp;"
escape1 c = [c] escape1 c = [c]
-}
-- * Static content -- * Static content
serveStaticFile path = serveStaticFile path =
@@ -290,6 +314,7 @@ logPutStrLn = hPutStrLn stderr
-- * Standard HTTP responses -- * Standard HTTP responses
ok200 = Response 200 [plainUTF8,noCache] . encodeString ok200 = Response 200 [plainUTF8,noCache] . encodeString
ok200' t = Response 200 [t] ok200' t = Response 200 [t]
json200 x = ok200' jsonUTF8 . encodeString . encode $ x
html200 = ok200' htmlUTF8 . encodeString html200 = ok200' htmlUTF8 . encodeString
resp204 = Response 204 [] "" -- no content resp204 = Response 204 [] "" -- no content
resp400 msg = Response 400 [plain] $ "Bad request: "++msg++"\n" resp400 msg = Response 400 [plain] $ "Bad request: "++msg++"\n"
@@ -299,6 +324,7 @@ resp501 msg = Response 501 [plain] $ "Not implemented: "++msg++"\n"
-- * Content types -- * Content types
plain = ct "text/plain" plain = ct "text/plain"
plainUTF8 = ct "text/plain; charset=UTF-8" plainUTF8 = ct "text/plain; charset=UTF-8"
jsonUTF8 = ct "text/javascript; charset=UTF-8"
htmlUTF8 = ct "text/html; charset=UTF-8" htmlUTF8 = ct "text/html; charset=UTF-8"
ct t = ("Content-Type",t) ct t = ("Content-Type",t)

View File

@@ -49,7 +49,7 @@ function old_upload(g) {
} }
// Upload the grammar to the server and check it for errors // Upload the grammar to the server and check it for errors
function upload(g) { function upload(g,cont) {
function upload2(dir) { function upload2(dir) {
var pre="dir="+encodeURIComponent(dir) var pre="dir="+encodeURIComponent(dir)
var form= {command:"make"} var form= {command:"make"}
@@ -61,10 +61,10 @@ function upload(g) {
ajax_http_post("/cloud",pre+encodeArgs(form),upload3) ajax_http_post("/cloud",pre+encodeArgs(form),upload3)
} }
function upload3(message) { function upload3(json) {
var dst=element("compiler_output") var res=JSON.parse(json)
if(dst) dst.innerHTML=message; if(cont) cont(res)
else alert(message); else alert(res.errorcode+"\n"+res.command+"\n\n"+res.output);
} }
with_dir(upload2) with_dir(upload2)

View File

@@ -148,7 +148,8 @@ function draw_grammar(g) {
function draw_namebar(g,files) { function draw_namebar(g,files) {
return div_class("namebar", return div_class("namebar",
[table([tr([td(draw_name(g)), [table([tr([td(draw_name(g)),
td_right([upload_button(g), td_right([minibar_button(g),
compile_button(g),
draw_plainbutton(g,files), draw_plainbutton(g,files),
draw_closebutton(g)])])])]) draw_closebutton(g)])])])])
} }
@@ -180,9 +181,35 @@ function draw_plainbutton(g,files) {
return b; return b;
} }
function upload_button(g) { function show_compile_error(res) {
var b=button("Compile",function(){upload(g);}); var dst=element("compiler_output")
b.title="Upload the grammar to the server to check it in GF and test it in the minibar"; if(dst) {
dst.innerHTML="";
var minibarlink=a(res.minibar_url,[text("Minibar")])
if(res.errorcode=="OK")
dst.appendChild(wrap("h3",text("OK")))
else
appendChildren(dst,
[node("h3",{"class":"error_message"},
[text(res.errorcode)]),
wrap("pre",text(res.command)),
wrap("pre",text(res.output))])
}
}
function compile_button(g) {
var b=button("Compile",function(){upload(g,show_compile_error);});
b.title="Upload the grammar to the server to check it in GF for errors";
return b;
}
function minibar_button(g) {
function goto_minibar(res) {
show_compile_error(res);
if(res.errorcode=="OK") location.href=res.minibar_url;
}
var b=button("Minibar",function(){upload(g,goto_minibar);});
b.title="Upload the grammar and test it in the minibar";
return b; return b;
} }