GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-04 08:42:50 -06:00
Code Issues Packages Projects Releases Wiki 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

10
src/server/PGFService.hs
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