Consolidated Rss and Atom Feed types into one
This commit is contained in:
patrick brisbin
parent
8f73e2ab8d
commit
bc40f62886
@ -17,42 +17,25 @@
|
||||
-- | Generation of Atom newsfeeds. See
|
||||
-- <http://en.wikipedia.org/wiki/Atom_(standard)>.
|
||||
module Yesod.Helpers.AtomFeed
|
||||
( AtomFeed (..)
|
||||
, AtomFeedEntry (..)
|
||||
, atomFeed
|
||||
( atomFeed
|
||||
, atomLink
|
||||
, RepAtom (..)
|
||||
, module Yesod.Helpers.Feed
|
||||
) where
|
||||
|
||||
import Yesod.Content
|
||||
import Yesod.Handler
|
||||
import Yesod.Widget
|
||||
import Text.Hamlet
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Yesod.Helpers.Feed
|
||||
|
||||
newtype RepAtom = RepAtom Content
|
||||
instance HasReps RepAtom where
|
||||
chooseRep (RepAtom c) _ = return (typeAtom, c)
|
||||
|
||||
atomFeed :: AtomFeed (Route master) -> GHandler sub master RepAtom
|
||||
atomFeed :: Feed (Route master) -> GHandler sub master RepAtom
|
||||
atomFeed = fmap RepAtom . hamletToContent . template
|
||||
|
||||
data AtomFeed url = AtomFeed
|
||||
{ atomTitle :: String
|
||||
, atomLinkSelf :: url
|
||||
, atomLinkHome :: url
|
||||
, atomUpdated :: UTCTime
|
||||
, atomEntries :: [AtomFeedEntry url]
|
||||
}
|
||||
|
||||
data AtomFeedEntry url = AtomFeedEntry
|
||||
{ atomEntryLink :: url
|
||||
, atomEntryUpdated :: UTCTime
|
||||
, atomEntryTitle :: String
|
||||
, atomEntryContent :: Html
|
||||
}
|
||||
|
||||
template :: AtomFeed url -> Hamlet url
|
||||
template :: Feed url -> Hamlet url
|
||||
template arg =
|
||||
#if __GLASGOW_HASKELL__ >= 700
|
||||
[xhamlet|
|
||||
@ -61,16 +44,16 @@ template arg =
|
||||
#endif
|
||||
\<?xml version="1.0" encoding="utf-8"?>
|
||||
%feed!xmlns="http://www.w3.org/2005/Atom"
|
||||
%title $atomTitle.arg$
|
||||
%link!rel=self!href=@atomLinkSelf.arg@
|
||||
%link!href=@atomLinkHome.arg@
|
||||
%updated $formatW3.atomUpdated.arg$
|
||||
%id @atomLinkHome.arg@
|
||||
$forall atomEntries.arg entry
|
||||
%title $feedTitle.arg$
|
||||
%link!rel=self!href=@feedLinkSelf.arg@
|
||||
%link!href=@feedLinkHome.arg@
|
||||
%updated $formatW3.feedUpdated.arg$
|
||||
%id @feedLinkHome.arg@
|
||||
$forall feedEntries.arg entry
|
||||
^entryTemplate.entry^
|
||||
|]
|
||||
|
||||
entryTemplate :: AtomFeedEntry url -> Hamlet url
|
||||
entryTemplate :: FeedEntry url -> Hamlet url
|
||||
entryTemplate arg =
|
||||
#if __GLASGOW_HASKELL__ >= 700
|
||||
[xhamlet|
|
||||
@ -78,11 +61,11 @@ entryTemplate arg =
|
||||
[$xhamlet|
|
||||
#endif
|
||||
%entry
|
||||
%id @atomEntryLink.arg@
|
||||
%link!href=@atomEntryLink.arg@
|
||||
%updated $formatW3.atomEntryUpdated.arg$
|
||||
%title $atomEntryTitle.arg$
|
||||
%content!type=html $cdata.atomEntryContent.arg$
|
||||
%id @feedEntryLink.arg@
|
||||
%link!href=@feedEntryLink.arg@
|
||||
%updated $formatW3.feedEntryUpdated.arg$
|
||||
%title $feedEntryTitle.arg$
|
||||
%content!type=html $cdata.feedEntryContent.arg$
|
||||
|]
|
||||
|
||||
-- | Generates a link tag in the head of a widget.
|
||||
@ -95,5 +78,5 @@ atomLink u title = addHamletHead
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%link!href=@u@!type="application/atom+xml"!rel="alternate"!title=$title$
|
||||
%link!href=@u@!type=$typeAtom$!rel="alternate"!title=$title$
|
||||
|]
|
||||
|
||||
40
Yesod/Helpers/Feed.hs
Normal file
40
Yesod/Helpers/Feed.hs
Normal file
@ -0,0 +1,40 @@
|
||||
-------------------------------------------------------------------------------
|
||||
--
|
||||
-- Module : Yesod.Helpers.Feed
|
||||
-- Copyright : Patrick Brisbin
|
||||
-- License : as-is
|
||||
--
|
||||
-- Maintainer : Patrick Brisbin <me@pbrisbin.com>
|
||||
-- Stability : Stable
|
||||
-- Portability : Portable
|
||||
--
|
||||
-- Generic Feed and Feed Entry data types that can be used as either and
|
||||
-- Rss feed or an Atom feed (or both, or other).
|
||||
--
|
||||
-------------------------------------------------------------------------------
|
||||
module Yesod.Helpers.Feed
|
||||
( Feed(..)
|
||||
, FeedEntry(..)
|
||||
) where
|
||||
|
||||
import Text.Hamlet (Html)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
|
||||
-- | The overal feed
|
||||
data Feed url = Feed
|
||||
{ feedTitle :: String
|
||||
, feedLinkSelf :: url
|
||||
, feedLinkHome :: url
|
||||
, feedDescription :: Html
|
||||
, feedLanguage :: String
|
||||
, feedUpdated :: UTCTime
|
||||
, feedEntries :: [FeedEntry url]
|
||||
}
|
||||
|
||||
-- | Each feed entry
|
||||
data FeedEntry url = FeedEntry
|
||||
{ feedEntryLink :: url
|
||||
, feedEntryUpdated :: UTCTime
|
||||
, feedEntryTitle :: String
|
||||
, feedEntryContent :: Html
|
||||
}
|
||||
@ -12,68 +12,47 @@
|
||||
--
|
||||
-------------------------------------------------------------------------------
|
||||
module Yesod.Helpers.RssFeed
|
||||
( RssFeed (..)
|
||||
, RssFeedEntry (..)
|
||||
, rssFeed
|
||||
( rssFeed
|
||||
, rssLink
|
||||
, RepRss (..)
|
||||
, module Yesod.Helpers.Feed
|
||||
) where
|
||||
|
||||
import Yesod.Handler
|
||||
import Yesod.Content
|
||||
import Yesod.Widget
|
||||
import Text.Hamlet
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Yesod.Helpers.Feed
|
||||
|
||||
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 :: Feed (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 :: Feed url -> Hamlet url
|
||||
template arg =
|
||||
#if __GLASGOW_HASKELL__ >= 700
|
||||
[xhamlet|
|
||||
#else
|
||||
[$xhamlet|
|
||||
#endif
|
||||
%rss!version="2.0"!xmlns:atom="http://www.w3.org/2005/Atom"
|
||||
%rss!version="2.0"
|
||||
|
||||
%channel
|
||||
%atom:link!href=@rssLinkSelf.arg@!rel="self"!type=$typeRss$
|
||||
%title $rssTitle.arg$
|
||||
%link @rssLinkHome.arg@
|
||||
%description $rssDescription.arg$
|
||||
%lastBuildDate $formatRFC822.rssUpdated.arg$
|
||||
%language $rssLanguage.arg$
|
||||
%atom:link!href=@feedLinkSelf.arg@!rel="self"!type=$typeRss$
|
||||
%title $feedTitle.arg$
|
||||
%link @feedLinkHome.arg@
|
||||
%description $feedDescription.arg$
|
||||
%lastBuildDate $formatRFC822.feedUpdated.arg$
|
||||
%language $feedLanguage.arg$
|
||||
|
||||
$forall rssEntries.arg entry
|
||||
$forall feedEntries.arg entry
|
||||
^entryTemplate.entry^
|
||||
|]
|
||||
|
||||
entryTemplate :: RssFeedEntry url -> Hamlet url
|
||||
entryTemplate :: FeedEntry url -> Hamlet url
|
||||
entryTemplate arg =
|
||||
#if __GLASGOW_HASKELL__ >= 700
|
||||
[xhamlet|
|
||||
@ -81,11 +60,11 @@ entryTemplate arg =
|
||||
[$xhamlet|
|
||||
#endif
|
||||
%item
|
||||
%title $rssEntryTitle.arg$
|
||||
%link @rssEntryLink.arg@
|
||||
%guid @rssEntryLink.arg@
|
||||
%pubDate $formatRFC822.rssEntryUpdated.arg$
|
||||
%description $rssEntryContent.arg$
|
||||
%title $feedEntryTitle.arg$
|
||||
%link @feedEntryLink.arg@
|
||||
%guid @feedEntryLink.arg@
|
||||
%pubDate $formatRFC822.feedEntryUpdated.arg$
|
||||
%description $feedEntryContent.arg$
|
||||
|]
|
||||
|
||||
-- | Generates a link tag in the head of a widget.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user