DownloadURL.hs (Inspired by the book Real World Haskell)

-- DownloadURL.hs (Inspired by the book Real World Haskell)

module DownloadURL where

import Network.HTTP
import System.IO
import Data.Maybe
import Network.URI

processRedirect r =
 case findHeader HdrLocation r of
  Nothing -> return $ Left (show r)
  Just url -> downloadURL url

processRspCode r =
 case rspCode r of
  (2,_,_) -> return $ Right (rspBody r)
  (3,_,_) -> processRedirect r
  _ -> return $ Left (show r)

processResponse resp =
 case resp of
  Left error -> return $ Left ("Error connecting: " ++ show error)
  Right r -> processRspCode r

downloadURL :: String -> IO (Either String String)
downloadURL url =
 simpleHTTP request >>=
 processResponse
 where
  request = Request {rqURI = uri, rqMethod = GET, rqHeaders = [], rqBody = ""}
  uri = fromJust $ parseURI url