mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-20 16:42:51 -06:00
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:
@@ -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 '<' = "<"
|
escape1 '<' = "<"
|
||||||
escape1 '&' = "&"
|
escape1 '&' = "&"
|
||||||
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)
|
||||||
|
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user