{-# LANGUAGE OverloadedStrings #-}
-- | High level functions for downloading files.
module Control.Shell.Download
  ( URI
  , fetch, fetchBytes
  , fetchFile
  , fetchTags, fetchXML, fetchFeed
  ) where
import Data.ByteString as BS (ByteString, writeFile)
import Data.String
import Network.HTTP
import qualified Network.URI as U
import Text.Feed.Import (parseFeedString)
import Text.Feed.Types (Feed)
import Text.HTML.TagSoup (Tag, parseTags)
import Text.XML.Light (Content, parseXML)
import Control.Shell

-- | A Uniform Resource Locator.
type URI = String

liftE :: Show e => IO (Either e a) -> Shell a
liftE m = do
  res <- liftIO m
  case res of
    Left e  -> fail (show e)
    Right x -> return x

httpFail :: (Int, Int, Int) -> String -> Shell a
httpFail (a,b,c) reason =
  fail $ "HTTP error " ++ concat [show a, show b, show c] ++ ": " ++ reason

fetchSomething :: (IsString a, HStream a) => URI -> Shell a
fetchSomething uri = do
    u <- assert ("could not parse URI `" ++ uri ++ "'") (U.parseURI uri)
    rsp <- liftE $ simpleHTTP (req u)
    case rspCode rsp of
      (2,_,_) -> return (rspBody rsp)
      code    -> httpFail code (rspReason rsp)
  where
    req u = Request {
        rqURI = u,
        rqMethod = GET,
        rqHeaders = [],
        rqBody = ""
      }

-- | Download content specified by a url using curl, returning the content
--   as a strict 'ByteString'.
fetchBytes :: URI -> Shell ByteString
fetchBytes = fetchSomething

-- | Download content specified by a url using curl, returning the content
--   as a 'String'.
fetch :: URI -> Shell String
fetch = fetchSomething

-- | Download content specified by a url using curl, writing the content to
--   the file specified by the given 'FilePath'.
fetchFile :: FilePath -> URI -> Shell ()
fetchFile file = fetchBytes >=> liftIO . BS.writeFile file

-- | Download the content as for 'fetch', but return it as a list of parsed
--   tags using the tagsoup html parser.
fetchTags :: URI -> Shell [Tag String]
fetchTags = fmap parseTags . fetch

-- | Download the content as for 'fetch', but return it as parsed XML, using
--   the xml-light parser.
fetchXML :: URI -> Shell [Content]
fetchXML = fmap parseXML . fetch

-- | Download the content as for 'fetch', but return it as as parsed RSS or
--   Atom content, using the feed library parser.
fetchFeed :: URI -> Shell Feed
fetchFeed uri = do
  str <- fetch uri
  assert ("could not parse feed from `" ++ uri ++ "'") (parseFeedString str)