hakyll 1.4 → 2.0

raw patch · 27 files changed

+1001/−766 lines, 27 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• data/templates/atom-item.xml +7/−0
• data/templates/atom.xml +12/−0
• data/templates/rss-item.xml +7/−0
• data/templates/rss.xml +12/−0
• hakyll.cabal +57/−49
• src/Network/Hakyll/SimpleServer.hs +10/−10
• src/Text/Hakyll.hs +18/−9
• src/Text/Hakyll/Context.hs +4/−75
• src/Text/Hakyll/ContextManipulations.hs +93/−0
• src/Text/Hakyll/CreateContext.hs +97/−0
• src/Text/Hakyll/Feed.hs +111/−0
• src/Text/Hakyll/File.hs +7/−19
• src/Text/Hakyll/Hakyll.hs +0/−33
• src/Text/Hakyll/HakyllAction.hs +95/−0
• src/Text/Hakyll/HakyllMonad.hs +50/−0
• src/Text/Hakyll/Internal/Cache.hs +3/−2
• src/Text/Hakyll/Internal/FileType.hs +48/−0
• src/Text/Hakyll/Internal/Page.hs +123/−0
• src/Text/Hakyll/Internal/Render.hs +0/−67
• src/Text/Hakyll/Internal/Template.hs +1/−1
• src/Text/Hakyll/Page.hs +0/−185
• src/Text/Hakyll/Paginate.hs +89/−0
• src/Text/Hakyll/Regex.hs +3/−2
• src/Text/Hakyll/Render.hs +80/−86
• src/Text/Hakyll/Renderable.hs +0/−18
• src/Text/Hakyll/Renderables.hs +0/−158
• src/Text/Hakyll/Tags.hs +74/−52

@@ -0,0 +1,7 @@+<entry>+    <title>$title</title>+    <link href="$absolute/$url" />+    <id>$absolute/$url</id>+    <updated>$timestamp</updated>+    <summary>$description</summary>+</entry>

@@ -0,0 +1,12 @@+<?xml version="1.0" encoding="utf-8"?>+<feed xmlns="http://www.w3.org/2005/Atom">+    <title>$title</title>+    <link href="$absolute/$url" rel="self" />+    <link href="$absolute" />+    <id>$absolute/$url</id>+    <author>+        <name>$authorName</name>+    </author>+    <updated>$timestamp</updated>+    $body+</feed>

@@ -0,0 +1,7 @@+<item>+    <title>$title</title>+    <link>$absolute/$url</link>+    <description>$description</description>+    <pubDate>$timestamp</pubDate>+    <guid>$absolute/$url</guid>+</item>

@@ -0,0 +1,12 @@+<?xml version="1.0" encoding="utf8"?>+<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">+    <channel>+        <title>$title</title>+        <link>$absolute</link>+        <description>$description</description>+        <atom:link href="$absolute/$url" rel="self"+                   type="application/rss+xml" />+        <lastBuildDate>$timestamp</lastBuildDate>+        $body+    </channel> +</rss>

@@ -1,55 +1,63 @@-Name:           hakyll-Version:        1.4+Name:               hakyll+Version:            2.0 -Synopsis:       A simple static site generator library.-Description:-  A simple static site generator library, mainly aimed at-  creating blogs and brochure sites.-Author:         Jasper Van der Jeugt-Maintainer:     jaspervdj@gmail.com-Homepage:       http://jaspervdj.be/hakyll-Bug-Reports:    http://github.com/jaspervdj/Hakyll/issues-License:        BSD3-License-File:   LICENSE-Category:       Text-Cabal-Version:  >= 1.6+Synopsis:           A simple static site generator library.+Description:        A simple static site generator library, mainly aimed at+                    creating blogs and brochure sites.+Author:             Jasper Van der Jeugt+Maintainer:         jaspervdj@gmail.com+Homepage:           http://jaspervdj.be/hakyll+Bug-Reports:        http://github.com/jaspervdj/Hakyll/issues+License:            BSD3+License-File:       LICENSE+Category:           Text+Cabal-Version:      >= 1.6+Data-Dir:           data+Data-Files:         templates/atom.xml+                    templates/atom-item.xml+                    templates/rss.xml+                    templates/rss-item.xml -build-type:     Simple+build-type:         Simple  source-repository head-  type: git-  location: git://github.com/jaspervdj/Hakyll.git+  type:             git+  location:         git://github.com/jaspervdj/Hakyll.git  library-  ghc-options: -Wall-  hs-source-dirs: src/-  build-depends:   base >= 4 && < 5,-                   filepath >= 1.1,-                   directory >= 1,-                   containers >= 0.1,-                   pandoc >= 1,-                   regex-base >= 0.83,-                   regex-tdfa >= 0.92,-                   network >= 2,-                   mtl >= 1.1,-                   old-locale >= 1,-                   old-time >= 1,-                   time >= 1,-                   binary >= 0.5,-                   QuickCheck >= 2-  exposed-modules: Network.Hakyll.SimpleServer-                   Text.Hakyll-                   Text.Hakyll.Context-                   Text.Hakyll.File-                   Text.Hakyll.Hakyll-                   Text.Hakyll.Regex-                   Text.Hakyll.Render-                   Text.Hakyll.Renderable-                   Text.Hakyll.Renderables-                   Text.Hakyll.Page-                   Text.Hakyll.Util-                   Text.Hakyll.Tags-                   Text.Hakyll.Internal.Cache-                   Text.Hakyll.Internal.CompressCss-                   Text.Hakyll.Internal.Render-                   Text.Hakyll.Internal.Template+  ghc-options:      -Wall+  hs-source-dirs:   src+  build-depends:    base >= 4 && < 5,+                    filepath >= 1.1,+                    directory >= 1,+                    containers >= 0.1,+                    pandoc >= 1,+                    regex-base >= 0.83,+                    regex-tdfa >= 0.92,+                    network >= 2,+                    mtl >= 1.1,+                    old-locale >= 1,+                    old-time >= 1,+                    time >= 1,+                    binary >= 0.5,+                    QuickCheck >= 2+  exposed-modules:  Network.Hakyll.SimpleServer+                    Text.Hakyll+                    Text.Hakyll.Context+                    Text.Hakyll.ContextManipulations+                    Text.Hakyll.CreateContext+                    Text.Hakyll.File+                    Text.Hakyll.HakyllMonad+                    Text.Hakyll.Regex+                    Text.Hakyll.Render+                    Text.Hakyll.HakyllAction+                    Text.Hakyll.Paginate+                    Text.Hakyll.Util+                    Text.Hakyll.Tags+                    Text.Hakyll.Feed+  other-modules:    Paths_hakyll+                    Text.Hakyll.Internal.Cache+                    Text.Hakyll.Internal.CompressCss+                    Text.Hakyll.Internal.FileType+                    Text.Hakyll.Internal.Page+                    Text.Hakyll.Internal.Template

@@ -143,16 +143,16 @@                    Nothing  -> []   where     result = lookup (takeExtension fileName) [ (".css", "text/css")-                                               , (".gif", "image/gif")-                                               , (".htm", "text/html")-                                               , (".html", "text/html")-                                               , (".jpeg", "image/jpeg")-                                               , (".jpg", "image/jpeg")-                                               , (".js", "text/javascript")-                                               , (".png", "image/png")-                                               , (".txt", "text/plain")-                                               , (".xml", "text/xml")-                                               ]+                                             , (".gif", "image/gif")+                                             , (".htm", "text/html")+                                             , (".html", "text/html")+                                             , (".jpeg", "image/jpeg")+                                             , (".jpg", "image/jpeg")+                                             , (".js", "text/javascript")+                                             , (".png", "image/png")+                                             , (".txt", "text/plain")+                                             , (".xml", "text/xml")+                                             ]  -- | Respond to an incoming request. respond :: Handle -> Server ()

