forked from GitHub/gf-core
Improvements of "gf -server" mode and related setup
"gf -server" mode now contains everything needed to run the minibar and the grammar editor (including example-based grammar writing). The Setup.hs script installs the required files where gf -server can find them. These files have been moved to a new directory: src/www. The separate server program pgf-http is now obsolete.
This commit is contained in:
@@ -27,21 +27,19 @@ import qualified ExampleService as ES
|
||||
import Paths_gf(getDataDir)
|
||||
import RunHTTP(Options(..),cgiHandler)
|
||||
|
||||
-- * Configuraiton
|
||||
|
||||
options = Options { documentRoot = "." {-datadir</>"www"-}, port = gfport }
|
||||
gfport = 41296
|
||||
|
||||
-- * HTTP server
|
||||
server execute1 state0 =
|
||||
do state <- newMVar M.empty
|
||||
cache <- PS.newPGFCache
|
||||
--datadir <- getDataDir
|
||||
putStrLn $ "Starting server on port "++show gfport
|
||||
initServer gfport (modifyMVar state . handle state0 cache execute1)
|
||||
datadir <- getDataDir
|
||||
let options = Options { documentRoot = datadir</>"www", port = 41296 }
|
||||
putStrLn $ "Starting HTTP server, open http://localhost:"
|
||||
++show (port options)++"/ in your web browser."
|
||||
initServer (port options)
|
||||
(modifyMVar state . handle options state0 cache execute1)
|
||||
|
||||
-- * HTTP request handler
|
||||
handle state0 cache execute1
|
||||
handle options state0 cache execute1
|
||||
rq@(Request method URI{uriPath=upath,uriQuery=q} hdrs body) state =
|
||||
do let qs = decodeQ $
|
||||
case method of
|
||||
@@ -67,6 +65,8 @@ handle state0 cache execute1
|
||||
where
|
||||
root = documentRoot options
|
||||
|
||||
translatePath rpath = root</>rpath -- hmm, check for ".."
|
||||
|
||||
wrapCGI cgi =
|
||||
do resp <- cgiHandler root (handleErrors . handleCGIErrors $ cgi) rq
|
||||
return (state,resp)
|
||||
@@ -191,8 +191,6 @@ escape1 c = [c]
|
||||
|
||||
-- * Static content
|
||||
|
||||
translatePath path = documentRoot options</>path -- hmm, check for ".."
|
||||
|
||||
serveStaticFile path =
|
||||
do b <- doesDirectoryExist path
|
||||
let path' = if b then path </> "index.html" else path
|
||||
|
||||
Reference in New Issue
Block a user