module RSS where

{-
Copyright 2004, Jeremy Shaw.
http://www.n-heptane.com/

Copyright 2004, Bjorn Bringert (bjorn@bringert.net)

This code is released to the public domain and comes with no warranty.

Changes by Bjorn Bringert:

* showXml just converts the RSS to a String, does not print it.

-}

-- arch-tag: d8d11fd3-71e9-412c-987e-a11341acb54c
import Data.List

import Maybe
import Network.URI

import System.IO.Unsafe
import System.Time

import Text.PrettyPrint.HughesPJ  (render)
import Text.XML.HaXml.Combinators
import Text.XML.HaXml.Escape
import Text.XML.HaXml.Pretty      (element)
import Text.XML.HaXml.Types       (Document(..),Content(..))


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
data ChannelElem = Image URI Title Link (Maybe Width) (Maybe Height)
		 | LastBuildDate CalendarTime
		   deriving Show

type Email = String
type MIME_Type = String
data ItemElem = Title Title
	      | Link Link
	      | Description Description
	      | Author Email
	      | Category String
	      | Enclosure URI Int MIME_Type
	      | Guid String
	      | PubDate CalendarTime
	      | Source URI Title
	      | ContentEncoded String
		deriving Show

-- | rssToXML converts things of type RSS to XML but doesn't show the
-- | output.  mkElem makes a tag with the string - <rss>, <channel>,
-- | etc.  mkTitle, mkLink, mkDescription, mkItem, mkItemElem are all
-- | versions of mkElem.

rssToXML (RSS title link description celems items) = 
    mkElem "rss" [ mkElem "channel" ([ (mkTitle title)
				     , (mkLink link)
				     , (mkDescription description) 
				     ]
				     ++ (map mkItem items))
		 ]

ppContent [CElem e] = element e
ppContent []  = error "produced no output"
ppContent _   = error "produced more than one output"

showXML f = (render . ppContent) (f (CString False ""))

mkTitle str = mkElem "title" [ literal str ]
mkLink uri = mkElem "link" [ cdata (show uri) ]
mkDescription str = mkElem "description" [ cdata str ]
mkItem itemElems = mkElem "item" (map mkItemElem itemElems)

mkItemElem (Title t) = mkTitle t
mkItemElem (Link l) = mkLink l
mkItemElem (Description d) = mkDescription d
mkItemElem (Author e) = mkElem "author" [ literal e ]
mkItemElem (Category s) = mkElem "category" [ literal s ]
mkItemElem (Enclosure uri length mtype) = mkElemAttr "enclosure" [ ("url", literal (show uri))
								 , ("length", literal (show length))
								 , ("type", literal (mtype))
								 ] 
					  []
mkItemElem (Guid s) = mkElem "guid" [ literal s ]
mkItemElem (PubDate ct) = mkElem "pubdate" [ literal (calendarTimeToString ct) ]
mkItemElem (Source uri t) = mkElemAttr "source" [("url", literal (show uri))] [ literal t ]
mkItemElem (ContentEncoded str) = mkElem "content:encoded" [ cdata str ]


{- 

To test, 

(1) create Main.hs

---> Main.hs <--
module Main where

import RSS

main = rssTest
<-------------->

(2) compile with: ghc --make -package HaXml Main.hs -o test.cgi

(3) Copy test.cgi into someplace like cgi-bin

(4) point your RSS aggregator at the test.cgi file and enjoy

-}

-- A simple static test feed
rssTest =   showXML $ rssToXML (RSS "my whiskers" 
				(fromJust (parseURI "http://www.n-heptane.com")) 
				"they are very pointy and luxurious" 
				[] 
				[[ Title "yea-haw"
				 , Link (fromJust (parseURI "http://www.n-heptane.com/"))
				 , Description "the best site ever!!!"
				 , Author "jeremy@n-heptane.com (Jeremy Shaw)"
				 , Category "meow"
				 , Enclosure (fromJust (parseURI "http://www.n-heptane.com/newpics/alice.gif")) 7333 "image/jpeg"
				 , Guid "whee babayyyy!"
				 , PubDate (unsafePerformIO (getClockTime >>= toCalendarTime))
				 , Source (fromJust (parseURI "http://www.google.com/")) "The best search engine eva!"
				]])