@@ -1,11 +1,11 @@
1−-- TODO: port
1+--------------------------------------------------------------------------------
2-- | A Module that allows easy rendering of RSS feeds.
2-- | A Module that allows easy rendering of RSS feeds.
4-- The main rendering functions (@renderRss@, @renderAtom@) all assume that
4-- The main rendering functions (@renderRss@, @renderAtom@) all assume that
5-- you pass the list of items so that the most recent entry in the feed is the
5-- you pass the list of items so that the most recent entry in the feed is the
6-- first item in the list.
6-- first item in the list.
8−-- Also note that the pages should have (at least) the following fields to
8+-- Also note that the context should have (at least) the following fields to
9-- produce a correct feed:
9-- produce a correct feed:
11-- - @$title$@: Title of the item
11-- - @$title$@: Title of the item
@@ -15,29 +15,33 @@
15-- - @$url$@: URL to the item - this is usually set automatically.
15-- - @$url$@: URL to the item - this is usually set automatically.
17-- In addition, the posts should be named according to the rules for
17-- In addition, the posts should be named according to the rules for
18−-- 'Hakyll.Page.Metadata.renderDateField'.
18+-- 'Hakyll.Web.Template.Context.dateField'
20module Hakyll.Web.Feed
19module Hakyll.Web.Feed
21 ( FeedConfiguration (..)
20 ( FeedConfiguration (..)
22 , renderRss
21 , renderRss
23 , renderAtom
22 , renderAtom
26−import Prelude hiding (id)
27−import Control.Category (id)
28−import Control.Arrow ((>>>), arr, (&&&))
29−import Control.Monad ((<=<))
30−import Data.Maybe (fromMaybe, listToMaybe)
26+--------------------------------------------------------------------------------
27+import Control.Monad (forM, (<=<))
28+import Data.Monoid (mconcat)
31+--------------------------------------------------------------------------------
32−import Hakyll.Core.Compiler
32+import Hakyll.Core.Compiler
33−import Hakyll.Web.Page
33+import Hakyll.Core.Compiler.Internal
34−import Hakyll.Web.Page.Metadata
34+import Hakyll.Core.Item
35+import Hakyll.Web.Template
35−import Hakyll.Web.Template
36+import Hakyll.Web.Template.Context
36−import Hakyll.Web.Template.Read.Hakyll (readTemplate)
37+import Hakyll.Web.Template.Read.Hakyll (readTemplate)
37−import Hakyll.Web.Urls
40+--------------------------------------------------------------------------------
44+--------------------------------------------------------------------------------
41-- | This is a data structure to keep the configuration of a feed.
45-- | This is a data structure to keep the configuration of a feed.
42data FeedConfiguration = FeedConfiguration
46data FeedConfiguration = FeedConfiguration
43 { -- | Title of the feed.
47 { -- | Title of the feed.
@@ -52,83 +56,74 @@ data FeedConfiguration = FeedConfiguration
52 feedRoot :: String
56 feedRoot :: String
53 } deriving (Show, Eq)
57 } deriving (Show, Eq)
55−-- | This is an auxiliary function to create a listing that is, in fact, a feed.
56−-- The items should be sorted on date. The @$updated@ field should be set for
59−createFeed :: Template -- ^ Feed template
60− -> Template -- ^ Item template
61− -> String -- ^ URL of the feed
62− -> FeedConfiguration -- ^ Feed configuration
63− -> [Page String] -- ^ Items to include
64− -> String -- ^ Resulting feed
65−createFeed feedTemplate itemTemplate url configuration items =
66− pageBody $ applyTemplateToPage feedTemplate
67− $ trySetField "updated" updated
68− $ trySetField "title" (feedTitle configuration)
69− $ trySetField "description" (feedDescription configuration)
70− $ trySetField "authorName" (feedAuthorName configuration)
71− $ trySetField "authorEmail" (feedAuthorEmail configuration)
72− $ trySetField "root" (feedRoot configuration)
73− $ trySetField "url" url
77− items' = flip map items $ applyTemplateToPage itemTemplate
78− . trySetField "root" (feedRoot configuration)
80− -- Body: concatenated items
81− body = concat $ map pageBody items'
83− -- Take the first updated, which should be the most recent
84− updated = fromMaybe "Unknown" $ do
85− p <- listToMaybe items
86− return $ getField "updated" p
60+--------------------------------------------------------------------------------
89-- | Abstract function to render any feed.
61-- | Abstract function to render any feed.
91−renderFeed :: FilePath -- ^ Feed template
62+renderFeed :: FilePath -- ^ Feed template
92− -> FilePath -- ^ Item template
63+ -> FilePath -- ^ Item template
93− -> FeedConfiguration -- ^ Feed configuration
64+ -> FeedConfiguration -- ^ Feed configuration
94− -> Compiler [Page String] String -- ^ Feed compiler
65+ -> Context String -- ^ Context for the items
95−renderFeed feedTemplate itemTemplate configuration =
66+ -> [Item String] -- ^ Input items
96− id &&& getRoute >>> renderFeed'
67+ -> Compiler (Item String) -- ^ Resulting item
97− where
68+renderFeed feedPath itemPath config itemContext items = do
98− -- Arrow rendering the feed from the items and the URL
69+ feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
99− renderFeed' = unsafeCompiler $ \(items, url) -> do
70+ itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
100− feedTemplate' <- loadTemplate feedTemplate
101− itemTemplate' <- loadTemplate itemTemplate
102− let url' = toUrl $ fromMaybe noUrl url
103− return $ createFeed feedTemplate' itemTemplate' url' configuration items
72+ items' <- forM items $ applyTemplate itemTpl itemContext'
73+ body <- makeItem $ concat $ map itemBody items'
74+ applyTemplate feedTpl feedContext body
105 -- Auxiliary: load a template from a datafile
76 -- Auxiliary: load a template from a datafile
106 loadTemplate = fmap readTemplate . readFile <=< getDataFileName
77 loadTemplate = fmap readTemplate . readFile <=< getDataFileName
108− -- URL is required to have a valid field
79+ itemContext' = mconcat
109− noUrl = error "Hakyll.Web.Feed.renderFeed: no route specified"
80+ [ constField "root" (feedRoot config)
84+ feedContext = mconcat
86+ , constField "title" (feedTitle config)
87+ , constField "description" (feedDescription config)
88+ , constField "authorName" (feedAuthorName config)
89+ , constField "authorEmail" (feedAuthorEmail config)
90+ , constField "root" (feedRoot config)
96+ -- Take the first "updated" field from all items -- this should be the most
98+ updatedField = field "updated" $ \_ -> case items of
99+ [] -> return "Unknown"
100+ (x : _) -> unContext itemContext' "updated" x
103+--------------------------------------------------------------------------------
111-- | Render an RSS feed with a number of items.
104-- | Render an RSS feed with a number of items.
113−renderRss :: FeedConfiguration -- ^ Feed configuration
105+renderRss :: FeedConfiguration -- ^ Feed configuration
114− -> Compiler [Page String] String -- ^ Feed compiler
106+ -> Context String -- ^ Item context
115−renderRss configuration = arr (map (addUpdated . renderDate))
107+ -> [Item String] -- ^ Feed items
108+ -> Compiler (Item String) -- ^ Resulting feed
109+renderRss config context = renderFeed
116− >>> renderFeed "templates/rss.xml" "templates/rss-item.xml" configuration
110+ "templates/rss.xml" "templates/rss-item.xml" config
117− where
111+ (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
118− renderDate = renderDateField "published" "%a, %d %b %Y %H:%M:%S UT"
114+--------------------------------------------------------------------------------
121-- | Render an Atom feed with a number of items.
115-- | Render an Atom feed with a number of items.
123−renderAtom :: FeedConfiguration -- ^ Feed configuration
116+renderAtom :: FeedConfiguration -- ^ Feed configuration
124− -> Compiler [Page String] String -- ^ Feed compiler
117+ -> Context String -- ^ Item context
125−renderAtom configuration = arr (map (addUpdated . renderDate))
118+ -> [Item String] -- ^ Feed items
119+ -> Compiler (Item String) -- ^ Resulting feed
120+renderAtom config context = renderFeed
126− >>> renderFeed "templates/atom.xml" "templates/atom-item.xml" configuration
121+ "templates/atom.xml" "templates/atom-item.xml" config
127− where
122+ (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
128− renderDate = renderDateField "published" "%Y-%m-%dT%H:%M:%SZ"
125+--------------------------------------------------------------------------------
131-- | Copies @$updated$@ from @$published$@ if it is not already set.
126-- | Copies @$updated$@ from @$published$@ if it is not already set.
132−--
127+makeItemContext :: String -> Context a -> Context a
133−addUpdated :: Page a -> Page a
128+makeItemContext fmt context = mconcat
134−addUpdated page = trySetField "updated" (getField "published" page) page
129+ [dateField "published" fmt, context, dateField "updated" fmt]