added support for feed logos and item enclosures
forgot a file
This commit is contained in:
parent
ae71026e71
commit
f7dfeee9b1
@ -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
|
||||||
|
|||||||
9
yesod-newsfeed/Yesod/Common.hs
Normal file
9
yesod-newsfeed/Yesod/Common.hs
Normal 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
|
||||||
@ -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)
|
||||||
}
|
}
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user