diff --git a/yesod-newsfeed/ChangeLog.md b/yesod-newsfeed/ChangeLog.md index fb70d46b..9370c8c7 100644 --- a/yesod-newsfeed/ChangeLog.md +++ b/yesod-newsfeed/ChangeLog.md @@ -1,5 +1,12 @@ # Changelog +## 1.7 + +* Add support for Feed Categories + * RSS: http://www.rssboard.org/rss-specification#ltcategorygtSubelementOfLtitemgt + * Atom: https://tools.ietf.org/html/rfc4287#section-4.2.2 + * Create the `EntryCategory` datatype + ## 1.6.1 * Upgrade to yesod-core 1.6.0 diff --git a/yesod-newsfeed/Yesod/AtomFeed.hs b/yesod-newsfeed/Yesod/AtomFeed.hs index 49fa2879..18e43a93 100644 --- a/yesod-newsfeed/Yesod/AtomFeed.hs +++ b/yesod-newsfeed/Yesod/AtomFeed.hs @@ -74,6 +74,15 @@ template Feed {..} render = Nothing -> [] Just (route, _) -> [Element "logo" Map.empty [NodeContent $ render route]] +entryCategoryTemplate :: EntryCategory -> Element +entryCategoryTemplate (EntryCategory mdomain mlabel category) = + Element "category" (Map.fromList ([("term",category)] + ++ (maybe [] (\d -> [("scheme",d)]) mdomain) + ++ (maybe [] (\l -> [("label",l)]) mlabel) + ) + + ) [] + entryTemplate :: FeedEntry url -> (url -> Text) -> Element entryTemplate FeedEntry {..} render = Element "entry" Map.empty $ map NodeElement $ [ Element "id" Map.empty [NodeContent $ render feedEntryLink] @@ -82,6 +91,7 @@ entryTemplate FeedEntry {..} render = Element "entry" Map.empty $ map NodeElemen , Element "title" Map.empty [NodeContent feedEntryTitle] , Element "content" (Map.singleton "type" "html") [NodeContent $ toStrict $ renderHtml feedEntryContent] ] + ++ map entryCategoryTemplate feedEntryCategories ++ case feedEntryEnclosure of Nothing -> [] diff --git a/yesod-newsfeed/Yesod/FeedTypes.hs b/yesod-newsfeed/Yesod/FeedTypes.hs index f235929b..1b10eaf7 100644 --- a/yesod-newsfeed/Yesod/FeedTypes.hs +++ b/yesod-newsfeed/Yesod/FeedTypes.hs @@ -2,6 +2,7 @@ module Yesod.FeedTypes ( Feed (..) , FeedEntry (..) , EntryEnclosure (..) + , EntryCategory (..) ) where import Text.Hamlet (Html) @@ -40,6 +41,20 @@ data EntryEnclosure url = EntryEnclosure , enclosedMimeType :: Text } +-- | RSS 2.0 and Atom allow category in a feed entry. +-- +-- * [RSS category](http://www.rssboard.org/rss-specification#ltcategorygtSubelementOfLtitemgt) +-- * [Atom category](https://tools.ietf.org/html/rfc4287#section-4.2.2) +-- +-- RSS feeds ignore 'categoryLabel' +-- +-- @since 1.7 +data EntryCategory = EntryCategory + { categoryDomain :: Maybe Text -- ^ category identifier + , categoryLabel :: Maybe Text -- ^ Human-readable label Atom only + , categoryValue :: Text -- ^ identified categorization scheme via URI + } + -- | Each feed entry data FeedEntry url = FeedEntry { feedEntryLink :: url @@ -51,4 +66,9 @@ data FeedEntry url = FeedEntry -- rel=enclosure> -- -- @since 1.5 + , feedEntryCategories :: [EntryCategory] + -- ^ Allows categories data: RSS \ + -- or Atom \ + -- + -- @since 1.7 } diff --git a/yesod-newsfeed/Yesod/RssFeed.hs b/yesod-newsfeed/Yesod/RssFeed.hs index 6ad098f1..d1b61743 100644 --- a/yesod-newsfeed/Yesod/RssFeed.hs +++ b/yesod-newsfeed/Yesod/RssFeed.hs @@ -75,6 +75,7 @@ template Feed {..} render = ] ] + entryTemplate :: FeedEntry url -> (url -> Text) -> Element entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement $ [ Element "title" Map.empty [NodeContent feedEntryTitle] @@ -83,6 +84,7 @@ entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement , Element "pubDate" Map.empty [NodeContent $ formatRFC822 feedEntryUpdated] , Element "description" Map.empty [NodeContent $ toStrict $ renderHtml feedEntryContent] ] + ++ map entryCategoryTemplate feedEntryCategories ++ case feedEntryEnclosure of Nothing -> [] @@ -92,6 +94,11 @@ entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement ,("length", pack $ show enclosedSize) ,("url", render enclosedUrl)]) []] +entryCategoryTemplate :: EntryCategory -> Element +entryCategoryTemplate (EntryCategory mdomain _ category) = + Element "category" prop [NodeContent category] + where prop = maybe Map.empty (\domain -> Map.fromList [("domain",domain)]) mdomain + -- | Generates a link tag in the head of a widget. rssLink :: MonadWidget m => Route (HandlerSite m) diff --git a/yesod-newsfeed/yesod-newsfeed.cabal b/yesod-newsfeed/yesod-newsfeed.cabal index cc4b9e6b..298c2005 100644 --- a/yesod-newsfeed/yesod-newsfeed.cabal +++ b/yesod-newsfeed/yesod-newsfeed.cabal @@ -1,5 +1,5 @@ name: yesod-newsfeed -version: 1.6.1.0 +version: 1.7.0.0 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin