diff options
| -rw-r--r-- | src/Text/Hakyll/Context.hs | 7 | ||||
| -rw-r--r-- | src/Text/Hakyll/File.hs | 4 | ||||
| -rw-r--r-- | src/Text/Hakyll/Page.hs | 9 | ||||
| -rw-r--r-- | src/Text/Hakyll/Render.hs | 16 | ||||
| -rw-r--r-- | src/Text/Hakyll/Renderables.hs | 3 | ||||
| -rw-r--r-- | tests/Tests.hs | 2 |
6 files changed, 21 insertions, 20 deletions
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs index 3d6f88c..22409bf 100644 --- a/src/Text/Hakyll/Context.hs +++ b/src/Text/Hakyll/Context.hs @@ -3,7 +3,6 @@ module Text.Hakyll.Context ( ContextManipulation , renderValue , renderDate - , ignoreKeys ) where import qualified Data.Map as M @@ -45,9 +44,3 @@ renderDate key format defaultValue context = "%Y-%m-%d" dateString :: Maybe UTCTime return $ formatTime defaultTimeLocale format time - --- | Ignore a number of keys during the render phase. -ignoreKeys :: [String] -> ContextManipulation -ignoreKeys keyList = M.union (M.fromList pairs) - where pairs = map pair keyList - pair key = (B.pack $ '$' : key, B.pack $ '$' : key) diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs index c285433..76589e0 100644 --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -38,9 +38,11 @@ toURL = flip addExtension ".html" . dropExtension -- | Get the relative url to the site root, for a given (absolute) url toRoot :: FilePath -> FilePath -toRoot = joinPath . map parent . splitPath +toRoot = emptyException . joinPath . map parent . splitPath . takeDirectory . removeLeadingSeparator where parent = const ".." + emptyException [] = "." + emptyException x = x -- | Swaps spaces for '-'. removeSpaces :: FilePath -> FilePath diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs index 85fd062..83ca654 100644 --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -4,7 +4,6 @@ module Text.Hakyll.Page , getValue , getBody , readPage - , writePage ) where import qualified Data.Map as M @@ -121,7 +120,6 @@ readPage pagePath = do [ (B.pack "body", rendered) , packPair ("url", url) , packPair ("path", pagePath) - , packPair ("root", toRoot url) ] ++ map packPair context -- Cache if needed @@ -130,13 +128,6 @@ readPage pagePath = do where url = toURL pagePath cacheFile = toCache url --- | Write a page to the site destination. -writePage :: Page -> IO () -writePage page = do - let destination = toDestination $ getURL page - makeDirectories destination - B.writeFile destination (getBody page) - -- Make pages renderable. instance Renderable Page where getDependencies = (:[]) . getPagePath diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index ac529e8..d3e4a34 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -52,7 +52,10 @@ renderWith manipulation templatePath renderable = do templateString <- liftM B.pack $ hGetContents handle seq templateString $ hClose handle context <- liftM manipulation $ toContext renderable - let body = substitute templateString context + -- Ignore $root when substituting here. We will only replace that in the + -- final render (just before writing). + let contextIgnoringRoot = M.insert (B.pack "root") (B.pack "$root") context + body = substitute templateString contextIgnoringRoot return $ fromContext (M.insert (B.pack "body") body context) -- | Render each renderable with the given template, then concatenate the @@ -92,6 +95,17 @@ renderChainWith manipulation templates renderable = result <- foldM (flip render) (fromContext initialPage) templates writePage result +-- | Write a page to the site destination. +writePage :: Page -> IO () +writePage page = do + let destination = toDestination url + makeDirectories destination + B.writeFile destination body + where url = getURL page + -- Substitute $root here, just before writing. + body = substitute (getBody page) + (M.singleton (B.pack "root") (B.pack $ toRoot url)) + -- | Mark a certain file as static, so it will just be copied when the site is -- generated. static :: FilePath -> IO () diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index 996534e..bd474e2 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -32,7 +32,8 @@ instance Renderable CustomPage where toContext page = do values <- mapM (either (return . B.pack) (>>= return) . snd) (mapping page) let keys = map (B.pack . fst) (mapping page) - return $ M.fromList $ (B.pack "url", B.pack $ url page) : zip keys values + return $ M.fromList $ [ (B.pack "url", B.pack $ url page) + ] ++ zip keys values -- | PagePath is a class that wraps a FilePath. This is used to render Pages -- without reading them first through use of caching. diff --git a/tests/Tests.hs b/tests/Tests.hs index e056b4b..38b072a 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -99,7 +99,7 @@ test_render_date2 = M.lookup (B.pack "date") rendered @?= Just (B.pack "Unknown -- toRoot test cases test_to_root1 = toRoot "/posts/foo.html" @?= ".." test_to_root2 = toRoot "posts/foo.html" @?= ".." -test_to_root3 = toRoot "foo.html" @?= "" +test_to_root3 = toRoot "foo.html" @?= "." -- Add an extension, and test that they have that extension prop_having_extension_count names extension = |