yesod-newsfeed 1.1.0.1 → 1.7.0.1
raw patch · 7 files changed
Files
- ChangeLog.md +42/−0
- README.md +3/−0
- Yesod/AtomFeed.hs +42/−13
- Yesod/Feed.hs +15/−14
- Yesod/FeedTypes.hs +40/−1
- Yesod/RssFeed.hs +43/−10
- yesod-newsfeed.cabal +8/−6
+ ChangeLog.md view
@@ -0,0 +1,42 @@+# Changelog++## 1.7.0.1++* Support `yesod-core` 1.7++## 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++## 1.6++* Create new datatype `EntryEnclosure` for self-documentation of `feedEntryEnclosure`.++## 1.5++### Yesod/FeedTypes.hs++* added `feedLogo` field to `Feed` type as `Maybe (url, Text)`. Should this field result in `Nothing`, nothing will be added to the feed.+ * `url`: Defines the URL to the logi image+ * `Text`: Is the description of the logo image. Will only be used for RSS feeds+* added `feedEntryEnclosure` field to `FeedEntry` type as `Maybe (url, Int, Text)`. Should this field result in `Nothing`, no data will be added to the feed entry.+ * `url`: Defines the URL to the enclosed data+ * `Int`: Is the content size in bytes. RSS requires this.+ * `Text`: Is the MIME-type of the enclosed file. RSS requires this++### Yesod/AtomFeed.hs++* modified `template` function to append an `<logo>url</logo>` tag at the end of the feed, when the provided `feedLogo` is not `Nothing`. This might look awkward, since it will be appended *after* the entries.+* modified `entryTemplate` to append an `<link rel="enclosure" href=url>` to the feed entry.++### Yesod/RssFeed.hs++* modified `template` function to append an `<image>` tag with its three required components `<url>`, `<title>` and `<link>`. `<url>` and `<title>` will be filled from `feedLogo`, `<link>` will be `feedLinkHome`.+* modified `entryTemplate` function to append an `<enclosure type=mime length=length url=url>` to the feed entry
+ README.md view
@@ -0,0 +1,3 @@+## yesod-newsfeed++Helper functions and data types for producing News feeds.
Yesod/AtomFeed.hs view
@@ -1,7 +1,8 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}+ --------------------------------------------------------- -- -- Module : Yesod.AtomFeed@@ -19,6 +20,7 @@ -- | Generation of Atom newsfeeds. module Yesod.AtomFeed ( atomFeed+ , atomFeedText , atomLink , RepAtom (..) , module Yesod.FeedTypes@@ -26,7 +28,6 @@ import Yesod.Core import Yesod.FeedTypes-import Text.Hamlet (hamlet) import qualified Data.ByteString.Char8 as S8 import Data.Text (Text) import Data.Text.Lazy (toStrict)@@ -35,14 +36,22 @@ import qualified Data.Map as Map newtype RepAtom = RepAtom Content-instance HasReps RepAtom where- chooseRep (RepAtom c) _ = return (typeAtom, c)+ deriving ToContent+instance HasContentType RepAtom where+ getContentType _ = typeAtom+instance ToTypedContent RepAtom where+ toTypedContent = TypedContent typeAtom . toContent -atomFeed :: Feed (Route master) -> GHandler sub master RepAtom+atomFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m RepAtom atomFeed feed = do render <- getUrlRender return $ RepAtom $ toContent $ renderLBS def $ template feed render +-- | Same as @'atomFeed'@ but for @'Feed Text'@. Useful for cases where you are+-- generating a feed of external links.+atomFeedText :: MonadHandler m => Feed Text -> m RepAtom+atomFeedText feed = return $ RepAtom $ toContent $ renderLBS def $ template feed id+ template :: Feed url -> (url -> Text) -> Document template Feed {..} render = Document (Prologue [] Nothing []) (addNS root) []@@ -58,23 +67,43 @@ : Element "link" (Map.singleton "href" $ render feedLinkHome) [] : Element "updated" Map.empty [NodeContent $ formatW3 feedUpdated] : Element "id" Map.empty [NodeContent $ render feedLinkHome]- : Element "author" Map.empty [NodeContent feedAuthor]+ : Element "author" Map.empty [NodeElement $ Element "name" Map.empty [NodeContent feedAuthor]] : map (flip entryTemplate render) feedEntries+ +++ case feedLogo of+ 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+entryTemplate FeedEntry {..} render = Element "entry" Map.empty $ map NodeElement $ [ Element "id" Map.empty [NodeContent $ render feedEntryLink] , Element "link" (Map.singleton "href" $ render feedEntryLink) [] , Element "updated" Map.empty [NodeContent $ formatW3 feedEntryUpdated] , Element "title" Map.empty [NodeContent feedEntryTitle] , Element "content" (Map.singleton "type" "html") [NodeContent $ toStrict $ renderHtml feedEntryContent] ]+ ++ map entryCategoryTemplate feedEntryCategories+ +++ case feedEntryEnclosure of+ Nothing -> []+ Just (EntryEnclosure{..}) ->+ [Element "link" (Map.fromList [("rel", "enclosure")+ ,("href", render enclosedUrl)]) []] -- | Generates a link tag in the head of a widget.-atomLink :: Route m+atomLink :: MonadWidget m+ => Route (HandlerSite m) -> Text -- ^ title- -> GWidget s m ()+ -> m () atomLink r title = toWidgetHead [hamlet|-$newline never-<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>-|]+ <link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>+ |]
Yesod/Feed.hs view
@@ -17,24 +17,25 @@ ------------------------------------------------------------------------------- module Yesod.Feed ( newsFeed- , RepAtomRss (..)+ , newsFeedText , module Yesod.FeedTypes ) where import Yesod.FeedTypes import Yesod.AtomFeed import Yesod.RssFeed-import Yesod.Content (HasReps (chooseRep), typeAtom, typeRss)-import Yesod.Core (Route, GHandler)+import Yesod.Core -data RepAtomRss = RepAtomRss RepAtom RepRss-instance HasReps RepAtomRss where- chooseRep (RepAtomRss (RepAtom a) (RepRss r)) = chooseRep- [ (typeAtom, a)- , (typeRss, r)- ]-newsFeed :: Feed (Route master) -> GHandler sub master RepAtomRss-newsFeed f = do- a <- atomFeed f- r <- rssFeed f- return $ RepAtomRss a r+import Data.Text++newsFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m TypedContent+newsFeed f = selectRep $ do+ provideRep $ atomFeed f+ provideRep $ rssFeed f++-- | Same as @'newsFeed'@ but for @'Feed Text'@. Useful for cases where you are+-- generating a feed of external links.+newsFeedText :: MonadHandler m => Feed Text -> m TypedContent+newsFeedText f = selectRep $ do+ provideRep $ atomFeedText f+ provideRep $ rssFeedText f
Yesod/FeedTypes.hs view
@@ -1,6 +1,8 @@ module Yesod.FeedTypes ( Feed (..) , FeedEntry (..)+ , EntryEnclosure (..)+ , EntryCategory (..) ) where import Text.Hamlet (Html)@@ -18,18 +20,55 @@ -- | note: currently only used for Rss , feedDescription :: Html - -- | note: currently only used for Rss, possible values: + -- | note: currently only used for Rss, possible values: -- <http://www.rssboard.org/rss-language-codes> , feedLanguage :: Text , feedUpdated :: UTCTime+ , feedLogo :: Maybe (url, Text) , feedEntries :: [FeedEntry url] } +-- | RSS and Atom allow for linked content to be enclosed in a feed entry.+-- This represents the enclosed content.+--+-- Atom feeds ignore 'enclosedSize' and 'enclosedMimeType'.+--+-- @since 1.6+data EntryEnclosure url = EntryEnclosure+ { enclosedUrl :: url+ , enclosedSize :: Int -- ^ Specified in bytes+ , 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 , feedEntryUpdated :: UTCTime , feedEntryTitle :: Text , feedEntryContent :: Html+ , feedEntryEnclosure :: Maybe (EntryEnclosure url)+ -- ^ Allows enclosed data: RSS \<enclosure> or Atom \<link+ -- rel=enclosure>+ --+ -- @since 1.5+ , feedEntryCategories :: [EntryCategory]+ -- ^ Allows categories data: RSS \<category>+ -- or Atom \<link term=category>+ --+ -- @since 1.7 }
Yesod/RssFeed.hs view
@@ -1,7 +1,8 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}+ ------------------------------------------------------------------------------- -- -- Module : Yesod.RssFeed@@ -15,6 +16,7 @@ ------------------------------------------------------------------------------- module Yesod.RssFeed ( rssFeed+ , rssFeedText , rssLink , RepRss (..) , module Yesod.FeedTypes@@ -22,7 +24,6 @@ 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)@@ -31,15 +32,23 @@ import qualified Data.Map as Map newtype RepRss = RepRss Content-instance HasReps RepRss where- chooseRep (RepRss c) _ = return (typeRss, c)+ deriving ToContent+instance HasContentType RepRss where+ getContentType _ = typeRss+instance ToTypedContent RepRss where+ toTypedContent = TypedContent typeRss . toContent -- | Generate the feed-rssFeed :: Feed (Route master) -> GHandler sub master RepRss+rssFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m RepRss rssFeed feed = do render <- getUrlRender return $ RepRss $ toContent $ renderLBS def $ template feed render +-- | Same as @'rssFeed'@ but for @'Feed Text'@. Useful for cases where you are+-- generating a feed of external links.+rssFeedText :: MonadHandler m => Feed Text -> m RepRss+rssFeedText feed = return $ RepRss $ toContent $ renderLBS def $ template feed id+ template :: Feed url -> (url -> Text) -> Document template Feed {..} render = Document (Prologue [] Nothing []) root []@@ -56,21 +65,45 @@ : Element "lastBuildDate" Map.empty [NodeContent $ formatRFC822 feedUpdated] : Element "language" Map.empty [NodeContent feedLanguage] : map (flip entryTemplate render) feedEntries+ +++ case feedLogo of+ Nothing -> []+ Just (route, desc) -> [Element "image" Map.empty+ [ NodeElement $ Element "url" Map.empty [NodeContent $ render route]+ , NodeElement $ Element "title" Map.empty [NodeContent desc]+ , NodeElement $ Element "link" Map.empty [NodeContent $ render feedLinkHome]+ ]+ ] + entryTemplate :: FeedEntry url -> (url -> Text) -> Element-entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement+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] ]+ ++ map entryCategoryTemplate feedEntryCategories+ +++ case feedEntryEnclosure of+ Nothing -> []+ Just (EntryEnclosure{..}) -> [+ Element "enclosure"+ (Map.fromList [("type", enclosedMimeType)+ ,("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 :: Route m+rssLink :: MonadWidget m+ => Route (HandlerSite m) -> Text -- ^ title- -> GWidget s m ()+ -> m () rssLink r title = toWidgetHead [hamlet|-$newline never <link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}> |]
yesod-newsfeed.cabal view
@@ -1,5 +1,5 @@ name: yesod-newsfeed-version: 1.1.0.1+version: 1.7.0.1 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin@@ -7,16 +7,17 @@ synopsis: Helper functions and data types for producing News feeds. category: Web, Yesod stability: Stable-cabal-version: >= 1.6+cabal-version: >= 1.10 build-type: Simple homepage: http://www.yesodweb.com/-description: Helper functions and data types for producing News feeds.+description: API docs and the README are available at <http://www.stackage.org/package/yesod-newsfeed>+extra-source-files: README.md ChangeLog.md library- build-depends: base >= 4 && < 5- , yesod-core >= 1.1 && < 1.2+ build-depends: base >= 4.10 && < 5+ , yesod-core >= 1.6 && < 1.8 , time >= 1.1.4- , hamlet >= 1.1 && < 1.2+ , shakespeare >= 2.0 , bytestring >= 0.9.1.4 , text >= 0.9 , xml-conduit >= 1.0@@ -29,6 +30,7 @@ , Yesod.Feed other-modules: Yesod.FeedTypes ghc-options: -Wall+ default-language: Haskell2010 source-repository head type: git