diff options
| -rw-r--r-- | src/Hakyll/Core/Provider/MetadataCache.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Core/Store.hs | 21 | ||||
| -rw-r--r-- | tests/Hakyll/Core/Store/Tests.hs | 16 |
3 files changed, 40 insertions, 7 deletions
diff --git a/src/Hakyll/Core/Provider/MetadataCache.hs b/src/Hakyll/Core/Provider/MetadataCache.hs index 077bad2..031960c 100644 --- a/src/Hakyll/Core/Provider/MetadataCache.hs +++ b/src/Hakyll/Core/Provider/MetadataCache.hs @@ -8,7 +8,7 @@ module Hakyll.Core.Provider.MetadataCache -------------------------------------------------------------------------------- import qualified Data.Map as M - +import Control.Monad (unless) -------------------------------------------------------------------------------- import Hakyll.Core.Identifier @@ -49,12 +49,8 @@ resourceInvalidateMetadataCache p r = do -------------------------------------------------------------------------------- load :: Provider -> Identifier -> IO () load p r = do - mmd <- Store.get store mdk :: IO (Store.Result Metadata) - case mmd of - -- Already loaded - Store.Found _ -> return () - -- Not yet loaded - _ -> do + mmof <- Store.isMember store mdk + unless mmof $ do (md, body) <- loadMetadata p r Store.set store mdk md Store.set store bk body diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index 1208c84..b2c61a0 100644 --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -9,6 +9,7 @@ module Hakyll.Core.Store , new , set , get + , isMember , delete , hash ) where @@ -101,6 +102,16 @@ cacheLookup (Store _ (Just lru)) key = do -------------------------------------------------------------------------------- +cacheIsMember :: Store -> String -> IO Bool +cacheIsMember (Store _ Nothing) _ = return False +cacheIsMember (Store _ (Just lru)) key = do + res <- Lru.lookup key lru + case res of + Nothing -> return False + _ -> return True + + +-------------------------------------------------------------------------------- -- | Auxiliary: delete an item from the in-memory cache cacheDelete :: Store -> String -> IO () cacheDelete (Store _ Nothing) _ = return () @@ -152,6 +163,16 @@ get store identifier = do -------------------------------------------------------------------------------- +-- | Strict function +isMember :: Store -> [String] -> IO Bool +isMember store identifier = do + inCache <- cacheIsMember store key + if inCache then return True else doesFileExist path + where + key = hash identifier + path = storeDirectory store </> key + +-------------------------------------------------------------------------------- -- | Delete an item delete :: Store -> [String] -> IO () delete store identifier = do diff --git a/tests/Hakyll/Core/Store/Tests.hs b/tests/Hakyll/Core/Store/Tests.hs index 95140e3..389d7fd 100644 --- a/tests/Hakyll/Core/Store/Tests.hs +++ b/tests/Hakyll/Core/Store/Tests.hs @@ -26,6 +26,7 @@ tests = testGroup "Hakyll.Core.Store.Tests" [ testProperty "simple get . set" simpleSetGet , testProperty "persistent get . set" persistentSetGet , testCase "WrongType get . set" wrongType + , testCase "isMembertest . set" isMembertest ] @@ -68,3 +69,18 @@ wrongType = do t == typeOf (undefined :: String) _ -> False cleanTestEnv + + +-------------------------------------------------------------------------------- + +isMembertest :: H.Assertion +isMembertest = do + store <- newTestStore + Store.set store ["foo", "bar"] ("qux" :: String) + --value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int) + good <- Store.isMember store ["foo", "bar"] + + bad <- Store.isMember store ["foo", "baz"] + H.assert good + H.assert (not bad) + cleanTestEnv
\ No newline at end of file |