module Yesod.AtomFeed
( atomFeed
, atomLink
, RepAtom (..)
, module Yesod.FeedTypes
) where
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)
import Text.XML
import Text.Blaze.Renderer.Text (renderHtml)
newtype RepAtom = RepAtom Content
instance HasReps RepAtom where
chooseRep (RepAtom c) _ = return (typeAtom, c)
atomFeed :: Feed (Route master) -> GHandler sub master RepAtom
atomFeed feed = do
render <- getUrlRender
return $ RepAtom $ toContent $ renderLBS def $ template feed render
template :: Feed url -> (url -> Text) -> Document
template Feed {..} render =
Document (Prologue [] Nothing []) (addNS root) []
where
addNS (Element (Name ln _ _) as ns) = Element (Name ln (Just namespace) Nothing) as (map addNS' ns)
addNS' (NodeElement e) = NodeElement $ addNS e
addNS' n = n
namespace = "http://www.w3.org/2005/Atom"
root = Element "feed" [] $ map NodeElement
$ Element "title" [] [NodeContent feedTitle]
: Element "link" [("rel", "self"), ("href", render feedLinkSelf)] []
: Element "link" [("href", render feedLinkHome)] []
: Element "updated" [] [NodeContent $ formatW3 feedUpdated]
: Element "id" [] [NodeContent $ render feedLinkHome]
: map (flip entryTemplate render) feedEntries
entryTemplate :: FeedEntry url -> (url -> Text) -> Element
entryTemplate FeedEntry {..} render = Element "entry" [] $ map NodeElement
[ Element "id" [] [NodeContent $ render feedEntryLink]
, Element "link" [("href", render feedEntryLink)] []
, Element "updated" [] [NodeContent $ formatW3 feedEntryUpdated]
, Element "title" [] [NodeContent feedEntryTitle]
, Element "content" [("type", "html")] [NodeContent $ toStrict $ renderHtml feedEntryContent]
]
atomLink :: Route m
-> Text
-> GWidget s m ()
atomLink r title = toWidgetHead [hamlet|
<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>
|]