Commit 2b6cd51a authored by Oleg Grenrus's avatar Oleg Grenrus

Resolve #5586. Treat all packages as remote except LocalUnpackedPackage

Also calculate hashes for all locally available tarballs.
parent 68e9e1aa
......@@ -99,8 +99,8 @@ checkFetched loc = case loc of
return (Just $ RemoteTarballPackage uri file)
RepoTarballPackage repo pkgid (Just file) ->
return (Just $ RepoTarballPackage repo pkgid file)
RemoteSourceRepoPackage repo (Just dir) ->
return (Just $ RemoteSourceRepoPackage repo dir)
RemoteSourceRepoPackage repo (Just file) ->
return (Just $ RemoteSourceRepoPackage repo file)
RemoteTarballPackage _uri Nothing -> return Nothing
RemoteSourceRepoPackage _repo Nothing -> return Nothing
......
......@@ -200,13 +200,8 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
-- artifacts under the shared dist directory.
dryRunLocalPkg pkg depsBuildStatus srcdir
Just (RemoteSourceRepoPackage _repo srcdir) ->
-- At this point, source repos are essentially the same as local
-- dirs, since we've already download them.
dryRunLocalPkg pkg depsBuildStatus srcdir
-- The three tarball cases are handled the same as each other,
-- though depending on the build style.
-- The rest cases are all tarball cases are,
-- and handled the same as each other though depending on the build style.
Just (LocalTarballPackage tarball) ->
dryRunTarballPkg pkg depsBuildStatus tarball
......@@ -216,6 +211,10 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
Just (RepoTarballPackage _ _ tarball) ->
dryRunTarballPkg pkg depsBuildStatus tarball
Just (RemoteSourceRepoPackage _repo tarball) ->
dryRunTarballPkg pkg depsBuildStatus tarball
dryRunTarballPkg :: ElaboratedConfiguredPackage
-> [BuildStatus]
-> FilePath
......
......@@ -127,6 +127,8 @@ import Distribution.Version
( Version )
import qualified Distribution.Deprecated.ParseUtils as OldParser
( ParseResult(..), locatedErrorMsg, showPWarning )
import Distribution.Client.SrcDist
( packageDirToSdist )
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
......@@ -1170,6 +1172,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity
syncSourceRepos verbosity vcs
[ (repo, repoPath)
| (repo, _, repoPath) <- repoGroupWithPaths ]
-- TODO phadej 2020-06-18 add post-sync script
-- But for reading we go through each 'SourceRepo' including its subdir
-- value and have to know which path each one ended up in.
......@@ -1199,24 +1202,30 @@ syncAndReadSourcePackagesRemoteRepos verbosity
: [ pathStem ++ "-" ++ show (i :: Int) | i <- [2..] ]
readPackageFromSourceRepo
:: SourceRepositoryPackage Maybe -> FilePath
:: SourceRepositoryPackage Maybe
-> FilePath
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readPackageFromSourceRepo repo repoPath = do
let packageDir = maybe repoPath (repoPath </>) (srpSubdir repo)
let packageDir :: FilePath
packageDir = maybe repoPath (repoPath </>) (srpSubdir repo)
entries <- liftIO $ getDirectoryContents packageDir
--TODO: wrap exceptions
--TODO: dcoutts 2018-06-23: wrap exceptions
case filter (\e -> takeExtension e == ".cabal") entries of
[] -> liftIO $ throwIO $ NoCabalFileFound packageDir
(_:_:_) -> liftIO $ throwIO $ MultipleCabalFilesFound packageDir
[cabalFileName] -> do
let cabalFilePath = packageDir </> cabalFileName
monitorFiles [monitorFileHashed cabalFilePath]
liftIO $ fmap (mkSpecificSourcePackage location)
. readSourcePackageCabalFile verbosity cabalFilePath
=<< BS.readFile cabalFilePath
where
cabalFilePath = packageDir </> cabalFileName
location = RemoteSourceRepoPackage repo packageDir
gpd <- liftIO $ readSourcePackageCabalFile verbosity cabalFilePath =<< BS.readFile cabalFilePath
-- write sdist tarball, to repoPath-pgkid
tarball <- liftIO $ packageDirToSdist verbosity gpd packageDir
let tarballPath = repoPath ++ "-" ++ prettyShow (packageId gpd) ++ ".tar.gz"
liftIO $ LBS.writeFile tarballPath tarball
let location = RemoteSourceRepoPackage repo tarballPath
return $ mkSpecificSourcePackage location gpd
reportSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> Rebuild a
reportSourceRepoProblems = liftIO . die' verbosity . renderSourceRepoProblems
......@@ -1231,13 +1240,11 @@ syncAndReadSourcePackagesRemoteRepos verbosity
--
mkSpecificSourcePackage :: PackageLocation FilePath
-> GenericPackageDescription
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe FilePath)))
-> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
mkSpecificSourcePackage location pkg =
SpecificSourcePackage SourcePackage
{ srcpkgPackageId = packageId pkg
, srcpkgDescription = pkg
--TODO: it is silly that we still have to use a Maybe FilePath here
, srcpkgSource = fmap Just location
, srcpkgDescrOverride = Nothing
}
......
......@@ -593,6 +593,10 @@ rebuildInstallPlan verbosity
Map.fromList
[ (pkgname, stanzas)
| pkg <- localPackages
-- TODO: misnormer: we should separate
-- builtin/global/inplace/local packages
-- and packages explicitly mentioned in the project
--
, let pkgname = pkgSpecifierTarget pkg
testsEnabled = lookupLocalPackageConfig
packageConfigTests
......@@ -600,12 +604,14 @@ rebuildInstallPlan verbosity
benchmarksEnabled = lookupLocalPackageConfig
packageConfigBenchmarks
projectConfig pkgname
stanzas =
Map.fromList $
isLocal = isJust (shouldBeLocal pkg)
stanzas
| isLocal = Map.fromList $
[ (TestStanzas, enabled)
| enabled <- flagToList testsEnabled ]
++ [ (BenchStanzas , enabled)
| enabled <- flagToList testsEnabled ] ++
[ (BenchStanzas , enabled)
| enabled <- flagToList benchmarksEnabled ]
| otherwise = Map.fromList [(TestStanzas, False), (BenchStanzas, False) ]
]
-- Elaborate the solver's install plan to get a fully detailed plan. This
......@@ -823,10 +829,14 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
-- Tarballs from remote URLs. We must have downloaded these already
-- (since we extracted the .cabal file earlier)
--TODO: [required eventually] finish remote tarball functionality
-- allRemoteTarballPkgs =
-- [ (pkgid, )
-- | (pkgid, RemoteTarballPackage ) <- allPkgLocations ]
remoteTarballPkgs =
[ (pkgid, tarball)
| (pkgid, RemoteTarballPackage _ (Just tarball)) <- allPkgLocations ]
-- tarballs from source-repository-package stanzas
sourceRepoTarballPkgs =
[ (pkgid, tarball)
| (pkgid, RemoteSourceRepoPackage _ (Just tarball)) <- allPkgLocations ]
-- Tarballs from repositories, either where the repository provides
-- hashes as part of the repo metadata, or where we will have to
......@@ -906,6 +916,8 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
--
let allTarballFilePkgs :: [(PackageId, FilePath)]
allTarballFilePkgs = localTarballPkgs
++ remoteTarballPkgs
++ sourceRepoTarballPkgs
++ repoTarballPkgsDownloaded
++ repoTarballPkgsNewlyDownloaded
hashesFromTarballFiles <- liftIO $
......@@ -1925,16 +1937,6 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
Set.fromList (catMaybes (map shouldBeLocal localPackages))
--TODO: localPackages is a misnomer, it's all project packages
-- here is where we decide which ones will be local!
where
shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId
shouldBeLocal NamedPackage{} = Nothing
shouldBeLocal (SpecificSourcePackage pkg)
| LocalTarballPackage _ <- srcpkgSource pkg = Nothing
| otherwise = Just (packageId pkg)
-- TODO: Is it only LocalTarballPackages we can know about without
-- them being "local" in the sense meant here?
--
-- Also, review use of SourcePackage's loc vs ProjectPackageLocation
pkgsUseSharedLibrary :: Set PackageId
pkgsUseSharedLibrary =
......@@ -1995,6 +1997,12 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
-- TODO: Drop matchPlanPkg/matchElabPkg in favor of mkCCMapping
shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId
shouldBeLocal NamedPackage{} = Nothing
shouldBeLocal (SpecificSourcePackage pkg) = case srcpkgSource pkg of
LocalUnpackedPackage _ -> Just (packageId pkg)
_ -> Nothing
-- | Given a 'ElaboratedPlanPackage', report if it matches a 'ComponentName'.
matchPlanPkg :: (ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
matchPlanPkg p = InstallPlan.foldPlanPackage (p . ipiComponentName) (matchElabPkg p)
......
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