diff options
| author | hallgren <hallgren@chalmers.se> | 2012-02-28 17:20:59 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2012-02-28 17:20:59 +0000 |
| commit | c1c1a73dc3db1f1ae8b298f836dfa7a2a17f2638 (patch) | |
| tree | 817e95443be3accf83e7bb67739ed2bb9aeac014 /src/compiler/GFServer.hs | |
| parent | 5fa14181944ff74cd3737f884b09dfb1e4404106 (diff) | |
gf -server mode: JSONP support for grammar lists
Needed by the translation quiz.
Diffstat (limited to 'src/compiler/GFServer.hs')
| -rw-r--r-- | src/compiler/GFServer.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs index 65ed6a315..f0eec5265 100644 --- a/src/compiler/GFServer.hs +++ b/src/compiler/GFServer.hs @@ -110,7 +110,7 @@ handle state0 cache execute1 '/':rpath -> case (takeDirectory path,takeFileName path,takeExtension path) of (_ ,_ ,".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 _ -> do resp <- serveStaticFile path return (state,resp) @@ -219,9 +219,9 @@ handle state0 cache execute1 link_directories olddir newdir _ = return (state,resp400 $ "unacceptable directories "++olddir++" "++newdir) - grammarList dir = + grammarList dir qs = do pgfs <- ls_ext dir ".pgf" - return (state,json200 pgfs) + return (state,jsonp qs pgfs) ls_ext dir ext = do paths <- getDirectoryContents dir @@ -313,10 +313,17 @@ serveStaticFile' path = -- * Logging logPutStrLn = hPutStrLn stderr +-- * JSONP output + +jsonp qs = json200' $ maybe id apply (lookup "jsonp" qs) + where + apply f json = f++"("++json++")" + -- * Standard HTTP responses ok200 = Response 200 [plainUTF8,noCache] . encodeString 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 resp204 = Response 204 [] "" -- no content resp400 msg = Response 400 [plain] $ "Bad request: "++msg++"\n" |