on master help sign in
Added tagMap caching.
4295de0Jasper Van der Jeugt
src/Text/Hakyll/Internal/Cache.hs+8−6
@@ -1,8 +1,10 @@
1module Text.Hakyll.Internal.Cache
1module Text.Hakyll.Internal.Cache
2 ( storeInCache
2 ( storeInCache
3 , getFromCache
3 , getFromCache
4+ , isCacheMoreRecent
4 ) where
5 ) where
5
6
7+import Control.Monad ((<=<))
6import Control.Monad.Reader (liftIO)
8import Control.Monad.Reader (liftIO)
7import Text.Hakyll.Hakyll (Hakyll)
9import Text.Hakyll.Hakyll (Hakyll)
8import Text.Hakyll.File
10import Text.Hakyll.File
@@ -20,9 +22,9 @@ storeInCache value path = do
20-- cache. This function performs a timestamp check on the filepath and the
22-- cache. This function performs a timestamp check on the filepath and the
21-- filepath in the cache, and only returns the cached value when it is still
23-- filepath in the cache, and only returns the cached value when it is still
22-- up-to-date.
24-- up-to-date.
23−getFromCache :: (Binary a) => FilePath -> Hakyll (Maybe a)
25+getFromCache :: (Binary a) => FilePath -> Hakyll a
24−getFromCache path = do
26+getFromCache = liftIO . decodeFile <=< toCache
25− cachePath <- toCache path
27+
26− valid <- isMoreRecent cachePath [path]
28+-- | Check if a file in the cache is more recent than a number of other files.
27− if valid then liftIO (decodeFile cachePath) >>= return . Just
29+isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool
28− else return Nothing
30+isCacheMoreRecent file depends = toCache file >>= flip isMoreRecent depends
src/Text/Hakyll/Page.hs+6−6
@@ -120,7 +120,7 @@ readPageFromFile path = do
120
120
121 -- Read file.
121 -- Read file.
122 contents <- liftIO $ readFile path
122 contents <- liftIO $ readFile path
123− let sections = splitAtDelimiters $ lines $ contents
123+ let sections = splitAtDelimiters $ lines contents
124 context = concat $ zipWith ($) sectionFunctions sections
124 context = concat $ zipWith ($) sectionFunctions sections
125 page = fromContext $ M.fromList $
125 page = fromContext $ M.fromList $
126 [ ("url", url)
126 [ ("url", url)
@@ -135,11 +135,11 @@ readPageFromFile path = do
135-- read it from the file given and store it in the cache.
135-- read it from the file given and store it in the cache.
136readPage :: FilePath -> Hakyll Page
136readPage :: FilePath -> Hakyll Page
137readPage path = do
137readPage path = do
138+ isCacheMoreRecent' <- isCacheMoreRecent path [path]
138− cacheResult <- getFromCache path
139+ if isCacheMoreRecent' then getFromCache path
139− case cacheResult of (Just page) -> return page
140− Nothing -> do page <- readPageFromFile path
140+ else do page <- readPageFromFile path
141− storeInCache page path
141+ storeInCache page path
142− return page
142+ return page
143
143
144-- Make pages renderable.
144-- Make pages renderable.
145instance Renderable Page where
145instance Renderable Page where
src/Text/Hakyll/Tags.hs+19−2
@@ -24,6 +24,8 @@ import qualified Data.Map as M
24import Data.List (intercalate)
24import Data.List (intercalate)
25import Control.Monad (foldM)
25import Control.Monad (foldM)
26import Control.Arrow (second)
26import Control.Arrow (second)
27+import Control.Applicative ((<$>))
28+import System.FilePath ((</>))
27
29
28import Text.Hakyll.Hakyll (Hakyll)
30import Text.Hakyll.Hakyll (Hakyll)
29import Text.Hakyll.Context (ContextManipulation, changeValue)
31import Text.Hakyll.Context (ContextManipulation, changeValue)
@@ -31,11 +33,26 @@ import Text.Hakyll.Render.Internal (finalSubstitute)
31import Text.Hakyll.Regex
33import Text.Hakyll.Regex
32import Text.Hakyll.Util
34import Text.Hakyll.Util
33import Text.Hakyll.Page
35import Text.Hakyll.Page
36+import Text.Hakyll.Internal.Cache
34
37
35-- | Read a tag map. This creates a map from tags to page paths.
38-- | Read a tag map. This creates a map from tags to page paths.
39+--
40+-- You also have to give a unique identifier for every tagmap. This is for
41+-- caching reasons, so the tagmap will be stored in
42+-- @_cache/_tagmap/identifier@.
43+readTagMap :: String -- ^ Unique identifier for the tagmap.
44+ -> [FilePath]
36−readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])
45+ -> Hakyll (M.Map String [FilePath])
37−readTagMap paths = foldM addPaths M.empty paths
46+readTagMap identifier paths = do
47+ isCacheMoreRecent' <- isCacheMoreRecent fileName paths
48+ if isCacheMoreRecent' then M.fromList <$> getFromCache fileName
49+ else do tagMap <- readTagMap'
50+ storeInCache (M.toList tagMap) fileName
51+ return tagMap
38 where
52 where
53+ fileName = "_tagmap" </> identifier
54+
55+ readTagMap' = foldM addPaths M.empty paths
39 addPaths current path = do
56 addPaths current path = do
40 page <- readPage path
57 page <- readPage path
41 let tags = map trim $ splitRegex "," $ getValue "tags" page
58 let tags = map trim $ splitRegex "," $ getValue "tags" page