@@ -1,11 +1,11 @@
1−-- TODO: port
1+--------------------------------------------------------------------------------
22-- | A Module that allows easy rendering of RSS feeds.
33--
44-- The main rendering functions (@renderRss@, @renderAtom@) all assume that
55-- you pass the list of items so that the most recent entry in the feed is the
66-- first item in the list.
77--
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
99-- produce a correct feed:
1010--
1111-- - @$title$@: Title of the item
@@ -15,29 +15,33 @@
1515-- - @$url$@: URL to the item - this is usually set automatically.
1616--
1717-- In addition, the posts should be named according to the rules for
18−-- 'Hakyll.Page.Metadata.renderDateField'.
19−--
18+-- 'Hakyll.Web.Template.Context.dateField'
2019module Hakyll.Web.Feed
2120 ( FeedConfiguration (..)
2221 , renderRss
2322 , renderAtom
2423 ) where
2524
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)
3125
32−import Hakyll.Core.Compiler
33−import Hakyll.Web.Page
34−import Hakyll.Web.Page.Metadata
35−import Hakyll.Web.Template
36−import Hakyll.Web.Template.Read.Hakyll (readTemplate)
37−import Hakyll.Web.Urls
26+--------------------------------------------------------------------------------
27+import Control.Monad (forM, (<=<))
28+import Data.Monoid (mconcat)
29+
30+
31+--------------------------------------------------------------------------------
32+import Hakyll.Core.Compiler
33+import Hakyll.Core.Compiler.Internal
34+import Hakyll.Core.Item
35+import Hakyll.Web.Template
36+import Hakyll.Web.Template.Context
37+import Hakyll.Web.Template.Read.Hakyll (readTemplate)
3838
39−import Paths_hakyll
4039
40+--------------------------------------------------------------------------------
41+import Paths_hakyll
42+
43+
44+--------------------------------------------------------------------------------
4145-- | This is a data structure to keep the configuration of a feed.
4246data FeedConfiguration = FeedConfiguration
4347 { -- | Title of the feed.
@@ -52,83 +56,74 @@ data FeedConfiguration = FeedConfiguration
5256 feedRoot :: String
5357 } deriving (Show, Eq)
5458
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
57−-- each item.
58−--
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
74− $ fromBody body
75− where
76− -- Preprocess items
77− items' = flip map items $ applyTemplateToPage itemTemplate
78− . trySetField "root" (feedRoot configuration)
79−
80− -- Body: concatenated items
81− body = concat $ map pageBody items'
82−
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
87−
8859
60+--------------------------------------------------------------------------------
8961-- | Abstract function to render any feed.
90−--
91−renderFeed :: FilePath -- ^ Feed template
92− -> FilePath -- ^ Item template
93− -> FeedConfiguration -- ^ Feed configuration
94− -> Compiler [Page String] String -- ^ Feed compiler
95−renderFeed feedTemplate itemTemplate configuration =
96− id &&& getRoute >>> renderFeed'
97− where
98− -- Arrow rendering the feed from the items and the URL
99− renderFeed' = unsafeCompiler $ \(items, url) -> do
100− feedTemplate' <- loadTemplate feedTemplate
101− itemTemplate' <- loadTemplate itemTemplate
102− let url' = toUrl $ fromMaybe noUrl url
103− return $ createFeed feedTemplate' itemTemplate' url' configuration items
62+renderFeed :: FilePath -- ^ Feed template
63+ -> FilePath -- ^ Item template
64+ -> FeedConfiguration -- ^ Feed configuration
65+ -> Context String -- ^ Context for the items
66+ -> [Item String] -- ^ Input items
67+ -> Compiler (Item String) -- ^ Resulting item
68+renderFeed feedPath itemPath config itemContext items = do
69+ feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
70+ itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
10471
72+ items' <- forM items $ applyTemplate itemTpl itemContext'
73+ body <- makeItem $ concat $ map itemBody items'
74+ applyTemplate feedTpl feedContext body
75+ where
10576 -- Auxiliary: load a template from a datafile
10677 loadTemplate = fmap readTemplate . readFile <=< getDataFileName
10778
108− -- URL is required to have a valid field
109− noUrl = error "Hakyll.Web.Feed.renderFeed: no route specified"
79+ itemContext' = mconcat
80+ [ constField "root" (feedRoot config)
81+ , itemContext
82+ ]
83+
84+ feedContext = mconcat
85+ [ bodyField "body"
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)
91+ , urlField "url"
92+ , updatedField
93+ , missingField
94+ ]
95+
96+ -- Take the first "updated" field from all items -- this should be the most
97+ -- recent.
98+ updatedField = field "updated" $ \_ -> case items of
99+ [] -> return "Unknown"
100+ (x : _) -> unContext itemContext' "updated" x
110101
102+
103+--------------------------------------------------------------------------------
111104-- | Render an RSS feed with a number of items.
112−--
113−renderRss :: FeedConfiguration -- ^ Feed configuration
114− -> Compiler [Page String] String -- ^ Feed compiler
115−renderRss configuration = arr (map (addUpdated . renderDate))
116− >>> renderFeed "templates/rss.xml" "templates/rss-item.xml" configuration
117− where
118− renderDate = renderDateField "published" "%a, %d %b %Y %H:%M:%S UT"
119− "No date found."
105+renderRss :: FeedConfiguration -- ^ Feed configuration
106+ -> Context String -- ^ Item context
107+ -> [Item String] -- ^ Feed items
108+ -> Compiler (Item String) -- ^ Resulting feed
109+renderRss config context = renderFeed
110+ "templates/rss.xml" "templates/rss-item.xml" config
111+ (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
120112
113+
114+--------------------------------------------------------------------------------
121115-- | Render an Atom feed with a number of items.
122−--
123−renderAtom :: FeedConfiguration -- ^ Feed configuration
124− -> Compiler [Page String] String -- ^ Feed compiler
125−renderAtom configuration = arr (map (addUpdated . renderDate))
126− >>> renderFeed "templates/atom.xml" "templates/atom-item.xml" configuration
127− where
128− renderDate = renderDateField "published" "%Y-%m-%dT%H:%M:%SZ"
129− "No date found."
116+renderAtom :: FeedConfiguration -- ^ Feed configuration
117+ -> Context String -- ^ Item context
118+ -> [Item String] -- ^ Feed items
119+ -> Compiler (Item String) -- ^ Resulting feed
120+renderAtom config context = renderFeed
121+ "templates/atom.xml" "templates/atom-item.xml" config
122+ (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
130123
124+
125+--------------------------------------------------------------------------------
131126-- | Copies @$updated$@ from @$published$@ if it is not already set.
132−--
133−addUpdated :: Page a -> Page a
134−addUpdated page = trySetField "updated" (getField "published" page) page
127+makeItemContext :: String -> Context a -> Context a
128+makeItemContext fmt context = mconcat
129+ [dateField "published" fmt, context, dateField "updated" fmt]