git.iko.soy/hakyll
on master help sign in
Use lrucache to limit the in-memory resource cache to the 500 most recently
d49694fAndrew Miller
hakyll.cabal+4−1
compare with master
unifiedsplit
@@ -60,6 +60,7 @@ Flag unixFilter
60
60
61Library
61Library
62 Ghc-Options: -Wall
62 Ghc-Options: -Wall
63+ Ghc-Prof-Options: -auto-all -caf-all
63 Hs-Source-Dirs: src
64 Hs-Source-Dirs: src
64
65
65 Build-Depends:
66 Build-Depends:
@@ -84,7 +85,8 @@ Library
84 regex-tdfa >= 1.1 && < 1.2,
85 regex-tdfa >= 1.1 && < 1.2,
85 tagsoup >= 0.12.6 && < 0.13,
86 tagsoup >= 0.12.6 && < 0.13,
86 text >= 0.11 && < 1.12,
87 text >= 0.11 && < 1.12,
87− time >= 1.1 && < 1.5
88+ time >= 1.1 && < 1.5,
89+ lrucache >= 1.1.1 && < 1.2
88
90
89 Exposed-Modules:
91 Exposed-Modules:
90 Hakyll
92 Hakyll
@@ -192,6 +194,7 @@ Test-suite hakyll-tests
192 tagsoup >= 0.12.6 && < 0.13,
194 tagsoup >= 0.12.6 && < 0.13,
193 text >= 0.11 && < 1.12,
195 text >= 0.11 && < 1.12,
194 time >= 1.1 && < 1.5,
196 time >= 1.1 && < 1.5,
197+ lrucache >= 1.1.1 && < 1.2,
195 unix >= 2.4 && < 2.6
198 unix >= 2.4 && < 2.6
196
199
197 Other-modules:
200 Other-modules:
src/Hakyll/Core/Store.hs+17−12
@@ -22,6 +22,7 @@ import Data.Typeable (Typeable, TypeRep, cast, typeOf)
22
22
23import Hakyll.Core.Identifier
23import Hakyll.Core.Identifier
24import Hakyll.Core.Util.File
24import Hakyll.Core.Util.File
25+import qualified Data.Cache.LRU.IO as LRU
25
26
26-- | Items we can store
27-- | Items we can store
27--
28--
@@ -40,40 +41,44 @@ data Store = Store
40 { -- | All items are stored on the filesystem
41 { -- | All items are stored on the filesystem
41 storeDirectory :: FilePath
42 storeDirectory :: FilePath
42 , -- | And some items are also kept in-memory
43 , -- | And some items are also kept in-memory
43− storeMap :: Maybe (MVar (Map FilePath Storable))
44+ storeLRU :: Maybe (LRU.AtomicLRU FilePath Storable)
44 }
45 }
45
46
47+-- | The size of the in-memory cache to use in items.
48+storeLRUSize :: Maybe Integer
49+storeLRUSize = Just 500
50+
46-- | Initialize the store
51-- | Initialize the store
47--
52--
48makeStore :: Bool -- ^ Use in-memory caching
53makeStore :: Bool -- ^ Use in-memory caching
49 -> FilePath -- ^ Directory to use for hard disk storage
54 -> FilePath -- ^ Directory to use for hard disk storage
50 -> IO Store -- ^ Store
55 -> IO Store -- ^ Store
51makeStore inMemory directory = do
56makeStore inMemory directory = do
52− mvar <- if inMemory then Just <$> newMVar M.empty else return Nothing
57+ lru <- if inMemory then Just <$> LRU.newAtomicLRU storeLRUSize else return Nothing
53 return Store
58 return Store
54 { storeDirectory = directory
59 { storeDirectory = directory
55− , storeMap = mvar
60+ , storeLRU = lru
56 }
61 }
57
62
58-- | Auxiliary: add an item to the map
63-- | Auxiliary: add an item to the map
59--
64--
60cacheInsert :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
65cacheInsert :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
61cacheInsert (Store _ Nothing) _ _ = return ()
66cacheInsert (Store _ Nothing) _ _ = return ()
62−cacheInsert (Store _ (Just mv)) path value =
67+cacheInsert (Store _ (Just lru)) path value =
63− modifyMVar_ mv $ return . M.insert path (Storable value)
68+ LRU.insert path (Storable value) lru
64
69
65-- | Auxiliary: get an item from the cache
70-- | Auxiliary: get an item from the cache
66--
71--
67cacheLookup :: forall a. (Binary a, Typeable a)
72cacheLookup :: forall a. (Binary a, Typeable a)
68 => Store -> FilePath -> IO (StoreGet a)
73 => Store -> FilePath -> IO (StoreGet a)
69cacheLookup (Store _ Nothing) _ = return NotFound
74cacheLookup (Store _ Nothing) _ = return NotFound
70−cacheLookup (Store _ (Just mv)) path = do
75+cacheLookup (Store _ (Just lru)) path = do
71− map' <- readMVar mv
72− case M.lookup path map' of
76+ res <- LRU.lookup path lru
77+ case res of
73− Nothing -> return NotFound
78+ Nothing -> return NotFound
74− Just (Storable s) -> return $ case cast s of
79+ Just (Storable s) -> return $ case cast s of
75− Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
80+ Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
76− Just s' -> Found s'
81+ Just s' -> Found s'
77
82
78-- | Create a path
83-- | Create a path
79--
84--