darcs-benchmark-0.1.9: source/Download.hs

module Download where

import Network.Browser
import Network.URI
import Network.HTTP.Base

import qualified Codec.Archive.Tar as Tar ( read, unpack )
import System.FilePath
import System.Directory
import Codec.Compression.GZip( decompress )
import Control.Monad

baseurl :: String
baseurl = "http://code.haskell.org/darcs/benchmark-repos/"

exists :: FilePath -> IO Bool
exists f =
 do exists_file <- doesFileExist f
    exists_dir  <- doesDirectoryExist f
    return (exists_file || exists_dir)

download :: String -> IO ()
download repo = do
  let Just repo_url   = parseURI $ baseurl  ++ repo ++ ".tgz"
      Just config_url = parseURI $ baseurl  ++ "config" <.> repo
      config_file = "config" <.> repo
  putStrLn $ "downloading and extracting: " ++ show repo_url
  repo_exists   <- exists ("repo" <.> repo)
  config_exists <- exists ("config" <.> repo)
  let go = do rsp <- fetch repo_url
              when (rspCode rsp /= (2, 0, 0)) $
                   fail ("download failed: " ++ rspReason rsp)
              createDirectory $ "repo" <.> repo
              let bits = rspBody rsp
                  entries = Tar.read $ decompress bits
              Tar.unpack ("repo" <.> repo) entries
      go_cfg = do rsp <- fetch config_url
                  case rspCode rsp of
                    (4, 0, 4) -> putStrLn $ "No config file detected for " ++ repo ++ " and that's fine!"
                    (2, 0, 0) -> writeFile ("config" <.> repo) (rspBody rsp)
                    _         -> fail ("download failed: " ++ rspReason rsp)
  if repo_exists
       then putStrLn $ "repo" <.> repo ++ " already exists, fetching config file only."
       else go
  if config_exists
       then putStrLn $ config_file ++ " already exists, skipping!"
       else go_cfg
 where
  fetch url =
    do (_, rsp) <- browse $ do setCheckForProxy True
                               setOutHandler (const $ return ())
                               request (mkRequest GET url)
       return rsp