diff --git a/Network/Hackage/CabalInstall/Dependency.hs b/Network/Hackage/CabalInstall/Dependency.hs index 789737fb3eb58b89f2303424b82e2877f273db86..bc939ad04a59e14de4b9be1bab833ae457046b08 100644 --- a/Network/Hackage/CabalInstall/Dependency.hs +++ b/Network/Hackage/CabalInstall/Dependency.hs @@ -144,7 +144,7 @@ getDependency ps (UnresolvedDependency { dependency=dep@(Dependency pkgname vran { fulfilling = dep , resolvedData = Nothing , pkgOptions = opts } - qs -> let PkgInfo pkg deps location _ = maximumBy versions qs + qs -> let PkgInfo { infoId = pkg, infoDeps = deps, infoURL = location } = maximumBy versions qs versions a b = pkgVersion (infoId a) `compare` pkgVersion (infoId b) in ResolvedPackage { fulfilling = dep diff --git a/Network/Hackage/CabalInstall/Fetch.hs b/Network/Hackage/CabalInstall/Fetch.hs index ab4292803a82acd8fd71434cbc388e13146518d8..36e4f653a61bb7b9ee7be14555c20627755ee029 100644 --- a/Network/Hackage/CabalInstall/Fetch.hs +++ b/Network/Hackage/CabalInstall/Fetch.hs @@ -19,6 +19,7 @@ module Network.Hackage.CabalInstall.Fetch , packageFile , packagesDirectory , isFetched + , readURI ) where import Network.URI (URI,parseURI,uriScheme,uriPath) @@ -40,15 +41,27 @@ import Text.ParserCombinators.ReadP (readP_to_S) import Distribution.ParseUtils (parseDependency) +readURI :: URI -> IO String +readURI uri + | uriScheme uri == "file:" = (readFile $ uriPath uri) + | otherwise = do + eitherResult <- simpleHTTP (Request uri GET [] "") + case eitherResult of + Left err -> fail $ printf "Failed to download '%s': %s" (show uri) (show err) + Right rsp + | rspCode rsp == (2,0,0) -> return (rspBody rsp) + | otherwise -> fail $ "Failed to download '" ++ show uri ++ "': Invalid HTTP code: " ++ show (rspCode rsp) + downloadURI :: FilePath -- ^ Where to put it -> URI -- ^ What to download -> IO (Maybe ConnError) -downloadURI path uri | uriScheme uri == "file:" = do - copyFile (uriPath uri) path - return Nothing downloadURI path uri - = do eitherResult <- simpleHTTP request - case eitherResult of + | uriScheme uri == "file:" = do + copyFile (uriPath uri) path + return Nothing + | otherwise = do + eitherResult <- simpleHTTP request + case eitherResult of Left err -> return (Just err) Right rsp | rspCode rsp == (2,0,0) -> writeFile path (rspBody rsp) >> return Nothing @@ -70,7 +83,7 @@ downloadPackage :: ConfigFlags -> PackageIdentifier -> String -> IO String downloadPackage cfg pkg url = do mbError <- downloadFile path url case mbError of - Just err -> error $ printf "Failed to download '%s': %s" (showPackageId pkg) (show err) + Just err -> fail $ printf "Failed to download '%s': %s" (showPackageId pkg) (show err) Nothing -> return path where path = configConfPath cfg `joinFileName` packagesDirectoryName `joinFileName` showPackageId pkg diff --git a/Network/Hackage/Client.hs b/Network/Hackage/Client.hs index 08232e55603265390b1335f5e95018cf41ab47a6..c41f0e8ebe0a70afaefc1b1a6223ff0e6b1d7606 100644 --- a/Network/Hackage/Client.hs +++ b/Network/Hackage/Client.hs @@ -1,5 +1,6 @@ module Network.Hackage.Client where +import Network.URI (URI,parseURI,uriScheme,uriPath) import Distribution.Package import Distribution.PackageDescription import Distribution.Version @@ -8,6 +9,7 @@ import Data.Maybe import Text.ParserCombinators.ReadP import Distribution.ParseUtils import Network.Hackage.CabalInstall.Types +import Network.Hackage.CabalInstall.Fetch (readURI) type PathName = String @@ -62,13 +64,12 @@ getPkgLocation url pkgId = return . Just $ url ++ "/" ++ pathOf pkgId "tar.gz" getServerVersion :: String -> IO Version getServerVersion url = fail "getServerVersion not implemented" -- remote url "getServerVersion" - getFrom :: String -> String -> IO String -getFrom ('f':'i':'l':'e':':':'/':'/':base) path = do - readFile $ base ++ "/" ++ path -getFrom base path = fail $ "Cannot handle " ++ base ++ "/" ++ path - - +getFrom base path = case parseURI uri of + Just parsed -> readURI parsed + Nothing -> fail $ "Failed to parse url: " ++ show uri + where + uri = base ++ "/" ++ path {- isCompatible :: String -> IO Bool