gistfile1.hs

module Main where
 
import Control.Monad
import Data.List (find)
import Data.Maybe
import Data.Text.Encoding
import Data.ByteString (ByteString)
import Data.Maybe
import Network.URI (parseURI, URI)
import Network.HTTP
import System.Exit
import System.IO
import Text.XML.Light
 
feedUrl :: URI
feedUrl = fromMaybe (error "Invalid url") $ parseURI "http://feeds.arstechnica.com/arstechnica/index?format=xml"
 
data Item = Item { itTitle :: String
, itLink :: String
} deriving (Show)
 
data Channel = Channel { chTitle :: String
, chDescription :: String
-- TODO: add last build date, language, etc.
, chItems :: [Item]
} deriving (Show)
 
main = do
  -- get the data from the feed
  feed <- simpleHTTP (defaultGETRequest_ feedUrl) >>= getResponseBody :: IO ByteString
 
  -- parse it
  let datums = parseXML $ decodeUtf8 feed
 
  -- find the root rss node, and quit if there is none
  let root' = findRoot datums
  when (isNothing root') $ do putStrLn "root node not found!" ; exitFailure
                                                   
  let root = fromJust root'
  let channels = map parseChannel $ findChildren (QName "channel" Nothing Nothing) root
 
  hSetEncoding stdout utf8
  putStrLn $ printChannel (head channels)
 
 
-- | Returns the root RSS element if it exists.
findRoot :: [Content] -> Maybe Element
findRoot = findRoot' . onlyElems
  where findRoot' = find $ (== QName "rss" Nothing Nothing) . elName
 
 
-- | Returns the text content of the child with the given name. Throws an exception
-- if it wasn't found.
prop :: Element -> String -> String
prop node name = strContent . fromJust $ findChild (QName name Nothing Nothing) node
 
 
-- | Parses a <channel> node into a Channel object.
parseChannel :: Element -> Channel
parseChannel node = Channel { chTitle = title, chDescription = desc, chItems = items }
  where title = prop node "title"
        desc = prop node "description"
        items = map parseItem $ findChildren (QName "item" Nothing Nothing) node
 
 
-- | Parses an <item> node into an Item object.
parseItem :: Element -> Item
parseItem node = Item { itTitle = title, itLink = link }
  where title = prop node "title"
        link = prop node "link"
 
 
printChannel :: Channel -> String
printChannel channel = fullTitle ++ "\n" ++ ['=' | _ <- fullTitle] ++ "\n" ++ content
  where fullTitle = chTitle channel ++ " - " ++ chDescription channel
        content = unlines $ map printItem (chItems channel)
 
 
printItem :: Item -> String
printItem item = itTitle item ++ "\n" ++ itLink item ++ "\n"