diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Core/Store.hs | 29 |
1 files changed, 17 insertions, 12 deletions
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 -- |
