hakyll 1.0.1 → 1.1

raw patch · 15 files changed

+351/−209 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hakyll.cabal +2/−1
• src/Network/Hakyll/SimpleServer.hs +17/−20
• src/Text/Hakyll.hs +33/−17
• src/Text/Hakyll/CompressCSS.hs +2/−1
• src/Text/Hakyll/Context.hs +2/−2
• src/Text/Hakyll/File.hs +38/−24
• src/Text/Hakyll/Hakyll.hs +25/−0
• src/Text/Hakyll/Page.hs +66/−65
• src/Text/Hakyll/Regex.hs +17/−7
• src/Text/Hakyll/Render.hs +49/−30
• src/Text/Hakyll/Render/Internal.hs +16/−13
• src/Text/Hakyll/Renderable.hs +2/−2
• src/Text/Hakyll/Renderables.hs +61/−10
• src/Text/Hakyll/Tags.hs +20/−16
• src/Text/Hakyll/Util.hs +1/−1

@@ -1,5 +1,5 @@ Name:           hakyll-Version:        1.0.1+Version:        1.1  Synopsis:       A simple static site generator library. Description:@@ -36,6 +36,7 @@                    time >= 1,                    parallel >= 2   exposed-modules: Text.Hakyll+                   Text.Hakyll.Hakyll                    Text.Hakyll.Render                    Text.Hakyll.Renderable                    Text.Hakyll.Renderables

@@ -5,9 +5,9 @@     ) where  import Prelude hiding (log)-import Network-import Control.Monad (forever, mapM_)+import Control.Monad (forever) import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)+import Network import System.IO import System.Directory (doesFileExist, doesDirectoryExist) import Control.Concurrent (forkIO)@@ -49,10 +49,11 @@ readRequest handle = do     requestLine <- liftIO $ hGetLine handle     let [method, uri, version] = map trim $ splitRegex " " requestLine-    return $ Request { requestMethod = method-                     , requestURI = uri-                     , requestVersion = version-                     }+        request = Request { requestMethod = method+                          , requestURI = uri+                          , requestVersion = version+                          }+    return request  -- | Simple representation of the HTTP response we send back. data Response = Response { responseVersion :: String@@ -64,7 +65,7 @@  instance Show Response where     show response =  responseVersion response ++ " "-                  ++ (show $ responseStatusCode response) ++ " "+                  ++ show (responseStatusCode response) ++ " "                   ++ responsePhrase response  -- | A default response.@@ -105,21 +106,19 @@         log' = writeChan (logChannel config)     isDirectory <- liftIO $ doesDirectoryExist $ documentRoot config ++ uri     let fileName =-            (documentRoot config) ++ if isDirectory then uri ++ "/index.html"-                                                    else uri+            documentRoot config ++ if isDirectory then uri ++ "/index.html"+                                                  else uri          create200 = do-            h <- openFile fileName ReadMode+            h <- openBinaryFile fileName ReadMode             contentLength <- hFileSize h-            hClose h-            body <- readFile fileName-            let headers =-                    [ ("Content-Length", show $ contentLength)-                    ] ++ getMIMEHeader fileName+            body <- hGetContents h+            let mimeHeader = getMIMEHeader fileName+                headers = ("Content-Length", show contentLength) : mimeHeader             return $ defaultResponse                 { responseStatusCode = 200                 , responsePhrase = "OK"-                , responseHeaders = (responseHeaders defaultResponse) +                , responseHeaders = responseHeaders defaultResponse                     `M.union` M.fromList headers                 , responseBody = body                 }@@ -132,8 +131,7 @@     -- Send back the page if found.     exists <- liftIO $ doesFileExist fileName     if exists-        then do response <- liftIO $ catch create200 create500-                return response+        then liftIO $ catch create200 create500         else do liftIO $ log' $ "Not Found: " ++ fileName                 return $ createErrorResponse 404 "Not Found" @@ -202,10 +200,9 @@           -- When a client connects, respond in a separate thread.         listen socket = do (handle, _, _) <- accept socket                            forkIO (runReaderT (respond handle) config)-                           return ()      -- Handle logging in a separate thread-    forkIO (log logChan)+    _ <- forkIO (log logChan)      writeChan logChan $ "Starting hakyll server on port " ++ show port ++ "..."     socket <- listenOn (PortNumber port)

@@ -1,38 +1,54 @@ module Text.Hakyll-    ( hakyll+    ( defaultHakyllConfiguration+    , hakyll+    , hakyllWithConfiguration     ) where -import Network.Hakyll.SimpleServer (simpleServer)-+import Control.Monad.Reader (runReaderT)+import Control.Monad (when)+import qualified Data.Map as M import System.Environment (getArgs, getProgName) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) --- | Main function to run hakyll.-hakyll :: IO () -> IO ()-hakyll buildFunction = do+import Network.Hakyll.SimpleServer (simpleServer)+import Text.Hakyll.Hakyll++-- | Default hakyll configuration.+defaultHakyllConfiguration :: HakyllConfiguration+defaultHakyllConfiguration = HakyllConfiguration+    { additionalContext = M.empty+    }++-- | Hakyll with a default configuration.+hakyll :: Hakyll () -> IO ()+hakyll = hakyllWithConfiguration defaultHakyllConfiguration++-- | Main function to run hakyll with a configuration.+hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO ()+hakyllWithConfiguration configuration buildFunction = do     args <- getArgs-    case args of ["build"]      -> build buildFunction+    case args of ["build"]      -> build'                  ["clean"]      -> clean-                 ["preview", p] -> build buildFunction >> server (read p)-                 ["preview"]    -> build buildFunction >> server 8000+                 ["preview", p] -> build' >> server (read p)+                 ["preview"]    -> build' >> server 8000                  ["server", p]  -> server (read p)                  ["server"]     -> server 8000                  _              -> help+  where+    build' = build configuration buildFunction  -- | Build the site.-build :: IO () -> IO ()-build buildFunction = do putStrLn "Generating..."-                         buildFunction+build :: HakyllConfiguration -> Hakyll () -> IO ()+build configuration buildFunction = do putStrLn "Generating..."+                                       runReaderT buildFunction configuration  -- | Clean up directories. clean :: IO ()-clean = do remove' "_cache"-           remove' "_site"+clean = remove' "_site"   where     remove' dir = do putStrLn $ "Removing " ++ dir ++ "..."                      exists <- doesDirectoryExist dir-                     if exists then removeDirectoryRecursive dir-                               else return ()+                     when exists $ removeDirectoryRecursive dir  -- | Show usage information. help :: IO ()@@ -49,4 +65,4 @@              ++ name ++ " server [port]   Run a local test server.\n"  server :: Integer -> IO ()-server p = do simpleServer (fromIntegral $ p) "_site"+server p = simpleServer (fromIntegral p) "_site"

@@ -3,6 +3,7 @@     ) where  import Data.List (isPrefixOf)+ import Text.Hakyll.Regex (substituteRegex)  -- | Compress CSS to speed up your site.@@ -26,7 +27,7 @@ stripComments [] = [] stripComments str     | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str-    | otherwise = (head str) : (stripComments $ tail str)+    | otherwise = head str : stripComments (tail str)   where     eatComments str' | null str' = []                      | isPrefixOf "*/" str' = drop 2 str'

