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.

3 files changed, 33 insertions, 14 deletions

diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs
index d28f849..0deb5f4 100644
--- a/src/Text/Hakyll/Internal/Cache.hs
+++ b/src/Text/Hakyll/Internal/Cache.hs
@@ -1,8 +1,10 @@
 module Text.Hakyll.Internal.Cache
     ( storeInCache
     , getFromCache
+    , isCacheMoreRecent
     ) where
 
+import Control.Monad ((<=<))
 import Control.Monad.Reader (liftIO)
 import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.File
@@ -20,9 +22,9 @@ storeInCache value path = do
 --   cache. This function performs a timestamp check on the filepath and the
 --   filepath in the cache, and only returns the cached value when it is still
 --   up-to-date.
-getFromCache :: (Binary a) => FilePath -> Hakyll (Maybe a)
-getFromCache path = do
-    cachePath <- toCache path
-    valid <- isMoreRecent cachePath [path]
-    if valid then liftIO (decodeFile cachePath) >>= return . Just
-             else return Nothing
+getFromCache :: (Binary a) => FilePath -> Hakyll a
+getFromCache = liftIO . decodeFile <=< toCache
+
+-- | Check if a file in the cache is more recent than a number of other files.
+isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool
+isCacheMoreRecent file depends = toCache file >>= flip isMoreRecent depends
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index abfd0b8..b9507b6 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -120,7 +120,7 @@ readPageFromFile path = do
 
     -- Read file.
     contents <- liftIO $ readFile path
-    let sections = splitAtDelimiters $ lines $ contents
+    let sections = splitAtDelimiters $ lines contents
         context = concat $ zipWith ($) sectionFunctions sections
         page = fromContext $ M.fromList $
             [ ("url", url)
@@ -135,11 +135,11 @@ readPageFromFile path = do
 --   read it from the file given and store it in the cache.
 readPage :: FilePath -> Hakyll Page
 readPage path = do
-    cacheResult <- getFromCache path
-    case cacheResult of (Just page) -> return page
-                        Nothing     -> do page <- readPageFromFile path
-                                          storeInCache page path
-                                          return page
+    isCacheMoreRecent' <- isCacheMoreRecent path [path]
+    if isCacheMoreRecent' then getFromCache path
+                          else do page <- readPageFromFile path
+                                  storeInCache page path
+                                  return page
 
 -- Make pages renderable.
 instance Renderable Page where
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index a2031f8..6a179a5 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -24,6 +24,8 @@ import qualified Data.Map as M
 import Data.List (intercalate)
 import Control.Monad (foldM)
 import Control.Arrow (second)
+import Control.Applicative ((<$>))
+import System.FilePath ((</>))
 
 import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.Context (ContextManipulation, changeValue)
@@ -31,11 +33,26 @@ import Text.Hakyll.Render.Internal (finalSubstitute)
 import Text.Hakyll.Regex
 import Text.Hakyll.Util
 import Text.Hakyll.Page
+import Text.Hakyll.Internal.Cache
 
 -- | Read a tag map. This creates a map from tags to page paths.
-readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])
-readTagMap paths = foldM addPaths M.empty paths
+--
+--   You also have to give a unique identifier for every tagmap. This is for
+--   caching reasons, so the tagmap will be stored in
+--   @_cache/_tagmap/identifier@.
+readTagMap :: String -- ^ Unique identifier for the tagmap.
+           -> [FilePath]
+           -> Hakyll (M.Map String [FilePath])
+readTagMap identifier paths = do
+    isCacheMoreRecent' <- isCacheMoreRecent fileName paths
+    if isCacheMoreRecent' then M.fromList <$> getFromCache fileName
+                          else do tagMap <- readTagMap'
+                                  storeInCache (M.toList tagMap) fileName
+                                  return tagMap
   where
+    fileName = "_tagmap" </> identifier
+
+    readTagMap' = foldM addPaths M.empty paths
     addPaths current path = do
         page <- readPage path
         let tags = map trim $ splitRegex "," $ getValue "tags" page