Skip to content
Snippets Groups Projects
Commit fe801e30 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Convert to using readTextFile as appropriate

Added readBinaryFile for on use (uploading .tar.gz files)
Remove readURI as it was not being used.
parent 576ea5e0
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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
......
......@@ -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 ""
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment