From de660617c4a1782259d917a3a1357e46a027b2b5 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Sat, 15 Jan 2011 18:30:51 -0500 Subject: [PATCH] Added Yesod.Helpers.Feed --- Yesod/Helpers/RssFeed.hs | 89 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 Yesod/Helpers/RssFeed.hs diff --git a/Yesod/Helpers/RssFeed.hs b/Yesod/Helpers/RssFeed.hs new file mode 100644 index 00000000..9ad70419 --- /dev/null +++ b/Yesod/Helpers/RssFeed.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE QuasiQuotes #-} +------------------------------------------------------------------------------- +-- +-- Module : Yesod.Helpers.RssFeed +-- Copyright : Patrick Brisbin +-- License : as-is +-- +-- Maintainer : Patrick Brisbin +-- Stability : Stable +-- Portability : Portable +-- +------------------------------------------------------------------------------- +module Yesod.Helpers.RssFeed + ( RssFeed (..) + , RssFeedEntry (..) + , rssFeed + , RepRss (..) + ) where + +import Yesod +import System.Locale (defaultTimeLocale) +import Data.Time.Clock (UTCTime) +import Data.Time.Format (formatTime) + +-- | note: This would normally be added in Yesod.Content +typeRss :: ContentType +typeRss = "application/rss+xml" + +newtype RepRss = RepRss Content +instance HasReps RepRss where + chooseRep (RepRss c) _ = return (typeRss, c) + +-- | Generate the feed +rssFeed :: RssFeed (Route master) -> GHandler sub master RepRss +rssFeed = fmap RepRss . hamletToContent . template + +-- | Data type for the overall feed +data RssFeed url = RssFeed + { rssTitle :: String + , rssLinkSelf :: url + , rssLinkHome :: url + , rssDescription :: String + , rssLanguage :: String + , rssUpdated :: UTCTime + , rssEntries :: [RssFeedEntry url] + } + +-- | Data type for each feed entry +data RssFeedEntry url = RssFeedEntry + { rssEntryLink :: url + , rssEntryUpdated :: UTCTime + , rssEntryTitle :: String + , rssEntryContent :: Html + } + +template :: RssFeed url -> Hamlet url +template arg = [$xhamlet| +%rss!version="2.0"!xmlns:atom="http://www.w3.org/2005/Atom" + + %channel + %atom:link!href=@rssLinkSelf.arg@!rel="self"!type="application/rss+xml" + %title $rssTitle.arg$ + %link @rssLinkHome.arg@ + %description $rssDescription.arg$ + %lastBuildDate $format.rssUpdated.arg$ + %language $rssLanguage.arg$ + + $forall rssEntries.arg entry + ^entryTemplate.entry^ +|] + +entryTemplate :: RssFeedEntry url -> Hamlet url +entryTemplate arg = [$xhamlet| +%item + %title $rssEntryTitle.arg$ + %link @rssEntryLink.arg@ + %guid @rssEntryLink.arg@ + %pubDate $format.rssEntryUpdated.arg$ + %description $rssEntryContent.arg$ +|] + +-- | Format as string +format :: UTCTime -> String +format = formatTime defaultTimeLocale rfc822DateFormat + +-- | System.Local.rfc822DateFormat disagrees with date -R and does not +-- validate, this one does. +rfc822DateFormat :: String +rfc822DateFormat = "%a, %d %b %Y %H:%M:%S %z"