Merge pull request #1631 from yogsototh/rss-2.0

Support categories for Atom and RSS newsfeed

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

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 -> []

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 \<category>
+      -- or Atom \<link term=category>
+      --
+      -- @since 1.7
     }

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)

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