[Implemented RSS 2.0 generation (not tested)
Manuel M T Chakravarty <chak@cse.unsw.edu.au>**20060502173717] {
hunk ./RSS.hs 16
+-- standard libraries
+--
+import Data.Char (
+  toLower)
+import Data.Maybe (
+  maybe, catMaybes, maybeToList)
+import Text.PrettyPrint
+
hunk ./RSS.hs 30
+infixr 0 $?
+infix  4 =!
+
hunk ./RSS.hs 37
-channelToRSS config chan = ""
+channelToRSS config chan = renderXML $
+  RecXML "rss" ["version" =! "2.0"]
+    [ RecXML "channel" [] $
+        [ TextXML "title"          []        $ titleChan chan
+	, TextXML "link"           []        $ linkChan chan
+	, TextXML "description"    []        $ descriptionChan chan
+        ] ++ catMaybes
+	[ TextXML "language"       []        $? languageChan chan
+	, TextXML "copyright"      []        $? copyrightChan chan
+	, TextXML "managingEditor" []        $? managingEditorChan chan
+	, TextXML "webMaster"	   []        $? webMasterChan chan
+	, TextXML "pubDate"        [] . show $? pubDateChan chan
+	, TextXML "lastBuildDate"  [] . show $? lastBuildDateChan chan
+        ] ++ 
+        categoryToRSS                        $* categoryChan chan
+        ++ catMaybes
+	[ TextXML "generator"	   []        $? generatorChan chan
+	, TextXML "docs"	   []        $? docsChan chan
+	, TextXML "ttl"	           [] . show $? ttlChan chan
+	, imageToRSS                         $? imageChan chan
+	] ++
+	map itemToRSS (itemsChan chan)
+    ]
+
+-- Render a category to RSS.
+--
+categoryToRSS :: Category -> XML
+categoryToRSS category =
+  TextXML "category" (maybeToList ("domain" =? domainCategory category)) $
+    categoryCategory category
+
+-- Render an image to RSS.
+--
+imageToRSS :: Image -> XML
+imageToRSS image =
+  EmptyXML "image" $
+    [ "url"   =! urlImage image
+    , "title" =! titleImage image
+    , "link"  =! linkImage image
+    ] ++ catMaybes
+    [ "width"       =? (show $? widthImage  image)
+    , "height"      =? (show $? heightImage image)
+    , "description" =? descriptionImage image
+    ]
+
+-- Render an item to RSS.
+--
+itemToRSS :: Item -> XML
+itemToRSS item =
+  RecXML "item" [] $ catMaybes
+    [ TextXML "title"        []        $? titleItem item
+    , TextXML "link"         []        $? linkItem item
+    , TextXML "description"  []        $? descriptionItem item
+    , TextXML "author"       []        $? authorItem item
+    ] ++
+    categoryToRSS		       $* categoryItem item
+    ++ catMaybes
+    [ TextXML "comments"     []        $? commentsItem item
+    , enclosureToRSS		       $? enclosureItem item
+    , guidToRSS			       $? guidItem item
+    , TextXML "pubDate"      [] . show $? pubDateItem item
+    , sourceToRSS		       $? sourceItem item
+    ]
+
+-- Render an enclosure to RSS.
+--
+enclosureToRSS :: Enclosure -> XML
+enclosureToRSS enclosure =
+  EmptyXML "enclosure"
+    [ "url"    =! urlEnclosure enclosure
+    , "length" =! (show . lengthEnclosure $ enclosure)
+    , "type"   =! typeEnclosure enclosure
+    ]
+
+-- Render a GUID to RSS.
+--
+guidToRSS :: GUID -> XML
+guidToRSS guid =
+  TextXML "guid" 
+    (maybeToList ("isPermaLink" =? (showBool $? isPermaLinkGUID guid))) $
+      guidGUID guid
+  where
+    showBool = map toLower . show
+
+-- Render a source specification to RSS.
+--
+sourceToRSS :: Source -> XML
+sourceToRSS source =
+  TextXML "source" ["url" =! urlSource source ] $
+      sourceSource source
+
+-- Attribute construction.
+--
+(=!) :: String -> String -> AttrXML
+name =! value = (name, value)
+
+-- Optional attribute construction.
+--
+(=?) :: String -> Maybe String -> Maybe AttrXML
+name =? value = (name =!) $? value
+
+-- Map
+--
+($*) :: (a -> b) -> [a] -> [b]
+($*) = fmap
+
+-- Optional application.
+--
+($?) :: (a -> b) -> Maybe a -> Maybe b
+($?) = fmap
+
+
+-- Poor Man's XML Rendering
+-- ------------------------
+
+-- An XML tree consisting of empty and non-empty tags.
+--
+data XML = EmptyXML String [AttrXML]
+	 | TextXML  String [AttrXML] String
+	 | RecXML   String [AttrXML] [XML]
+
+-- XML attributes are associations.
+--
+type AttrXML = (String, String)
+
+-- Render an XML tree.
+--
+renderXML :: XML -> String
+renderXML xml = render $
+  text "<?xml version=\"1.0\"?>"
+  $+$
+  renderTag xml
+  where
+    renderTag (EmptyXML name attrs     ) = 
+      renderStartTag name attrs (text "/>")
+    renderTag (TextXML  name attrs txt ) = cat
+      [ renderStartTag name attrs (char '>')
+      , nest 4 (text txt)
+      , renderEndTag name
+      ]
+    renderTag (RecXML   name attrs xmls) =
+      renderStartTag name attrs (char '>')
+      $+$
+      nest 4 (vcat . map renderTag $ xmls)
+      $+$
+      renderEndTag name
+    --
+    renderStartTag name attrs terminator = sep
+      [ char '<' <> text name
+      , nest 2 (sep $ map renderAttr attrs)
+      , terminator
+      ]
+    --
+    renderEndTag name = text "</" <> text name <> char '>'
+    --
+    renderAttr (name, value) = 
+      text name <> char '=' <> doubleQuotes (text value)
}