Feed.hs

{-# LANGUAGE OverloadedStrings #-}

import Prelude hiding (FilePath)
import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.Text as T
import qualified Data.ByteString.Lazy.Char8 as C
import Text.Feed.Types
import Text.Feed.Import
import Text.Feed.Query
import Network.HTTP.Conduit
import qualified Text.XML as X
import Text.XML.Cursor
import Filesystem.Path.CurrentOS (FilePath)
import Control.Concurrent.ParallelIO

fetchFeed :: String -> IO Feed
fetchFeed url = liftM (fromJust' . parseFeedString . C.unpack) (simpleHttp url)
  where fromJust' Nothing = error $ "Feed " ++ url ++ " is invalid."
        fromJust' (Just x) = x

showFeed :: Feed -> String
showFeed f = getFeedTitle f ++ " (" ++ fromMaybe "" (getFeedHome f) ++ ")"

showFeeds :: [Feed] -> String
showFeeds feeds = intercalate "\n" $ map showFeed feeds

readOpmlFile :: FilePath -> IO [String]
readOpmlFile filename = liftM findUrls (X.readFile X.def filename)
  where findUrls doc = map T.unpack $ fromDocument doc $/ element "body" &/ attribute "xmlUrl"

main :: IO ()
main = do
  urls <- readOpmlFile "test.opml"
  feeds <- parallelInterleaved $ map fetchFeed urls
  putStr $ showFeeds feeds