{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -F -pgmFtrhsx #-}
module Clckwrks.Page.Atom where
import Control.Monad.Trans (liftIO)
import Clckwrks.Monad
import Clckwrks.Page.Acid
import Clckwrks.Page.Types
import Clckwrks.ProfileData.Acid
import Clckwrks.URL
import qualified Data.ByteString.Lazy.UTF8 as UTF8
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import Data.Text (Text, pack)
import qualified Data.Text as Text
import Data.Time
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Time.Format (formatTime)
import Data.UUID (toString)
import Happstack.Server (Response, ok, toResponseBS)
import HSP
import HSP.XML (renderXML)
import System.Locale (defaultTimeLocale)
atom :: FeedConfig -- ^ feed configuration
-> [Page] -- ^ pages to publish in feed
-> Clck ClckURL XML
atom FeedConfig{..} pages =
unXMLGenT $
<% feedTitle %>
<% feedAuthorName %>
<% atomDate $ mostRecentUpdate pages %>
<% "urn:uuid:" ++ toString feedUUID %>
<% mapM entry pages %>
mostRecentUpdate :: [Page] -- ^ pages to consider
-> UTCTime -- ^ most recent updated time
mostRecentUpdate [] = posixSecondsToUTCTime 0
mostRecentUpdate pages =
maximum $ map pageUpdated pages
entry :: Page
-> Clck ClckURL XML
entry Page{..} =
unXMLGenT $
<% pageTitle %>
<% "urn:uuid:" ++ toString pageUUID %>
<% author %>
<% atomDate pageUpdated %>
<% atomContent pageSrc %>
where
author :: XMLGenT (Clck ClckURL) XML
author =
do mu <- query $ UsernameForId pageAuthor
case mu of
Nothing -> return $ cdata ""
(Just n)
| Text.null n ->
return $ cdata ""
| otherwise ->
<% n %>
atomDate :: UTCTime -> String
atomDate time =
formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" time
atomContent :: Markup -> Clck ClckURL XML
atomContent markup =
do c <- markupToContent markup
case c of
(PlainText txt) ->
unXMLGenT $ <% txt %>
(TrustedHtml html) ->
unXMLGenT $ <% html %>
handleAtomFeed :: Clck ClckURL Response
handleAtomFeed =
do ps <- query AllPosts
feedConfig <- query GetFeedConfig
xml <- atom feedConfig ps
ok $ toResponseBS (fromString "application/atom+xml;charset=utf-8") (UTF8.fromString $ "\n" ++ renderXML xml)