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

the server must checkout the grammar if an .ngf file changes

Browse Source
This commit is contained in:
Krasimir Angelov
2022-06-16 18:20:18 +02:00
parent ad8a32ce86
commit 8ac0d881ed
2 changed files with 11 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/server/Cache.hs
View File

@@ -12,14 +12,14 @@ import Data.Time (UTCTime,getCurrentTime,diffUTCTime)
--import Data.Time.Compat (toUTCTime)
data Cache a = Cache {
cacheLoad :: FilePath -> IO a,
cacheLoad :: Maybe a -> FilePath -> IO a,
cacheObjects :: MVar (Map FilePath (MVar (Maybe (FileInfo a))))
}
type FileInfo a = (UTCTime,UTCTime,a) -- modification time, access time, contents
-- | Create a new cache that uses the given function to read and parse files
newCache :: (FilePath -> IO a) -> IO (Cache a)
newCache :: (Maybe a -> FilePath -> IO a) -> IO (Cache a)
newCache load =
do objs <- newMVar Map.empty
return $ Cache { cacheLoad = load, cacheObjects = objs }
@@ -66,6 +66,7 @@ readCache' c file =
readObject m = do t' <- {-toUTCTime `fmap`-} getModificationTime file
now <- getCurrentTime
x' <- case m of
Just (t,_,x) | t' == t -> return x
_ -> cacheLoad c file
Just (t,_,x) | t' == t -> return x
| otherwise -> cacheLoad c (Just x) file
_ -> cacheLoad c Nothing file
return (Just (t',now,x'), (t',x'))

9
src/server/PGFService.hs
View File

@@ -4,6 +4,7 @@ module PGFService(cgiMain,cgiMain',getPath,
Caches,pgfCache,newPGFCache,flushPGFCache,listPGFCache) where
import PGF2
import PGF2.Transactions
import GF.Text.Lexing
import Cache
import CGIUtils(outputJSONP,outputPlain,outputHTML,outputText,
@@ -60,16 +61,18 @@ data Caches = Caches { qsem :: QSem,
newPGFCache jobs = do let n = maybe 4 id jobs
qsem <- newQSem n
pgfCache <- newCache' readGrammar
lblCache <- newCache' (fmap getDepLabels . readFile)
lblCache <- newCache' (const (fmap getDepLabels . readFile))
return $ Caches qsem pgfCache lblCache
flushPGFCache c = do flushCache (pgfCache c)
flushCache (labelsCache c)
listPGFCache c = listCache (pgfCache c)
readGrammar path =
readGrammar mb_pgf path =
case takeExtension path of
".pgf" -> readPGF path
".ngf" -> readNGF path
".ngf" -> case mb_pgf of
Nothing -> readNGF path
Just gr -> putStrLn "CHECKOUT!!!" >> checkoutPGF gr
_ -> error "Extension must be .pgf or .ngf"
newCache' rd = do c <- newCache rd