82 lines
1.9 KiB
Haskell
82 lines
1.9 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
---------------------------------------------------------
|
|
--
|
|
-- Module : Yesod.Helpers.AtomFeed
|
|
-- Copyright : Michael Snoyman
|
|
-- License : BSD3
|
|
--
|
|
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
|
-- Stability : Stable
|
|
-- Portability : portable
|
|
--
|
|
-- Generating atom news feeds.
|
|
--
|
|
---------------------------------------------------------
|
|
|
|
module Yesod.Helpers.AtomFeed
|
|
( AtomFeed (..)
|
|
, AtomFeedEntry (..)
|
|
--, atomFeed
|
|
, template -- FIXME
|
|
) where
|
|
|
|
import Yesod
|
|
import Data.Time.Clock (UTCTime)
|
|
import Web.Encodings (formatW3)
|
|
import Text.Hamlet.Monad
|
|
|
|
{-
|
|
atomFeed :: Yesod y => AtomFeed -> Handler y AtomFeedResponse
|
|
atomFeed f = do
|
|
y <- getYesod
|
|
return $ AtomFeedResponse f $ approot y
|
|
-}
|
|
|
|
data AtomFeed url = AtomFeed
|
|
{ atomTitle :: String
|
|
, atomLinkSelf :: url
|
|
, atomLinkHome :: url
|
|
, atomUpdated :: UTCTime
|
|
, atomEntries :: [AtomFeedEntry url]
|
|
}
|
|
{- FIXME
|
|
instance HasReps (AtomFeed url) where
|
|
chooseRep = defChooseRep
|
|
[ (TypeAtom, return . cs)
|
|
]
|
|
-}
|
|
|
|
data AtomFeedEntry url = AtomFeedEntry
|
|
{ atomEntryLink :: url
|
|
, atomEntryUpdated :: UTCTime
|
|
, atomEntryTitle :: String
|
|
, atomEntryContent :: HtmlContent
|
|
}
|
|
|
|
xmlns :: a -> HtmlContent
|
|
xmlns _ = cs "http://www.w3.org/2005/Atom"
|
|
|
|
template :: AtomFeed url -> Hamlet url IO ()
|
|
template = [$hamlet|
|
|
%feed!xmlns=$xmlns$
|
|
%title $atomTitle.cs$
|
|
%link!rel=self!href=@atomLinkSelf@
|
|
%link!href=@atomLinkHome@
|
|
%updated $atomUpdated.formatW3.cs$
|
|
%id @atomLinkHome@
|
|
$forall atomEntries entry
|
|
^entry.entryTemplate^
|
|
|]
|
|
|
|
entryTemplate :: AtomFeedEntry url -> Hamlet url IO ()
|
|
entryTemplate = [$hamlet|
|
|
%entry
|
|
%id @atomEntryLink@
|
|
%link!href=@atomEntryLink@
|
|
%updated $atomEntryUpdated.formatW3.cs$
|
|
%title $atomEntryTitle.cs$
|
|
%content!type=html $atomEntryContent.cdata$
|
|
|]
|