diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runghc + +import Distribution.Simple +main = defaultMain diff --git a/Text/RSS.hs b/Text/RSS.hs new file mode 100644 --- /dev/null +++ b/Text/RSS.hs @@ -0,0 +1,214 @@ +----------------------------------------------------------------------------- +-- | +-- 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 ] diff --git a/rss.cabal b/rss.cabal new file mode 100644 --- /dev/null +++ b/rss.cabal @@ -0,0 +1,12 @@ +Name: rss +Version: 3000.0.0 +Copyright: Jeremy Shaw 2004, Bjorn Bringert 2004-2006 +Maintainer: bjorn@bringert.net +Author: Jeremy Shaw, Bjorn Bringert +License: PublicDomain +build-depends: base, network, HaXml >=1.13 && <1.14 +Synopsis: A library for generating RSS 2.0 feeds. +Description: + This library allows you to generate RSS 2.0 feeds. +Exposed-Modules: Text.RSS +ghc-options: -O2 -W -fwarn-incomplete-patterns