on master help sign in
Added simple caching.
08b2fe3Jasper Van der Jeugt
src/Text/Hakyll/Page.hs+29−3
@@ -14,6 +14,7 @@ import qualified Data.Map as M
14import qualified Data.List as L
14import qualified Data.List as L
15import qualified Data.ByteString.Lazy.Char8 as B
15import qualified Data.ByteString.Lazy.Char8 as B
16import Data.Maybe
16import Data.Maybe
17+import Control.Monad
17
18
18import System.FilePath
19import System.FilePath
19import System.IO
20import System.IO
@@ -67,11 +68,30 @@ readMetaData handle = do
67isDelimiter :: String -> Bool
68isDelimiter :: String -> Bool
68isDelimiter = L.isPrefixOf "---"
69isDelimiter = L.isPrefixOf "---"
69
70
71+-- | Used for caching of files.
72+cachePage :: Page -> IO ()
73+cachePage page = do
74+ let destination = toCache $ getURL page
75+ makeDirectories destination
76+ handle <- openFile destination WriteMode
77+ hPutStrLn handle "---"
78+ mapM_ (writePair handle) $ M.toList page
79+ hPutStrLn handle "---"
80+ B.hPut handle $ getBody page
81+ hClose handle
82+ where writePair _ ("body", _) = return ()
83+ writePair h (k, v) = hPutStr h (k ++ ": ") >> B.hPut h v >> hPutStrLn h ""
84+
70-- | Read a page from a file. Metadata is supported, and if the filename
85-- | Read a page from a file. Metadata is supported, and if the filename
71-- has a .markdown extension, it will be rendered using pandoc. Note that
86-- has a .markdown extension, it will be rendered using pandoc. Note that
72-- pages are not templates, so they should not contain $identifiers.
87-- pages are not templates, so they should not contain $identifiers.
73readPage :: FilePath -> IO Page
88readPage :: FilePath -> IO Page
74−readPage path = do
89+readPage pagePath = do
90+ -- Check cache.
91+ getFromCache <- isCacheFileValid cacheFile pagePath
92+ let path = if getFromCache then cacheFile else pagePath
93+
94+ -- Read file.
75 handle <- openFile path ReadMode
95 handle <- openFile path ReadMode
76 line <- hGetLine handle
96 line <- hGetLine handle
77 (context, body) <- if isDelimiter line
97 (context, body) <- if isDelimiter line
@@ -80,10 +100,16 @@ readPage path = do
80 return (md, c)
100 return (md, c)
81 else hGetContents handle >>= \b -> return ([], line ++ b)
101 else hGetContents handle >>= \b -> return ([], line ++ b)
82
102
103+ -- Render file
83 let rendered = B.pack $ (renderFunction $ takeExtension path) body
104 let rendered = B.pack $ (renderFunction $ takeExtension path) body
84− url = addExtension (dropExtension path) ".html"
85 seq rendered $ hClose handle
105 seq rendered $ hClose handle
86− return $ M.insert "body" rendered $ addContext "url" url $ pageFromList context
106+ let page = M.insert "body" rendered $ addContext "url" url $ pageFromList context
107+
108+ -- Cache if needed
109+ if getFromCache then return () else cachePage page
110+ return page
111+ where url = addExtension (dropExtension pagePath) ".html"
112+ cacheFile = toCache url
87
113
88-- | Create a key-value mapping page from an association list.
114-- | Create a key-value mapping page from an association list.
89pageFromList :: [(String, String)] -> Page
115pageFromList :: [(String, String)] -> Page
src/Text/Hakyll/Render.hs−4
@@ -10,16 +10,12 @@ import qualified Data.ByteString.Lazy.Char8 as B
10import qualified Data.Map as M
10import qualified Data.Map as M
11import Control.Monad
11import Control.Monad
12
12
13−import System.FilePath
14import System.Directory
13import System.Directory
15import System.IO
14import System.IO
16
15
17import Text.Hakyll.Page
16import Text.Hakyll.Page
18import Text.Hakyll.Util
17import Text.Hakyll.Util
19
18
20−toDestination :: FilePath -> FilePath
21−toDestination path = "_site" </> path
22−
23createContext :: Page -> Context
19createContext :: Page -> Context
24createContext = M.fromList . map packPair . M.toList
20createContext = M.fromList . map packPair . M.toList
25 where packPair (a, b) = (B.pack a, b)
21 where packPair (a, b) = (B.pack a, b)
src/Text/Hakyll/Util.hs+18−2
@@ -1,7 +1,10 @@
1module Text.Hakyll.Util
1module Text.Hakyll.Util
2+ ( toDestination,
3+ toCache,
2− ( makeDirectories,
4+ makeDirectories,
3 getRecursiveContents,
5 getRecursiveContents,
4− trim
6+ trim,
7+ isCacheFileValid
5 ) where
8 ) where
6
9
7import System.Directory
10import System.Directory
@@ -10,6 +13,12 @@ import Control.Monad
10import Data.Char
13import Data.Char
11import Data.List
14import Data.List
12
15
16+toDestination :: FilePath -> FilePath
17+toDestination path = "_site" </> path
18+
19+toCache :: FilePath -> FilePath
20+toCache path = "_cache" </> path
21+
13-- | Given a path to a file, try to make the path writable by making
22-- | Given a path to a file, try to make the path writable by making
14-- all directories on the path.
23-- all directories on the path.
15makeDirectories :: FilePath -> IO ()
24makeDirectories :: FilePath -> IO ()
@@ -44,3 +53,10 @@ split element = unfoldr splitOnce
44 (x, xs) -> if null xs
53 (x, xs) -> if null xs
45 then Just (x, [])
54 then Just (x, [])
46 else Just (x, tail xs)
55 else Just (x, tail xs)
56+
57+-- | Check is a cache file is still valid.
58+isCacheFileValid :: FilePath -> FilePath -> IO Bool
59+isCacheFileValid cache file = doesFileExist cache >>= \exists ->
60+ if not exists then return False
61+ else liftM2 (<=) (getModificationTime file)
62+ (getModificationTime cache)