From 0205f341f5d817fcf3a43057db9d0ef2a23af98c Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Fri, 17 Oct 2008 14:12:53 +0000
Subject: (fastcgi) replace DataRef with a more general Cache type, which can
 hold several PGF grammars.

---
 src/server/Cache.hs | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)
 create mode 100644 src/server/Cache.hs

(limited to 'src/server/Cache.hs')

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'
-- 
cgit v1.2.3