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

the web server now serves both .pgf and .ngf files

Browse Source
This commit is contained in:
Krasimir Angelov
2022-05-31 11:32:02 +02:00
parent 4c433b6b9d
commit 418aa1a2b2
2 changed files with 10 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Server.hs
View File

@@ -166,8 +166,8 @@ handle logLn documentroot state0 cache execute1 stateVar
-- This code runs without mutual exclusion, so it must *not* -- This code runs without mutual exclusion, so it must *not*
-- use/change the cwd. Access files by absolute paths only. -- use/change the cwd. Access files by absolute paths only.
case (takeDirectory path,takeFileName path,takeExtension path) of case (takeDirectory path,takeFileName path,takeExtension path) of
(_ ,_ ,".pgf") -> do --debug $ "PGF service: "++path (_ ,_ ,".pgf") -> wrapCGI $ PS.cgiMain' cache path
wrapCGI $ PS.cgiMain' cache path (_ ,_ ,".ngf") -> wrapCGI $ PS.cgiMain' cache path
(dir,"grammars.cgi",_ ) -> grammarList dir (decoded qs) (dir,"grammars.cgi",_ ) -> grammarList dir (decoded qs)
_ -> serveStaticFile rpath path _ -> serveStaticFile rpath path
where path = translatePath rpath where path = translatePath rpath

10
src/server/PGFService.hs
View File

@@ -42,7 +42,7 @@ import System.Exit
import System.IO import System.IO
import System.IO.Error(isDoesNotExistError) import System.IO.Error(isDoesNotExistError)
import System.Directory(removeFile) import System.Directory(removeFile)
import System.FilePath(dropExtension,takeDirectory,(</>),(<.>)) import System.FilePath(takeExtension,dropExtension,takeDirectory,(</>),(<.>))
import System.Mem(performGC) import System.Mem(performGC)
catchIOE :: IO a -> (E.IOException -> IO a) -> IO a catchIOE :: IO a -> (E.IOException -> IO a) -> IO a
@@ -59,13 +59,19 @@ data Caches = Caches { qsem :: QSem,
newPGFCache jobs = do let n = maybe 4 id jobs newPGFCache jobs = do let n = maybe 4 id jobs
qsem <- newQSem n qsem <- newQSem n
pgfCache <- newCache' readPGF pgfCache <- newCache' readGrammar
lblCache <- newCache' (fmap getDepLabels . readFile) lblCache <- newCache' (fmap getDepLabels . readFile)
return $ Caches qsem pgfCache lblCache return $ Caches qsem pgfCache lblCache
flushPGFCache c = do flushCache (pgfCache c) flushPGFCache c = do flushCache (pgfCache c)
flushCache (labelsCache c) flushCache (labelsCache c)
listPGFCache c = listCache (pgfCache c) listPGFCache c = listCache (pgfCache c)
readGrammar path =
case takeExtension path of
".pgf" -> readPGF path
".ngf" -> readNGF path
_ -> error "Extension must be .pgf or .ngf"
newCache' rd = do c <- newCache rd newCache' rd = do c <- newCache rd
forkIO $ forever $ clean c forkIO $ forever $ clean c
return c return c