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