Backports feeds

3 files changed, 129 insertions, 0 deletions

diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 7e428ae..494cf25 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -135,6 +135,7 @@ addNewCompilers oldCompilers newCompilers = Hakyll $ do
         orderedCompilers = map (id &&& (compilerMap M.!)) ordered
 
     liftIO $ putStrLn "Adding compilers..."
+    liftIO $ putStrLn $ "Added: " ++ show (map fst orderedCompilers)
 
     modify $ updateState modified' completeGraph
 
diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs
new file mode 100644
index 0000000..25f31db
--- /dev/null
+++ b/src/Hakyll/Web/Feed.hs
@@ -0,0 +1,122 @@
+-- | A Module that allows easy rendering of RSS feeds.
+--
+-- 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 pages 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.
+--
+-- In addition, the posts should be named according to the rules for
+-- 'Hakyll.Page.Metadata.renderDateField'.
+--
+module Hakyll.Web.Feed
+    ( FeedConfiguration (..)
+    , renderRss
+    , renderAtom
+    ) where
+
+import Prelude hiding (id)
+import Control.Category (id)
+import Control.Arrow ((>>>), arr, (&&&))
+import Control.Monad ((<=<))
+import Data.Maybe (fromMaybe, listToMaybe)
+
+import Hakyll.Core.Compiler
+import Hakyll.Web.Page
+import Hakyll.Web.Page.Metadata
+import Hakyll.Web.Template
+
+import Paths_hakyll
+
+-- | This is a data structure to keep the configuration of a feed.
+data FeedConfiguration = FeedConfiguration
+    { -- | Title of the feed.
+      feedTitle       :: String
+    , -- | Description of the feed.
+      feedDescription :: String
+    , -- | Name of the feed author.
+      feedAuthorName  :: String
+    , -- | Absolute root URL of the feed site (e.g. @http://jaspervdj.be@)
+      feedRoot        :: String
+    }
+
+-- | This is an auxiliary function to create a listing that is, in fact, a feed.
+-- The items should be sorted on date. The @$timestamp@ field should be set.
+--
+createFeed :: Template           -- ^ Feed template
+           -> Template           -- ^ Item template
+           -> String             -- ^ URL of the feed
+           -> FeedConfiguration  -- ^ Feed configuration
+           -> [Page String]      -- ^ Items to include
+           -> String             -- ^ Resulting feed
+createFeed feedTemplate itemTemplate url configuration items =
+    pageBody $ applyTemplate feedTemplate
+             $ setField "timestamp" timestamp
+             $ setField "title" (feedTitle configuration)
+             $ setField "description" (feedDescription configuration)
+             $ setField "authorName" (feedDescription configuration)
+             $ setField "root" (feedRoot configuration)
+             $ setField "url" url
+             $ fromBody body
+  where
+    -- Preprocess items
+    items' = flip map items $ applyTemplate itemTemplate
+                            . setField "root" (feedRoot configuration)
+
+    -- Body: concatenated items
+    body = concat $ map pageBody items'
+
+    -- Take the first timestamp, which should be the most recent
+    timestamp = fromMaybe "Unknown" $ do
+        p <- listToMaybe items
+        return $ getField "timestamp" p
+
+
+-- | Abstract function to render any feed.
+--
+renderFeed :: FilePath                       -- ^ Feed template
+           -> FilePath                       -- ^ Item template
+           -> FeedConfiguration              -- ^ Feed configuration
+           -> Compiler [Page String] String  -- ^ Feed compiler
+renderFeed feedTemplate itemTemplate configuration =
+    id &&& getRoute >>> renderFeed'
+  where
+    -- Arrow rendering the feed from the items and the URL
+    renderFeed' = unsafeCompiler $ \(items, url) -> do
+        feedTemplate' <- loadTemplate feedTemplate
+        itemTemplate' <- loadTemplate itemTemplate
+        let url' = fromMaybe noUrl url
+        return $ createFeed feedTemplate' itemTemplate' url' configuration items
+
+    -- Auxiliary: load a template from a datafile
+    loadTemplate = fmap readTemplate . readFile <=< getDataFileName
+
+    -- URL is required to have a valid field
+    noUrl = error "Hakyll.Web.Feed.renderFeed: no route specified"
+
+-- | Render an RSS feed with a number of items.
+--
+renderRss :: FeedConfiguration              -- ^ Feed configuration
+          -> Compiler [Page String] String  -- ^ Feed compiler
+renderRss configuration = arr (map renderDate)
+    >>> renderFeed "templates/rss.xml" "templates/rss-item.xml" configuration
+  where
+    renderDate = renderDateField "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
+           -> Compiler [Page String] String  -- ^ Feed compiler
+renderAtom configuration = arr (map renderDate)
+    >>> renderFeed "templates/atom.xml" "templates/atom-item.xml" configuration
+  where
+    renderDate = renderDateField "timestamp" "%Y-%m-%dT%H:%M:%SZ"
+                                 "No date found."
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 35a58ff..a7c237a 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 module Hakyll.Web.Page
     ( Page (..)
+    , fromBody
     , toMap
     , pageRead
     , addDefaultFields
@@ -24,6 +25,11 @@ import Hakyll.Web.Page.Read
 import Hakyll.Web.Page.Metadata
 import Hakyll.Web.Util.String
 
+-- | Create a page from a body, without metadata
+--
+fromBody :: a -> Page a
+fromBody = Page M.empty
+
 -- | Convert a page to a map. The body will be placed in the @body@ key.
 --
 toMap :: Page String -> Map String String