gistfile1.hs

module Main where

import qualified Codec.Binary.UTF8.String as UTF
import Control.Monad
import Data.ByteString (ByteString)
import Data.List (find)
import Data.Maybe
import Data.Text.Encoding
import Network.HTTP
import Network.URI (parseURI, URI)
import System.Exit
import System.IO
import Text.XML.Light

feedUri :: URI
feedUri = 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_ feedUri) >>= 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"