module Yesod.RssFeed
( rssFeed
, rssFeedText
, rssLink
, RepRss (..)
, module Yesod.FeedTypes
) where
import Yesod.Core
import Yesod.FeedTypes
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
rssFeedText :: MonadHandler m => Feed Text -> m RepRss
rssFeedText feed = return $ RepRss $ toContent $ renderLBS def $ template feed id
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
++
case feedLogo of
Nothing -> []
Just (route, desc) -> [Element "image" Map.empty
[ NodeElement $ Element "url" Map.empty [NodeContent $ render route]
, NodeElement $ Element "title" Map.empty [NodeContent desc]
, NodeElement $ Element "link" Map.empty [NodeContent $ render feedLinkHome]
]
]
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]
]
++
case feedEntryEnclosure of
Nothing -> []
Just (EntryEnclosure{..}) -> [
Element "enclosure"
(Map.fromList [("type", enclosedMimeType)
,("length", pack $ show enclosedSize)
,("url", render enclosedUrl)]) []]
rssLink :: MonadWidget m
=> Route (HandlerSite m)
-> Text
-> m ()
rssLink r title = toWidgetHead [hamlet|
<link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>
|]