Skip to content

Commit

Permalink
Rename fields in SourcePackage
Browse files Browse the repository at this point in the history
Also remove specific field for PackageId, as it is in GPD.
  • Loading branch information
phadej committed Jun 18, 2020
1 parent a6915fe commit 02e4381
Show file tree
Hide file tree
Showing 20 changed files with 88 additions and 92 deletions.
2 changes: 1 addition & 1 deletion cabal-install/Distribution/Client/BuildReports/Storage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
6 changes: 3 additions & 3 deletions cabal-install/Distribution/Client/CmdInstall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
11 changes: 5 additions & 6 deletions cabal-install/Distribution/Client/CmdRepl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
7 changes: 3 additions & 4 deletions cabal-install/Distribution/Client/CmdRun.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/CmdSdist.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
13 changes: 6 additions & 7 deletions cabal-install/Distribution/Client/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down
17 changes: 8 additions & 9 deletions cabal-install/Distribution/Client/Dependency.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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.
Expand Down
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/Fetch.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down
6 changes: 3 additions & 3 deletions cabal-install/Distribution/Client/Get.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
15 changes: 7 additions & 8 deletions cabal-install/Distribution/Client/IndexUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/Init/Heuristics.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand Down Expand Up @@ -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
]

Expand Down
8 changes: 4 additions & 4 deletions cabal-install/Distribution/Client/Install.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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. "
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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 {
Expand Down
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/InstallSymlink.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/List.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 {
Expand Down
15 changes: 7 additions & 8 deletions cabal-install/Distribution/Client/ProjectConfig.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down
Loading

0 comments on commit 02e4381

Please sign in to comment.