1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
--------------------------------------------------------------------------------
-- | 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 context 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.Web.Template.Context.dateField'
module Hakyll.Web.Feed
( FeedConfiguration (..)
, renderRss
, renderAtom
) where
--------------------------------------------------------------------------------
import Control.Monad ((<=<))
import Data.Monoid (mconcat)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Item
import Hakyll.Web.Template
import Hakyll.Web.Template.Context
import Hakyll.Web.Template.List
--------------------------------------------------------------------------------
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
, -- | Email of the feed author.
feedAuthorEmail :: String
, -- | Absolute root URL of the feed site (e.g. @http://jaspervdj.be@)
feedRoot :: String
} deriving (Show, Eq)
--------------------------------------------------------------------------------
-- | Abstract function to render any feed.
renderFeed :: FilePath -- ^ Feed template
-> FilePath -- ^ Item template
-> FeedConfiguration -- ^ Feed configuration
-> Context String -- ^ Context for the items
-> [Item String] -- ^ Input items
-> Compiler (Item String) -- ^ Resulting item
renderFeed feedPath itemPath config itemContext items = do
feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
body <- makeItem =<< applyTemplateList itemTpl itemContext' items
applyTemplate feedTpl feedContext body
where
-- Auxiliary: load a template from a datafile
loadTemplate = fmap readTemplate . readFile <=< getDataFileName
itemContext' = mconcat
[ constField "root" (feedRoot config)
, constField "authorName" (feedAuthorName config)
, constField "authorEmail" (feedAuthorEmail config)
, itemContext
]
feedContext = mconcat
[ bodyField "body"
, constField "title" (feedTitle config)
, constField "description" (feedDescription config)
, constField "authorName" (feedAuthorName config)
, constField "authorEmail" (feedAuthorEmail config)
, constField "root" (feedRoot config)
, urlField "url"
, updatedField
, missingField
]
-- Take the first "updated" field from all items -- this should be the most
-- recent.
updatedField = field "updated" $ \_ -> case items of
[] -> return "Unknown"
(x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of
ListField _ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"
StringField s -> return s
--------------------------------------------------------------------------------
-- | Render an RSS feed with a number of items.
renderRss :: FeedConfiguration -- ^ Feed configuration
-> Context String -- ^ Item context
-> [Item String] -- ^ Feed items
-> Compiler (Item String) -- ^ Resulting feed
renderRss config context = renderFeed
"templates/rss.xml" "templates/rss-item.xml" config
(makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
--------------------------------------------------------------------------------
-- | Render an Atom feed with a number of items.
renderAtom :: FeedConfiguration -- ^ Feed configuration
-> Context String -- ^ Item context
-> [Item String] -- ^ Feed items
-> Compiler (Item String) -- ^ Resulting feed
renderAtom config context = renderFeed
"templates/atom.xml" "templates/atom-item.xml" config
(makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
--------------------------------------------------------------------------------
-- | Copies @$updated$@ from @$published$@ if it is not already set.
makeItemContext :: String -> Context a -> Context a
makeItemContext fmt context = mconcat
[dateField "published" fmt, context, dateField "updated" fmt]
|
