mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 11:19:32 -06:00
src/server/gf-server.cabal: compile it as a common library + executables
This commit is contained in:
49
src/server/exec/pgf-http.hs
Normal file
49
src/server/exec/pgf-http.hs
Normal file
@@ -0,0 +1,49 @@
|
||||
|
||||
import Network.CGI(requestMethod,getVarWithDefault,logCGI,handleErrors,liftIO)
|
||||
import System.Environment(getArgs)
|
||||
import System.Directory(getDirectoryContents)
|
||||
import System.FilePath(takeExtension,takeFileName,takeDirectory,(</>))
|
||||
|
||||
import RunHTTP(runHTTP,Options(..))
|
||||
import ServeStaticFile(serveStaticFile)
|
||||
import PGFService(cgiMain',getPath,stderrToFile,logFile,newPGFCache)
|
||||
import FastCGIUtils(outputJSONP,handleCGIErrors)
|
||||
|
||||
import Paths_gf_server(getDataDir)
|
||||
|
||||
main :: IO ()
|
||||
main = do datadir <- getDataDir
|
||||
let defaults = Options { documentRoot = datadir</>"www",
|
||||
port = 41296 }
|
||||
cache <- newPGFCache
|
||||
args <- getArgs
|
||||
options <- case args of
|
||||
[] -> return defaults
|
||||
[port] -> do p <- readIO port
|
||||
return defaults{port=p}
|
||||
putStrLn $ "Starting HTTP server, open http://localhost:"
|
||||
++show (port options)++"/ in your web browser.\n"
|
||||
print options
|
||||
putStrLn $ "logFile="++logFile
|
||||
stderrToFile logFile
|
||||
httpMain cache options
|
||||
|
||||
|
||||
httpMain cache options = runHTTP options (do log ; serve =<< getPath)
|
||||
where
|
||||
log = do method <- requestMethod
|
||||
uri <- getVarWithDefault "REQUEST_URI" "-"
|
||||
logCGI $ method++" "++uri
|
||||
|
||||
serve path =
|
||||
handleErrors . handleCGIErrors $
|
||||
if takeExtension path==".pgf"
|
||||
then cgiMain' cache path
|
||||
else if takeFileName path=="grammars.cgi"
|
||||
then grammarList (takeDirectory path)
|
||||
else serveStaticFile path
|
||||
|
||||
grammarList dir =
|
||||
do paths <- liftIO $ getDirectoryContents dir
|
||||
let pgfs = [path|path<-paths, takeExtension path==".pgf"]
|
||||
outputJSONP pgfs
|
||||
Reference in New Issue
Block a user