msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

gf -server mode: JSONP support for grammar lists

Browse Source 
Needed by the translation quiz.
This commit is contained in:
hallgren
2012-02-28 17:20:59 +00:00
parent e0bf3c0a07
commit a68331d287
1 changed files with 11 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/compiler/GFServer.hs
View File

@@ -110,7 +110,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",_ ) -> grammarList dir (dir,"grammars.cgi",_ ) -> grammarList dir qs
(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)
@@ -219,9 +219,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 = grammarList dir qs =
do pgfs <- ls_ext dir ".pgf" do pgfs <- ls_ext dir ".pgf"
return (state,json200 pgfs) return (state,jsonp qs pgfs)
ls_ext dir ext = ls_ext dir ext =
do paths <- getDirectoryContents dir do paths <- getDirectoryContents dir
@@ -313,10 +313,17 @@ serveStaticFile' path =
-- * Logging -- * Logging
logPutStrLn = hPutStrLn stderr logPutStrLn = hPutStrLn stderr
-- * JSONP output
jsonp qs = json200' $ maybe id apply (lookup "jsonp" qs)
where
apply f json = f++"("++json++")"
-- * 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 json200 x = json200' id x
json200' f = ok200' jsonUTF8 . encodeString . f . encode
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"