From a3021bc703d8a60a2e6467afce6691ee039f3612 Mon Sep 17 00:00:00 2001 From: noxx Date: Sat, 4 May 2013 12:51:58 +0300 Subject: Added isMember functions for Store --- src/Hakyll/Core/Store.hs | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'src') diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index 1208c84..eb2d742 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 @@ -100,6 +101,16 @@ cacheLookup (Store _ (Just lru)) key = do Nothing -> WrongType (typeOf (undefined :: a)) (typeOf x) +-------------------------------------------------------------------------------- +cacheIsMember :: Store -> String -> Bool +cacheIsMember (Store _ Nothing) _ = False +cacheIsMember (Store _ (Just lru)) key = + let res = Lru.lookup key lru in + case Just res of + Nothing -> False + _ -> True + + -------------------------------------------------------------------------------- -- | Auxiliary: delete an item from the in-memory cache cacheDelete :: Store -> String -> IO () @@ -151,6 +162,17 @@ get store identifier = do return $ decode lbs +-------------------------------------------------------------------------------- +-- | Strict function +isMember :: Store -> [String] -> IO Bool +isMember store identifier + | cacheIsMember store key = return True + | otherwise = doesFileExist path + + where + key = hash identifier + path = storeDirectory store key + -------------------------------------------------------------------------------- -- | Delete an item delete :: Store -> [String] -> IO () -- cgit v1.2.3 From 0f779a8c53039829030eb984528974d80372002d Mon Sep 17 00:00:00 2001 From: noxx Date: Sat, 4 May 2013 13:05:47 +0300 Subject: Added isMember to load function --- src/Hakyll/Core/Provider/MetadataCache.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'src') 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 -- cgit v1.2.3 From f4ee3e7fcb0817098643c6b34cab92466584680a Mon Sep 17 00:00:00 2001 From: noxx Date: Sat, 4 May 2013 15:42:28 +0300 Subject: Created tests and fixed isMember function --- src/Hakyll/Core/Store.hs | 21 ++++++++++----------- tests/Hakyll/Core/Store/Tests.hs | 16 ++++++++++++++++ 2 files changed, 26 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index eb2d742..b2c61a0 100644 --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -102,13 +102,13 @@ cacheLookup (Store _ (Just lru)) key = do -------------------------------------------------------------------------------- -cacheIsMember :: Store -> String -> Bool -cacheIsMember (Store _ Nothing) _ = False -cacheIsMember (Store _ (Just lru)) key = - let res = Lru.lookup key lru in - case Just res of - Nothing -> False - _ -> True +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 -------------------------------------------------------------------------------- @@ -165,10 +165,9 @@ get store identifier = do -------------------------------------------------------------------------------- -- | Strict function isMember :: Store -> [String] -> IO Bool -isMember store identifier - | cacheIsMember store key = return True - | otherwise = doesFileExist path - +isMember store identifier = do + inCache <- cacheIsMember store key + if inCache then return True else doesFileExist path where key = hash identifier path = storeDirectory store key 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 -- cgit v1.2.3