on master help sign in
Added basic dependency checking.
453e81fJasper Van der Jeugt
src/Text/Hakyll/Page.hs+7−2
@@ -2,6 +2,7 @@ module Text.Hakyll.Page
2 ( Page,
2 ( Page,
3 PageValue,
3 PageValue,
4 addContext,
4 addContext,
5+ toURL,
5 getURL,
6 getURL,
6 getBody,
7 getBody,
7 readPage,
8 readPage,
@@ -33,6 +34,10 @@ type PageValue = B.ByteString
33addContext :: String -> String -> Page -> Page
34addContext :: String -> String -> Page -> Page
34addContext key value = M.insert key (B.pack value)
35addContext key value = M.insert key (B.pack value)
35
36
37+-- | Get the url for a given page.
38+toURL :: FilePath -> FilePath
39+toURL = flip addExtension ".html" . dropExtension
40+
36-- | Get the URL for a certain page. This should always be defined. If
41-- | Get the URL for a certain page. This should always be defined. If
37-- not, it will return trash.html.
42-- not, it will return trash.html.
38getURL :: Page -> String
43getURL :: Page -> String
@@ -88,7 +93,7 @@ cachePage page = do
88readPage :: FilePath -> IO Page
93readPage :: FilePath -> IO Page
89readPage pagePath = do
94readPage pagePath = do
90 -- Check cache.
95 -- Check cache.
91− getFromCache <- isCacheFileValid cacheFile pagePath
96+ getFromCache <- isCacheValid cacheFile [pagePath]
92 let path = if getFromCache then cacheFile else pagePath
97 let path = if getFromCache then cacheFile else pagePath
93
98
94 -- Read file.
99 -- Read file.
@@ -108,7 +113,7 @@ readPage pagePath = do
108 -- Cache if needed
113 -- Cache if needed
109 if getFromCache then return () else cachePage page
114 if getFromCache then return () else cachePage page
110 return page
115 return page
111− where url = addExtension (dropExtension pagePath) ".html"
116+ where url = toURL pagePath
112 cacheFile = toCache url
117 cacheFile = toCache url
113
118
114-- | Create a key-value mapping page from an association list.
119-- | Create a key-value mapping page from an association list.
src/Text/Hakyll/Render.hs+23−5
@@ -1,7 +1,10 @@
1module Text.Hakyll.Render
1module Text.Hakyll.Render
2+ ( depends,
2− ( renderPage,
3+ renderPage,
3 renderAndWrite,
4 renderAndWrite,
5+ writePage,
4 renderAndConcat,
6 renderAndConcat,
7+ renderChain,
5 static,
8 static,
6 staticDirectory
9 staticDirectory
7 ) where
10 ) where
@@ -17,6 +20,12 @@ import System.IO
17import Text.Hakyll.Page
20import Text.Hakyll.Page
18import Text.Hakyll.Util
21import Text.Hakyll.Util
19
22
23+depends :: FilePath -> [FilePath] -> IO () -> IO ()
24+depends file dependencies action = do
25+ valid <- isCacheValid (toDestination file) dependencies
26+ if valid then return ()
27+ else action
28+
20createContext :: Page -> Context
29createContext :: Page -> Context
21createContext = M.fromList . map packPair . M.toList
30createContext = M.fromList . map packPair . M.toList
22 where packPair (a, b) = (B.pack a, b)
31 where packPair (a, b) = (B.pack a, b)
@@ -30,11 +39,14 @@ renderPage templatePath page = do
30 return $ M.insert "body" body page
39 return $ M.insert "body" body page
31
40
32renderAndWrite :: FilePath -> Page -> IO ()
41renderAndWrite :: FilePath -> Page -> IO ()
33−renderAndWrite templatePath page = do
42+renderAndWrite templatePath page =
34− rendered <- renderPage templatePath page
43+ renderPage templatePath page >>= writePage
44+
45+writePage :: Page -> IO ()
46+writePage page = do
35− let destination = toDestination $ getURL rendered
47+ let destination = toDestination $ getURL page
36 makeDirectories destination
48 makeDirectories destination
37− B.writeFile destination (getBody rendered)
49+ B.writeFile destination (getBody page)
38
50
39renderAndConcat :: FilePath -> [FilePath] -> IO B.ByteString
51renderAndConcat :: FilePath -> [FilePath] -> IO B.ByteString
40renderAndConcat templatePath paths = foldM concatRender' B.empty paths
52renderAndConcat templatePath paths = foldM concatRender' B.empty paths
@@ -45,6 +57,12 @@ renderAndConcat templatePath paths = foldM concatRender' B.empty paths
45 let body = getBody rendered
57 let body = getBody rendered
46 return $ B.append chunk $ body
58 return $ B.append chunk $ body
47
59
60+renderChain :: FilePath -> [FilePath] -> IO ()
61+renderChain pagePath templates = depends (toURL pagePath) (pagePath : templates) $
62+ do page <- readPage pagePath
63+ result <- foldM (flip renderPage) page templates
64+ writePage result
65+
48static :: FilePath -> IO ()
66static :: FilePath -> IO ()
49static source = do
67static source = do
50 makeDirectories destination
68 makeDirectories destination
src/Text/Hakyll/Util.hs+6−5
@@ -5,7 +5,7 @@ module Text.Hakyll.Util
5 getRecursiveContents,
5 getRecursiveContents,
6 trim,
6 trim,
7 split,
7 split,
8− isCacheFileValid
8+ isCacheValid
9 ) where
9 ) where
10
10
11import System.Directory
11import System.Directory
@@ -56,8 +56,9 @@ split element = unfoldr splitOnce
56 else Just (x, tail xs)
56 else Just (x, tail xs)
57
57
58-- | Check is a cache file is still valid.
58-- | Check is a cache file is still valid.
59−isCacheFileValid :: FilePath -> FilePath -> IO Bool
59+isCacheValid :: FilePath -> [FilePath] -> IO Bool
60−isCacheFileValid cache file = doesFileExist cache >>= \exists ->
60+isCacheValid cache depends = doesFileExist cache >>= \exists ->
61 if not exists then return False
61 if not exists then return False
62− else liftM2 (<=) (getModificationTime file)
62+ else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum
63− (getModificationTime cache)
63+ cacheModified <- getModificationTime cache
64+ return (cacheModified >= dependsModified)