Commit 31af8e27 authored by Duncan Coutts's avatar Duncan Coutts Committed by Alexis Williams
Browse files

Refactor (and rename) fetchAndReadSourcePackages

In preparation for adding support for additional target types (local and
remote tarballs, local and remote source repos), refactor the existing
readSourcePackage action so it can be more easily extended to support
the extra target types.

In particular, having to download things means there are advantages to
handling all the packags in a batch. Indeed for source repos there will
be quite a bit of sharing, so they must be handled as a batch.
parent 42e52bbb
......@@ -33,7 +33,7 @@ module Distribution.Client.ProjectConfig (
BadPackageLocation(..),
BadPackageLocationMatch(..),
findProjectPackages,
readSourcePackage,
fetchAndReadSourcePackages,
-- * Resolving configuration
lookupLocalPackageConfig,
......@@ -571,7 +571,7 @@ reportParseResult verbosity filetype filename (ParseFailed err) =
---------------------------------------------
-- Reading packages in the project
-- Finding packages in the project
--
-- | The location of a package as part of a project. Local file paths are
......@@ -888,19 +888,62 @@ mplusMaybeT ma mb = do
Just x -> return (Just x)
-- | Read the @.cabal@ file of the given package.
-------------------------------------------------
-- Fetching and reading packages in the project
--
-- | Read the @.cabal@ files for a set of packages. For remote tarballs and
-- VCS source repos this also fetches them if needed.
--
-- Note here is where we convert from project-root relative paths to absolute
-- paths.
--
readSourcePackage :: Verbosity -> ProjectPackageLocation
-> Rebuild (PackageSpecifier UnresolvedSourcePackage)
readSourcePackage verbosity (ProjectPackageLocalCabalFile cabalFile) =
readSourcePackage verbosity (ProjectPackageLocalDirectory dir cabalFile)
where
dir = takeDirectory cabalFile
fetchAndReadSourcePackages
:: Verbosity
-> [ProjectPackageLocation]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
fetchAndReadSourcePackages verbosity pkgLocations = do
pkgsLocalDirectory <-
sequence
[ readSourcePackageLocalDirectory verbosity dir cabalFile
| location <- pkgLocations
, (dir, cabalFile) <- projectPackageLocal location ]
unless (null [ path | ProjectPackageLocalTarball path <- pkgLocations ]) $
fail $ "TODO: add support for reading local tarballs"
unless (null [ uri | ProjectPackageRemoteTarball uri <- pkgLocations ]) $
fail $ "TODO: add support for fetching and reading remote tarballs"
readSourcePackage verbosity (ProjectPackageLocalDirectory dir cabalFile) = do
unless (null [ repo | ProjectPackageRemoteRepo repo <- pkgLocations ]) $
fail $ "TODO: add support for fetching and reading remote source repos"
let pkgsNamed =
[ NamedPackage pkgname [PackagePropertyVersion verrange]
| ProjectPackageNamed (Dependency pkgname verrange) <- pkgLocations ]
return $ concat
[ pkgsLocalDirectory
, pkgsNamed
]
where
projectPackageLocal (ProjectPackageLocalDirectory dir file) = [(dir, file)]
projectPackageLocal (ProjectPackageLocalCabalFile file) = [(dir, file)]
where dir = takeDirectory file
projectPackageLocal _ = []
-- | A helper for 'fetchAndReadSourcePackages' to handle the case of
-- 'ProjectPackageLocalDirectory' and 'ProjectPackageLocalCabalFile'.
-- We simply read the @.cabal@ file.
--
readSourcePackageLocalDirectory
:: Verbosity
-> FilePath -- ^ The package directory
-> FilePath -- ^ The package @.cabal@ file
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readSourcePackageLocalDirectory verbosity dir cabalFile = do
monitorFiles [monitorFileHashed cabalFile]
root <- askRoot
pkgdesc <- liftIO $ readGenericPackageDescription verbosity (root </> cabalFile)
......@@ -911,13 +954,6 @@ readSourcePackage verbosity (ProjectPackageLocalDirectory dir cabalFile) = do
packageDescrOverride = Nothing
}
readSourcePackage _ (ProjectPackageNamed (Dependency pkgname verrange)) =
return $ NamedPackage pkgname [PackagePropertyVersion verrange]
readSourcePackage _verbosity _ =
fail $ "TODO: add support for fetching and reading local tarballs, remote "
++ "tarballs, remote repos and passing named packages through"
-- TODO: add something like this, here or in the project planning
-- Based on the package location, which packages will be built inplace in the
......
......@@ -355,7 +355,7 @@ rebuildProjectConfig verbosity
phaseReadLocalPackages :: ProjectConfig
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
phaseReadLocalPackages projectConfig = do
localCabalFiles <- findProjectPackages distDirLayout projectConfig
pkgLocations <- findProjectPackages distDirLayout projectConfig
-- Create folder only if findProjectPackages did not throw a
-- BadPackageLocations exception.
......@@ -363,7 +363,7 @@ rebuildProjectConfig verbosity
createDirectoryIfMissingVerbose verbosity True distDirectory
createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory
mapM (readSourcePackage verbosity) localCabalFiles
fetchAndReadSourcePackages verbosity pkgLocations
-- | Return an up-to-date elaborated install plan.
......
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