summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Hakyll/Page.hs32
-rw-r--r--src/Text/Hakyll/Render.hs4
-rw-r--r--src/Text/Hakyll/Util.hs20
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)