GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-21 10:49:33 -06:00
Code Issues Packages Projects Releases Wiki Activity

refactoring pgfMain now takes the file path directly

Browse Source
This commit is contained in:
Krasimir Angelov
2024-05-16 19:34:02 +02:00
parent 02e8dcbb56
commit efe00f88e3
2 changed files with 4 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
src/server/PGFService.hs
View File

@@ -25,7 +25,6 @@ import System.IO.Error(isDoesNotExistError)
import System.FilePath(takeExtension)
import System.Mem(performGC)
import Network.HTTP
import Network.FastCGI hiding (Connection, writeHeaders)
import Numeric(showHex)
@@ -62,8 +61,8 @@ newCache' root rd = do
clean c = do threadDelay 2000000000 -- 2000 seconds, i.e. ~33 minutes
expireCache (24*60*60) c -- 24 hours
pgfMain :: (String -> IO ()) -> Connection -> Caches -> Env -> Request -> IO ()
pgfMain logLn conn cache env rq =
pgfMain :: (String -> IO ()) -> Connection -> Caches -> FilePath -> Request -> IO ()
pgfMain logLn conn cache path rq =
case fromMaybe "grammar" (lookup "command" query) of
"download"
| ext == ".pgf" -> do tpgf <- getFile (readCache' (pgfCache cache)) path
@@ -77,8 +76,6 @@ pgfMain logLn conn cache env rq =
handleErrors logLn (pgfCommand (qsem cache) command query tpgf) >>= respondHTTP conn
_ -> respondHTTP conn (Response 415 "Bad Request" [] "Extension must be .pgf or .ngf")
where
path = fromMaybe "" (lookup "PATH_TRANSLATED" env `mplus`
lookup "SCRIPT_FILENAME" env)
ext = takeExtension path
query = rqQuery rq