diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Hakyll/Page.hs | 9 | ||||
-rw-r--r-- | src/Text/Hakyll/Render.hs | 28 | ||||
-rw-r--r-- | src/Text/Hakyll/Util.hs | 11 |
3 files changed, 36 insertions, 12 deletions
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs index dcb9c97..31e2135 100644 --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -2,6 +2,7 @@ module Text.Hakyll.Page ( Page, PageValue, addContext, + toURL, getURL, getBody, readPage, @@ -33,6 +34,10 @@ type PageValue = B.ByteString addContext :: String -> String -> Page -> Page addContext key value = M.insert key (B.pack value) +-- | Get the url for a given page. +toURL :: FilePath -> FilePath +toURL = flip addExtension ".html" . dropExtension + -- | Get the URL for a certain page. This should always be defined. If -- not, it will return trash.html. getURL :: Page -> String @@ -88,7 +93,7 @@ cachePage page = do readPage :: FilePath -> IO Page readPage pagePath = do -- Check cache. - getFromCache <- isCacheFileValid cacheFile pagePath + getFromCache <- isCacheValid cacheFile [pagePath] let path = if getFromCache then cacheFile else pagePath -- Read file. @@ -108,7 +113,7 @@ readPage pagePath = do -- Cache if needed if getFromCache then return () else cachePage page return page - where url = addExtension (dropExtension pagePath) ".html" + where url = toURL pagePath cacheFile = toCache url -- | Create a key-value mapping page from an association list. diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index 79f8764..a554fd5 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -1,7 +1,10 @@ module Text.Hakyll.Render - ( renderPage, + ( depends, + renderPage, renderAndWrite, + writePage, renderAndConcat, + renderChain, static, staticDirectory ) where @@ -17,6 +20,12 @@ import System.IO import Text.Hakyll.Page import Text.Hakyll.Util +depends :: FilePath -> [FilePath] -> IO () -> IO () +depends file dependencies action = do + valid <- isCacheValid (toDestination file) dependencies + if valid then return () + else action + createContext :: Page -> Context createContext = M.fromList . map packPair . M.toList where packPair (a, b) = (B.pack a, b) @@ -30,11 +39,14 @@ renderPage templatePath page = do return $ M.insert "body" body page renderAndWrite :: FilePath -> Page -> IO () -renderAndWrite templatePath page = do - rendered <- renderPage templatePath page - let destination = toDestination $ getURL rendered +renderAndWrite templatePath page = + renderPage templatePath page >>= writePage + +writePage :: Page -> IO () +writePage page = do + let destination = toDestination $ getURL page makeDirectories destination - B.writeFile destination (getBody rendered) + B.writeFile destination (getBody page) renderAndConcat :: FilePath -> [FilePath] -> IO B.ByteString renderAndConcat templatePath paths = foldM concatRender' B.empty paths @@ -45,6 +57,12 @@ renderAndConcat templatePath paths = foldM concatRender' B.empty paths let body = getBody rendered return $ B.append chunk $ body +renderChain :: FilePath -> [FilePath] -> IO () +renderChain pagePath templates = depends (toURL pagePath) (pagePath : templates) $ + do page <- readPage pagePath + result <- foldM (flip renderPage) page templates + writePage result + static :: FilePath -> IO () static source = do makeDirectories destination diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs index 773e32c..1d79b4a 100644 --- a/src/Text/Hakyll/Util.hs +++ b/src/Text/Hakyll/Util.hs @@ -5,7 +5,7 @@ module Text.Hakyll.Util getRecursiveContents, trim, split, - isCacheFileValid + isCacheValid ) where import System.Directory @@ -56,8 +56,9 @@ split element = unfoldr splitOnce else Just (x, tail xs) -- | Check is a cache file is still valid. -isCacheFileValid :: FilePath -> FilePath -> IO Bool -isCacheFileValid cache file = doesFileExist cache >>= \exists -> +isCacheValid :: FilePath -> [FilePath] -> IO Bool +isCacheValid cache depends = doesFileExist cache >>= \exists -> if not exists then return False - else liftM2 (<=) (getModificationTime file) - (getModificationTime cache) + else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum + cacheModified <- getModificationTime cache + return (cacheModified >= dependsModified) |