module Yesod.RssFeed
( rssFeed
, rssLink
, RepRss (..)
, module Yesod.FeedTypes
) where
import Yesod.Core
import Yesod.FeedTypes
import Text.Hamlet (hamlet)
import qualified Data.ByteString.Char8 as S8
import Data.Text (Text, pack)
import Data.Text.Lazy (toStrict)
import Text.XML
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Data.Map as Map
newtype RepRss = RepRss Content
deriving ToContent
instance HasContentType RepRss where
getContentType _ = typeRss
instance ToTypedContent RepRss where
toTypedContent = TypedContent typeRss . toContent
rssFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m RepRss
rssFeed feed = do
render <- getUrlRender
return $ RepRss $ toContent $ renderLBS def $ template feed render
template :: Feed url -> (url -> Text) -> Document
template Feed {..} render =
Document (Prologue [] Nothing []) root []
where
root = Element "rss" (Map.singleton "version" "2.0") $ return $ NodeElement $ Element "channel" Map.empty $ map NodeElement
$ Element "{http://www.w3.org/2005/Atom}link" (Map.fromList
[ ("href", render feedLinkSelf)
, ("rel", "self")
, ("type", pack $ S8.unpack typeRss)
]) []
: Element "title" Map.empty [NodeContent feedTitle]
: Element "link" Map.empty [NodeContent $ render feedLinkHome]
: Element "description" Map.empty [NodeContent $ toStrict $ renderHtml feedDescription]
: Element "lastBuildDate" Map.empty [NodeContent $ formatRFC822 feedUpdated]
: Element "language" Map.empty [NodeContent feedLanguage]
: map (flip entryTemplate render) feedEntries
entryTemplate :: FeedEntry url -> (url -> Text) -> Element
entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement
[ Element "title" Map.empty [NodeContent feedEntryTitle]
, Element "link" Map.empty [NodeContent $ render feedEntryLink]
, Element "guid" Map.empty [NodeContent $ render feedEntryLink]
, Element "pubDate" Map.empty [NodeContent $ formatRFC822 feedEntryUpdated]
, Element "description" Map.empty [NodeContent $ toStrict $ renderHtml feedEntryContent]
]
rssLink :: MonadWidget m
=> Route (HandlerSite m)
-> Text
-> m ()
rssLink r title = toWidgetHead [hamlet|
<link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>
|]