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

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

View File

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

View File

@@ -42,7 +42,7 @@ import System.Exit
import System.IO
import System.IO.Error(isDoesNotExistError)
import System.Directory(removeFile)
import System.FilePath(dropExtension,takeDirectory,(</>),(<.>))
import System.FilePath(takeExtension,dropExtension,takeDirectory,(</>),(<.>))
import System.Mem(performGC)
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
qsem <- newQSem n
pgfCache <- newCache' readPGF
pgfCache <- newCache' readGrammar
lblCache <- newCache' (fmap getDepLabels . readFile)
return $ Caches qsem pgfCache lblCache
flushPGFCache c = do flushCache (pgfCache c)
flushCache (labelsCache 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
forkIO $ forever $ clean c
return c