diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/server/FastCGIUtils.hs | 35 | ||||
| -rw-r--r-- | src/server/MainFastCGI.hs | 17 | ||||
| -rw-r--r-- | src/server/gf-server.cabal | 1 |
3 files changed, 30 insertions, 23 deletions
diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs index e95cad3f5..1b75403d5 100644 --- a/src/server/FastCGIUtils.hs +++ b/src/server/FastCGIUtils.hs @@ -104,21 +104,26 @@ restartIfModified = -- Utilities for getting and caching read-only data from disk. -- The data is reloaded when the file on disk has been modified. -type DataRef a = IORef (Maybe (ClockTime, a)) - -newDataRef :: MonadIO m => m (DataRef a) -newDataRef = liftIO $ newIORef Nothing - -getData :: MonadIO m => (FilePath -> m a) -> DataRef a -> FilePath -> m a -getData loadData ref file = - do t' <- liftIO $ getModificationTime file - m <- liftIO $ readIORef ref - case m of - Just (t,x) | t' == t -> return x - _ -> do logCGI $ "Loading " ++ show file ++ "..." - x <- loadData file - liftIO $ writeIORef ref (Just (t',x)) - return x +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 diff --git a/src/server/MainFastCGI.hs b/src/server/MainFastCGI.hs index ed3e8278e..b36014840 100644 --- a/src/server/MainFastCGI.hs +++ b/src/server/MainFastCGI.hs @@ -5,28 +5,29 @@ import qualified PGF import FastCGIUtils import URLEncoding -import Network.CGI +import Network.FastCGI import Text.JSON import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString) +import Control.Concurrent import Control.Monad import Data.Char import qualified Data.Map as Map import Data.Maybe +import System.Environment -grammarFile :: FilePath -grammarFile = "grammar.pgf" - - +grammarFile :: IO FilePath +grammarFile = do env <- getEnvironment + return $ fromMaybe "grammar.pgf" $ lookup "PGF_FILE" env main :: IO () main = do initFastCGI - r <- newDataRef - loopFastCGI (handleErrors (handleCGIErrors (fcgiMain r))) + ref <- grammarFile >>= newDataRef PGF.readPGF + runFastCGIConcurrent' forkIO 100 (handleErrors (handleCGIErrors (fcgiMain ref))) fcgiMain :: DataRef PGF -> CGI CGIResult -fcgiMain ref = getData (liftIO . PGF.readPGF) ref grammarFile >>= cgiMain +fcgiMain ref = liftIO (getData ref) >>= cgiMain cgiMain :: PGF -> CGI CGIResult cgiMain pgf = diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal index afbad3283..2256e5cfe 100644 --- a/src/server/gf-server.cabal +++ b/src/server/gf-server.cabal @@ -20,3 +20,4 @@ executable gf.fcgi main-is: MainFastCGI.hs other-modules: FastCGIUtils + ghc-options: -threaded
\ No newline at end of file |