@@ -8,12 +8,12 @@  import qualified Data.Map as M import Data.Map (Map)- import System.Locale (defaultTimeLocale) import System.FilePath (takeFileName) import Data.Time.Format (parseTime, formatTime) import Data.Time.Clock (UTCTime) import Data.Maybe (fromMaybe)+ import Text.Hakyll.Regex (substituteRegex)  -- | Type for a context.@@ -31,7 +31,7 @@     Nothing      -> context     (Just value) -> M.insert dst (f value) context --- | When the context has a key called `path` in a `yyyy-mm-dd-title.extension`+-- | When the context has a key called @path@ in a @yyyy-mm-dd-title.extension@ --   format (default for pages), this function can render the date. renderDate :: String -- ^ Key in which the rendered date should be placed.            -> String -- ^ Format to use on the date.

@@ -2,7 +2,6 @@ --   files and directories. module Text.Hakyll.File     ( toDestination-    , toCache     , toURL     , toRoot     , removeSpaces@@ -17,29 +16,38 @@ import System.FilePath import Control.Monad import Data.List (isPrefixOf)+import Control.Monad.Reader (liftIO) +import Text.Hakyll.Hakyll (Hakyll)+ -- | Auxiliary function to remove pathSeparators form the start. We don't deal --   with absolute paths here. We also remove $root from the start. removeLeadingSeparator :: FilePath -> FilePath removeLeadingSeparator [] = [] removeLeadingSeparator path-    | (head path') `elem` pathSeparators = (tail path')-    | otherwise                          = path'+    | head path' `elem` pathSeparators = tail path'+    | otherwise                        = path'   where     path' = if "$root" `isPrefixOf` path then drop 5 path                                          else path --- | Convert a relative filepath to a filepath in the destination (_site).+-- | Convert a relative filepath to a filepath in the destination (@_site@). toDestination :: FilePath -> FilePath-toDestination path = "_site" </> (removeLeadingSeparator path)---- | Convert a relative filepath to a filepath in the cache (_cache).-toCache :: FilePath -> FilePath-toCache path = "_cache" </> (removeLeadingSeparator path)+toDestination path = "_site" </> removeLeadingSeparator path  -- | Get the url for a given page. toURL :: FilePath -> FilePath-toURL path = if takeExtension path `elem` [".markdown", ".md", ".tex"]+toURL path = if takeExtension path `elem` [ ".markdown"+                                          , ".md"+                                          , ".mdn"+                                          , ".mdwn"+                                          , ".mkd"+                                          , ".mkdn"+                                          , ".mkdwn"+                                          , ".rst"+                                          , ".text"+                                          , ".tex"+                                          ]                 then flip addExtension ".html" $ dropExtension path                 else path @@ -61,20 +69,20 @@  -- | Given a path to a file, try to make the path writable by making --   all directories on the path.-makeDirectories :: FilePath -> IO ()-makeDirectories path = createDirectoryIfMissing True dir+makeDirectories :: FilePath -> Hakyll ()+makeDirectories path = liftIO $ createDirectoryIfMissing True dir   where     dir = takeDirectory path  -- | Get all contents of a directory. Note that files starting with a dot (.) --   will be ignored.-getRecursiveContents :: FilePath -> IO [FilePath]+getRecursiveContents :: FilePath -> Hakyll [FilePath] getRecursiveContents topdir = do-    names <- getDirectoryContents topdir+    names <- liftIO $ getDirectoryContents topdir     let properNames = filter isProper names     paths <- forM properNames $ \name -> do         let path = topdir </> name-        isDirectory <- doesDirectoryExist path+        isDirectory <- liftIO $ doesDirectoryExist path         if isDirectory             then getRecursiveContents path             else return [path]@@ -85,18 +93,24 @@ -- | A filter that takes all file names with a given extension. Prefix the --   extension with a dot: -----   > havingExtension ".markdown" ["index.markdown", "style.css"] == ["index.markdown"]+--   > havingExtension ".markdown" [ "index.markdown"+--   >                             , "style.css"+--   >                             ] == ["index.markdown"] havingExtension :: String -> [FilePath] -> [FilePath] havingExtension extension = filter ((==) extension . takeExtension) --- | Perform an IO action on every file in a given directory.-directory :: (FilePath -> IO ()) -> FilePath -> IO ()+-- | Perform a Hakyll action on every file in a given directory.+directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll () directory action dir = getRecursiveContents dir >>= mapM_ action  -- | Check if a cache file is still valid.-isCacheValid :: FilePath -> [FilePath] -> IO Bool-isCacheValid cache depends = doesFileExist cache >>= \exists ->-    if not exists then return False-                  else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum-                          cacheModified <- getModificationTime cache-                          return (cacheModified >= dependsModified)+isCacheValid :: FilePath -- ^ The cached file.+             -> [FilePath] -- ^ Dependencies of the cached file.+             -> Hakyll Bool+isCacheValid cache depends = do+    exists <- liftIO $ doesFileExist cache+    if not exists+        then return False+        else do dependsModified <- liftIO $ mapM getModificationTime depends+                cacheModified <- liftIO $ getModificationTime cache+                return (cacheModified >= maximum dependsModified)

@@ -0,0 +1,25 @@+-- | Module describing the Hakyll monad stack.+module Text.Hakyll.Hakyll+    ( HakyllConfiguration (..)+    , Hakyll+    , askHakyll+    ) where++import Control.Monad.Reader (ReaderT, ask)+import Control.Monad (liftM)++import Text.Hakyll.Context (Context)++-- | Hakyll global configuration type.+data HakyllConfiguration = HakyllConfiguration+    { -- | An additional context to use when rendering. This additional context+      --   is used globally.+      additionalContext :: Context+    }++-- | Our custom monad stack.+type Hakyll = ReaderT HakyllConfiguration IO++-- | Simplified @ask@ function for the Hakyll monad stack.+askHakyll :: (HakyllConfiguration -> a) -> Hakyll a+askHakyll = flip liftM ask

@@ -4,23 +4,26 @@     , getValue     , getBody     , readPage+    , splitAtDelimiters     ) where  import qualified Data.Map as M-import qualified Data.List as L+import Data.List (isPrefixOf)+import Data.Char (isSpace) import Data.Maybe (fromMaybe)- import Control.Parallel.Strategies (rdeepseq, ($|))--import System.FilePath (FilePath, takeExtension)+import Control.Monad.Reader (liftIO)+import System.FilePath (takeExtension) import System.IO +import Text.Pandoc++import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.File import Text.Hakyll.Util (trim) import Text.Hakyll.Context (Context) import Text.Hakyll.Renderable-import Text.Pandoc-+import Text.Hakyll.Regex (substituteRegex, matchesRegex)  -- | A Page is basically key-value mapping. Certain keys have special --   meanings, like for example url, body and title.@@ -50,87 +53,85 @@ getBody :: Page -> String getBody (Page page) = fromMaybe [] $ M.lookup "body" page +-- | The default reader options for pandoc parsing.+readerOptions :: ParserState+readerOptions = defaultParserState { stateSmart = True }+ -- | The default writer options for pandoc rendering. writerOptions :: WriterOptions writerOptions = defaultWriterOptions  -- | Get a render function for a given extension.-renderFunction :: String -> (String -> String)-renderFunction ".html" = id-renderFunction ext = writeHtmlString writerOptions-                   . readFunction ext defaultParserState+getRenderFunction :: String -> (String -> String)+getRenderFunction ".html" = id+getRenderFunction ext = writeHtmlString writerOptions+                      . readFunction ext readerOptions   where-    readFunction ".markdown" = readMarkdown-    readFunction ".md"       = readMarkdown-    readFunction ".tex"      = readLaTeX-    readFunction _           = readMarkdown+    readFunction ".rst" = readRST+    readFunction ".tex" = readLaTeX+    readFunction _      = readMarkdown --- | Read metadata header from a file handle.-readMetaData :: Handle -> IO [(String, String)]-readMetaData handle = do-    line <- hGetLine handle-    if isDelimiter line-        then return []-        else do others <- readMetaData handle-                return $ (trimPair . break (== ':')) line : others-  where-    trimPair (key, value) = (trim key, trim $ tail value)+-- | Split a page into sections.+splitAtDelimiters :: [String] -> [[String]]+splitAtDelimiters [] = []+splitAtDelimiters ls@(x:xs)+    | isDelimiter x = let (content, rest) = break isDelimiter xs+                      in (x : content) : splitAtDelimiters rest+    | otherwise = [ls]  -- | Check if the given string is a metadata delimiter. isDelimiter :: String -> Bool-isDelimiter = L.isPrefixOf "---"+isDelimiter = isPrefixOf "---" --- | Used for caching of files.-cachePage :: Page -> IO ()-cachePage page@(Page mapping) = do-    let destination = toCache $ getURL page-    makeDirectories destination-    handle <- openFile destination WriteMode-    hPutStrLn handle "---"-    mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping-    hPutStrLn handle "---"-    hPutStr handle $ getBody page-    hClose handle+-- | Read one section of a page.+readSection :: (String -> String) -- ^ Render function.+            -> Bool -- ^ If this section is the first section in the page.+            -> [String] -- ^ Lines in the section.+            -> [(String, String)] -- ^ Key-values extracted.+readSection _ _ [] = []+readSection renderFunction isFirst ls+    | not isDelimiter' = body ls+    | isNamedDelimiter = readSectionMetaData ls+    | isFirst = readSimpleMetaData (tail ls)+    | otherwise = body (tail ls)   where-    writePair h (k, v) = do hPutStr h $ k ++ ": " ++ v-                            hPutStrLn h ""+    isDelimiter' = isDelimiter (head ls)+    isNamedDelimiter = head ls `matchesRegex` "^----*  *[a-zA-Z0-9][a-zA-Z0-9]*"+    body ls' = [("body", renderFunction $ unlines ls')] +    readSimpleMetaData = map readPair . filter (not . all isSpace)+    readPair = trimPair . break (== ':')+    trimPair (key, value) = (trim key, trim $ tail value)++    readSectionMetaData [] = []+    readSectionMetaData (header:value) =+        let key = substituteRegex "[^a-zA-Z0-9]" "" header+        in [(key, renderFunction $ unlines value)]+ -- | 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 pagePath = do-    -- Check cache.-    getFromCache <- isCacheValid cacheFile [pagePath]-    let path = if getFromCache then cacheFile else pagePath+--   has a @.markdown@ extension, it will be rendered using pandoc.+readPage :: FilePath -> Hakyll Page+readPage path = do+    let renderFunction = getRenderFunction $ takeExtension path+        sectionFunctions = map (readSection renderFunction)+                               (True : repeat False)      -- Read file.-    handle <- openFile path ReadMode-    line <- hGetLine handle-    (metaData, body) <--        if isDelimiter line-            then do md <- readMetaData handle-                    b <- hGetContents handle-                    return (md, b)-            else do b <- hGetContents handle-                    return ([], line ++ "\n" ++ b)+    handle <- liftIO $ openFile path ReadMode+    sections <- fmap (splitAtDelimiters . lines )+                     (liftIO $ hGetContents handle) -    -- Render file-    let rendered = (renderFunction $ takeExtension path) body+    let context = concat $ zipWith ($) sectionFunctions sections         page = fromContext $ M.fromList $-            [ ("body", rendered)-            , ("url", url)-            , ("path", pagePath)-            ] ++ metaData+            [ ("url", url)+            , ("path", path)+            ] ++ context -    seq (($|) id rdeepseq rendered) $ hClose handle+    seq (($|) id rdeepseq context) $ liftIO $ hClose handle -    -- Cache if needed-    if getFromCache then return () else cachePage page     return page   where-    url = toURL pagePath-    cacheFile = toCache url+    url = toURL path  -- Make pages renderable. instance Renderable Page where

