Multithreaded gf.fcgi.

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))
+data DataRef a = DataRef {
+      dataFile :: FilePath,
+      dataLoad :: FilePath -> IO a,
+      dataValue :: MVar (ClockTime, a)
+    }
 
-newDataRef :: MonadIO m => m (DataRef a)
+newDataRef :: (FilePath -> IO a) -> FilePath -> IO (DataRef a)
-newDataRef = liftIO $ newIORef Nothing
+newDataRef load file = 
+    do t <- getModificationTime file
+       x <- load file
+       v <- newMVar (t,x)
+       return $ DataRef { dataFile = file, dataLoad = load, dataValue = v }
 
-getData :: MonadIO m => (FilePath -> m a) -> DataRef a -> FilePath -> m a
+getData :: DataRef a -> IO a
-getData loadData ref file = 
+getData ref = 
-    do t' <- liftIO $ getModificationTime file
+    do t' <- getModificationTime (dataFile ref)
-       m <- liftIO $ readIORef ref
+       (t,x) <- takeMVar (dataValue ref)
-       case m of
+       x' <- if t' == t then return x else (dataLoad ref) (dataFile ref)
-         Just (t,x) | t' == t -> return x
+       putMVar (dataValue ref) (t',x')
-         _                    -> do logCGI $ "Loading " ++ show file ++ "..."
+       return x'
-                                    x <- loadData file
-                                    liftIO $ writeIORef ref (Just (t',x))
-                                    return x
 
 -- Logging
 

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 :: IO FilePath
-grammarFile = "grammar.pgf"
+grammarFile = do env <- getEnvironment
-
+                 return $ fromMaybe "grammar.pgf" $ lookup "PGF_FILE" env
-
 
 main :: IO ()
 main = do initFastCGI
-          r <- newDataRef
+          ref <- grammarFile >>= newDataRef PGF.readPGF
-          loopFastCGI (handleErrors (handleCGIErrors (fcgiMain r)))
+          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 =

src/server/gf-server.cabal

@@ -20,3 +20,4 @@ executable gf.fcgi
   main-is: MainFastCGI.hs
   other-modules:
     FastCGIUtils
+  ghc-options: -threaded