From 02e438136a52b91f05db73758b2b05f90a54b925 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 18 Jun 2020 11:24:37 +0300 Subject: [PATCH] Rename fields in SourcePackage Also remove specific field for PackageId, as it is in GPD. --- .../Client/BuildReports/Storage.hs | 2 +- .../Distribution/Client/CmdInstall.hs | 6 ++--- cabal-install/Distribution/Client/CmdRepl.hs | 11 +++++----- cabal-install/Distribution/Client/CmdRun.hs | 7 +++--- cabal-install/Distribution/Client/CmdSdist.hs | 4 ++-- .../Distribution/Client/Configure.hs | 13 +++++------ .../Distribution/Client/Dependency.hs | 17 +++++++------- cabal-install/Distribution/Client/Fetch.hs | 4 ++-- cabal-install/Distribution/Client/Get.hs | 6 ++--- .../Distribution/Client/IndexUtils.hs | 15 ++++++------- .../Distribution/Client/Init/Heuristics.hs | 4 ++-- cabal-install/Distribution/Client/Install.hs | 8 +++---- .../Distribution/Client/InstallSymlink.hs | 4 ++-- cabal-install/Distribution/Client/List.hs | 4 ++-- .../Distribution/Client/ProjectConfig.hs | 15 ++++++------- .../Distribution/Client/ProjectPlanning.hs | 16 +++++++++----- .../Distribution/Client/TargetSelector.hs | 4 ++-- cabal-install/Distribution/Client/Targets.hs | 22 +++++++++---------- .../Solver/Modular/IndexConversion.hs | 5 +++-- .../Solver/Types/SourcePackage.hs | 13 +++++------ 20 files changed, 88 insertions(+), 92 deletions(-) diff --git a/cabal-install/Distribution/Client/BuildReports/Storage.hs b/cabal-install/Distribution/Client/BuildReports/Storage.hs index 039dd7bdd08..61a882cf3b1 100644 --- a/cabal-install/Distribution/Client/BuildReports/Storage.hs +++ b/cabal-install/Distribution/Client/BuildReports/Storage.hs @@ -148,7 +148,7 @@ fromPlanPackage (Platform arch os) comp buildResult , extractRepo srcPkg) where - extractRepo (SourcePackage { packageSource = RepoTarballPackage repo _ _ }) + extractRepo (SourcePackage { srcpkgSource = RepoTarballPackage repo _ _ }) = Just repo extractRepo _ = Nothing diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 946cb145335..f4bde8a3f1f 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -443,11 +443,11 @@ getSpecsAndTargetSelectors verbosity reducedVerbosity pkgDb targetSelectors loca planMap = InstallPlan.toMap elaboratedPlan targetIds = Map.keys targets - sdistize (SpecificSourcePackage spkg@SourcePackage{..}) = + sdistize (SpecificSourcePackage spkg) = SpecificSourcePackage spkg' where - sdistPath = distSdistFile localDistDirLayout packageInfoId - spkg' = spkg { packageSource = LocalTarballPackage sdistPath } + sdistPath = distSdistFile localDistDirLayout (packageId spkg) + spkg' = spkg { srcpkgSource = LocalTarballPackage sdistPath } sdistize named = named local = sdistize <$> localPackages localBaseCtx diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 71d811102b4..e4f28b09714 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -360,10 +360,9 @@ withoutProject config verbosity extraArgs = do -- We need to create a dummy package that lives in our dummy project. let sourcePackage = SourcePackage - { packageInfoId = pkgId - , packageDescription = genericPackageDescription - , packageSource = LocalUnpackedPackage tempDir - , packageDescrOverride = Nothing + { srcpkgDescription = genericPackageDescription + , srcpkgSource = LocalUnpackedPackage tempDir + , srcpkgDescrOverride = Nothing } genericPackageDescription = emptyGenericPackageDescription & L.packageDescription .~ packageDescription @@ -414,8 +413,8 @@ addDepsToProjectTarget deps pkgId ctx = addDeps (SpecificSourcePackage pkg) | packageId pkg /= pkgId = SpecificSourcePackage pkg | SourcePackage{..} <- pkg = - SpecificSourcePackage $ pkg { packageDescription = - packageDescription & (\f -> L.allCondTrees $ traverseCondTreeC f) + SpecificSourcePackage $ pkg { srcpkgDescription = + srcpkgDescription & (\f -> L.allCondTrees $ traverseCondTreeC f) %~ (deps ++) } addDeps spec = spec diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 48e895769d0..6576854c2b7 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -406,10 +406,9 @@ handleScriptCase verbosity pol baseCtx tmpDir scriptContents = do LiterateHaskell -> "Main.lhs" sourcePackage = SourcePackage - { packageInfoId = pkgId - , SP.packageDescription = genericPackageDescription - , packageSource = LocalUnpackedPackage tmpDir - , packageDescrOverride = Nothing + { srcpkgDescription = genericPackageDescription + , srcpkgSource = LocalUnpackedPackage tmpDir + , srcpkgDescrOverride = Nothing } genericPackageDescription = emptyGenericPackageDescription { GPD.packageDescription = packageDescription diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index ec268a55533..5d88b2bf2c7 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -228,7 +228,7 @@ data OutputFormat = SourceList Char packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () packageToSdist verbosity projectRootDir format outputFile pkg = do let death = die' verbosity ("The impossible happened: a local package isn't local" <> (show pkg)) - dir0 <- case packageSource pkg of + dir0 <- case srcpkgSource pkg of LocalUnpackedPackage path -> pure (Right path) RemoteSourceRepoPackage _ (Just path) -> pure (Right path) RemoteSourceRepoPackage {} -> death @@ -256,7 +256,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do _ -> die' verbosity ("cannot convert tarball package to " ++ show format) Right dir -> do - files' <- listPackageSources verbosity dir (flattenPackageDescription $ packageDescription pkg) knownSuffixHandlers + files' <- listPackageSources verbosity dir (flattenPackageDescription $ srcpkgDescription pkg) knownSuffixHandlers let files = nub $ sort $ map normalise files' case format of diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index be6f5e3986d..3bda480cab6 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -140,7 +140,7 @@ configure verbosity packageDBs repoCtxt comp platform progdb let installPlan = InstallPlan.configureInstallPlan configFlags installPlan0 in case fst (InstallPlan.ready installPlan) of [pkg@(ReadyPackage - (ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _) + (ConfiguredPackage _ (SourcePackage _ (LocalUnpackedPackage _) _) _ _ _))] -> do configurePackage verbosity platform (compilerInfo comp) @@ -238,7 +238,7 @@ configureSetupScript packageDBs maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo maybeSetupBuildInfo = do ReadyPackage cpkg <- mpkg - let gpkg = packageDescription (confPkgSource cpkg) + let gpkg = srcpkgDescription (confPkgSource cpkg) PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg) -- Was a default 'custom-setup' stanza added by 'cabal-install' itself? If @@ -305,10 +305,9 @@ planLocalPackage verbosity comp platform configFlags configExFlags let -- We create a local package and ask to resolve a dependency on it localPkg = SourcePackage { - packageInfoId = packageId pkg, - packageDescription = pkg, - packageSource = LocalUnpackedPackage ".", - packageDescrOverride = Nothing + srcpkgDescription = pkg, + srcpkgSource = LocalUnpackedPackage ".", + srcpkgDescrOverride = Nothing } testsEnabled = fromFlagOrDefault False $ configTests configFlags @@ -392,7 +391,7 @@ configurePackage verbosity platform comp scriptOptions configFlags scriptOptions (Just pkg) configureCommand configureFlags (const extraArgs) where - gpkg = packageDescription spkg + gpkg = srcpkgDescription spkg configureFlags = filterConfigureFlags configFlags { configIPID = if isJust (flagToMaybe (configIPID configFlags)) -- Make sure cabal configure --ipid works. diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index 07c23ccf2b7..784deae00c4 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -466,9 +466,8 @@ removeBounds relKind relDeps params = sourcePkgIndex' = fmap relaxDeps $ depResolverSourcePkgIndex params relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage - relaxDeps srcPkg = srcPkg { - packageDescription = relaxPackageDeps relKind relDeps - (packageDescription srcPkg) + relaxDeps srcPkg = srcPkg + { srcpkgDescription = relaxPackageDeps relKind relDeps (srcpkgDescription srcPkg) } -- | Relax the dependencies of this package if needed. @@ -543,7 +542,7 @@ addDefaultSetupDependencies defaultSetupDeps params = applyDefaultSetupDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage applyDefaultSetupDeps srcpkg = srcpkg { - packageDescription = gpkgdesc { + srcpkgDescription = gpkgdesc { PD.packageDescription = pkgdesc { PD.setupBuildInfo = case PD.setupBuildInfo pkgdesc of @@ -560,7 +559,7 @@ addDefaultSetupDependencies defaultSetupDeps params = } where isCustom = PD.buildType pkgdesc == PD.Custom - gpkgdesc = packageDescription srcpkg + gpkgdesc = srcpkgDescription srcpkg pkgdesc = PD.packageDescription gpkgdesc -- | If a package has a custom setup then we need to add a setup-depends @@ -656,7 +655,7 @@ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers Just [Dependency (mkPackageName "Cabal") (orLaterVersion $ mkVersion [1,24]) mainLibSet] | otherwise = Nothing where - gpkgdesc = packageDescription srcpkg + gpkgdesc = srcpkgDescription srcpkg pkgdesc = PD.packageDescription gpkgdesc bt = PD.buildType pkgdesc affected = bt == PD.Custom && hasBuildableFalse gpkgdesc @@ -902,7 +901,7 @@ configuredPackageProblems platform cinfo , not (packageSatisfiesDependency pkgid dep) ] -- TODO: sanity tests on executable deps where - thisPkgName = packageName (packageDescription pkg) + thisPkgName = packageName (srcpkgDescription pkg) specifiedDeps1 :: ComponentDeps [PackageId] specifiedDeps1 = fmap (map solverSrcId) specifiedDeps0 @@ -911,7 +910,7 @@ configuredPackageProblems platform cinfo specifiedDeps = CD.flatDeps specifiedDeps1 mergedFlags = mergeBy compare - (sort $ map PD.flagName (PD.genPackageFlags (packageDescription pkg))) + (sort $ map PD.flagName (PD.genPackageFlags (srcpkgDescription pkg))) (sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO packageSatisfiesDependency @@ -948,7 +947,7 @@ configuredPackageProblems platform cinfo (const True) platform cinfo [] - (packageDescription pkg) of + (srcpkgDescription pkg) of Right (resolvedPkg, _) -> -- we filter self/internal dependencies. They are still there. -- This is INCORRECT. diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs index d2f3bc94aa4..21d53180007 100644 --- a/cabal-install/Distribution/Client/Fetch.hs +++ b/cabal-install/Distribution/Client/Fetch.hs @@ -95,7 +95,7 @@ fetch verbosity packageDBs repoCtxt comp platform progdb verbosity comp platform fetchFlags installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers - pkgs' <- filterM (fmap not . isFetched . packageSource) pkgs + pkgs' <- filterM (fmap not . isFetched . srcpkgSource) pkgs if null pkgs' --TODO: when we add support for remote tarballs then this message -- will need to be changed because for remote tarballs we fetch them @@ -108,7 +108,7 @@ fetch verbosity packageDBs repoCtxt comp platform progdb "The following packages would be fetched:" : map (prettyShow . packageId) pkgs' - else traverse_ (fetchPackage verbosity repoCtxt . packageSource) pkgs' + else traverse_ (fetchPackage verbosity repoCtxt . srcpkgSource) pkgs' where dryRun = fromFlag (fetchDryRun fetchFlags) diff --git a/cabal-install/Distribution/Client/Get.hs b/cabal-install/Distribution/Client/Get.hs index cd569d3358f..244b5c4c5da 100644 --- a/cabal-install/Distribution/Client/Get.hs +++ b/cabal-install/Distribution/Client/Get.hs @@ -114,15 +114,15 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do packageSourceRepos :: SourcePackage loc -> [PD.SourceRepo] packageSourceRepos = PD.sourceRepos . PD.packageDescription - . packageDescription + . srcpkgDescription unpack :: [UnresolvedSourcePackage] -> IO () unpack pkgs = do for_ pkgs $ \pkg -> do - location <- fetchPackage verbosity repoCtxt (packageSource pkg) + location <- fetchPackage verbosity repoCtxt (srcpkgSource pkg) let pkgid = packageId pkg descOverride | usePristine = Nothing - | otherwise = packageDescrOverride pkg + | otherwise = srcpkgDescrOverride pkg case location of LocalTarballPackage tarballPath -> unpackPackage verbosity prefix pkgid descOverride tarballPath diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs index 11906d96c3d..4cd79f38aeb 100644 --- a/cabal-install/Distribution/Client/IndexUtils.hs +++ b/cabal-install/Distribution/Client/IndexUtils.hs @@ -364,19 +364,18 @@ readRepoIndex verbosity repoCtxt repo idxState = idxState where - mkAvailablePackage pkgEntry = - SourcePackage { - packageInfoId = pkgid, - packageDescription = packageDesc pkgEntry, - packageSource = case pkgEntry of + mkAvailablePackage pkgEntry = SourcePackage + { srcpkgDescription = pkgdesc + , srcpkgSource = case pkgEntry of NormalPackage _ _ _ _ -> RepoTarballPackage repo pkgid Nothing - BuildTreeRef _ _ _ path _ -> LocalUnpackedPackage path, - packageDescrOverride = case pkgEntry of + BuildTreeRef _ _ _ path _ -> LocalUnpackedPackage path + , srcpkgDescrOverride = case pkgEntry of NormalPackage _ _ pkgtxt _ -> Just pkgtxt _ -> Nothing } where - pkgid = packageId pkgEntry + pkgdesc = packageDesc pkgEntry + pkgid = packageId pkgdesc handleNotFound action = catchIO action $ \e -> if isDoesNotExistError e then do diff --git a/cabal-install/Distribution/Client/Init/Heuristics.hs b/cabal-install/Distribution/Client/Init/Heuristics.hs index 1726dd06a68..cff114a3503 100644 --- a/cabal-install/Distribution/Client/Init/Heuristics.hs +++ b/cabal-install/Distribution/Client/Init/Heuristics.hs @@ -37,7 +37,7 @@ import Language.Haskell.Extension ( Extension ) import Distribution.Solver.Types.PackageIndex ( allPackagesByName ) import Distribution.Solver.Types.SourcePackage - ( packageDescription ) + ( srcpkgDescription ) import Distribution.Client.Types ( SourcePackageDb(..) ) import Data.Char ( isLower ) @@ -344,7 +344,7 @@ maybeReadFile f = do knownCategories :: SourcePackageDb -> [String] knownCategories (SourcePackageDb sourcePkgIndex _) = nubSet [ cat | pkg <- maybeToList . safeHead =<< (allPackagesByName sourcePkgIndex) - , let catList = (PD.category . PD.packageDescription . packageDescription) pkg + , let catList = (PD.category . PD.packageDescription . srcpkgDescription) pkg , cat <- splitString ',' $ ShortText.fromShortText catList ] diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 7652a3db9f2..9679d5163ee 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -572,8 +572,8 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb when offline $ do let pkgs = [ confPkgSource cpkg | InstallPlan.Configured cpkg <- InstallPlan.toList installPlan ] - notFetched <- fmap (map packageInfoId) - . filterM (fmap isNothing . checkFetched . packageSource) + notFetched <- fmap (map packageId) + . filterM (fmap isNothing . checkFetched . srcpkgSource) $ pkgs unless (null notFetched) $ die' verbosity $ "Can't download packages in offline mode. " @@ -692,7 +692,7 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of nonDefaultFlags cpkg = let defaultAssignment = toFlagAssignment - (genPackageFlags (SourcePackage.packageDescription $ + (genPackageFlags (SourcePackage.srcpkgDescription $ confPkgSource cpkg)) in confPkgFlags cpkg `diffFlagAssignment` defaultAssignment @@ -1189,7 +1189,7 @@ installReadyPackage :: Platform -> CompilerInfo -> a installReadyPackage platform cinfo configFlags (ReadyPackage (ConfiguredPackage ipid - (SourcePackage _ gpkg source pkgoverride) + (SourcePackage gpkg source pkgoverride) flags stanzas deps)) installPkg = installPkg configFlags { diff --git a/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal-install/Distribution/Client/InstallSymlink.hs index 0c3c390794f..45ad38ebe81 100644 --- a/cabal-install/Distribution/Client/InstallSymlink.hs +++ b/cabal-install/Distribution/Client/InstallSymlink.hs @@ -134,11 +134,11 @@ symlinkBinaries platform comp overwritePolicy , exe <- PackageDescription.executables pkg , PackageDescription.buildable (PackageDescription.buildInfo exe) ] - pkgDescription (ConfiguredPackage _ (SourcePackage _ pkg _ _) + pkgDescription (ConfiguredPackage _ (SourcePackage gpd _ _) flags stanzas _) = case finalizePD flags (enableStanzas stanzas) (const True) - platform cinfo [] pkg of + platform cinfo [] gpd of Left _ -> error "finalizePD ReadyPackage failed" Right (desc, _) -> desc diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs index d1bc5449ca7..fd792b6845d 100644 --- a/cabal-install/Distribution/Client/List.hs +++ b/cabal-install/Distribution/Client/List.hs @@ -507,7 +507,7 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer = sourceSelected | isJust selectedPkg = selectedPkg | otherwise = latestWithPref versionPref sourcePkgs - sourceGeneric = fmap packageDescription sourceSelected + sourceGeneric = fmap srcpkgDescription sourceSelected source = fmap flattenPackageDescription sourceGeneric uncons :: b -> (a -> b) -> [a] -> b @@ -521,7 +521,7 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer = -- updateFileSystemPackageDetails :: PackageDisplayInfo -> IO PackageDisplayInfo updateFileSystemPackageDetails pkginfo = do - fetched <- maybe (return False) (isFetched . packageSource) + fetched <- maybe (return False) (isFetched . srcpkgSource) (selectedSourcePkg pkginfo) docsExist <- doesDirectoryExist (haddockHtml pkginfo) return pkginfo { diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index ecf71d516ae..1dcf9770f69 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -88,7 +88,7 @@ import Distribution.Solver.Types.PackageConstraint ( PackageProperty(..) ) import Distribution.Package - ( PackageName, PackageId, packageId, UnitId ) + ( PackageName, PackageId, UnitId ) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint(..) ) import Distribution.System @@ -1234,13 +1234,12 @@ mkSpecificSourcePackage :: PackageLocation FilePath -> PackageSpecifier (SourcePackage (PackageLocation (Maybe FilePath))) mkSpecificSourcePackage location pkg = - SpecificSourcePackage SourcePackage { - packageInfoId = packageId pkg, - packageDescription = pkg, - --TODO: it is silly that we still have to use a Maybe FilePath here - packageSource = fmap Just location, - packageDescrOverride = Nothing - } + SpecificSourcePackage SourcePackage + { srcpkgDescription = pkg + --TODO: it is silly that we still have to use a Maybe FilePath here + , srcpkgSource = fmap Just location + , srcpkgDescrOverride = Nothing + } -- | Errors reported upon failing to parse a @.cabal@ file. diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 70e45cd02aa..c1ebb3f2092 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -789,7 +789,7 @@ getPkgConfigDb verbosity progdb = do packageLocationsSignature :: SolverInstallPlan -> [(PackageId, PackageLocation (Maybe FilePath))] packageLocationsSignature solverPlan = - [ (packageId pkg, packageSource pkg) + [ (packageId pkg, srcpkgSource pkg) | SolverInstallPlan.Configured (SolverPackage { solverPkgSource = pkg}) <- SolverInstallPlan.toList solverPlan ] @@ -810,7 +810,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do -- let allPkgLocations :: [(PackageId, PackageLocation (Maybe FilePath))] allPkgLocations = - [ (packageId pkg, packageSource pkg) + [ (packageId pkg, srcpkgSource pkg) | SolverInstallPlan.Configured (SolverPackage { solverPkgSource = pkg}) <- SolverInstallPlan.toList solverPlan ] @@ -995,7 +995,7 @@ planPackages verbosity comp platform solver SolverSettings{..} . addDefaultSetupDependencies (defaultSetupDeps comp platform . PD.packageDescription - . packageDescription) + . srcpkgDescription) . addSetupCabalMinVersionConstraint setupMinCabalVersionConstraint . addSetupCabalMaxVersionConstraint setupMaxCabalVersionConstraint @@ -1616,7 +1616,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB -> [ElaboratedConfiguredPackage] -> ElaboratedConfiguredPackage elaborateSolverToPackage - pkg@(SolverPackage (SourcePackage pkgid _gdesc _srcloc _descOverride) + pkg@(SolverPackage (SourcePackage gpd _srcloc _descOverride) _flags _stanzas _deps0 _exe_deps0) compGraph comps = -- Knot tying: the final elab includes the @@ -1624,6 +1624,8 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB -- of the other fields of the elaboratedPackage. elab where + pkgid = packageId gpd + elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon pkg elab1 = elab0 { elabUnitId = newSimpleUnitId pkgInstalledId, @@ -1704,10 +1706,12 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elaborateSolverToCommon :: SolverPackage UnresolvedPkgLoc -> ElaboratedConfiguredPackage elaborateSolverToCommon - pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride) + pkg@(SolverPackage (SourcePackage gdesc srcloc descOverride) flags stanzas deps0 _exe_deps0) = elaboratedPackage where + pkgid = packageId gdesc + elaboratedPackage = ElaboratedConfiguredPackage {..} -- These get filled in later @@ -1929,7 +1933,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId shouldBeLocal NamedPackage{} = Nothing shouldBeLocal (SpecificSourcePackage pkg) - | LocalTarballPackage _ <- packageSource pkg = Nothing + | 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? diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index e08cdc92347..df01de1f25f 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal-install/Distribution/Client/TargetSelector.hs @@ -1781,8 +1781,8 @@ collectKnownPackageInfo _ (NamedPackage pkgname _props) = return (KnownPackageName pkgname) collectKnownPackageInfo dirActions@DirActions{..} (SpecificSourcePackage SourcePackage { - packageDescription = pkg, - packageSource = loc + srcpkgDescription = pkg, + srcpkgSource = loc }) = do (pkgdir, pkgfile) <- case loc of diff --git a/cabal-install/Distribution/Client/Targets.hs b/cabal-install/Distribution/Client/Targets.hs index 71bb7f30fc3..9040da41be7 100644 --- a/cabal-install/Distribution/Client/Targets.hs +++ b/cabal-install/Distribution/Client/Targets.hs @@ -419,12 +419,11 @@ readPackageTarget verbosity = traverse modifyLocation LocalUnpackedPackage dir -> do pkg <- tryFindPackageDesc verbosity dir (localPackageError dir) >>= readGenericPackageDescription verbosity - return $ SourcePackage { - packageInfoId = packageId pkg, - packageDescription = pkg, - packageSource = fmap Just location, - packageDescrOverride = Nothing - } + return SourcePackage + { srcpkgDescription = pkg + , srcpkgSource = fmap Just location + , srcpkgDescrOverride = Nothing + } LocalTarballPackage tarballFile -> readTarballPackageTarget location tarballFile tarballFile @@ -451,12 +450,11 @@ readPackageTarget verbosity = traverse modifyLocation Nothing -> die' verbosity $ "Could not parse the cabal file " ++ filename ++ " in " ++ tarballFile Just pkg -> - return $ SourcePackage { - packageInfoId = packageId pkg, - packageDescription = pkg, - packageSource = fmap Just location, - packageDescrOverride = Nothing - } + return SourcePackage + { srcpkgDescription = pkg + , srcpkgSource = fmap Just location + , srcpkgDescrOverride = Nothing + } extractTarballPackageCabalFile :: FilePath -> String -> IO (FilePath, BS.ByteString) diff --git a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index c16aa665b07..0023f12c16d 100644 --- a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -162,8 +162,9 @@ convSPI' os arch cinfo constraints strfl solveExes = -- | Convert a single source package into the solver-specific format. convSP :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint] -> StrongFlags -> SolveExecutables -> SourcePackage loc -> (PN, I, PInfo) -convSP os arch cinfo constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) = - let i = I pv InRepo +convSP os arch cinfo constraints strfl solveExes (SourcePackage gpd _ _pl) = + let PackageIdentifier pn pv = packageId gpd + i = I pv InRepo pkgConstraints = fromMaybe [] $ M.lookup pn constraints in (pn, i, convGPD os arch cinfo pkgConstraints strfl solveExes pn gpd) diff --git a/cabal-install/Distribution/Solver/Types/SourcePackage.hs b/cabal-install/Distribution/Solver/Types/SourcePackage.hs index c7379c753a3..40e4dba8722 100644 --- a/cabal-install/Distribution/Solver/Types/SourcePackage.hs +++ b/cabal-install/Distribution/Solver/Types/SourcePackage.hs @@ -9,7 +9,7 @@ import Distribution.Solver.Compat.Prelude import Prelude () import Distribution.Package - ( PackageId, Package(..) ) + ( Package(..) ) import Distribution.PackageDescription ( GenericPackageDescription(..) ) @@ -17,18 +17,17 @@ import Data.ByteString.Lazy (ByteString) -- | A package description along with the location of the package sources. -- -data SourcePackage loc = SourcePackage { - packageInfoId :: PackageId, - packageDescription :: GenericPackageDescription, - packageSource :: loc, - packageDescrOverride :: PackageDescriptionOverride +data SourcePackage loc = SourcePackage + { srcpkgDescription :: GenericPackageDescription + , srcpkgSource :: loc + , srcpkgDescrOverride :: PackageDescriptionOverride } deriving (Eq, Show, Generic, Typeable) instance Binary loc => Binary (SourcePackage loc) instance Structured loc => Structured (SourcePackage loc) -instance Package (SourcePackage a) where packageId = packageInfoId +instance Package (SourcePackage a) where packageId = packageId . srcpkgDescription -- | We sometimes need to override the .cabal file in the tarball with -- the newer one from the package index.