@@ -1,8 +1,10 @@ -- | A module that exports a simple regex interface. This code is mostly copied---   from the regex-compat package at hackage.+--   from the regex-compat package at hackage. I decided to write this module+--   because I want to abstract the regex package used. module Text.Hakyll.Regex     ( splitRegex     , substituteRegex+    , matchesRegex     ) where  import Text.Regex.TDFA@@ -10,7 +12,7 @@ -- | Match a regular expression against a string, returning more information --   about the match. matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])-matchRegexAll p str = matchM p str+matchRegexAll = matchM  -- | Replaces every occurance of the given regexp with the replacement string. subRegex :: Regex -- ^ Search pattern@@ -28,10 +30,10 @@           Nothing -> repl           Just (lead, _, trail, bgroups) ->             let newval =-                 if (head bgroups) == "\\"+                 if head bgroups == "\\"                    then "\\"                    else let index :: Int-                            index = (read (head bgroups)) - 1+                            index = read (head bgroups) - 1                         in if index == -1                              then match'                              else groups !! index@@ -39,7 +41,7 @@   in case matchRegexAll regexp inp of        Nothing -> inp        Just (lead, match', trail, groups) ->-         lead ++ lookup' match' replacement groups ++ (subRegex regexp trail replacement)+         lead ++ lookup' match' replacement groups ++ subRegex regexp trail replacement  -- | Splits a string based on a regular expression.  The regular expression --   should identify one delimiter.@@ -58,9 +60,17 @@ splitRegex pattern = filter (not . null)                    . splitRegex' (makeRegex pattern) --- | Substitute a regex. Simplified interface.+-- | Substitute a regex. Simplified interface. This function performs a global+--   substitution. substituteRegex :: String -- ^ Pattern to replace (regex).                 -> String -- ^ Replacement string.                 -> String -- ^ Input string.                 -> String -- ^ Result.-substituteRegex pattern replacement str = subRegex (makeRegex pattern) str replacement+substituteRegex pattern replacement string =+    subRegex (makeRegex pattern) string replacement++-- | Simple regex matching.+matchesRegex :: String -- ^ Input string.+             -> String -- ^ Pattern to match.+             -> Bool+matchesRegex = (=~)

