Added RSS module.

6 files changed, 75 insertions, 10 deletions

diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs
index 7554972..fab0be6 100644
--- a/src/Text/Hakyll/Hakyll.hs
+++ b/src/Text/Hakyll/Hakyll.hs
@@ -3,26 +3,30 @@ module Text.Hakyll.Hakyll
     ( 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)
 
 -- | Hakyll global configuration type.
 data HakyllConfiguration = HakyllConfiguration
-    { -- | An additional context to use when rendering. This additional context
+    { -- | 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
+      siteDirectory     :: FilePath
     , -- | Directory for cache files.
-      cacheDirectory :: FilePath
+      cacheDirectory    :: FilePath
     , -- | Enable index links.
-      enableIndexUrl :: Bool
+      enableIndexUrl    :: Bool
     , -- | Delay between polls in preview mode.
-      previewPollDelay :: Int
+      previewPollDelay  :: Int
     }
 
 -- | Our custom monad stack.
@@ -39,3 +43,8 @@ type Hakyll = ReaderT HakyllConfiguration IO
 --
 askHakyll :: (HakyllConfiguration -> a) -> Hakyll a
 askHakyll = flip liftM ask
+
+getAdditionalContext :: HakyllConfiguration -> Context
+getAdditionalContext configuration =
+    M.insert "absolute" (absoluteUrl configuration)
+             (additionalContext configuration)
diff --git a/src/Text/Hakyll/Internal/Render.hs b/src/Text/Hakyll/Internal/Render.hs
index 5432f4d..92f6ad9 100644
--- a/src/Text/Hakyll/Internal/Render.hs
+++ b/src/Text/Hakyll/Internal/Render.hs
@@ -33,7 +33,7 @@ pureRenderWith manipulation template context =
 --   chains and such.
 writePage :: RenderAction Context ()
 writePage = createRenderAction $ \initialContext -> do
-    additionalContext' <- askHakyll additionalContext
+    additionalContext' <- askHakyll getAdditionalContext
     let url = fromMaybe (error "No url defined at write time.")
                         (M.lookup "url" initialContext)
         body = fromMaybe "" (M.lookup "body" initialContext)
diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs
index 0038c9e..62ac713 100644
--- a/src/Text/Hakyll/RenderAction.hs
+++ b/src/Text/Hakyll/RenderAction.hs
@@ -56,7 +56,8 @@ createManipulationAction :: ContextManipulation -> RenderAction Context Context
 createManipulationAction = createRenderAction . (return .)
 
 chain :: [RenderAction a a] -> RenderAction a a
-chain = foldl1 (>>>)
+chain []         = id
+chain list@(_:_) = foldl1 (>>>) list
 
 runRenderAction :: RenderAction () a -> Hakyll a
 runRenderAction action = actionFunction action ()
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index 4c135b3..36fef09 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -38,7 +38,7 @@ createCustomPage url dependencies association = RenderAction
     mtuple (a, b) = b >>= \b' -> return (a, b')
     toHakyllString = second (either return runRenderAction)
     assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association
-    dataDependencies = (map snd association) >>= getDependencies
+    dataDependencies = map snd association >>= getDependencies
     getDependencies (Left _) = []
     getDependencies (Right x) = actionDependencies x
 
diff --git a/src/Text/Hakyll/Rss.hs b/src/Text/Hakyll/Rss.hs
new file mode 100644
index 0000000..d3e5be2
--- /dev/null
+++ b/src/Text/Hakyll/Rss.hs
@@ -0,0 +1,57 @@
+-- | A Module that allows easy rendering of RSS feeds.
+module Text.Hakyll.Rss
+    ( RssConfiguration (..)
+    , renderRss
+    , renderRssWith
+    ) where
+
+import Control.Arrow ((>>>), second)
+import Control.Monad.Reader (liftIO)
+
+import Text.Hakyll.Context (ContextManipulation)
+import Text.Hakyll.Hakyll (Hakyll)
+import Text.Hakyll.Render (render, renderChain)
+import Text.Hakyll.Renderables (createListingWith)
+import Text.Hakyll.RenderAction (Renderable)
+
+import Paths_hakyll
+
+data RssConfiguration = RssConfiguration
+    { -- | Url of the RSS feed (relative to site root). For example, @rss.xml@.
+      rssUrl         :: String
+    , -- | Title of the RSS feed.
+      rssTitle       :: String
+    , -- | Description of the RSS feed.
+      rssDescription :: String
+    }
+
+createRssWith :: ContextManipulation
+              -> RssConfiguration
+              -> [Renderable]
+              -> FilePath
+              -> FilePath
+              -> Renderable
+createRssWith manipulation configuration renderables template itemTemplate =
+    listing >>> render template
+  where
+    listing = createListingWith manipulation (rssUrl configuration) itemTemplate
+                                renderables additional
+
+    additional = map (second $ Left . ($ configuration))
+        [ ("title", rssTitle)
+        , ("description", rssDescription)
+        ]
+
+renderRss :: RssConfiguration -> [Renderable] -> Hakyll ()
+renderRss = renderRssWith id
+
+renderRssWith :: ContextManipulation
+              -> RssConfiguration
+              -> [Renderable]
+              -> Hakyll ()
+renderRssWith manipulation configuration renderables = do
+    template <- liftIO $ getDataFileName "templates/rss.xml"
+    itemTemplate <- liftIO $ getDataFileName "templates/rss-item.xml"
+    let renderRssWith' = createRssWith manipulation configuration
+                                       renderables template itemTemplate
+    renderChain [] renderRssWith'
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 3d43abc..6a04b04 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -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