From 08b2fe3eb44e1afc45e11cc76819ca62ba331baf Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Fri, 4 Dec 2009 18:32:56 +0100
Subject: Added simple caching.

---
 src/Text/Hakyll/Page.hs   | 32 +++++++++++++++++++++++++++++---
 src/Text/Hakyll/Render.hs |  4 ----
 src/Text/Hakyll/Util.hs   | 20 ++++++++++++++++++--
 3 files changed, 47 insertions(+), 9 deletions(-)

diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 3888b1d..7219f1a 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -14,6 +14,7 @@ import qualified Data.Map as M
 import qualified Data.List as L
 import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Maybe
+import Control.Monad
 
 import System.FilePath
 import System.IO
@@ -67,11 +68,30 @@ readMetaData handle = do
 isDelimiter :: String -> Bool
 isDelimiter = L.isPrefixOf "---"
 
+-- | Used for caching of files.
+cachePage :: Page -> IO ()
+cachePage page = do
+    let destination = toCache $ getURL page
+    makeDirectories destination
+    handle <- openFile destination WriteMode
+    hPutStrLn handle "---"
+    mapM_ (writePair handle) $ M.toList page
+    hPutStrLn handle "---"
+    B.hPut handle $ getBody page
+    hClose handle
+    where writePair _ ("body", _) = return ()
+          writePair h (k, v) = hPutStr h (k ++ ": ") >> B.hPut h v >> hPutStrLn h ""
+
 -- | Read a page from a file. Metadata is supported, and if the filename
 --   has a .markdown extension, it will be rendered using pandoc. Note that
 --   pages are not templates, so they should not contain $identifiers.
 readPage :: FilePath -> IO Page
-readPage path = do
+readPage pagePath = do
+    -- Check cache.
+    getFromCache <- isCacheFileValid cacheFile pagePath
+    let path = if getFromCache then cacheFile else pagePath
+
+    -- Read file.
     handle <- openFile path ReadMode
     line <- hGetLine handle
     (context, body) <- if isDelimiter line
@@ -80,10 +100,16 @@ readPage path = do
                                     return (md, c)
                             else hGetContents handle >>= \b -> return ([], line ++ b)
 
+    -- Render file
     let rendered = B.pack $ (renderFunction $ takeExtension path) body
-        url = addExtension (dropExtension path) ".html"
     seq rendered $ hClose handle
-    return $ M.insert "body" rendered $ addContext "url" url $ pageFromList context
+    let page = M.insert "body" rendered $ addContext "url" url $ pageFromList context
+
+    -- Cache if needed
+    if getFromCache then return () else cachePage page
+    return page
+    where url = addExtension (dropExtension pagePath) ".html"
+          cacheFile = toCache url
 
 -- | Create a key-value mapping page from an association list.
 pageFromList :: [(String, String)] -> Page
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 2d09d42..a69d27d 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -10,16 +10,12 @@ import qualified Data.ByteString.Lazy.Char8 as B
 import qualified Data.Map as M
 import Control.Monad
 
-import System.FilePath
 import System.Directory
 import System.IO
 
 import Text.Hakyll.Page
 import Text.Hakyll.Util
 
-toDestination :: FilePath -> FilePath
-toDestination path = "_site" </> path
-
 createContext :: Page -> Context
 createContext = M.fromList . map packPair . M.toList
     where packPair (a, b) = (B.pack a, b)
diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs
index 83348c3..68dc2b8 100644
--- a/src/Text/Hakyll/Util.hs
+++ b/src/Text/Hakyll/Util.hs
@@ -1,7 +1,10 @@
 module Text.Hakyll.Util 
-    ( makeDirectories,
+    ( toDestination,
+      toCache,
+      makeDirectories,
       getRecursiveContents,
-      trim
+      trim,
+      isCacheFileValid
     ) where
 
 import System.Directory
@@ -10,6 +13,12 @@ import Control.Monad
 import Data.Char
 import Data.List
 
+toDestination :: FilePath -> FilePath
+toDestination path = "_site" </> path
+
+toCache :: FilePath -> FilePath
+toCache path = "_cache" </> path
+
 -- | Given a path to a file, try to make the path writable by making
 --   all directories on the path.
 makeDirectories :: FilePath -> IO ()
@@ -44,3 +53,10 @@ split element = unfoldr splitOnce
                                      (x, xs) -> if null xs
                                                     then Just (x, [])
                                                     else Just (x, tail xs)
+
+-- | Check is a cache file is still valid.
+isCacheFileValid :: FilePath -> FilePath -> IO Bool
+isCacheFileValid cache file = doesFileExist cache >>= \exists ->
+    if not exists then return False
+                  else liftM2 (<=) (getModificationTime file)
+                                   (getModificationTime cache)
-- 
cgit v1.2.3