@@ -10,24 +10,23 @@     , css     ) where -import Control.Monad (unless, mapM)-+import Control.Monad (unless)+import Control.Monad.Reader (liftIO) import System.Directory (copyFile)-import System.IO +import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (ContextManipulation) import Text.Hakyll.Page import Text.Hakyll.Renderable import Text.Hakyll.File import Text.Hakyll.CompressCSS- import Text.Hakyll.Render.Internal  -- | Execute an IO action only when the cache is invalid. depends :: FilePath -- ^ File to be rendered or created.         -> [FilePath] -- ^ Files the render depends on.-        -> IO () -- ^ IO action to execute when the file is out of date.-        -> IO ()+        -> Hakyll () -- ^ IO action to execute when the file is out of date.+        -> Hakyll () depends file dependencies action = do     valid <- isCacheValid (toDestination file) dependencies     unless valid action@@ -36,7 +35,7 @@ render :: Renderable a        => FilePath -- ^ Template to use for rendering.        -> a -- ^ Renderable object to render with given template.-       -> IO Page -- ^ The body of the result will contain the render.+       -> Hakyll Page -- ^ The body of the result will contain the render. render = renderWith id  -- | Render to a Page. This function allows you to manipulate the context@@ -45,61 +44,81 @@            => ContextManipulation -- ^ Manipulation to apply on the context.            -> FilePath -- ^ Template to use for rendering.            -> a -- ^ Renderable object to render with given template.-           -> IO Page -- ^ The body of the result will contain the render.+           -> Hakyll Page -- ^ The body of the result will contain the render. renderWith manipulation templatePath renderable = do-    template <- readFile templatePath+    template <- liftIO $ readFile templatePath     context <- toContext renderable     return $ fromContext $ pureRenderWith manipulation template context --- | Render each renderable with the given template, then concatenate the---   result.-renderAndConcat :: Renderable a => FilePath -> [a] -> IO String+-- | Render each renderable with the given templates, then concatenate the+--   result. So, basically this function:+--+--   * Takes every renderable.+--+--   * Renders every renderable with all given templates. This is comparable+--     with a renderChain action.+--+--   * Concatenates the result.+--+renderAndConcat :: Renderable a+                => [FilePath] -- ^ Templates to apply on every renderable.+                -> [a] -- ^ Renderables to render.+                -> Hakyll String renderAndConcat = renderAndConcatWith id --- | Render each renderable with the given template, then concatenate the+-- | Render each renderable with the given templates, then concatenate the --   result. This function allows you to specify a "ContextManipulation" to --   apply on every "Renderable". renderAndConcatWith :: Renderable a                     => ContextManipulation-                    -> FilePath+                    -> [FilePath]                     -> [a]-                    -> IO String-renderAndConcatWith manipulation templatePath renderables = do-    template <- readFile templatePath+                    -> Hakyll String+renderAndConcatWith manipulation templatePaths renderables = do+    templates <- liftIO $ mapM readFile templatePaths     contexts <- mapM toContext renderables-    return $ pureRenderAndConcatWith manipulation template contexts+    return $ pureRenderAndConcatWith manipulation templates contexts  -- | Chain a render action for a page with a number of templates. This will --   also write the result to the site destination. This is the preferred way --   to do general rendering.-renderChain :: Renderable a => [FilePath] -> a -> IO ()+--+--   > renderChain [ "templates/notice.html"+--   >             , "templates/default.html"+--   >             ] $ createPagePath "warning.html"+--+--   This code will first render @warning.html@ using @templates/notice.html@,+--   and will then render the result with @templates/default.html@.+renderChain :: Renderable a => [FilePath] -> a -> Hakyll () renderChain = renderChainWith id  -- | A more custom render chain that allows you to specify a --   "ContextManipulation" which to apply on the context when it is read first. renderChainWith :: Renderable a-                => ContextManipulation -> [FilePath] -> a -> IO ()+                => ContextManipulation -> [FilePath] -> a -> Hakyll () renderChainWith manipulation templatePaths renderable =-    depends (getURL renderable) (getDependencies renderable ++ templatePaths) $-        do templates <- mapM readFile templatePaths-           context <- toContext renderable-           let result = pureRenderChainWith manipulation templates context-           writePage $ fromContext result+    depends (getURL renderable) dependencies render'+  where+    dependencies = getDependencies renderable ++ templatePaths+    render' = do templates <- liftIO $ mapM readFile templatePaths+                 context <- toContext renderable+                 let result = pureRenderChainWith manipulation templates context+                 writePage $ fromContext result  -- | Mark a certain file as static, so it will just be copied when the site is --   generated.-static :: FilePath -> IO ()+static :: FilePath -> Hakyll () static source = depends destination [source] action   where     destination = toDestination source     action = do makeDirectories destination-                copyFile source destination+                liftIO $ copyFile source destination  -- | Render a css file, compressing it.-css :: FilePath -> IO ()+css :: FilePath -> Hakyll () css source = depends destination [source] css'   where     destination = toDestination source-    css' = do contents <- readFile source+    css' = do contents <- liftIO $ readFile source               makeDirectories destination-              writeFile destination (compressCSS contents)+              liftIO $ writeFile destination (compressCSS contents)

