diff options
| -rw-r--r-- | hakyll.cabal | 5 | ||||
| -rw-r--r-- | src/Hakyll/Core/Store.hs | 29 |
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 -- |