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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- | 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 Hakyll.Core.Compiler
import Hakyll.Core.Item
import Hakyll.Core.Util.String (replaceAll)
import Hakyll.Web.Template
import Hakyll.Web.Template.Context
import Hakyll.Web.Template.List
--------------------------------------------------------------------------------
import Data.FileEmbed (makeRelativeToProject, embedFile)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
--------------------------------------------------------------------------------
rssTemplate :: String
rssTemplate = T.unpack $
T.decodeUtf8 $(makeRelativeToProject "data/templates/rss.xml" >>= embedFile)
rssItemTemplate :: String
rssItemTemplate = T.unpack $
T.decodeUtf8 $(makeRelativeToProject "data/templates/rss-item.xml" >>= embedFile)
atomTemplate :: String
atomTemplate = T.unpack $
T.decodeUtf8 $(makeRelativeToProject "data/templates/atom.xml" >>= embedFile)
atomItemTemplate :: String
atomItemTemplate = T.unpack $
T.decodeUtf8 $(makeRelativeToProject "data/templates/atom-item.xml" >>= embedFile)
--------------------------------------------------------------------------------
-- | 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 :: String -- ^ Default feed template
-> String -- ^ Default item template
-> FeedConfiguration -- ^ Feed configuration
-> Context String -- ^ Context for the items
-> [Item String] -- ^ Input items
-> Compiler (Item String) -- ^ Resulting item
renderFeed defFeed defItem config itemContext items = do
feedTpl <- readTemplateFile defFeed
itemTpl <- readTemplateFile defItem
protectedItems <- mapM (applyFilter protectCDATA) items
body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems
applyTemplate feedTpl feedContext body
where
applyFilter :: (Monad m,Functor f) => (String -> String) -> f String -> m (f String)
applyFilter tr str = return $ fmap tr str
protectCDATA :: String -> String
protectCDATA = replaceAll "]]>" (const "]]>")
itemContext' = mconcat
[ itemContext
, constField "root" (feedRoot config)
, constField "authorName" (feedAuthorName config)
, constField "authorEmail" (feedAuthorEmail config)
]
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
readTemplateFile :: String -> Compiler Template
readTemplateFile value = pure $ template $ readTemplateElems value
--------------------------------------------------------------------------------
-- | 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
rssTemplate rssItemTemplate 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
atomTemplate atomItemTemplate 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]
|