@@ -11,26 +11,29 @@  import qualified Data.Map as M import Text.Hakyll.Context (Context, ContextManipulation)+import Control.Monad.Reader (liftIO) import Data.List (isPrefixOf, foldl')-import Data.Char (isAlpha)+import Data.Char (isAlphaNum) import Data.Maybe (fromMaybe) import Control.Parallel.Strategies (rdeepseq, ($|))+ import Text.Hakyll.Renderable import Text.Hakyll.Page import Text.Hakyll.File+import Text.Hakyll.Hakyll --- | Substitutes `$identifiers` in the given string by values from the given+-- | Substitutes @$identifiers@ in the given string by values from the given --   "Context". When a key is not found, it is left as it is. You can here---   specify the characters used to replace escaped dollars `$$`.+--   specify the characters used to replace escaped dollars (@$$@). substitute :: String -> String -> Context -> String  substitute _ [] _ = [] substitute escaper string context      | "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')     | "$" `isPrefixOf` string = substituteKey-    | otherwise = (head string) : (substitute' tail')+    | otherwise = head string : substitute' tail'   where     tail' = tail string-    (key, rest) = break (not . isAlpha) tail'+    (key, rest) = span isAlphaNum tail'     replacement = fromMaybe ('$' : key) $ M.lookup key context     substituteKey = replacement ++ substitute' rest     substitute' str = substitute escaper str context@@ -58,14 +61,14 @@  -- | A pure renderAndConcat function. pureRenderAndConcatWith :: ContextManipulation-                        -> String -- ^ Template to use.+                        -> [String] -- ^ Templates to use.                         -> [Context] -- ^ Different renderables.                         -> String-pureRenderAndConcatWith manipulation template contexts =+pureRenderAndConcatWith manipulation templates contexts =     foldl' renderAndConcat [] contexts   where     renderAndConcat chunk context =-        let rendered = pureRenderWith manipulation template context+        let rendered = pureRenderChainWith manipulation templates context         in chunk ++ fromMaybe "" (M.lookup "body" rendered)  -- | A pure renderChain function.@@ -79,13 +82,13 @@  -- | Write a page to the site destination. Final action after render --   chains and such.-writePage :: Page -> IO ()+writePage :: Page -> Hakyll () writePage page = do+    additionalContext' <- askHakyll additionalContext     let destination = toDestination url+        context = additionalContext' `M.union` M.singleton "root" (toRoot url)     makeDirectories destination-    writeFile destination body+    -- Substitute $root here, just before writing.+    liftIO $ writeFile destination $ finalSubstitute (getBody page) context   where     url = getURL page-    -- Substitute $root here, just before writing.-    body = finalSubstitute (getBody page)-                           (M.singleton "root" $ toRoot url)

