3ac3037 · hakyll · git.iko.soy

src/Hakyll/Core/Provider/MetadataCache.hs+3−7

compare with master

unifiedsplit

@@ -8,7 +8,7 @@ module Hakyll.Core.Provider.MetadataCache

8

9--------------------------------------------------------------------------------

10import qualified Data.Map as M

11−

11+import Control.Monad (unless)

12

13--------------------------------------------------------------------------------

14import Hakyll.Core.Identifier

@@ -49,12 +49,8 @@ resourceInvalidateMetadataCache p r = do

49--------------------------------------------------------------------------------

50load :: Provider -> Identifier -> IO ()

51load p r = do

52− mmd <- Store.get store mdk :: IO (Store.Result Metadata)

52+ mmof <- Store.isMember store mdk

53− case mmd of

53+ unless mmof $ do

54− -- Already loaded

55− Store.Found _ -> return ()

56− -- Not yet loaded

57− _ -> do

58 (md, body) <- loadMetadata p r

54 (md, body) <- loadMetadata p r

59 Store.set store mdk md

55 Store.set store mdk md

60 Store.set store bk body

56 Store.set store bk body

src/Hakyll/Core/Store.hs+21

@@ -9,6 +9,7 @@ module Hakyll.Core.Store

9 , new

10 , set

11 , get

12+ , isMember

12 , delete

13 , delete

13 , hash

14 , hash

14 ) where

15 ) where

@@ -100,6 +101,16 @@ cacheLookup (Store _ (Just lru)) key = do

100 Nothing -> WrongType (typeOf (undefined :: a)) (typeOf x)

101 Nothing -> WrongType (typeOf (undefined :: a)) (typeOf x)

101

102

103

104+--------------------------------------------------------------------------------

105+cacheIsMember :: Store -> String -> IO Bool

106+cacheIsMember (Store _ Nothing) _ = return False

107+cacheIsMember (Store _ (Just lru)) key = do

108+ res <- Lru.lookup key lru

109+ case res of

110+ Nothing -> return False

111+ _ -> return True

112+

113+

103--------------------------------------------------------------------------------

114--------------------------------------------------------------------------------

104-- | Auxiliary: delete an item from the in-memory cache

115-- | Auxiliary: delete an item from the in-memory cache

105cacheDelete :: Store -> String -> IO ()

116cacheDelete :: Store -> String -> IO ()

@@ -151,6 +162,16 @@ get store identifier = do

151 return $ decode lbs

162 return $ decode lbs

152

163

153

164

165+--------------------------------------------------------------------------------

166+-- | Strict function

167+isMember :: Store -> [String] -> IO Bool

168+isMember store identifier = do

169+ inCache <- cacheIsMember store key

170+ if inCache then return True else doesFileExist path

171+ where

172+ key = hash identifier

173+ path = storeDirectory store </> key

174+

154--------------------------------------------------------------------------------

175--------------------------------------------------------------------------------

155-- | Delete an item

176-- | Delete an item

156delete :: Store -> [String] -> IO ()

177delete :: Store -> [String] -> IO ()

tests/Hakyll/Core/Store/Tests.hs+16

@@ -26,6 +26,7 @@ tests = testGroup "Hakyll.Core.Store.Tests"

26 [ testProperty "simple get . set" simpleSetGet

27 , testProperty "persistent get . set" persistentSetGet

28 , testCase "WrongType get . set" wrongType

29+ , testCase "isMembertest . set" isMembertest

29 ]

30 ]

30

31

32

@@ -68,3 +69,18 @@ wrongType = do

68 t == typeOf (undefined :: String)

69 t == typeOf (undefined :: String)

69 _ -> False

70 _ -> False

70 cleanTestEnv

71 cleanTestEnv

72+

73+

74+--------------------------------------------------------------------------------

75+

76+isMembertest :: H.Assertion

77+isMembertest = do

78+ store <- newTestStore

79+ Store.set store ["foo", "bar"] ("qux" :: String)

80+ --value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)

81+ good <- Store.isMember store ["foo", "bar"]

82+

83+ bad <- Store.isMember store ["foo", "baz"]

84+ H.assert good

85+ H.assert (not bad)

86+ cleanTestEnv