diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Hakyll/Page.hs | 32 | ||||
-rw-r--r-- | src/Text/Hakyll/Render.hs | 4 | ||||
-rw-r--r-- | 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) |