----------------------------------------------------------------------------- -- | -- Module : Text.RSS -- Copyright : Copyright 2004, Jeremy Shaw, http://www.n-heptane.com/ -- Copyright 2004-2006, Bjorn Bringert (bjorn@bringert.net) -- License : This code is released to the public domain and comes -- with no warranty. -- -- Maintainer : Bjorn Bringert -- Stability : experimental -- Portability : portable -- -- A libary for generating RSS 2.0 feeds. -- -- -- Original module by Jeremy Shaw. -- -- Changes by Bjorn Bringert: -- -- * showXml just converts the RSS to a String, does not print it. -- -- * Added XML escaping. -- -- * Use RFC 2822 format for dates. -- -- * Added all elements from RSS 2.0.1-rv-6, -- -- -- * Use HaXml.Verbatim instead of HaXml.Pretty, since -- HaXml.Pretty seems to introduce spaces around entities. -- -- * Removed the use of content:encoded, since the description -- tag is the recommented way to include HTML content in RSS 2.0. -- ----------------------------------------------------------------------------- module Text.RSS (RSS(..), Item, ChannelElem(..), ItemElem(..), Title,Link,Description,Width,Height, Email,Domain,MIME_Type,InputName, Hour, Minutes, CloudHost, CloudPort, CloudPath, CloudProcedure, CloudProtocol(..), rssToXML, showXML ) where import Data.List import Data.Maybe import Network.URI import System.Locale import System.Time import Text.XML.HaXml.Combinators (CFilter, mkElem, mkElemAttr, literal, cdata) import Text.XML.HaXml.Escape (xmlEscape, stdXmlEscaper) import Text.XML.HaXml.Types (Element,Content(..)) import Text.XML.HaXml.Verbatim (verbatim) data RSS = RSS Title Link Description [ChannelElem] [Item] deriving Show type Item = [ItemElem] type Title = String type Link = URI type Description = String type Width = Int type Height = Int type Email = String type Domain = String type MIME_Type = String type InputName = String type Hour = Int type Minutes = Int type CloudHost = String type CloudPort = Int type CloudPath = String type CloudProcedure = String data CloudProtocol = CloudProtocolXmlRpc | CloudProtocolSOAP deriving Show data ChannelElem = Language String | Copyright String | ManagingEditor Email | WebMaster Email | ChannelPubDate CalendarTime | LastBuildDate CalendarTime | ChannelCategory (Maybe Domain) String | Generator String -- no docs tag, we generate that automatically | Cloud CloudHost CloudPort CloudPath CloudProcedure CloudProtocol | TTL Minutes | Image URI Title Link (Maybe Width) (Maybe Height) (Maybe Description) | Rating String | TextInput Title Description InputName Link | SkipHours [Hour] | SkipDays [Day] deriving Show data ItemElem = Title Title | Link Link | Description Description | Author Email | Category (Maybe Domain) String | Comments URI | Enclosure URI Int MIME_Type | Guid Bool String | PubDate CalendarTime | Source URI Title deriving Show -- | Converts RSS to XML. rssToXML :: RSS -> CFilter rssToXML (RSS title link description celems items) = mkElemAttr "rss" [("version",literal "2.0")] [mkElem "channel" ([mkTitle title, mkLink link, mkDescription description, mkDocs] ++ map mkChannelElem celems ++ map mkItem items)] -- | Render XML as a string. showXML :: CFilter -> String showXML = verbatim . cfilterToElem cfilterToElem :: CFilter -> Element cfilterToElem f = case f (CString False "") of [CElem e] -> xmlEscape stdXmlEscaper e [] -> error "RSS produced no output" _ -> error "RSS produced more than one output" mkSimple :: String -> String -> CFilter mkSimple t str = mkElem t [literal str] mkTitle :: Title -> CFilter mkTitle = mkSimple "title" mkLink :: Link -> CFilter mkLink = mkSimple "link" . show mkDescription :: Description -> CFilter mkDescription str = mkElem "description" [cdata str] mkDocs :: CFilter mkDocs = mkSimple "docs" "http://www.rssboard.org/rss-specification" mkPubDate :: CalendarTime -> CFilter mkPubDate = mkSimple "pubDate" . formatDate formatDate :: CalendarTime -> String formatDate = formatCalendarTime defaultTimeLocale rfc822DateFormat mkCategory :: Maybe Domain -> String -> CFilter mkCategory md s = mkElemAttr "category" attrs [literal s] where attrs = maybe [] (\d -> [("domain", literal d)]) md maybeElem :: (a -> CFilter) -> Maybe a -> [CFilter] maybeElem = maybe [] . ((:[]) .) mkChannelElem :: ChannelElem -> CFilter mkChannelElem (Language str) = mkSimple "language" str mkChannelElem (Copyright str) = mkSimple "copyright" str mkChannelElem (ManagingEditor str) = mkSimple "managingEditor" str mkChannelElem (WebMaster str) = mkSimple "webMaster" str mkChannelElem (ChannelPubDate date) = mkPubDate date mkChannelElem (LastBuildDate date) = mkSimple "lastBuildDate" $ formatDate date mkChannelElem (ChannelCategory md str) = mkCategory md str mkChannelElem (Generator str) = mkSimple "generator" str mkChannelElem (Cloud host port path proc proto) = mkElemAttr "cloud" [("domain", literal host), ("port", literal (show port)), ("path", literal path), ("registerProcedure", literal proc), ("protocol", literal (protocolName proto))] [] mkChannelElem (TTL min) = mkSimple "ttl" $ show min mkChannelElem (Image uri title link mw mh mdesc) = mkElem "image" ([mkElem "url" [literal (show uri)], mkTitle title, mkLink link] ++ maybeElem (mkSimple "width" . show) mw ++ maybeElem (mkSimple "height" . show) mh ++ maybeElem mkDescription mdesc) mkChannelElem (Rating str) = mkSimple "rating" str mkChannelElem (TextInput title desc name link) = mkElem "textInput" [mkTitle title, mkDescription desc, mkSimple "name" name, mkLink link] mkChannelElem (SkipHours hs) = mkElem "skipHours" (map (mkSimple "hour" . show) hs) mkChannelElem (SkipDays ds) = mkElem "skipDays" (map (mkSimple "day" . show) ds) protocolName :: CloudProtocol -> String protocolName CloudProtocolXmlRpc = "xml-rpc" protocolName CloudProtocolSOAP = "soap" mkItem :: Item -> CFilter mkItem itemElems = mkElem "item" (map mkItemElem itemElems) mkItemElem :: ItemElem -> CFilter mkItemElem (Title t) = mkTitle t mkItemElem (Link l) = mkLink l mkItemElem (Description d) = mkDescription d mkItemElem (Author e) = mkElem "author" [literal e] mkItemElem (Category md str) = mkCategory md str mkItemElem (Comments uri) = mkSimple "comments" $ show uri mkItemElem (Enclosure uri length mtype) = mkElemAttr "enclosure" [("url", literal (show uri)), ("length", literal (show length)), ("type", literal (mtype))] [] mkItemElem (Guid perm s) = mkElemAttr "guid" attrs [ literal s ] where attrs = if perm then [("isPermaLink", literal "true")] else [] mkItemElem (PubDate ct) = mkElem "pubDate" [ literal (formatDate ct) ] mkItemElem (Source uri t) = mkElemAttr "source" [("url", literal (show uri))] [ literal t ]