-- |A simple feed generator: HTML generator
--
-- Copyright (c) 2006 Manuel M T Chakravarty
--
-- License: <http://www.gnu.org/licenses/gpl.html>
--
--- Description ---------------------------------------------------------------
--
-- Language: Haskell 98
--
-- Docs ----------------------------------------------------------------------
--
-- Introduction to Text.Html: <http://www.cse.ogi.edu/~andy/html/intro.htm>
--
module HTML (
channelToHTML
) where
-- hierachical libraries
import Control.Monad (
mplus, liftM2)
import Data.Maybe (
isJust)
import Text.Html
-- lambdaFeed
import Config (
Config(..))
import Date (
Date, addMinutes)
import Feed (
URL, Channel(..), Image(..), Category(..), Item(..), Enclosure(..),
GUID(..), Source(..))
-- Render a channel to HTML.
--
channelToHTML :: Config -> Channel [Item] -> String
channelToHTML config chan =
renderHtml $
header << concatHtml
[ thetitle <<
titleChan chan
, primHtml "<link rel=\"stylesheet\" type=\"text/css\" \
\href=\"channel.css\"/>"
, meta ! [httpequiv "Content-Type",
content "text/html; charset=iso-8859-1"]
-- FIXME: We should be able to parametrise the charset!!
, languageChan chan `optional`
\lang -> meta ! [httpequiv "Content-Language", content lang]
, (liftM2 addMinutes (lastBuildDateChan chan) (ttlChan chan)) `optional`
\expiryDate -> meta ! [httpequiv "expires",
content (show expiryDate)]
, generatorChan chan `optional`
\gen -> meta ! [name "generator", content gen]
, copyrightChan chan `optional`
\cr -> meta ! [name "copyright", content cr]
, (pubDateChan chan `mplus` lastBuildDateChan chan) `optional`
\date -> meta ! [name "date", content (show date)]
-- NB: `pubDate' takes preference
]
+++
body << concatHtml
[ imageChan chan `optional` imageToHTML
, h1 << titleChan chan
, p << descriptionChan chan
]
+++
map itemToHTML (itemsChan chan)
-- Render an channel image element in HTML.
--
imageToHTML :: Image -> Html
imageToHTML img =
anchor ! ([href (linkImage img)] ++
descriptionImage img `optionalAttr` title) <<
image ! ([ theclass "channel"
, src (urlImage img)
, alt (titleImage img)
] ++
((widthImage img `mplus` Just 88) `optionalAttr` (width.show))++
((heightImage img `mplus` Just 31) `optionalAttr` height))
-- defaults from RSS 2.0 spec
-- Render an item in HTML.
--
itemToHTML :: Item -> Html
itemToHTML item =
thediv ! [theclass "item"] << concatHtml
[ titleItem item `optional`
\title -> linkItem item `optionalHrefFor` (h2 << title)
, descriptionItem item `optional` (p <<)
, thediv ! [theclass "authorDate"] << concatHtml
[ authorItem item `optional` toHtml
, if isJust (authorItem item) && isJust (authorItem item)
then bulletWithSpace else noHtml
, pubDateItem item `optional` (toHtml . show)
]
, thediv ! [theclass "commentsEnclosure"] << concatHtml
[ enclosureItem item `optional` enclosureToHtml
, if isJust (enclosureItem item) &&
isJust (commentsItem item)
then bulletWithSpace else noHtml
, commentsItem item `optional`
\commentsLink -> anchor ! [href commentsLink] << "Comments"
]
]
where bulletWithSpace = spaceHtml +++ bullet +++ spaceHtml
-- Render an enclosure to HTML.
--
enclosureToHtml :: Enclosure -> Html
enclosureToHtml enc =
anchor ! [href (urlEnclosure enc), thetype (typeEnclosure enc) ] <<
"Enclosure"
-- Render an optional element.
--
optional :: Maybe a -> (a -> Html) -> Html
optional = flip (maybe noHtml)
-- Render an optional attribute.
--
optionalAttr :: Maybe a -> (a -> HtmlAttr) -> [HtmlAttr]
optionalAttr Nothing _ = []
optionalAttr (Just x) attr = [attr x]
-- An optional enclosing href.
--
optionalHrefFor :: Maybe String -> Html -> Html
optionalHrefFor Nothing inner = inner
optionalHrefFor (Just link) inner = anchor ! [href link] << inner