Use lrucache to limit the in-memory resource cache to the 500 most recently

used items.

This stops swap being used on sites where not all the resources will fit in
memory, but ensures that frequently used resources like templates stay in the
cache. This drastically improves performance in such cases.

2 files changed, 21 insertions, 13 deletions

diff --git a/hakyll.cabal b/hakyll.cabal
index 2d06d28..271439c 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -60,6 +60,7 @@ Flag unixFilter
 
 Library
   Ghc-Options:    -Wall
+  Ghc-Prof-Options: -auto-all -caf-all
   Hs-Source-Dirs: src
 
   Build-Depends:
@@ -84,7 +85,8 @@ Library
     regex-tdfa   >= 1.1    && < 1.2,
     tagsoup      >= 0.12.6 && < 0.13,
     text         >= 0.11   && < 1.12,
-    time         >= 1.1    && < 1.5
+    time         >= 1.1    && < 1.5,
+    lrucache     >= 1.1.1  && < 1.2
 
   Exposed-Modules:
     Hakyll
@@ -192,6 +194,7 @@ Test-suite hakyll-tests
     tagsoup      >= 0.12.6 && < 0.13,
     text         >= 0.11   && < 1.12,
     time         >= 1.1    && < 1.5,
+    lrucache     >= 1.1.1  && < 1.2,
     unix         >= 2.4    && < 2.6
 
   Other-modules:
diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs
index 9c1b9ba..0b5f438 100644
--- a/src/Hakyll/Core/Store.hs
+++ b/src/Hakyll/Core/Store.hs
@@ -22,6 +22,7 @@ import Data.Typeable (Typeable, TypeRep, cast, typeOf)
 
 import Hakyll.Core.Identifier
 import Hakyll.Core.Util.File
+import qualified Data.Cache.LRU.IO as LRU
 
 -- | Items we can store
 --
@@ -40,40 +41,44 @@ data Store = Store
     { -- | All items are stored on the filesystem
       storeDirectory :: FilePath
     , -- | And some items are also kept in-memory
-      storeMap       :: Maybe (MVar (Map FilePath Storable))
+      storeLRU       :: Maybe (LRU.AtomicLRU FilePath Storable)
     }
 
+-- | The size of the in-memory cache to use in items.
+storeLRUSize :: Maybe Integer
+storeLRUSize = Just 500
+
 -- | Initialize the store
 --
 makeStore :: Bool      -- ^ Use in-memory caching
           -> FilePath  -- ^ Directory to use for hard disk storage
           -> IO Store  -- ^ Store
 makeStore inMemory directory = do
-    mvar <- if inMemory then Just <$> newMVar M.empty else return Nothing
+    lru <- if inMemory then Just <$> LRU.newAtomicLRU storeLRUSize else return Nothing
     return Store
         { storeDirectory = directory
-        , storeMap       = mvar
+        , storeLRU       = lru
         }
 
 -- | Auxiliary: add an item to the map
 --
 cacheInsert :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
 cacheInsert (Store _ Nothing)   _    _     = return ()
-cacheInsert (Store _ (Just mv)) path value =
-    modifyMVar_ mv $ return . M.insert path (Storable value)
+cacheInsert (Store _ (Just lru)) path value =
+    LRU.insert path (Storable value) lru
 
 -- | Auxiliary: get an item from the cache
 --
 cacheLookup :: forall a. (Binary a, Typeable a)
             => Store -> FilePath -> IO (StoreGet a)
 cacheLookup (Store _ Nothing) _      = return NotFound
-cacheLookup (Store _ (Just mv)) path = do
-    map' <- readMVar mv
-    case M.lookup path map' of
-        Nothing           -> return NotFound
-        Just (Storable s) -> return $ case cast s of
-            Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
-            Just s' -> Found s'
+cacheLookup (Store _ (Just lru)) path = do
+    res <- LRU.lookup path lru
+    case res of
+      Nothing           -> return NotFound
+      Just (Storable s) -> return $ case cast s of
+        Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
+        Just s' -> Found s'
 
 -- | Create a path
 --