diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/server/Cache.hs | 36 | ||||
| -rw-r--r-- | src/server/FastCGIUtils.hs | 26 | ||||
| -rw-r--r-- | src/server/MainFastCGI.hs | 16 | ||||
| -rw-r--r-- | src/server/gf-server.cabal | 2 |
4 files changed, 47 insertions, 33 deletions
diff --git a/src/server/Cache.hs b/src/server/Cache.hs new file mode 100644 index 000000000..c56e122ae --- /dev/null +++ b/src/server/Cache.hs @@ -0,0 +1,36 @@ +module Cache (Cache,newCache,readCache) where + +import Control.Concurrent +import Data.Map (Map) +import qualified Data.Map as Map +import System.Directory (getModificationTime) +import System.Time (ClockTime) + +data Cache a = Cache { + cacheLoad :: FilePath -> IO a, + cacheObjects :: MVar (Map FilePath (MVar (ClockTime, a))) + } + +newCache :: (FilePath -> IO a) -> IO (Cache a) +newCache load = + do objs <- newMVar Map.empty + return $ Cache { cacheLoad = load, cacheObjects = objs } + +readCache :: Cache a -> FilePath -> IO a +readCache c file = + do t' <- getModificationTime file + objs <- takeMVar (cacheObjects c) + case Map.lookup file objs of + -- object is in cache + Just v -> do (t,x) <- takeMVar v + putMVar (cacheObjects c) objs + -- check timestamp + x' <- if t == t' then return x else cacheLoad c file + putMVar v (t',x') + return x' + -- first time this object is requested + Nothing -> do v <- newEmptyMVar + putMVar (cacheObjects c) (Map.insert file v objs) + x' <- cacheLoad c file + putMVar v (t',x') + return x' diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs index 1b75403d5..e9824d099 100644 --- a/src/server/FastCGIUtils.hs +++ b/src/server/FastCGIUtils.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} module FastCGIUtils (initFastCGI, loopFastCGI, - DataRef, newDataRef, getData, throwCGIError, handleCGIErrors) where import Control.Concurrent @@ -17,7 +16,6 @@ import System.IO.Unsafe import System.Posix import System.Time - import Network.FastCGI initFastCGI :: IO () @@ -101,30 +99,6 @@ restartIfModified = -- FIXME: setCurrentDirectory? executeFile prog False args Nothing --- Utilities for getting and caching read-only data from disk. --- The data is reloaded when the file on disk has been modified. - -data DataRef a = DataRef { - dataFile :: FilePath, - dataLoad :: FilePath -> IO a, - dataValue :: MVar (ClockTime, a) - } - -newDataRef :: (FilePath -> IO a) -> FilePath -> IO (DataRef a) -newDataRef load file = - do t <- getModificationTime file - x <- load file - v <- newMVar (t,x) - return $ DataRef { dataFile = file, dataLoad = load, dataValue = v } - -getData :: DataRef a -> IO a -getData ref = - do t' <- getModificationTime (dataFile ref) - (t,x) <- takeMVar (dataValue ref) - x' <- if t' == t then return x else (dataLoad ref) (dataFile ref) - putMVar (dataValue ref) (t',x') - return x' - -- Logging logError :: String -> IO () diff --git a/src/server/MainFastCGI.hs b/src/server/MainFastCGI.hs index 059b26bb9..5f58787bd 100644 --- a/src/server/MainFastCGI.hs +++ b/src/server/MainFastCGI.hs @@ -2,6 +2,7 @@ import PGF (PGF) import qualified PGF +import Cache import FastCGIUtils import URLEncoding @@ -17,17 +18,18 @@ import Data.Maybe import System.Environment -grammarFile :: IO FilePath -grammarFile = do env <- getEnvironment - return $ fromMaybe "grammar.pgf" $ lookup "PGF_FILE" env +defaultGrammarFile :: IO FilePath +defaultGrammarFile = + do env <- getEnvironment + return $ fromMaybe "grammar.pgf" $ lookup "PGF_FILE" env main :: IO () main = do initFastCGI - ref <- grammarFile >>= newDataRef PGF.readPGF - runFastCGIConcurrent' forkIO 100 (handleErrors (handleCGIErrors (fcgiMain ref))) + cache <- newCache PGF.readPGF + runFastCGIConcurrent' forkIO 100 (handleErrors (handleCGIErrors (fcgiMain cache))) -fcgiMain :: DataRef PGF -> CGI CGIResult -fcgiMain ref = liftIO (getData ref) >>= cgiMain +fcgiMain :: Cache PGF -> CGI CGIResult +fcgiMain cache = liftIO (defaultGrammarFile >>= readCache cache) >>= cgiMain cgiMain :: PGF -> CGI CGIResult cgiMain pgf = diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal index b2f01bcc5..0b42f9d90 100644 --- a/src/server/gf-server.cabal +++ b/src/server/gf-server.cabal @@ -20,4 +20,6 @@ executable pgf.fcgi main-is: MainFastCGI.hs other-modules: FastCGIUtils + Cache + URLEncoding ghc-options: -threaded
\ No newline at end of file |