@@ -22,22 +22,29 @@ import System.Time (getClockTime)  import Network.Hakyll.SimpleServer (simpleServer)-import Text.Hakyll.Hakyll+import Text.Hakyll.HakyllMonad import Text.Hakyll.File  -- | The default hakyll configuration. defaultHakyllConfiguration :: HakyllConfiguration defaultHakyllConfiguration = HakyllConfiguration-    { additionalContext = M.empty-    , siteDirectory = "_site"-    , cacheDirectory = "_cache"-    , enableIndexUrl = False-    , previewPollDelay = 1000000+    { absoluteUrl       = ""+    , additionalContext = M.empty+    , siteDirectory     = "_site"+    , cacheDirectory    = "_cache"+    , enableIndexUrl    = False+    , previewPollDelay  = 1000000     } --- | Main function to run Hakyll with the default configuration.-hakyll :: Hakyll () -> IO ()-hakyll = hakyllWithConfiguration defaultHakyllConfiguration+-- | Main function to run Hakyll with the default configuration. The+--   absolute URL is only used in certain cases, for example RSS feeds et+--   cetera.+hakyll :: String    -- ^ Absolute URL of your site. Used in certain cases.+       -> Hakyll () -- ^ You code.+       -> IO ()+hakyll absolute = hakyllWithConfiguration configuration+  where+    configuration = defaultHakyllConfiguration { absoluteUrl = absolute }  -- | Main function to run hakyll with a custom configuration. hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO ()@@ -47,6 +54,7 @@                          ["clean"]      -> clean                          ["preview", p] -> preview buildFunction (read p)                          ["preview"]    -> preview buildFunction 8000+                         ["rebuild"]    -> clean >> buildFunction                          ["server", p]  -> server (read p)                          ["server"]     -> server 8000                          _              -> help@@ -90,6 +98,7 @@              ++ name ++ " clean           Clean up and remove cache.\n"              ++ name ++ " help            Show this message.\n"              ++ name ++ " preview [port]  Run a server and autocompile.\n"+             ++ name ++ " rebuild         Clean up and build again.\n"              ++ name ++ " server [port]   Run a local test server.\n"  -- | Start a server at the given port number.

@@ -1,82 +1,11 @@--- | Module containing various functions to manipulate contexts.+-- | This (quite small) module exports the datatype used for contexts. A+--   @Context@ is a simple key-value mapping. You can render these @Context@s+--   with templates, and manipulate them in various ways. module Text.Hakyll.Context     ( Context-    , ContextManipulation-    , renderValue-    , changeValue-    , renderDate-    , changeExtension     ) where -import qualified Data.Map as M import Data.Map (Map)-import System.Locale (defaultTimeLocale)-import System.FilePath (takeFileName, addExtension, dropExtension)-import Data.Time.Format (parseTime, formatTime)-import Data.Time.Clock (UTCTime)-import Data.Maybe (fromMaybe) -import Text.Hakyll.Regex (substituteRegex)---- | Type for a context.+-- | Datatype used for key-value mappings. type Context = Map String String---- | Type for context manipulating functions.-type ContextManipulation = Context -> Context---- | Do something with a value in a @Context@, but keep the old value as well.---   This is probably the most common function to construct a---   @ContextManipulation@.-renderValue :: String -- ^ Key of which the value should be copied.-            -> String -- ^ Key the value should be copied to.-            -> (String -> String) -- ^ Function to apply on the value.-            -> ContextManipulation-renderValue src dst f context = case M.lookup src context of-    Nothing      -> context-    (Just value) -> M.insert dst (f value) context---- | Change a value in a @Context@.------   > import Data.Char (toUpper)---   > changeValue "title" (map toUpper)------   Will put the title in UPPERCASE.-changeValue :: String -- ^ Key of which the value should be changed.-            -> (String -> String) -- ^ Function to apply on the value.-            -> ContextManipulation-changeValue key = renderValue key key---- | 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 "date" "%B %e, %Y" "Date unknown"------   Will render something like @January 32, 2010@.-renderDate :: String -- ^ Key in which the rendered date should be placed.-           -> String -- ^ Format to use on the date.-           -> String -- ^ Default value when the date cannot be parsed.-           -> ContextManipulation-renderDate key format defaultValue context = M.insert key value context-  where-    value = fromMaybe defaultValue pretty-    pretty = do filePath <- M.lookup "path" context-                let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"-                                                 (takeFileName filePath)-                time <- parseTime defaultTimeLocale-                                  "%Y-%m-%d"-                                  dateString :: Maybe UTCTime-                return $ formatTime defaultTimeLocale format time---- | Change the extension of a file. This is only needed when you want to---   render, for example, mardown to @.php@ files instead of @.html@ files.------   > renderChainWith (changeExtension "php")---   >                 ["templates/default.html"]---   >                 (createPagePath "test.markdown")------   Will render to @test.php@ instead of @test.html@.-changeExtension :: String -- ^ Extension to change to.-                   -> ContextManipulation-changeExtension extension = changeValue "url" changeExtension'-  where-    changeExtension' = flip addExtension extension . dropExtension

@@ -0,0 +1,93 @@+-- | This module exports a number of functions that produce @HakyllAction@s to+--   manipulate @Context@s.+module Text.Hakyll.ContextManipulations+    ( renderValue+    , changeValue+    , copyValue+    , renderDate+    , changeExtension+    , renderBody+    ) where++import Control.Arrow (arr)+import System.Locale (defaultTimeLocale)+import System.FilePath (takeFileName, addExtension, dropExtension)+import Data.Time.Format (parseTime, formatTime)+import Data.Time.Clock (UTCTime)+import Data.Maybe (fromMaybe)+import qualified Data.Map as M++import Text.Hakyll.Regex (substituteRegex)+import Text.Hakyll.HakyllAction (HakyllAction)+import Text.Hakyll.Context (Context)++-- | Do something with a value in a @Context@, but keep the old value as well.+--   If the key given is not present in the @Context@, nothing will happen.+renderValue :: String             -- ^ Key of which the value should be copied.+            -> String             -- ^ Key the value should be copied to.+            -> (String -> String) -- ^ Function to apply on the value.+            -> HakyllAction Context Context+renderValue source destination f = arr $ \context ->+    case M.lookup source context of+        Nothing      -> context+        (Just value) -> M.insert destination (f value) context++-- | Change a value in a @Context@.+--+--   > import Data.Char (toUpper)+--   > changeValue "title" (map toUpper)+--+--   Will put the title in UPPERCASE.+changeValue :: String             -- ^ Key to change.+            -> (String -> String) -- ^ Function to apply on the value.+            -> HakyllAction Context Context+changeValue key = renderValue key key++-- | Copy a value from one key to another in a @Context@.+copyValue :: String -- ^ Source key.+          -> String -- ^ Destination key.+          -> HakyllAction Context Context+copyValue source destination = renderValue source destination id++-- | When the context has a key called @path@ in a+--   @folder/yyyy-mm-dd-title.extension@ format (the convention for pages),+--   this function can render the date.+--+--   > renderDate "date" "%B %e, %Y" "Date unknown"+--+--   Will render something like @January 32, 2010@.+renderDate :: String -- ^ Key in which the rendered date should be placed.+           -> String -- ^ Format to use on the date.+           -> String -- ^ Default key, in case the date cannot be parsed.+           -> HakyllAction Context Context+renderDate key format defaultValue = renderValue "path" key renderDate'+  where+    renderDate' filePath = fromMaybe defaultValue $ do+        let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"+                                         (takeFileName filePath)+        time <- parseTime defaultTimeLocale+                          "%Y-%m-%d"+                          dateString :: Maybe UTCTime+        return $ formatTime defaultTimeLocale format time++-- | Change the extension of a file. This is only needed when you want to+--   render, for example, mardown to @.php@ files instead of @.html@ files.+--+--   > changeExtension "php"+--+--   Will render @test.markdown@ to @test.php@ instead of @test.html@.+changeExtension :: String -- ^ Extension to change to.+                -> HakyllAction Context Context+changeExtension extension = changeValue "url" changeExtension'+  where+    changeExtension' = flip addExtension extension . dropExtension++-- | Change the body of a file using a certain manipulation.+--+--   > import Data.Char (toUpper)+--   > renderBody (map toUpper)+--+--   Will put the entire body of the page in UPPERCASE.+renderBody :: (String -> String)+           -> HakyllAction Context Context+renderBody = renderValue "body" "body"

@@ -0,0 +1,97 @@+-- | A module that provides different ways to create a @Context@. These+--   functions all use the @HakyllAction@ arrow, so they produce values of the+--   type @HakyllAction () Context@.+module Text.Hakyll.CreateContext+    ( createPage+    , createCustomPage+    , createListing+    , combine+    , combineWithUrl+    ) where++import qualified Data.Map as M+import Control.Arrow (second)+import Control.Monad (liftM2, mplus)+import Control.Applicative ((<$>))++import Text.Hakyll.File+import Text.Hakyll.Context+import Text.Hakyll.HakyllAction+import Text.Hakyll.Render+import Text.Hakyll.Internal.Page++-- | Create a @Context@ from a page file stored on the disk. This is probably+--   the most common way to create a @Context@.+createPage :: FilePath -> HakyllAction () Context+createPage path = HakyllAction+    { actionDependencies = [path]+    , actionUrl          = Just $ toUrl path+    , actionFunction     = const (readPage path)+    }++-- | Create a "custom page" @Context@.+--   +--   The association list given maps keys to values for substitution. Note+--   that as value, you can either give a @String@ or a+--   @HakyllAction () String@. The latter is preferred for more complex data,+--   since it allows dependency checking. A @String@ is obviously more simple+--   to use in some cases.+createCustomPage :: FilePath+                 -> [(String, Either String (HakyllAction () String))]+                 -> HakyllAction () Context+createCustomPage url association = HakyllAction+    { actionDependencies = dataDependencies+    , actionUrl          = Just $ return url+    , actionFunction     = \_ -> M.fromList <$> assoc'+    }+  where+    mtuple (a, b) = b >>= \b' -> return (a, b')+    toHakyllString = second (either return runHakyllAction)+    assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association+    dataDependencies = map snd association >>= getDependencies+    getDependencies (Left _) = []+    getDependencies (Right x) = actionDependencies x++-- | A @createCustomPage@ function specialized in creating listings.+--+--   This function creates a listing of a certain list of @Context@s. Every+--   item in the list is created by applying the given template to every+--   renderable. You can also specify additional context to be included in the+--   @CustomPage@.+createListing :: FilePath                  -- ^ Destination of the page.+              -> [FilePath]                -- ^ Templates to render items with.+              -> [HakyllAction () Context] -- ^ Renderables in the list.+              -> [(String, Either String (HakyllAction () String))]+              -> HakyllAction () Context+createListing url templates renderables additional =+    createCustomPage url context+  where+    context = ("body", Right concatenation) : additional+    concatenation = renderAndConcat templates renderables++-- | Combine two @Context@s. The url will always be taken from the first+--   @Renderable@. Also, if a `$key` is present in both renderables, the+--   value from the first @Context@ will be taken as well.+--+--   You can see this as a this as a @union@ between two mappings.+combine :: HakyllAction () Context -> HakyllAction () Context+        -> HakyllAction () Context+combine x y = HakyllAction+    { actionDependencies = actionDependencies x ++ actionDependencies y+    , actionUrl          = actionUrl x `mplus` actionUrl y+    , actionFunction     = \_ ->+        liftM2 M.union (runHakyllAction x) (runHakyllAction y)+    }++-- | Combine two @Context@s and set a custom URL. This behaves like @combine@,+--   except that for the @url@ field, the given URL is always chosen.+combineWithUrl :: FilePath+               -> HakyllAction () Context+               -> HakyllAction () Context+               -> HakyllAction () Context+combineWithUrl url x y = combine'+    { actionUrl          = Just $ return url+    , actionFunction     = \_ -> M.insert "url" url <$> runHakyllAction combine'+    }+  where+    combine' = combine x y

@@ -0,0 +1,111 @@+-- | A Module that allows easy rendering of RSS feeds. If you use this module,+--   you must make sure you set the `absoluteUrl` field in the main Hakyll+--   configuration.+--+--   Apart from that, the main rendering functions (@renderRss@, @renderAtom@) +--   all assume that you pass the list of items so that the most recent entry+--   in the feed is the first item in the list.+--+--   Also note that the @Context@s should have (at least) the following+--   fields to produce a correct feed:+--+--   - @$title@: Title of the item.+--+--   - @$description@: Description to appear in the feed.+--+--   - @$url@: URL to the item - this is usually set automatically.+--+--   Furthermore, the feed will be generated, but will be incorrect (it won't+--   validate) if an empty list is passed.+module Text.Hakyll.Feed+    ( FeedConfiguration (..)+    , renderRss+    , renderAtom+    ) where++import Control.Arrow ((>>>), second)+import Control.Monad.Reader (liftIO)+import Data.Maybe (fromMaybe)+import qualified Data.Map as M++import Text.Hakyll.Context (Context)+import Text.Hakyll.CreateContext (createListing)+import Text.Hakyll.ContextManipulations (renderDate)+import Text.Hakyll.HakyllMonad (Hakyll)+import Text.Hakyll.Render (render, renderChain)+import Text.Hakyll.HakyllAction++import Paths_hakyll++-- | This is a data structure to keep the configuration of a feed.+data FeedConfiguration = FeedConfiguration+    { -- | Url of the feed (relative to site root). For example, @rss.xml@.+      feedUrl         :: String+    , -- | Title of the feed.+      feedTitle       :: String+    , -- | Description of the feed.+      feedDescription :: String+    , -- | Name of the feed author.+      feedAuthorName  :: String+    }++-- | This is an auxiliary function to create a listing that is, in fact, a feed.+--   The items should be sorted on date.+createFeed :: FeedConfiguration         -- ^ Feed configuration.+           -> [HakyllAction () Context] -- ^ Items to include.+           -> FilePath                  -- ^ Feed template.+           -> FilePath                  -- ^ Item template.+           -> HakyllAction () Context+createFeed configuration renderables template itemTemplate =+    listing >>> render template+  where+    listing = createListing (feedUrl configuration)+                            [itemTemplate] renderables additional++    additional = map (second $ Left . ($ configuration))+        [ ("title", feedTitle)+        , ("description", feedDescription)+        , ("authorName", feedAuthorName)+        ] ++ updated++    -- Take the first timestamp, which should be the most recent.+    updated = let action = createHakyllAction $+                                return . fromMaybe "foo" . M.lookup "timestamp"+                  toTuple r = ("timestamp", Right $ r >>> action)+              in map toTuple $ take 1 renderables+            ++-- | Abstract function to render any feed.+renderFeed :: FeedConfiguration         -- ^ Feed configuration.+           -> [HakyllAction () Context] -- ^ Items to include in the feed.+           -> FilePath                  -- ^ Feed template.+           -> FilePath                  -- ^ Item template.+           -> Hakyll ()+renderFeed configuration renderables template itemTemplate = do+    template' <- liftIO $ getDataFileName template+    itemTemplate' <- liftIO $ getDataFileName itemTemplate+    let renderFeed' = createFeed configuration renderables+                                 template' itemTemplate'+    renderChain [] renderFeed'++-- | Render an RSS feed with a number of items.+renderRss :: FeedConfiguration         -- ^ Feed configuration.+          -> [HakyllAction () Context] -- ^ Items to include in the feed.+          -> Hakyll ()+renderRss configuration renderables =+    renderFeed configuration (map (>>> renderRssDate) renderables)+               "templates/rss.xml" "templates/rss-item.xml"+  where+    renderRssDate = renderDate "timestamp" "%a, %d %b %Y %H:%M:%S UT"+                               "No date found."++-- | Render an Atom feed with a number of items.+renderAtom :: FeedConfiguration         -- ^ Feed configuration.+           -> [HakyllAction () Context] -- ^ Items to include in the feed.+           -> Hakyll ()+renderAtom configuration renderables =+    renderFeed configuration (map (>>> renderAtomDate) renderables)+               "templates/atom.xml" "templates/atom-item.xml"+  where+    renderAtomDate = renderDate "timestamp" "%Y-%m-%dT%H:%M:%SZ"+                                            "No date found."

@@ -20,9 +20,11 @@ import System.Time (ClockTime) import Control.Monad import Data.List (isPrefixOf, sortBy)+import Data.Ord (comparing) import Control.Monad.Reader (liftIO) -import Text.Hakyll.Hakyll+import Text.Hakyll.HakyllMonad+import Text.Hakyll.Internal.FileType (isRenderableFile)  -- | Auxiliary function to remove pathSeparators form the start. We don't deal --   with absolute paths here. We also remove $root from the start.@@ -61,7 +63,7 @@ toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl                 -- If the file does not have a renderable extension, like for                 -- example favicon.ico, we don't have to change it at all.-                return $ if not hasRenderableExtension+                return $ if not (isRenderableFile path)                             then path                             -- If index url's are enabled, we create pick it                             -- unless the page is an index already.@@ -69,23 +71,9 @@                                 then indexUrl                                 else withSimpleHtmlExtension   where-    hasRenderableExtension = takeExtension path `elem` [ ".markdown"-                                                       , ".md"-                                                       , ".mdn"-                                                       , ".mdwn"-                                                       , ".mkd"-                                                       , ".mkdn"-                                                       , ".mkdwn"-                                                       , ".rst"-                                                       , ".text"-                                                       , ".tex"-                                                       , ".lhs"-                                                       , ".htm"-                                                       , ".html"-                                                       ]-    isIndex = (dropExtension $ takeFileName path) == "index"+    isIndex = dropExtension (takeFileName path) == "index"     withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path-    indexUrl = (dropExtension path) ++ "/"+    indexUrl = dropExtension path ++ "/"                               -- | Get the relative url to the site root, for a given (absolute) url@@ -131,7 +119,7 @@ sortByBaseName :: [FilePath] -> [FilePath] sortByBaseName = sortBy compareBaseName   where-    compareBaseName f1 f2 = compare (takeFileName f1) (takeFileName f2)+    compareBaseName = comparing takeFileName  -- | A filter that takes all file names with a given extension. Prefix the --   extension with a dot:

@@ -1,33 +0,0 @@--- | 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-    , -- | Directory where the site is placed.-      siteDirectory :: FilePath-    , -- | Directory for cache files.-      cacheDirectory :: FilePath-    , -- | Enable index links.-      enableIndexUrl :: Bool-    , -- | Delay between polls in preview mode.-      previewPollDelay :: Int-    }---- | 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

@@ -0,0 +1,95 @@+-- | This is the module which exports @HakyllAction@.+module Text.Hakyll.HakyllAction+    ( HakyllAction (..)+    , createHakyllAction+    , createSimpleHakyllAction+    , createFileHakyllAction+    , chain+    , runHakyllAction+    , runHakyllActionIfNeeded+    ) where++import Control.Arrow+import Control.Category+import Control.Monad ((<=<), mplus, unless)+import Control.Monad.Reader (liftIO)+import Prelude hiding ((.), id)+import System.IO (hPutStrLn, stderr)++import Text.Hakyll.File (toDestination, isFileMoreRecent)+import Text.Hakyll.HakyllMonad++-- | Type used for rendering computations that carry along dependencies.+data HakyllAction a b = HakyllAction+    { -- | Dependencies of the @HakyllAction@.+      actionDependencies :: [FilePath]+    , -- | URL pointing to the result of this @HakyllAction@.+      actionUrl          :: Maybe (Hakyll FilePath)+    , -- | The actual render function.+      actionFunction     :: a -> Hakyll b+    }++-- | Create a @HakyllAction@ from a function.+createHakyllAction :: (a -> Hakyll b)  -- ^ Function to execute.+                   -> HakyllAction a b+createHakyllAction f = id { actionFunction = f }++-- | Create a @HakyllAction@ from a simple @Hakyll@ value.+createSimpleHakyllAction :: Hakyll b -- ^ Hakyll value to pass on.+                         -> HakyllAction () b+createSimpleHakyllAction = createHakyllAction . const++-- | Create a @HakyllAction@ that operates on one file.+createFileHakyllAction :: FilePath          -- ^ File to operate on.+                       -> Hakyll b          -- ^ Value to pass on.+                       -> HakyllAction () b -- ^ The resulting action.+createFileHakyllAction path action = HakyllAction+    { actionDependencies = [path]+    , actionUrl          = Just $ return path+    , actionFunction     = const action+    }++-- | Run a @HakyllAction@ now.+runHakyllAction :: HakyllAction () a -- ^ Render action to run.+                -> Hakyll a          -- ^ Result of the action.+runHakyllAction action = actionFunction action ()++-- | Run a @HakyllAction@, but only when it is out-of-date. At this point, the+--   @actionUrl@ field must be set.+runHakyllActionIfNeeded :: HakyllAction () () -- ^ Action to run.+                        -> Hakyll ()          -- ^ Empty result.+runHakyllActionIfNeeded action = do+    url <- case actionUrl action of+        (Just u) -> u+        Nothing  -> error "No url when checking dependencies."+    destination <- toDestination url+    valid <- isFileMoreRecent destination $ actionDependencies action+    unless valid $ do liftIO $ hPutStrLn stderr $ "Rendering " ++ destination+                      runHakyllAction action++-- | Chain a number of @HakyllAction@ computations.+chain :: [HakyllAction a a] -- ^ Actions to chain.+      -> HakyllAction a a   -- ^ Resulting action.+chain []   = id+chain list = foldl1 (>>>) list++instance Category HakyllAction where+    id = HakyllAction+        { actionDependencies = []+        , actionUrl          = Nothing+        , actionFunction     = return+        }++    x . y = HakyllAction+        { actionDependencies = actionDependencies x ++ actionDependencies y+        , actionUrl          = actionUrl x `mplus` actionUrl y+        , actionFunction     = actionFunction x <=< actionFunction y+        }++instance Arrow HakyllAction where+    arr f = id { actionFunction = return . f }++    first x = x+        { actionFunction = \(y, z) -> do y' <- actionFunction x y+                                         return (y', z)+        }

@@ -0,0 +1,50 @@+-- | Module describing the Hakyll monad stack.+module Text.Hakyll.HakyllMonad+    ( HakyllConfiguration (..)+    , Hakyll+    , askHakyll+    , getAdditionalContext+    ) where++import Control.Monad.Reader (ReaderT, ask)+import Control.Monad (liftM)+import qualified Data.Map as M++import Text.Hakyll.Context (Context)++-- | Our custom monad stack.+type Hakyll = ReaderT HakyllConfiguration IO++-- | Hakyll global configuration type.+data HakyllConfiguration = HakyllConfiguration+    { -- | Absolute URL of the site.+      absoluteUrl       :: String+    , -- | An additional context to use when rendering. This additional context+      --   is used globally.+      additionalContext :: Context+    , -- | Directory where the site is placed.+      siteDirectory     :: FilePath+    , -- | Directory for cache files.+      cacheDirectory    :: FilePath+    , -- | Enable index links.+      enableIndexUrl    :: Bool+    , -- | Delay between polls in preview mode.+      previewPollDelay  :: Int+    }++-- | Simplified @ask@ function for the Hakyll monad stack.+--+--   Usage would typically be something like:+--+--   > doSomething :: a -> b -> Hakyll c+--   > doSomething arg1 arg2 = do+--   >     siteDirectory' <- askHakyll siteDirectory+--   >     ...+--+askHakyll :: (HakyllConfiguration -> a) -> Hakyll a+askHakyll = flip liftM ask++getAdditionalContext :: HakyllConfiguration -> Context+getAdditionalContext configuration =+    M.insert "absolute" (absoluteUrl configuration)+             (additionalContext configuration)

@@ -6,9 +6,10 @@  import Control.Monad ((<=<)) import Control.Monad.Reader (liftIO)-import Text.Hakyll.Hakyll (Hakyll)-import Text.Hakyll.File import Data.Binary++import Text.Hakyll.File+import Text.Hakyll.HakyllMonad (Hakyll)  -- | We can store all datatypes instantiating @Binary@ to the cache. The cache --   directory is specified by the @HakyllConfiguration@, usually @_cache@.

@@ -0,0 +1,48 @@+-- | A module dealing with file extensions and associated file types.+module Text.Hakyll.Internal.FileType+    ( FileType (..)+    , getFileType+    , isRenderable+    , isRenderableFile+    ) where++import System.FilePath (takeExtension)++-- | Datatype to represent the different file types Hakyll can deal with.+data FileType = Html+              | LaTeX+              | LiterateHaskellMarkdown+              | Markdown+              | ReStructuredText+              | Text+              | UnknownFileType+              deriving (Eq, Ord, Show, Read)++-- | Get the file type for a certain file. The type is determined by extension.+getFileType :: FilePath -> FileType+getFileType = getFileType' . takeExtension+  where+    getFileType' ".htm"      = Html+    getFileType' ".html"     = Html+    getFileType' ".lhs"      = LiterateHaskellMarkdown+    getFileType' ".markdown" = Markdown+    getFileType' ".md"       = Markdown+    getFileType' ".mdn"      = Markdown+    getFileType' ".mdown"    = Markdown+    getFileType' ".mdwn"     = Markdown+    getFileType' ".mkd"      = Markdown+    getFileType' ".mkdwn"    = Markdown+    getFileType' ".rst"      = ReStructuredText+    getFileType' ".tex"      = LaTeX+    getFileType' ".text"     = Text+    getFileType' ".txt"      = Text+    getFileType' _           = UnknownFileType++-- | Check if a certain @FileType@ is renderable.+isRenderable :: FileType -> Bool+isRenderable UnknownFileType = False+isRenderable _               = True++-- | Check if a certain file is renderable.+isRenderableFile :: FilePath -> Bool+isRenderableFile = isRenderable . getFileType

@@ -0,0 +1,123 @@+-- | A module for dealing with @Page@s. This module is mostly internally used.+module Text.Hakyll.Internal.Page +    ( readPage+    ) where++import qualified Data.Map as M+import Data.List (isPrefixOf)+import Data.Char (isSpace)+import Control.Monad.Reader (liftIO)+import System.FilePath++import Text.Pandoc++import Text.Hakyll.Context (Context)+import Text.Hakyll.File+import Text.Hakyll.HakyllMonad+import Text.Hakyll.Regex (substituteRegex, matchesRegex)+import Text.Hakyll.Util (trim)+import Text.Hakyll.Internal.Cache+import Text.Hakyll.Internal.FileType++-- | The default reader options for pandoc parsing.+readerOptions :: ParserState+readerOptions = defaultParserState+    { -- The following option causes pandoc to read smart typography, a nice+      -- and free bonus.+      stateSmart = True+    }++-- | The default writer options for pandoc rendering.+writerOptions :: WriterOptions+writerOptions = defaultWriterOptions+    { -- This option causes literate haskell to be written using '>' marks in+      -- html, which I think is a good default.+      writerLiterateHaskell = True+    }++-- | Get a render function for a given extension.+getRenderFunction :: FileType -> (String -> String)+getRenderFunction Html     = id+getRenderFunction Text     = id+getRenderFunction fileType = writeHtmlString writerOptions+                           . readFunction fileType (readOptions fileType)+  where+    readFunction ReStructuredText        = readRST+    readFunction LaTeX                   = readLaTeX+    readFunction Markdown                = readMarkdown+    readFunction LiterateHaskellMarkdown = readMarkdown+    readFunction t                       = error $ "Cannot render " ++ show t++    readOptions LiterateHaskellMarkdown =+        readerOptions { stateLiterateHaskell = True }+    readOptions _                       = readerOptions++-- | 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 = isPrefixOf "---"++-- | 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+    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.+readPageFromFile :: FilePath -> Hakyll Context+readPageFromFile path = do+    let renderFunction = getRenderFunction $ getFileType path+        sectionFunctions = map (readSection renderFunction)+                               (True : repeat False)++    -- Read file.+    contents <- liftIO $ readFile path+    url <- toUrl path+    let sections = splitAtDelimiters $ lines contents+        sectionsData = concat $ zipWith ($) sectionFunctions sections+        context = M.fromList $+            ("url", url) : ("path", path) : category ++ sectionsData++    return context+  where+    category = let dirs = splitDirectories $ takeDirectory path+               in [("category", last dirs) | not (null dirs)]++-- | Read a page. Might fetch it from the cache if available. Otherwise, it will+--   read it from the file given and store it in the cache.+readPage :: FilePath -> Hakyll Context+readPage path = do+    isCacheMoreRecent' <- isCacheMoreRecent fileName [path]+    if isCacheMoreRecent' then getFromCache fileName+                          else do page <- readPageFromFile path+                                  storeInCache page fileName+                                  return page+  where+    fileName = "pages" </> path

@@ -1,67 +0,0 @@--- | Internal module do some low-level rendering.-module Text.Hakyll.Internal.Render-    ( substitute-    , regularSubstitute-    , finalSubstitute-    , pureRenderWith-    , pureRenderAndConcatWith-    , pureRenderChainWith-    , writePage-    ) where--import qualified Data.Map as M-import Control.Monad.Reader (liftIO)-import Data.List (foldl')-import Data.Maybe (fromMaybe)--import Text.Hakyll.Context (Context, ContextManipulation)-import Text.Hakyll.Renderable-import Text.Hakyll.Page-import Text.Hakyll.File-import Text.Hakyll.Hakyll-import Text.Hakyll.Internal.Template---- | A pure render function.-pureRenderWith :: ContextManipulation -- ^ Manipulation to apply on the context.-               -> Template -- ^ Template to use for rendering.-               -> Context -- ^ Renderable object to render with given template.-               -> Context -- ^ The body of the result will contain the render.-pureRenderWith manipulation template context =-    -- Ignore $root when substituting here. We will only replace that in the-    -- final render (just before writing).-    let contextIgnoringRoot = M.insert "root" "$root" (manipulation context)-        body = regularSubstitute template contextIgnoringRoot-    in M.insert "body" body context---- | A pure renderAndConcat function.-pureRenderAndConcatWith :: ContextManipulation -- ^ Manipulation to apply.-                        -> [Template] -- ^ Templates to use.-                        -> [Context] -- ^ Different renderables.-                        -> String-pureRenderAndConcatWith manipulation templates =-    concatMap renderAndConcat-  where-    renderAndConcat = fromMaybe "" . M.lookup "body"-                    . pureRenderChainWith manipulation templates---- | A pure renderChain function.-pureRenderChainWith :: ContextManipulation-                    -> [Template]-                    -> Context-                    -> Context-pureRenderChainWith manipulation templates context =-    let initial = manipulation context-    in foldl' (flip $ pureRenderWith id) initial templates---- | Write a page to the site destination. Final action after render---   chains and such.-writePage :: Page -> Hakyll ()-writePage page = do-    additionalContext' <- askHakyll additionalContext-    url <- getUrl page-    destination <- toDestination url-    let context = additionalContext' `M.union` M.singleton "root" (toRoot url)-    makeDirectories destination-    -- Substitute $root here, just before writing.-    liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)-                                                     context

@@ -19,8 +19,8 @@  import Test.QuickCheck -import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (Context)+import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Internal.Cache  -- | Datatype used for template substitutions.

@@ -1,185 +0,0 @@--- | A module for dealing with @Page@s. This module is mostly internally used.-module Text.Hakyll.Page -    ( Page-    , fromContext-    , getValue-    , getBody-    , readPage-    ) where--import qualified Data.Map as M-import Data.List (isPrefixOf)-import Data.Char (isSpace)-import Data.Maybe (fromMaybe)-import Control.Monad (liftM, replicateM)-import Control.Monad.Reader (liftIO)-import System.FilePath--import Test.QuickCheck-import Text.Pandoc-import Data.Binary--import Text.Hakyll.Internal.Cache-import Text.Hakyll.Hakyll-import Text.Hakyll.File-import Text.Hakyll.Util (trim)-import Text.Hakyll.Context (Context)-import Text.Hakyll.Renderable-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.-data Page = Page Context-          deriving (Ord, Eq, Show, Read)---- | Create a Page from a key-value mapping.-fromContext :: Context -> Page-fromContext = Page---- | Obtain a value from a page. Will resturn an empty string when nothing is---   found.-getValue :: String -> Page -> String-getValue str (Page page) = fromMaybe [] $ M.lookup str page---- | Get the URL for a certain page. This should always be defined. If---   not, it will error.-getPageUrl :: Page -> String-getPageUrl (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page---- | Get the original page path.-getPagePath :: Page -> String-getPagePath (Page page) =-    fromMaybe (error "No page path") $ M.lookup "path" page---- | Get the body for a certain page. When not defined, the body will be---   empty.-getBody :: Page -> String-getBody (Page page) = fromMaybe [] $ M.lookup "body" page---- | The default reader options for pandoc parsing.-readerOptions :: ParserState-readerOptions = defaultParserState-    { -- The following option causes pandoc to read smart typography, a nice-      -- and free bonus.-      stateSmart = True-    }---- | The default writer options for pandoc rendering.-writerOptions :: WriterOptions-writerOptions = defaultWriterOptions-    { -- This option causes literate haskell to be written using '>' marks in-      -- html, which I think is a good default.-      writerLiterateHaskell = True-    }---- | Get a render function for a given extension.-getRenderFunction :: String -> (String -> String)-getRenderFunction ".html" = id-getRenderFunction ".htm"  = id-getRenderFunction ext = writeHtmlString writerOptions-                      . readFunction ext (readOptions ext)-  where-    readFunction ".rst" = readRST-    readFunction ".tex" = readLaTeX-    readFunction _      = readMarkdown--    readOptions ".lhs"  = readerOptions { stateLiterateHaskell = True }-    readOptions _       = readerOptions---- | 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 = isPrefixOf "---"---- | 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-    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.-readPageFromFile :: FilePath -> Hakyll Page-readPageFromFile path = do-    let renderFunction = getRenderFunction $ takeExtension path-        sectionFunctions = map (readSection renderFunction)-                               (True : repeat False)--    -- Read file.-    contents <- liftIO $ readFile path-    url <- toUrl path-    let sections = splitAtDelimiters $ lines contents-        context = concat $ zipWith ($) sectionFunctions sections-        page = fromContext $ M.fromList $-            category ++-            [ ("url", url)-            , ("path", path)-            ] ++ context--    return page-  where-    category = let dirs = splitDirectories $ takeDirectory path-               in [("category", last dirs) | not (null dirs)]---- | Read a page. Might fetch it from the cache if available. Otherwise, it will---   read it from the file given and store it in the cache.-readPage :: FilePath -> Hakyll Page-readPage path = do-    isCacheMoreRecent' <- isCacheMoreRecent fileName [path]-    if isCacheMoreRecent' then getFromCache fileName-                          else do page <- readPageFromFile path-                                  storeInCache page fileName-                                  return page-  where-    fileName = "pages" </> path---- Make pages renderable.-instance Renderable Page where-    getDependencies = (:[]) . getPagePath-    getUrl = return . getPageUrl-    toContext (Page page) = return page---- Make pages serializable.-instance Binary Page where-    put (Page context) = put $ M.toAscList context-    get = liftM (Page . M.fromAscList) get---- | Generate an arbitrary page.-arbitraryPage :: Gen Page-arbitraryPage = do keys <- listOf key'-                   values <- arbitrary-                   return $ Page $ M.fromList $ zip keys values-  where-    key' = do l <- choose (5, 10)-              replicateM l $ choose ('a', 'z')---- Make pages testable-instance Arbitrary Page where-    arbitrary = arbitraryPage-    shrink (Page context) = map (Page . flip M.delete context) $ M.keys context

@@ -0,0 +1,89 @@+-- | Module aimed to paginate web pages.+module Text.Hakyll.Paginate+    ( PaginateConfiguration (..)+    , defaultPaginateConfiguration+    , paginate+    ) where++import Control.Applicative ((<$>))++import Text.Hakyll.Context (Context)+import Text.Hakyll.CreateContext+import Text.Hakyll.HakyllAction+import Text.Hakyll.Util (link)++-- | A configuration for a pagination.+data PaginateConfiguration = PaginateConfiguration+    { -- | Label for the link to the previous page.+      previousLabel :: String+    , -- | Label for the link to the next page.+      nextLabel     :: String+    , -- | Label for the link to the first page.+      firstLabel    :: String+    , -- | Label for the link to the last page.+      lastLabel     :: String+    }++-- | A simple default configuration for pagination.+defaultPaginateConfiguration :: PaginateConfiguration+defaultPaginateConfiguration = PaginateConfiguration+    { previousLabel = "Previous"+    , nextLabel     = "Next"+    , firstLabel    = "First"+    , lastLabel     = "Last"+    }++-- | The most important function for pagination. This function operates on a+--   list of @Context@s (the pages), and basically just adds fields to them+--   by combining them with a custom page.+--+--   The following metadata fields will be added:+--+--   - @$previous@: A link to the previous page.+--+--   - @$next@: A link to the next page.+--+--   - @$first@: A link to the first page.+--+--   - @$last@: A link to the last page.+--+--   - @$index@: 1-based index of the current page.+--+--   - @$length@: Total number of pages.+--+--   When @$previous@ or @$next@ are not available, they will be just a label+--   without a link. The same goes for when we are on the first or last page for+--   @$first@ and @$last@.+paginate :: PaginateConfiguration+         -> [HakyllAction () Context]+         -> [HakyllAction () Context]+paginate configuration renderables = paginate' Nothing renderables (1 :: Int)+  where+    -- Create a link with a given label, taken from the configuration.+    linkWithLabel f r = Right $ case actionUrl r of+        Just l  -> createSimpleHakyllAction $ link (f configuration) <$> l+        Nothing -> error "No link found for pagination."++    -- The main function that creates combined renderables by recursing over+    -- the list of items.+    paginate' _ [] _ = []+    paginate' maybePrev (x:xs) index = +        let (previous, first) = case maybePrev of+                (Just r) -> ( linkWithLabel previousLabel r+                            , linkWithLabel firstLabel (head renderables) )+                Nothing  -> ( Left $ previousLabel configuration+                            , Left $ firstLabel configuration )+            (next, last') = case xs of+                (n:_) -> ( linkWithLabel nextLabel n+                         , linkWithLabel lastLabel (last renderables) )+                []    -> ( Left $ nextLabel configuration+                         , Left $ lastLabel configuration )+            customPage = createCustomPage ""+                [ ("previous", previous)+                , ("next", next)+                , ("first", first)+                , ("last", last')+                , ("index", Left $ show index)+                , ("length", Left $ show $ length renderables)+                ]+        in (x `combine` customPage) : paginate' (Just x) xs (index + 1)

@@ -15,7 +15,7 @@ matchRegexAll = matchM  -- | Replaces every occurance of the given regexp with the replacement string.-subRegex :: Regex -- ^ Search pattern+subRegex :: Regex  -- ^ Search pattern          -> String -- ^ Input string          -> String -- ^ Replacement text          -> String -- ^ Output string@@ -41,7 +41,8 @@   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.

@@ -1,87 +1,74 @@ -- | Module containing rendering functions. All these functions are used to --   render files to the @_site@ directory. module Text.Hakyll.Render -    ( depends-    , render-    , renderWith+    ( render     , renderAndConcat-    , renderAndConcatWith     , renderChain-    , renderChainWith     , static     , css+    , writePage     ) where -import Control.Monad (unless)+import Control.Arrow ((>>>))+import Control.Applicative ((<$>)) import Control.Monad.Reader (liftIO) import System.Directory (copyFile)+import Data.Maybe (fromMaybe)+import qualified Data.Map as M -import Text.Hakyll.Hakyll (Hakyll)-import Text.Hakyll.Context (ContextManipulation)-import Text.Hakyll.Page-import Text.Hakyll.Renderable+import Text.Hakyll.Context (Context)+import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, getAdditionalContext) import Text.Hakyll.File-import Text.Hakyll.Internal.Template (readTemplate)+import Text.Hakyll.HakyllAction import Text.Hakyll.Internal.CompressCss-import Text.Hakyll.Internal.Render---- | Execute an IO action only when the cache is invalid.-depends :: FilePath -- ^ File to be rendered or created.-        -> [FilePath] -- ^ Files the render depends on.-        -> Hakyll () -- ^ IO action to execute when the file is out of date.-        -> Hakyll ()-depends file dependencies action = do-    destination <- toDestination file-    valid <- isFileMoreRecent destination dependencies-    unless valid action+import Text.Hakyll.Internal.Template --- | Render to a Page.-render :: Renderable a-       => FilePath -- ^ Template to use for rendering.-       -> a -- ^ Renderable object to render with given template.-       -> Hakyll Page -- ^ The body of the result will contain the render.-render = renderWith id+-- | A pure render function - used internally.+pureRender :: Template -- ^ Template to use for rendering.+           -> Context  -- ^ Renderable object to render with given template.+           -> Context  -- ^ The body of the result will contain the render.+pureRender template context =+    -- Ignore $root when substituting here. We will only replace that in the+    -- final render (just before writing).+    let contextIgnoringRoot = M.insert "root" "$root" context+        body = regularSubstitute template contextIgnoringRoot+    in M.insert "body" body context --- | Render to a Page. This function allows you to manipulate the context---   first.-renderWith :: Renderable a-           => ContextManipulation -- ^ Manipulation to apply on the context.-           -> FilePath -- ^ Template to use for rendering.-           -> a -- ^ Renderable object to render with given template.-           -> Hakyll Page -- ^ The body of the result will contain the render.-renderWith manipulation templatePath renderable = do-    template <- readTemplate templatePath-    context <- toContext renderable-    return $ fromContext $ pureRenderWith manipulation template context+-- | This is the most simple render action. You render a @Context@ with a+--   template, and get back the result.+render :: FilePath                     -- ^ Template to use for rendering.+       -> HakyllAction Context Context -- ^ The render computation.+render templatePath = HakyllAction+    { actionDependencies = [templatePath]+    , actionUrl          = Nothing+    , actionFunction     = \context ->+        flip pureRender context <$> readTemplate templatePath+    } --- | Render each renderable with the given templates, then concatenate the+-- | Render each @Context@ with the given templates, then concatenate the --   result. So, basically this function: -----   * Takes every renderable.+--   - Takes every @Context@. -----   * Renders every renderable with all given templates. This is comparable+--   - Renders every @Context@ 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+--   - Concatenates the result and returns that as a @String@.+renderAndConcat :: [FilePath]+                -> [HakyllAction () Context]+                -> HakyllAction () String+renderAndConcat templatePaths renderables = HakyllAction+    { actionDependencies = renders >>= actionDependencies+    , actionUrl          = Nothing+    , actionFunction     = actionFunction'+    }+  where+    render' = chain (map render templatePaths)+    renders = map (>>> render') renderables --- | 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]-                    -> [a]-                    -> Hakyll String-renderAndConcatWith manipulation templatePaths renderables = do-    templates <- mapM readTemplate templatePaths-    contexts <- mapM toContext renderables-    return $ pureRenderAndConcatWith manipulation templates contexts+    actionFunction' _ = do+        contexts <- mapM runHakyllAction renders+        return $ concatMap (fromMaybe "" . M.lookup "body") 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@@ -93,38 +80,45 @@ -- --   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 -> Hakyll ()-renderChainWith manipulation templatePaths renderable = do-    url <- getUrl renderable-    depends url dependencies render'+renderChain :: [FilePath]+            -> HakyllAction () Context+            -> Hakyll ()+renderChain templatePaths initial =+    runHakyllActionIfNeeded renderChainWith'   where-    dependencies = getDependencies renderable ++ templatePaths-    render' = do-        templates <- mapM readTemplate templatePaths-        context <- toContext renderable-        let result = pureRenderChainWith manipulation templates context-        writePage $ fromContext result+    renderChainWith' = initial >>> chain' >>> writePage+    chain' = chain $ map render templatePaths  -- | Mark a certain file as static, so it will just be copied when the site is --   generated. static :: FilePath -> Hakyll ()-static source = do destination <- toDestination source-                   depends destination [source] (action destination)+static source = runHakyllActionIfNeeded static'   where-    action destination = do makeDirectories destination-                            liftIO $ copyFile source destination+    static' = createFileHakyllAction source $ do+        destination <- toDestination source+        makeDirectories destination+        liftIO $ copyFile source destination  -- | Render a css file, compressing it. css :: FilePath -> Hakyll ()-css source = do destination <- toDestination source-                depends destination [source] (css' destination)+css source = runHakyllActionIfNeeded css'   where-    css' destination = do contents <- liftIO $ readFile source-                          makeDirectories destination-                          liftIO $ writeFile destination (compressCss contents)+    css' = createFileHakyllAction source $ do+        contents <- liftIO $ readFile source+        destination <- toDestination source+        makeDirectories destination+        liftIO $ writeFile destination (compressCss contents)++-- | Write a page to the site destination. Final action after render+--   chains and such.+writePage :: HakyllAction Context ()+writePage = createHakyllAction $ \initialContext -> do+    additionalContext' <- askHakyll getAdditionalContext+    let url = fromMaybe (error "No url defined at write time.")+                        (M.lookup "url" initialContext)+        body = fromMaybe "" (M.lookup "body" initialContext)+    let context = additionalContext' `M.union` M.singleton "root" (toRoot url)+    destination <- toDestination url+    makeDirectories destination+    -- Substitute $root here, just before writing.+    liftIO $ writeFile destination $ finalSubstitute (fromString body) context

@@ -1,18 +0,0 @@-module Text.Hakyll.Renderable-    ( Renderable(toContext, getDependencies, getUrl)-    ) where--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 -> Hakyll Context--    -- | Get the dependencies for the renderable. This is used for cache-    --   invalidation.-    getDependencies :: a -> [FilePath]--    -- | Get the destination for the renderable.-    getUrl :: a -> Hakyll FilePath

@@ -1,158 +0,0 @@-module Text.Hakyll.Renderables-    ( CustomPage-    , createCustomPage-    , createListing-    , createListingWith-    , PagePath-    , createPagePath-    , CombinedRenderable-    , combine-    , combineWithUrl-    ) where--import qualified Data.Map as M-import Control.Arrow (second)-import Control.Monad (liftM)--import Data.Binary--import Text.Hakyll.Hakyll (Hakyll)-import Text.Hakyll.Page-import Text.Hakyll.Renderable-import Text.Hakyll.File-import Text.Hakyll.Context-import Text.Hakyll.Render---- | A custom page.-data CustomPage = CustomPage -    { 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 (Hakyll String))] -- ^ Mapping.-                 -> CustomPage-createCustomPage = CustomPage---- | A @createCustomPage@ function specialized in creating listings.------   This function creates a listing of a certain list of @Renderable@s. Every---   item in the list is created by applying the given template to every---   renderable. You can also specify additional context to be included in the---   @CustomPage@.------   > let customPage = createListingWith ---   >                      "index.html" -- Destination of the page.---   >                      "templates/postitem.html" -- Path to template to---   >                                                -- render the items with.---   >                      posts -- ^ Renderables to create the list with.---   >                      [("title", "Home")] -- ^ Additional context-createListing :: (Renderable a)-              => String -- ^ Destination of the page.-              -> FilePath -- ^ Template to render all items with.-              -> [a] -- ^ Renderables in the list.-              -> [(String, String)] -- ^ Additional context.-              -> CustomPage-createListing = createListingWith id---- | A @createCustomPage@ function specialized in creating listings.------   In addition to @createListing@, this function allows you to specify an---   extra @ContextManipulation@ for all @Renderable@s given.-createListingWith :: (Renderable a)-                  => ContextManipulation -- ^ Manipulation for the renderables.-                  -> String -- ^ Destination of the page.-                  -> FilePath -- ^ Template to render all items with.-                  -> [a] -- ^ Renderables in the list.-                  -> [(String, String)] -- ^ Additional context.-                  -> CustomPage-createListingWith manipulation url template renderables additional =-    createCustomPage url dependencies context-  where-    dependencies = template : concatMap getDependencies renderables-    context = ("body", Right concatenation) : additional'-    concatenation = renderAndConcatWith manipulation [template] renderables-    additional' = map (second Left) additional--instance Renderable CustomPage where-    getDependencies = customPageDependencies-    getUrl = return . customPageUrl-    toContext page = do-        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.-data PagePath = PagePath FilePath-              deriving (Ord, Eq, Read, Show)---- | Create a PagePath from a FilePath.-createPagePath :: FilePath -> PagePath-createPagePath = PagePath---- We can render filepaths-instance Renderable PagePath where-    getDependencies (PagePath path) = return path-    getUrl (PagePath path) = toUrl path-    toContext (PagePath path) = readPage path >>= toContext---- We can serialize filepaths-instance Binary PagePath where-    put (PagePath path) = put path-    get = liftM PagePath get---- | A combination of two other renderables.-data CombinedRenderable a b = CombinedRenderable a b-                            | CombinedRenderableWithUrl FilePath a b-                            deriving (Ord, Eq, Read, Show)---- | 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.------   Since renderables are always more or less key-value maps, you can see---   this as a @union@ between two maps.-combine :: (Renderable a, Renderable b) => a -> b -> CombinedRenderable a b-combine = CombinedRenderable---- | Combine two renderables and set a custom URL. This behaves like @combine@,---   except that for the @url@ field, the given URL is always chosen.-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 _ _) = return 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

@@ -18,8 +18,6 @@ --   is to place pages in subdirectories. -- --   An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@---   would be placed under the `coding` category.--- --   Tags or categories are read using the @readTagMap@ and @readCategoryMap@ --   functions. Because categories are implemented using tags - categories can --   be seen as tags, with the restriction that a page can only have one@@ -33,6 +31,7 @@     ( TagMap     , readTagMap     , readCategoryMap+    , withTagMap     , renderTagCloud     , renderTagLinks     ) where@@ -40,16 +39,16 @@ import qualified Data.Map as M import Data.List (intercalate) import Data.Maybe (fromMaybe, maybeToList)-import Control.Monad (foldM)-import Control.Arrow (second)+import Control.Arrow (second, (>>>)) import Control.Applicative ((<$>)) import System.FilePath -import Text.Hakyll.Hakyll-import Text.Hakyll.Context+import Text.Hakyll.Context (Context)+import Text.Hakyll.ContextManipulations (changeValue)+import Text.Hakyll.CreateContext (createPage)+import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Regex-import Text.Hakyll.Renderable-import Text.Hakyll.Renderables+import Text.Hakyll.HakyllAction import Text.Hakyll.Util import Text.Hakyll.Internal.Cache import Text.Hakyll.Internal.Template@@ -59,75 +58,98 @@ --   This is a map associating tags or categories to the appropriate pages --   using that tag or category. In the case of categories, each path will only --   appear under one category - this is not the case with tags.-type TagMap = M.Map String [PagePath]+type TagMap = M.Map String [HakyllAction () Context]  -- | Read a tag map. This is a internally used function that can be used for --   tags as well as for categories. readMap :: (Context -> [String]) -- ^ Function to get tags from a context.         -> String -- ^ Unique identifier for the tagmap.-        -> [PagePath]-        -> Hakyll TagMap-readMap getTagsFunction identifier paths = do-    isCacheMoreRecent' <- isCacheMoreRecent fileName (getDependencies =<< paths)-    if isCacheMoreRecent' then M.fromAscList <$> getFromCache fileName-                          else do tagMap <- readTagMap'-                                  storeInCache (M.toAscList tagMap) fileName-                                  return tagMap+        -> [FilePath]+        -> HakyllAction () TagMap+readMap getTagsFunction identifier paths = HakyllAction+    { actionDependencies = paths+    , actionUrl          = Nothing+    , actionFunction     = actionFunction'+    }    where     fileName = "tagmaps" </> identifier -    readTagMap' = foldM addPaths M.empty paths-    addPaths current path = do-        context <- toContext path+    actionFunction' _ = do+        isCacheMoreRecent' <- isCacheMoreRecent fileName paths+        assocMap <- if isCacheMoreRecent'+                        then M.fromAscList <$> getFromCache fileName+                        else do assocMap' <- readTagMap'+                                storeInCache (M.toAscList assocMap') fileName+                                return assocMap'+        return $ M.map (map createPage) assocMap++    -- TODO: preserve order+    readTagMap' :: Hakyll (M.Map String [FilePath])+    readTagMap' = do+        pairs' <- concat <$> mapM pairs paths+        return $ M.fromListWith (flip (++)) pairs'++    -- | Read a page, and return an association list where every tag is+    -- associated with some paths. Of course, this will always be just one+    -- @FilePath@ here.+    pairs :: FilePath -> Hakyll [(String, [FilePath])]+    pairs path = do+        context <- runHakyllAction $ createPage path         let tags = getTagsFunction context-            addPaths' = flip (M.insertWith (++)) [path]-        return $ foldr addPaths' current tags+        return $ map (\tag -> (tag, [path])) tags  -- | Read a @TagMap@, using the @tags@ metadata field.-readTagMap :: String -- ^ Unique identifier for the map.-           -> [PagePath] -- ^ Paths to get tags from.-           -> Hakyll TagMap-readTagMap = readMap  getTagsFunction+readTagMap :: String     -- ^ Unique identifier for the map.+           -> [FilePath] -- ^ Paths to get tags from.+           -> HakyllAction () TagMap+readTagMap = readMap getTagsFunction   where     getTagsFunction = map trim . splitRegex ","                     . fromMaybe [] . M.lookup "tags"  -- | Read a @TagMap@, using the subdirectories the pages are placed in.-readCategoryMap :: String -- ^ Unique identifier for the map.-                -> [PagePath] -- ^ Paths to get tags from.-                -> Hakyll TagMap+readCategoryMap :: String     -- ^ Unique identifier for the map.+                -> [FilePath] -- ^ Paths to get tags from.+                -> HakyllAction () TagMap readCategoryMap = readMap $ maybeToList . M.lookup "category" +withTagMap :: HakyllAction () TagMap+           -> (String -> [HakyllAction () Context] -> Hakyll ())+           -> Hakyll ()+withTagMap tagMap function = runHakyllAction (tagMap >>> action)+  where+    action = createHakyllAction (mapM_ (uncurry function) . M.toList)+ -- | Render a tag cloud.-renderTagCloud :: TagMap -- ^ 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.-renderTagCloud tagMap urlFunction minSize maxSize =-    intercalate " " $ map renderTag tagCount+renderTagCloud :: (String -> String) -- ^ Function to produce an url for a tag.+               -> Float              -- ^ Smallest font size, in percent.+               -> Float              -- ^ Biggest font size, in percent.+               -> HakyllAction TagMap String+renderTagCloud urlFunction minSize maxSize = createHakyllAction renderTagCloud'   where-    renderTag :: (String, Float) -> String-    renderTag (tag, count) = -        finalSubstitute linkTemplate $ M.fromList [ ("size", sizeTag count)-                                                  , ("url", urlFunction tag)-                                                  , ("tag", tag)-                                                  ]+    renderTagCloud' tagMap =+        return $ intercalate " " $ map (renderTag tagMap) (tagCount tagMap)++    renderTag tagMap (tag, count) = +        finalSubstitute linkTemplate $ M.fromList+            [ ("size", sizeTag tagMap count)+            , ("url", urlFunction tag)+            , ("tag", tag)+            ]+     linkTemplate =         fromString "<a style=\"font-size: $size\" href=\"$url\">$tag</a>" -    sizeTag :: Float -> String-    sizeTag count = show size' ++ "%"+    sizeTag tagMap count = show (size' :: Int) ++ "%"       where-        size' :: Int-        size' = floor $ minSize + relative count * (maxSize - minSize)+        size' = floor $ minSize + relative tagMap count * (maxSize - minSize) -    minCount = minimum $ map snd tagCount-    maxCount = maximum $ map snd tagCount-    relative count = (count - minCount) / (maxCount - minCount)+    minCount = minimum . map snd . tagCount+    maxCount = maximum . map snd . tagCount+    relative tagMap count = (count - minCount tagMap) /+                            (maxCount tagMap - minCount tagMap) -    tagCount :: [(String, Float)]-    tagCount = map (second $ fromIntegral . length) $ M.toList tagMap+    tagCount = map (second $ fromIntegral . length) . M.toList  -- | Render all tags to links. --   @@ -140,7 +162,7 @@ --   Note that it is your own responsibility to ensure a page with such an url --   exists. renderTagLinks :: (String -> String) -- ^ Function to produce an url for a tag.-               -> ContextManipulation+               -> HakyllAction Context Context renderTagLinks urlFunction = changeValue "tags" renderTagLinks'   where     renderTagLinks' = intercalate ", "