summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler/GFServer.hs40
-rw-r--r--src/www/gfse/cloud2.js10
-rw-r--r--src/www/gfse/editor.js35
3 files changed, 69 insertions, 16 deletions
diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs
index 685b9d76f..3fcec3f4d 100644
--- a/src/compiler/GFServer.hs
+++ b/src/compiler/GFServer.hs
@@ -10,7 +10,8 @@ import System.IO.Error(try,ioError,isAlreadyExistsError)
import System.Directory(doesDirectoryExist,doesFileExist,createDirectory,
setCurrentDirectory,getCurrentDirectory,
getDirectoryContents,removeFile,removeDirectory)
-import System.FilePath(takeExtension,takeFileName,takeDirectory,(</>))
+import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory,
+ (</>))
#ifndef mingw32_HOST_OS
import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink,
createSymbolicLink)
@@ -23,6 +24,7 @@ import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments,
--import qualified Data.ByteString.Char8 as BS(pack,unpack,length)
import Network.CGI(handleErrors,liftIO)
import FastCGIUtils(outputJSONP,handleCGIErrors,stderrToFile)
+import Text.JSON(encode,showJSON,toJSObject)
import System.IO.Silently(hCapture)
import System.Process(readProcessWithExitCode)
import System.Exit(ExitCode(..))
@@ -107,7 +109,7 @@ handle state0 cache execute1
'/':rpath ->
case (takeDirectory path,takeFileName path,takeExtension path) of
(_ ,_ ,".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
_ -> do resp <- serveStaticFile path
return (state,resp)
@@ -171,7 +173,7 @@ handle state0 cache execute1
cmd = unwords ("gf":args)
out <- readProcessWithExitCode "gf" args ""
cwd <- getCurrentDirectory
- return (state,html200 (resultpage cwd ('/':dir++"/") cmd out files))
+ return (state,json200 (jsonresult cwd ('/':dir++"/") cmd out files))
upload files =
do let update (name,contents)= updateFile name contents
@@ -180,7 +182,7 @@ handle state0 cache execute1
jsonList =
do jsons <- ls_ext "." ".json"
- return (state,ok200 (unwords jsons))
+ return (state,json200 jsons)
rm path _ | takeExtension path==".json" =
do b <- doesFileExist path
@@ -213,7 +215,9 @@ handle state0 cache execute1
link_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 =
do paths <- getDirectoryContents dir
@@ -221,6 +225,26 @@ handle state0 cache execute1
-- * 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 =
unlines $
"<!DOCTYPE html>":
@@ -239,7 +263,7 @@ resultpage cwd dir cmd (ecode,stdout,stderr) files =
[]
pgf = case files of
- (abstract,_):_ -> "%20"++take (length abstract-3) abstract++".pgf"
+ (abstract,_):_ -> "%20"++dropExtension abstract++".pgf"
_ -> ""
listing = concatMap listfile files
@@ -267,7 +291,7 @@ escape = concatMap escape1
escape1 '<' = "&lt;"
escape1 '&' = "&amp;"
escape1 c = [c]
-
+-}
-- * Static content
serveStaticFile path =
@@ -290,6 +314,7 @@ logPutStrLn = hPutStrLn stderr
-- * Standard HTTP responses
ok200 = Response 200 [plainUTF8,noCache] . encodeString
ok200' t = Response 200 [t]
+json200 x = ok200' jsonUTF8 . encodeString . encode $ x
html200 = ok200' htmlUTF8 . encodeString
resp204 = Response 204 [] "" -- no content
resp400 msg = Response 400 [plain] $ "Bad request: "++msg++"\n"
@@ -299,6 +324,7 @@ resp501 msg = Response 501 [plain] $ "Not implemented: "++msg++"\n"
-- * Content types
plain = ct "text/plain"
plainUTF8 = ct "text/plain; charset=UTF-8"
+jsonUTF8 = ct "text/javascript; charset=UTF-8"
htmlUTF8 = ct "text/html; charset=UTF-8"
ct t = ("Content-Type",t)
diff --git a/src/www/gfse/cloud2.js b/src/www/gfse/cloud2.js
index c9e59a21d..8cfaa077d 100644
--- a/src/www/gfse/cloud2.js
+++ b/src/www/gfse/cloud2.js
@@ -49,7 +49,7 @@ function old_upload(g) {
}
// Upload the grammar to the server and check it for errors
-function upload(g) {
+function upload(g,cont) {
function upload2(dir) {
var pre="dir="+encodeURIComponent(dir)
var form= {command:"make"}
@@ -61,10 +61,10 @@ function upload(g) {
ajax_http_post("/cloud",pre+encodeArgs(form),upload3)
}
- function upload3(message) {
- var dst=element("compiler_output")
- if(dst) dst.innerHTML=message;
- else alert(message);
+ function upload3(json) {
+ var res=JSON.parse(json)
+ if(cont) cont(res)
+ else alert(res.errorcode+"\n"+res.command+"\n\n"+res.output);
}
with_dir(upload2)
diff --git a/src/www/gfse/editor.js b/src/www/gfse/editor.js
index 885a6871c..dca939ec8 100644
--- a/src/www/gfse/editor.js
+++ b/src/www/gfse/editor.js
@@ -148,7 +148,8 @@ function draw_grammar(g) {
function draw_namebar(g,files) {
return div_class("namebar",
[table([tr([td(draw_name(g)),
- td_right([upload_button(g),
+ td_right([minibar_button(g),
+ compile_button(g),
draw_plainbutton(g,files),
draw_closebutton(g)])])])])
}
@@ -180,9 +181,35 @@ function draw_plainbutton(g,files) {
return b;
}
-function upload_button(g) {
- var b=button("Compile",function(){upload(g);});
- b.title="Upload the grammar to the server to check it in GF and test it in the minibar";
+function show_compile_error(res) {
+ var dst=element("compiler_output")
+ 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;
}
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 20:13:01 +0000