Commit d1b640ff authored by audreyt@audreyt.org's avatar audreyt@audreyt.org
Browse files

finish interaction with remote HTTP servers

parent 5954e871
......@@ -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
......
......@@ -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
......
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment