Conflicts: yesod-auth/Yesod/Auth.hs yesod-auth/Yesod/Auth/BrowserId.hs yesod-auth/Yesod/Auth/Dummy.hs yesod-auth/Yesod/Auth/Email.hs yesod-auth/Yesod/Auth/HashDB.hs yesod-auth/Yesod/Auth/OpenId.hs yesod-auth/Yesod/Auth/Rpxnow.hs yesod-form/Yesod/Form/Fields.hs yesod-form/Yesod/Form/Functions.hs yesod-form/Yesod/Form/Jquery.hs yesod-form/Yesod/Form/Nic.hs yesod-form/Yesod/Helpers/Crud.hs yesod-newsfeed/Yesod/AtomFeed.hs yesod-newsfeed/Yesod/RssFeed.hs
71 lines
1.9 KiB
Haskell
71 lines
1.9 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
---------------------------------------------------------
|
|
--
|
|
-- Module : Yesod.AtomFeed
|
|
-- Copyright : Michael Snoyman
|
|
-- License : BSD3
|
|
--
|
|
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
|
-- Stability : Stable
|
|
-- Portability : portable
|
|
--
|
|
-- Generating atom news feeds.
|
|
--
|
|
---------------------------------------------------------
|
|
|
|
-- | Generation of Atom newsfeeds.
|
|
module Yesod.AtomFeed
|
|
( atomFeed
|
|
, atomLink
|
|
, RepAtom (..)
|
|
, module Yesod.FeedTypes
|
|
) where
|
|
|
|
import Yesod.Core
|
|
import Yesod.FeedTypes
|
|
import Text.Hamlet (HtmlUrl, xhamlet, hamlet)
|
|
import qualified Data.ByteString.Char8 as S8
|
|
import Control.Monad (liftM)
|
|
import Data.Text (Text)
|
|
|
|
newtype RepAtom = RepAtom Content
|
|
instance HasReps RepAtom where
|
|
chooseRep (RepAtom c) _ = return (typeAtom, c)
|
|
|
|
atomFeed :: Feed (Route master) -> GHandler sub master RepAtom
|
|
atomFeed = liftM RepAtom . hamletToContent . template
|
|
|
|
template :: Feed url -> HtmlUrl url
|
|
template arg = [xhamlet|
|
|
\<?xml version="1.0" encoding="utf-8"?>
|
|
<feed xmlns="http://www.w3.org/2005/Atom">
|
|
<title>#{feedTitle arg}
|
|
<link rel=self href=@{feedLinkSelf arg}>
|
|
<link href=@{feedLinkHome arg}>
|
|
<updated>#{formatW3 $ feedUpdated arg}
|
|
<id>@{feedLinkHome arg}
|
|
$forall entry <- feedEntries arg
|
|
^{entryTemplate entry}
|
|
|]
|
|
|
|
entryTemplate :: FeedEntry url -> HtmlUrl url
|
|
entryTemplate arg = [xhamlet|
|
|
<entry>
|
|
<id>@{feedEntryLink arg}
|
|
<link href=@{feedEntryLink arg}>
|
|
<updated>#{formatW3 $ feedEntryUpdated arg}
|
|
<title>#{feedEntryTitle arg}
|
|
<content type=html>
|
|
\<![CDATA[
|
|
\#{feedEntryContent arg}
|
|
]]>
|
|
|]
|
|
|
|
-- | Generates a link tag in the head of a widget.
|
|
atomLink :: Route m
|
|
-> Text -- ^ title
|
|
-> GWidget s m ()
|
|
atomLink r title = toWidgetHead [hamlet|
|
|
<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>
|
|
|]
|