module Yesod.AtomFeed
( atomFeed
, atomFeedText
, atomLink
, RepAtom (..)
, module Yesod.FeedTypes
) where
import Yesod.Core
import Yesod.FeedTypes
import qualified Data.ByteString.Char8 as S8
import Data.Text (Text)
import Data.Text.Lazy (toStrict)
import Text.XML
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Data.Map as Map
newtype RepAtom = RepAtom Content
deriving ToContent
instance HasContentType RepAtom where
getContentType _ = typeAtom
instance ToTypedContent RepAtom where
toTypedContent = TypedContent typeAtom . toContent
atomFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m RepAtom
atomFeed feed = do
render <- getUrlRender
return $ RepAtom $ toContent $ renderLBS def $ template feed render
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) []
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.empty $ map NodeElement
$ Element "title" Map.empty [NodeContent feedTitle]
: Element "link" (Map.fromList [("rel", "self"), ("href", render feedLinkSelf)]) []
: 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 [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]]
entryTemplate :: FeedEntry url -> (url -> Text) -> Element
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]
]
++
case feedEntryEnclosure of
Nothing -> []
Just (EntryEnclosure{..}) ->
[Element "link" (Map.fromList [("rel", "enclosure")
,("href", render enclosedUrl)]) []]
atomLink :: MonadWidget m
=> Route (HandlerSite m)
-> Text
-> m ()
atomLink r title = toWidgetHead [hamlet|
<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>
|]