@@ -22,6 +22,7 @@ import Data.Typeable (Typeable, TypeRep, cast, typeOf)
2222
2323import Hakyll.Core.Identifier
2424import Hakyll.Core.Util.File
25+import qualified Data.Cache.LRU.IO as LRU
2526
2627-- | Items we can store
2728--
@@ -40,40 +41,44 @@ data Store = Store
4041 { -- | All items are stored on the filesystem
4142 storeDirectory :: FilePath
4243 , -- | And some items are also kept in-memory
43− storeMap :: Maybe (MVar (Map FilePath Storable))
44+ storeLRU :: Maybe (LRU.AtomicLRU FilePath Storable)
4445 }
4546
47+-- | The size of the in-memory cache to use in items.
48+storeLRUSize :: Maybe Integer
49+storeLRUSize = Just 500
50+
4651-- | Initialize the store
4752--
4853makeStore :: Bool -- ^ Use in-memory caching
4954 -> FilePath -- ^ Directory to use for hard disk storage
5055 -> IO Store -- ^ Store
5156makeStore inMemory directory = do
52− mvar <- if inMemory then Just <$> newMVar M.empty else return Nothing
57+ lru <- if inMemory then Just <$> LRU.newAtomicLRU storeLRUSize else return Nothing
5358 return Store
5459 { storeDirectory = directory
55− , storeMap = mvar
60+ , storeLRU = lru
5661 }
5762
5863-- | Auxiliary: add an item to the map
5964--
6065cacheInsert :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
6166cacheInsert (Store _ Nothing) _ _ = return ()
62−cacheInsert (Store _ (Just mv)) path value =
63− modifyMVar_ mv $ return . M.insert path (Storable value)
67+cacheInsert (Store _ (Just lru)) path value =
68+ LRU.insert path (Storable value) lru
6469
6570-- | Auxiliary: get an item from the cache
6671--
6772cacheLookup :: forall a. (Binary a, Typeable a)
6873 => Store -> FilePath -> IO (StoreGet a)
6974cacheLookup (Store _ Nothing) _ = return NotFound
70−cacheLookup (Store _ (Just mv)) path = do
71− map' <- readMVar mv
72− case M.lookup path map' of
73− Nothing -> return NotFound
74− Just (Storable s) -> return $ case cast s of
75− Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
76− Just s' -> Found s'
75+cacheLookup (Store _ (Just lru)) path = do
76+ res <- LRU.lookup path lru
77+ case res of
78+ Nothing -> return NotFound
79+ Just (Storable s) -> return $ case cast s of
80+ Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
81+ Just s' -> Found s'
7782
7883-- | Create a path
7984--