diff options
Diffstat (limited to 'src/Hakyll/Core')
| -rw-r--r-- | src/Hakyll/Core/Resource/Provider.hs | 12 | ||||
| -rw-r--r-- | src/Hakyll/Core/Store.hs | 29 |
2 files changed, 26 insertions, 15 deletions
diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs index d91c374..14848a8 100644 --- a/src/Hakyll/Core/Resource/Provider.hs +++ b/src/Hakyll/Core/Resource/Provider.hs @@ -12,6 +12,7 @@ -- module Hakyll.Core.Resource.Provider ( ResourceProvider (..) + , resourceList , makeResourceProvider , resourceExists , resourceDigest @@ -22,6 +23,7 @@ import Control.Applicative ((<$>)) import Control.Concurrent (MVar, readMVar, modifyMVar_, newMVar) import Data.Map (Map) import qualified Data.Map as M +import qualified Data.Set as S import Data.Time (UTCTime) import qualified Crypto.Hash.MD5 as MD5 @@ -35,7 +37,7 @@ import Hakyll.Core.Resource -- data ResourceProvider = ResourceProvider { -- | A list of all resources this provider is able to provide - resourceList :: [Resource] + resourceSet :: S.Set Resource , -- | Retrieve a certain resource as string resourceString :: Resource -> IO String , -- | Retrieve a certain resource as lazy bytestring @@ -53,12 +55,16 @@ makeResourceProvider :: [Resource] -- ^ Resource list -> (Resource -> IO LB.ByteString) -- ^ ByteString reader -> (Resource -> IO UTCTime) -- ^ Time checker -> IO ResourceProvider -- ^ Resulting provider -makeResourceProvider l s b t = ResourceProvider l s b t <$> newMVar M.empty +makeResourceProvider l s b t = ResourceProvider (S.fromList l) s b t <$> newMVar M.empty + +-- | Get the list of all resources +resourceList :: ResourceProvider -> [Resource] +resourceList = S.toList . resourceSet -- | Check if a given identifier has a resource -- resourceExists :: ResourceProvider -> Resource -> Bool -resourceExists provider = flip elem $ resourceList provider +resourceExists provider = flip S.member $ resourceSet provider -- | Retrieve a digest for a given resource -- 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 -- |