Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 498d22714b
Fetching contributors…

Cannot retrieve contributors at this time

77 lines (70 sloc) 2.868 kb
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-------------------------------------------------------------------------------
--
-- Module : Yesod.RssFeed
-- Copyright : Patrick Brisbin
-- License : as-is
--
-- Maintainer : Patrick Brisbin <me@pbrisbin.com>
-- Stability : Stable
-- Portability : Portable
--
-------------------------------------------------------------------------------
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
instance HasReps RepRss where
chooseRep (RepRss c) _ = return (typeRss, c)
-- | Generate the feed
rssFeed :: Feed (Route master) -> GHandler sub master 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]
]
-- | Generates a link tag in the head of a widget.
rssLink :: Route m
-> Text -- ^ title
-> GWidget s m ()
rssLink r title = toWidgetHead [hamlet|
$newline never
<link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>
|]
Jump to Line
Something went wrong with that request. Please try again.