@@ -2,13 +2,13 @@     ( Renderable(toContext, getDependencies, getURL)     ) where -import System.FilePath (FilePath)+import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (Context)  -- | A class for datatypes that can be rendered to pages. class Renderable a where     -- | Get a context to do substitutions with.-    toContext :: a -> IO Context+    toContext :: a -> Hakyll Context      -- | Get the dependencies for the renderable. This is used for cache     --   invalidation.

@@ -3,35 +3,45 @@     , createCustomPage     , PagePath     , createPagePath+    , CombinedRenderable+    , combine+    , combineWithURL     ) where -import System.FilePath (FilePath) import qualified Data.Map as M++import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Page import Text.Hakyll.Renderable import Text.Hakyll.File  -- | A custom page. data CustomPage = CustomPage -    { url :: String,-      dependencies :: [FilePath],-      mapping :: [(String, Either String (IO String))]+    { customPageURL :: String,+      customPageDependencies :: [FilePath],+      customPageContext :: [(String, Either String (Hakyll String))]     }  -- | Create a custom page.+--   +--   The association list given maps keys to values for substitution. Note+--   that as value, you can either give a @String@ or a @Hakyll String@.+--   A @Hakyll String@ is preferred for more complex data, since it allows+--   dependency checking. A @String@ is obviously more simple to use in some+--   cases. createCustomPage :: String -- ^ Destination of the page, relative to _site.                  -> [FilePath] -- ^ Dependencies of the page.-                 -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering.+                 -> [(String, Either String (Hakyll String))] -- ^ Mapping.                  -> CustomPage createCustomPage = CustomPage  instance Renderable CustomPage where-    getDependencies = dependencies-    getURL = url+    getDependencies = customPageDependencies+    getURL = customPageURL     toContext page = do-        values <- mapM (either (return) (>>= return) . snd) (mapping page)-        return $ M.fromList $ [ ("url", url page)-                              ] ++ zip (map fst $ mapping page) values +        values <- mapM (either return id . snd) (customPageContext page)+        let pairs = zip (map fst $ customPageContext page) values+        return $ M.fromList $ ("url", customPageURL page) : pairs  -- | PagePath is a class that wraps a FilePath. This is used to render Pages --   without reading them first through use of caching.@@ -46,3 +56,44 @@     getDependencies (PagePath path) = return path     getURL (PagePath path) = toURL path     toContext (PagePath path) = readPage path >>= toContext++-- | A combination of two other renderables.+data CombinedRenderable a b = CombinedRenderable a b+                            | CombinedRenderableWithURL FilePath a b++-- | Combine two renderables. The url will always be taken from the first+--   "Renderable". Also, if a `$key` is present in both renderables, the+--   value from the first "Renderable" will be taken as well.+combine :: (Renderable a, Renderable b) => a -> b -> CombinedRenderable a b+combine = CombinedRenderable++-- | Combine two renderables and set a custom URL.+combineWithURL :: (Renderable a, Renderable b)+               => FilePath+               -> a+               -> b+               -> CombinedRenderable a b+combineWithURL = CombinedRenderableWithURL++-- | Render combinations.+instance (Renderable a, Renderable b)+         => Renderable (CombinedRenderable a b) where++    -- Add the dependencies.+    getDependencies (CombinedRenderable a b) =+        getDependencies a ++ getDependencies b+    getDependencies (CombinedRenderableWithURL _ a b) =+        getDependencies a ++ getDependencies b++    -- Take the url from the first renderable, or the specified URL.+    getURL (CombinedRenderable a _) = getURL a+    getURL (CombinedRenderableWithURL url _ _) = url++    -- Take a union of the contexts.+    toContext (CombinedRenderable a b) = do+        c1 <- toContext a+        c2 <- toContext b+        return $ c1 `M.union` c2+    toContext (CombinedRenderableWithURL url a b) = do+        c <- toContext (CombinedRenderable a b)+        return $ M.singleton "url" url `M.union` c

@@ -9,27 +9,29 @@ import qualified Data.Map as M import Data.List (intercalate) import Control.Monad (foldM)+import Control.Arrow (second) +import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (ContextManipulation, renderValue)+import Text.Hakyll.Render.Internal (finalSubstitute) import Text.Hakyll.Regex import Text.Hakyll.Util import Text.Hakyll.Page-import Control.Arrow (second)  -- | Read a tag map. This creates a map from tags to page paths. This function---   assumes the tags are located in the `tags` metadata field, separated by+--   assumes the tags are located in the @tags@ metadata field, separated by --   commas.-readTagMap :: [FilePath] -> IO (M.Map String [FilePath])+readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath]) readTagMap paths = foldM addPaths M.empty paths   where     addPaths current path = do         page <- readPage path-        let tags = map trim $ splitRegex "," $ getValue ("tags") page-        return $ foldr (\t -> M.insertWith (++) t [path]) current tags+        let tags = map trim $ splitRegex "," $ getValue "tags" page+        return $ foldr (flip (M.insertWith (++)) [path]) current tags  -- | Render a tag cloud.-renderTagCloud :: M.Map String [FilePath] -- ^ A tag map as produced by 'readTagMap'.-               -> (String -> String) -- ^ Function that produces an url for a tag.+renderTagCloud :: M.Map String [FilePath] -- ^ Map as produced by "readTagMap".+               -> (String -> String) -- ^ Function to produce an url for a tag.                -> Float -- ^ Smallest font size, in percent.                -> Float -- ^ Biggest font size, in percent.                -> String -- ^ Result of the render.@@ -37,19 +39,21 @@     intercalate " " $ map renderTag tagCount   where     renderTag :: (String, Float) -> String-    renderTag (tag, count) =  "<a style=\"font-size: "-                           ++ sizeTag count ++ "\" href=\""-                           ++ urlFunction tag ++ "\">"-                           ++ tag ++ "</a>"+    renderTag (tag, count) = +        finalSubstitute "<a style=\"font-size: $size\" href=\"$url\">$tag</a>" $+                        M.fromList [ ("size", sizeTag count)+                                   , ("url", urlFunction tag)+                                   , ("tag", tag)+                                   ]      sizeTag :: Float -> String     sizeTag count = show size' ++ "%"       where         size' :: Int-        size' = floor (minSize + (relative count) * (maxSize - minSize))+        size' = floor $ minSize + relative count * (maxSize - minSize) -    minCount = minimum $ map snd $ tagCount-    maxCount = maximum $ map snd $ tagCount+    minCount = minimum $ map snd tagCount+    maxCount = maximum $ map snd tagCount     relative count = (count - minCount) / (maxCount - minCount)      tagCount :: [(String, Float)]@@ -61,5 +65,5 @@ renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'   where     renderTagLinks' = intercalate ", "-                    . map (\t -> link t $ urlFunction t)-                    . map trim . splitRegex ","+                    . map ((\t -> link t $ urlFunction t) . trim)+                    . splitRegex ","

@@ -17,7 +17,7 @@ stripHTML []  = [] stripHTML str = let (beforeTag, rest) = break (== '<') str                     (_, afterTag)     = break (== '>') rest-                in beforeTag ++ (stripHTML $ tail' afterTag)+                in beforeTag ++ stripHTML (tail' afterTag)     -- We need a failsafe tail function.   where     tail' [] = []