4295de0 · hakyll · git.iko.soy

git.iko.soy/hakyll

Added tagMap caching.

Because the readTagMap function was currently one of the bottlenexks, this has caused a speedup of 900% for some test cases, so yay for that.

commit4295de01bc524b5dccb17dfe2e50f2121feeea07 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateSun 24 Jan 2010, 11:31 (17 years ago) parent59e3c7f

3 files changed+33−14

compare with master

unifiedsplit

src/Text/Hakyll/Internal/Cache.hs+8−6 src/Text/Hakyll/Page.hs+6−6 src/Text/Hakyll/Tags.hs+19−2

src/Text/Hakyll/Internal/Cache.hs+8−6

@@ -1,8 +1,10 @@

11module Text.Hakyll.Internal.Cache

22 ( storeInCache

33 , getFromCache

4+ , isCacheMoreRecent

45 ) where

7+import Control.Monad ((<=<))

68import Control.Monad.Reader (liftIO)

79import Text.Hakyll.Hakyll (Hakyll)

810import Text.Hakyll.File

@@ -20,9 +22,9 @@ storeInCache value path = do

2022-- cache. This function performs a timestamp check on the filepath and the

2123-- filepath in the cache, and only returns the cached value when it is still

2224-- up-to-date.

23−getFromCache :: (Binary a) => FilePath -> Hakyll (Maybe a)

24−getFromCache path = do

25− cachePath <- toCache path

26− valid <- isMoreRecent cachePath [path]

27− if valid then liftIO (decodeFile cachePath) >>= return . Just

28− else return Nothing

25+getFromCache :: (Binary a) => FilePath -> Hakyll a

26+getFromCache = liftIO . decodeFile <=< toCache

27+

28+-- | Check if a file in the cache is more recent than a number of other files.

29+isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool

30+isCacheMoreRecent file depends = toCache file >>= flip isMoreRecent depends

src/Text/Hakyll/Page.hs+6−6

@@ -120,7 +120,7 @@ readPageFromFile path = do

120120

121121 -- Read file.

122122 contents <- liftIO $ readFile path

123− let sections = splitAtDelimiters $ lines $ contents

123+ let sections = splitAtDelimiters $ lines contents

124124 context = concat $ zipWith ($) sectionFunctions sections

125125 page = fromContext $ M.fromList $

126126 [ ("url", url)

@@ -135,11 +135,11 @@ readPageFromFile path = do

135135-- read it from the file given and store it in the cache.

136136readPage :: FilePath -> Hakyll Page

137137readPage path = do

138− cacheResult <- getFromCache path

139− case cacheResult of (Just page) -> return page

140− Nothing -> do page <- readPageFromFile path

141− storeInCache page path

142− return page

138+ isCacheMoreRecent' <- isCacheMoreRecent path [path]

139+ if isCacheMoreRecent' then getFromCache path

140+ else do page <- readPageFromFile path

141+ storeInCache page path

142+ return page

143143

144144-- Make pages renderable.

145145instance Renderable Page where

src/Text/Hakyll/Tags.hs+19−2

@@ -24,6 +24,8 @@ import qualified Data.Map as M

2424import Data.List (intercalate)

2525import Control.Monad (foldM)

2626import Control.Arrow (second)

27+import Control.Applicative ((<$>))

28+import System.FilePath ((</>))

2729

2830import Text.Hakyll.Hakyll (Hakyll)

2931import Text.Hakyll.Context (ContextManipulation, changeValue)

@@ -31,11 +33,26 @@ import Text.Hakyll.Render.Internal (finalSubstitute)

3133import Text.Hakyll.Regex

3234import Text.Hakyll.Util

3335import Text.Hakyll.Page

36+import Text.Hakyll.Internal.Cache

3437

3538-- | Read a tag map. This creates a map from tags to page paths.

36−readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])

37−readTagMap paths = foldM addPaths M.empty 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]

45+ -> Hakyll (M.Map String [FilePath])

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

3852 where

53+ fileName = "_tagmap" </> identifier

54+

55+ readTagMap' = foldM addPaths M.empty paths

3956 addPaths current path = do

4057 page <- readPage path

4158 let tags = map trim $ splitRegex "," $ getValue "tags" page