diff options
-rw-r--r-- | src/Text/Hakyll/Internal/Cache.hs | 14 | ||||
-rw-r--r-- | src/Text/Hakyll/Page.hs | 12 | ||||
-rw-r--r-- | src/Text/Hakyll/Tags.hs | 21 |
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 |