added support for feed logos and item enclosures

forgot a file
This commit is contained in:
nek0 2015-09-30 03:09:21 +02:00
parent ae71026e71
commit f7dfeee9b1
4 changed files with 36 additions and 2 deletions

View File

@ -28,6 +28,7 @@ module Yesod.AtomFeed
import Yesod.Core import Yesod.Core
import Yesod.FeedTypes import Yesod.FeedTypes
import Yesod.Common
import Text.Hamlet (hamlet) import Text.Hamlet (hamlet)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import Data.Text (Text) import Data.Text (Text)
@ -70,15 +71,23 @@ template Feed {..} render =
: Element "id" Map.empty [NodeContent $ render feedLinkHome] : Element "id" Map.empty [NodeContent $ render feedLinkHome]
: Element "author" Map.empty [NodeElement $ Element "name" Map.empty [NodeContent feedAuthor]] : Element "author" Map.empty [NodeElement $ Element "name" Map.empty [NodeContent feedAuthor]]
: map (flip entryTemplate render) feedEntries : map (flip entryTemplate render) feedEntries
++
case feedLogo of
Nothing -> []
Just (route, _) -> [Element "logo" Map.empty [NodeContent $ render route]]
entryTemplate :: FeedEntry url -> (url -> Text) -> Element 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 "id" Map.empty [NodeContent $ render feedEntryLink]
, Element "link" (Map.singleton "href" $ render feedEntryLink) [] , Element "link" (Map.singleton "href" $ render feedEntryLink) []
, Element "updated" Map.empty [NodeContent $ formatW3 feedEntryUpdated] , Element "updated" Map.empty [NodeContent $ formatW3 feedEntryUpdated]
, Element "title" Map.empty [NodeContent feedEntryTitle] , Element "title" Map.empty [NodeContent feedEntryTitle]
, Element "content" (Map.singleton "type" "html") [NodeContent $ toStrict $ renderHtml feedEntryContent] , Element "content" (Map.singleton "type" "html") [NodeContent $ toStrict $ renderHtml feedEntryContent]
] ]
++
case feedEntryEnclosure of
Nothing -> []
Just (route, _, _) -> [Element "link" (Map.fromList [("rel", "enclosure"), ("href", render route)]) []]
-- | Generates a link tag in the head of a widget. -- | Generates a link tag in the head of a widget.
atomLink :: MonadWidget m atomLink :: MonadWidget m

View File

@ -0,0 +1,9 @@
module Yesod.Common
( removeItem
) where
removeItem :: Eq a => a -> [a] -> [a]
removeItem _ [] = []
removeItem r (x:xs)
| r == x = removeItem r xs
| otherwise = x : removeItem r xs

View File

@ -23,6 +23,7 @@ data Feed url = Feed
, feedLanguage :: Text , feedLanguage :: Text
, feedUpdated :: UTCTime , feedUpdated :: UTCTime
, feedLogo :: Maybe (url, Text)
, feedEntries :: [FeedEntry url] , feedEntries :: [FeedEntry url]
} }
@ -32,4 +33,5 @@ data FeedEntry url = FeedEntry
, feedEntryUpdated :: UTCTime , feedEntryUpdated :: UTCTime
, feedEntryTitle :: Text , feedEntryTitle :: Text
, feedEntryContent :: Html , feedEntryContent :: Html
, feedEntryEnclosure :: Maybe (url, Int, Text)
} }

View File

@ -24,6 +24,7 @@ module Yesod.RssFeed
import Yesod.Core import Yesod.Core
import Yesod.FeedTypes import Yesod.FeedTypes
import Yesod.Common
import Text.Hamlet (hamlet) import Text.Hamlet (hamlet)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import Data.Text (Text, pack) import Data.Text (Text, pack)
@ -66,15 +67,28 @@ template Feed {..} render =
: Element "lastBuildDate" Map.empty [NodeContent $ formatRFC822 feedUpdated] : Element "lastBuildDate" Map.empty [NodeContent $ formatRFC822 feedUpdated]
: Element "language" Map.empty [NodeContent feedLanguage] : Element "language" Map.empty [NodeContent feedLanguage]
: map (flip entryTemplate render) feedEntries : 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 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 "title" Map.empty [NodeContent feedEntryTitle]
, Element "link" Map.empty [NodeContent $ render feedEntryLink] , Element "link" Map.empty [NodeContent $ render feedEntryLink]
, Element "guid" Map.empty [NodeContent $ render feedEntryLink] , Element "guid" Map.empty [NodeContent $ render feedEntryLink]
, Element "pubDate" Map.empty [NodeContent $ formatRFC822 feedEntryUpdated] , Element "pubDate" Map.empty [NodeContent $ formatRFC822 feedEntryUpdated]
, Element "description" Map.empty [NodeContent $ toStrict $ renderHtml feedEntryContent] , Element "description" Map.empty [NodeContent $ toStrict $ renderHtml feedEntryContent]
] ]
++
case feedEntryEnclosure of
Nothing -> []
Just (route, length, mime) -> [Element "enclosure" (Map.fromList [("type", mime), ("length", pack $ show length), ("url", render route)]) []]
-- | Generates a link tag in the head of a widget. -- | Generates a link tag in the head of a widget.
rssLink :: MonadWidget m rssLink :: MonadWidget m