diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs index a9c624f06c3e5bcd4aa328db6f9a53896bd176dc..1d6b7e3bc7fc58d366d877d958cb8f47e95107b4 100644 --- a/cabal-install/Hackage/Config.hs +++ b/cabal-install/Hackage/Config.hs @@ -41,8 +41,8 @@ import Distribution.Verbosity (Verbosity, normal) import Hackage.Types (RemoteRepo(..), Repo(..), Username, Password) import Hackage.ParseUtils -import Hackage.Utils (readFileIfExists) -import Distribution.Simple.Utils (notice, warn) +import Hackage.Utils (readTextFileIfExists) +import Distribution.Simple.Utils (notice, warn, writeTextFile) -- @@ -159,7 +159,7 @@ defaultRemoteRepo = loadConfig :: Verbosity -> FilePath -> IO SavedConfig loadConfig verbosity configFile = do defaultConf <- defaultSavedConfig - minp <- readFileIfExists configFile + minp <- readTextFileIfExists configFile case minp of Nothing -> do notice verbosity $ "Config file " ++ configFile ++ " not found." notice verbosity $ "Writing default configuration to " ++ configFile @@ -179,7 +179,7 @@ loadConfig verbosity configFile = writeDefaultConfigFile :: FilePath -> SavedConfig -> IO () writeDefaultConfigFile file cfg = do createDirectoryIfMissing True (takeDirectory file) - writeFile file $ showFields configWriteFieldDescrs cfg ++ "\n" + writeTextFile file $ showFields configWriteFieldDescrs cfg ++ "\n" showConfig :: SavedConfig -> String showConfig = showFields configFieldDescrs diff --git a/cabal-install/Hackage/Fetch.hs b/cabal-install/Hackage/Fetch.hs index ef805ac70385bae2d884bddbf4c4a4c75cfb552c..0c9a8fa1fd3f675fe2fd593b7f08d40d45b55ab6 100644 --- a/cabal-install/Hackage/Fetch.hs +++ b/cabal-install/Hackage/Fetch.hs @@ -17,7 +17,6 @@ module Hackage.Fetch , -- * Utilities fetchPackage , isFetched - , readURI , downloadIndex ) where @@ -48,17 +47,6 @@ import System.Directory (copyFile) import System.IO (IOMode(..), hPutStr, Handle, hClose, openBinaryFile) -readURI :: Verbosity -> URI -> IO String -readURI verbosity uri - | uriScheme uri == "file:" = (readFile $ uriPath uri) - | otherwise = do - eitherResult <- getHTTP verbosity uri - case eitherResult of - Left err -> die $ "Failed to download '" ++ show uri ++ "': " ++ show err - Right rsp - | rspCode rsp == (2,0,0) -> return (rspBody rsp) - | otherwise -> die $ "Failed to download '" ++ show uri ++ "': Invalid HTTP code: " ++ show (rspCode rsp) - downloadURI :: Verbosity -> FilePath -- ^ Where to put it -> URI -- ^ What to download diff --git a/cabal-install/Hackage/Upload.hs b/cabal-install/Hackage/Upload.hs index 34cbd6add8e74b83366610af5dc3ddc6c4d49c98..0b7485019649861edcd877c7fc86651eaef87561 100644 --- a/cabal-install/Hackage/Upload.hs +++ b/cabal-install/Hackage/Upload.hs @@ -18,7 +18,7 @@ import Network.URI (URI, parseURI) import Data.Char (intToDigit) import Numeric (showHex) -import System.IO (hFlush, stdout) +import System.IO (hFlush, stdout, openBinaryFile, IOMode(ReadMode), hGetContents) import System.Random (randomRIO) @@ -80,7 +80,7 @@ handlePackage verbosity uri auth path = mkRequest :: URI -> FilePath -> IO Request mkRequest uri path = - do pkg <- readFile path + do pkg <- readBinaryFile path boundary <- genBoundary let body = printMultiPart boundary (mkFormData path pkg) return $ Request { @@ -92,6 +92,9 @@ mkRequest uri path = rqBody = body } +readBinaryFile :: FilePath -> IO String +readBinaryFile path = openBinaryFile path ReadMode >>= hGetContents + genBoundary :: IO String genBoundary = do i <- randomRIO (0x10000000000000,0xFFFFFFFFFFFFFF) :: IO Integer return $ showHex i "" diff --git a/cabal-install/Hackage/Utils.hs b/cabal-install/Hackage/Utils.hs index bbdf0247ad1b08111d767c56acc7e497ec739b14..e09d61f7217699acdcaa4609eec5e37d84d65584 100644 --- a/cabal-install/Hackage/Utils.hs +++ b/cabal-install/Hackage/Utils.hs @@ -2,16 +2,16 @@ module Hackage.Utils where import Distribution.ParseUtils (showDependency) import Distribution.Version (Dependency(..)) -import Distribution.Simple.Utils (intercalate) +import Distribution.Simple.Utils (intercalate, readTextFile) import Control.Monad (guard) import Control.Exception (Exception, catchJust, ioErrors) import System.IO.Error (isDoesNotExistError) -readFileIfExists :: FilePath -> IO (Maybe String) -readFileIfExists path = +readTextFileIfExists :: FilePath -> IO (Maybe String) +readTextFileIfExists path = catchJust fileNotFoundExceptions - (fmap Just (readFile path)) + (fmap Just (readTextFile path)) (\_ -> return Nothing) fileNotFoundExceptions :: Exception -> Maybe IOError