#if __GLASGOW_HASKELL__ >= 704
#endif
module Text.RSS (RSS(..), Item, ChannelElem(..), ItemElem(..),
Title,Link,Description,Width,Height,
Email,Domain,MIME_Type,InputName,
Weekday(..), Hour, Minutes,
CloudHost, CloudPort, CloudPath,
CloudProcedure, CloudProtocol(..),
rssToXML, showXML
) where
import Data.Ix (Ix)
import Network.URI (URI)
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format(defaultTimeLocale, rfc822DateFormat)
#else
import System.Locale (defaultTimeLocale, rfc822DateFormat)
#endif
import Data.Time.Clock (UTCTime)
import Data.Time.Format (formatTime)
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 UTCTime
| LastBuildDate UTCTime
| ChannelCategory (Maybe Domain) String
| Generator String
| 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 [Weekday]
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 UTCTime
| Source URI Title
deriving (Show)
data Weekday = Sunday | Monday | Tuesday | Wednesday
| Thursday | Friday | Saturday
deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
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)]
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 :: UTCTime -> CFilter ()
mkPubDate = mkSimple "pubDate" . formatDate
formatDate :: UTCTime -> String
formatDate = formatTime 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 minutes) = mkSimple "ttl" $ show minutes
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 len mtype) =
mkElemAttr "enclosure" [("url", literal (show uri)),
("length", literal (show len)),
("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 ]