Skip to content

Commit 6329c91

Browse files
committed
refactor(cabal-install): rename, format and comment
1 parent 36c8195 commit 6329c91

File tree

1 file changed

+86
-65
lines changed

1 file changed

+86
-65
lines changed

cabal-install/src/Distribution/Client/ProjectPlanning.hs

Lines changed: 86 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -1706,21 +1706,33 @@ elaborateInstallPlan
17061706
=> (SolverId -> [ElaboratedPlanPackage])
17071707
-> SolverPackage UnresolvedPkgLoc
17081708
-> LogProgress [ElaboratedConfiguredPackage]
1709-
elaborateSolverToComponents mapDep spkg@SolverPackage{solverPkgStage, solverPkgLibDeps, solverPkgExeDeps} =
1709+
elaborateSolverToComponents
1710+
mapDep
1711+
solverPkg@SolverPackage{solverPkgStage, solverPkgLibDeps, solverPkgExeDeps} =
17101712
case mkComponentsGraph (elabEnabledSpec elab0) pd of
1713+
Left cns ->
1714+
dieProgress $
1715+
hang
1716+
(text "Dependency cycle between the following components:")
1717+
4
1718+
(vcat (map (text . componentNameStanza) cns))
17111719
Right g -> do
17121720
let src_comps = componentsGraphToList g
1721+
17131722
infoProgress $
17141723
hang
1715-
(text "Component graph for" <+> pretty (solverId (ResolverPackage.Configured spkg)))
1724+
(text "Component graph for" <+> pretty (solverId (ResolverPackage.Configured solverPkg)))
17161725
4
17171726
(dispComponentsWithDeps src_comps)
1727+
17181728
(_, comps) <-
17191729
mapAccumM
17201730
buildComponent
17211731
(Map.empty, Map.empty, Map.empty)
17221732
(map fst src_comps)
1733+
17231734
let whyNotPerComp = why_not_per_component src_comps
1735+
17241736
case NE.nonEmpty whyNotPerComp of
17251737
Nothing ->
17261738
return comps
@@ -1729,18 +1741,13 @@ elaborateInstallPlan
17291741
pkgComp <-
17301742
elaborateSolverToPackage
17311743
notPerCompReasons
1732-
spkg
1744+
solverPkg
17331745
g
17341746
(comps ++ maybeToList setupComponent)
17351747
return [pkgComp]
1736-
Left cns ->
1737-
dieProgress $
1738-
hang
1739-
(text "Dependency cycle between the following components:")
1740-
4
1741-
(vcat (map (text . componentNameStanza) cns))
17421748
where
17431749
bt = PD.buildType (elabPkgDescription elab0)
1750+
17441751
-- You are eligible to per-component build if this list is empty
17451752
why_not_per_component g =
17461753
cuz_buildtype ++ cuz_spec ++ cuz_length ++ cuz_flag
@@ -1793,7 +1800,7 @@ elaborateInstallPlan
17931800
<+> fsep (punctuate comma $ map (text . whyNotPerComponent) $ toList reasons)
17941801
-- TODO: Maybe exclude Backpack too
17951802

1796-
elab0 = elaborateSolverToCommon spkg
1803+
elab0 = elaborateSolverToCommon solverPkg
17971804
pkgid = elabPkgSourceId elab0
17981805
pd = elabPkgDescription elab0
17991806

@@ -1866,6 +1873,7 @@ elaborateInstallPlan
18661873
[ text "lib_dep_map:" <+> Disp.hsep (punctuate comma $ map pretty (Map.keys lib_dep_map))
18671874
, text "exe_dep_map:" <+> Disp.hsep (punctuate comma $ map pretty (Map.keys exe_dep_map))
18681875
]
1876+
18691877
cc0 <-
18701878
toConfiguredComponent
18711879
pd
@@ -2000,14 +2008,16 @@ elaborateInstallPlan
20002008
, elabPkgOrComp =
20012009
ElabComponent $
20022010
elab_comp
2003-
{ compLinkedLibDependencies = ordNub (map ci_id (lc_includes lc))
2011+
{ compLinkedLibDependencies =
2012+
ordNub (map ci_id (lc_includes lc))
20042013
, compOrderLibDependencies =
20052014
ordNub
20062015
( map
20072016
(abstractUnitId . ci_id)
20082017
(lc_includes lc ++ lc_sig_includes lc)
20092018
)
2010-
, compLinkedInstantiatedWith = Map.fromList (lc_insts lc)
2019+
, compLinkedInstantiatedWith =
2020+
Map.fromList (lc_insts lc)
20112021
}
20122022
}
20132023
elab =
@@ -2041,14 +2051,17 @@ elaborateInstallPlan
20412051
[ (getComponentId pkg, planPackageExePaths pkg)
20422052
| pkg <- external_exe_dep_pkgs
20432053
]
2054+
20442055
exe_map1 = Map.union external_exe_map $ fmap (\x -> [x]) exe_map
20452056

20462057
external_lib_cc_map =
20472058
Map.fromListWith Map.union $
20482059
map mkCCMapping external_lib_dep_pkgs
2060+
20492061
external_exe_cc_map =
20502062
Map.fromListWith Map.union $
20512063
map mkCCMapping external_exe_dep_pkgs
2064+
20522065
external_lc_map =
20532066
Map.fromList $
20542067
map mkShapeMapping $
@@ -2127,7 +2140,7 @@ elaborateInstallPlan
21272140
-> LogProgress ElaboratedConfiguredPackage
21282141
elaborateSolverToPackage
21292142
pkgWhyNotPerComponent
2130-
pkg@SolverPackage {solverPkgSource = SourcePackage {srcpkgPackageId}}
2143+
solverPkg@SolverPackage {solverPkgSource = SourcePackage {srcpkgPackageId}}
21312144
compGraph
21322145
comps = do
21332146
-- Knot tying: the final elab includes the
@@ -2139,23 +2152,13 @@ elaborateInstallPlan
21392152
{ elabPkgSourceHash
21402153
, elabStanzasRequested
21412154
, elabStage
2142-
} = elaborateSolverToCommon pkg
2155+
} = elaborateSolverToCommon solverPkg
21432156

21442157
elab1 =
21452158
elab0
21462159
{ elabUnitId = newSimpleUnitId pkgInstalledId
21472160
, elabComponentId = pkgInstalledId
2148-
, elabPkgOrComp = ElabPackage $ ElaboratedPackage
2149-
{ pkgStage = elabStage
2150-
, pkgInstalledId
2151-
, pkgLibDependencies
2152-
, pkgDependsOnSelfLib
2153-
, pkgExeDependencies
2154-
, pkgExeDependencyPaths
2155-
, pkgPkgConfigDependencies
2156-
, pkgStanzasEnabled
2157-
, pkgWhyNotPerComponent
2158-
}
2161+
, elabPkgOrComp = ElabPackage elabPkg
21592162
, elabModuleShape = modShape
21602163
}
21612164

@@ -2174,7 +2177,7 @@ elaborateInstallPlan
21742177
Just e -> Ty.elabModuleShape e
21752178

21762179
pkgInstalledId
2177-
| shouldBuildInplaceOnly pkg =
2180+
| shouldBuildInplaceOnly solverPkg =
21782181
mkComponentId (prettyShow srcpkgPackageId)
21792182
| otherwise =
21802183
assert (isJust elabPkgSourceHash) $
@@ -2189,19 +2192,31 @@ elaborateInstallPlan
21892192
isExternal confid = confSrcId confid /= srcpkgPackageId
21902193
isExternal' (WithStage stage confId) = stage /= elabStage || isExternal confId
21912194

2192-
pkgLibDependencies =
2193-
buildComponentDeps (filter (isExternal . fst) . compLibDependencies)
2194-
2195-
pkgExeDependencies =
2196-
buildComponentDeps (filter isExternal' . compExeDependencies)
2197-
2198-
pkgExeDependencyPaths =
2199-
buildComponentDeps (filter (isExternal' . fst) . compExeDependencyPaths)
2200-
2201-
-- TODO: Why is this flat?
2202-
pkgPkgConfigDependencies =
2203-
CD.flatDeps $ buildComponentDeps compPkgConfigDependencies
2195+
elabPkg = ElaboratedPackage
2196+
{ pkgStage = elabStage
2197+
, pkgInstalledId
2198+
, pkgLibDependencies = buildComponentDeps (filter (isExternal . fst) . compLibDependencies)
2199+
, pkgDependsOnSelfLib
2200+
, pkgExeDependencies = buildComponentDeps (filter isExternal' . compExeDependencies)
2201+
, pkgExeDependencyPaths = buildComponentDeps (filter (isExternal' . fst) . compExeDependencyPaths)
2202+
-- Why is this flat?
2203+
, pkgPkgConfigDependencies = CD.flatDeps $ buildComponentDeps compPkgConfigDependencies
2204+
, -- NB: This is not the final setting of 'pkgStanzasEnabled'.
2205+
-- See [Sticky enabled testsuites]; we may enable some extra
2206+
-- stanzas opportunistically when it is cheap to do so.
2207+
--
2208+
-- However, we start off by enabling everything that was
2209+
-- requested, so that we can maintain an invariant that
2210+
-- pkgStanzasEnabled is a superset of elabStanzasRequested
2211+
pkgStanzasEnabled = optStanzaKeysFilteredByValue (fromMaybe False) elabStanzasRequested
2212+
, pkgWhyNotPerComponent
2213+
}
22042214

2215+
-- This tells us which components depend on the main library of this package.
2216+
-- Note: the sublib case should not occur, because sub-libraries are not
2217+
-- supported without per-component builds.
2218+
-- TODO: Add a check somewhere that this is the case.
2219+
pkgDependsOnSelfLib :: CD.ComponentDeps [()]
22052220
pkgDependsOnSelfLib =
22062221
CD.fromList
22072222
[ (CD.componentNameToComponent cn, [()])
@@ -2221,20 +2236,11 @@ elaborateInstallPlan
22212236
| ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent comp} <- comps
22222237
]
22232238

2224-
-- NB: This is not the final setting of 'pkgStanzasEnabled'.
2225-
-- See [Sticky enabled testsuites]; we may enable some extra
2226-
-- stanzas opportunistically when it is cheap to do so.
2227-
--
2228-
-- However, we start off by enabling everything that was
2229-
-- requested, so that we can maintain an invariant that
2230-
-- pkgStanzasEnabled is a superset of elabStanzasRequested
2231-
pkgStanzasEnabled = optStanzaKeysFilteredByValue (fromMaybe False) elabStanzasRequested
2232-
22332239
elaborateSolverToCommon
22342240
:: SolverPackage UnresolvedPkgLoc
22352241
-> ElaboratedConfiguredPackage
22362242
elaborateSolverToCommon
2237-
pkg@SolverPackage{
2243+
solverPkg@SolverPackage{
22382244
solverPkgStage,
22392245
solverPkgSource = SourcePackage
22402246
{ srcpkgPackageId
@@ -2270,17 +2276,20 @@ elaborateInstallPlan
22702276
elabPlatform = getStage platforms elabStage
22712277
elabProgramDb = getStage programDbs elabStage
22722278

2273-
elabPkgDescription = case PD.finalizePD
2274-
solverPkgFlags
2275-
elabEnabledSpec
2276-
(const Satisfied)
2277-
elabPlatform
2278-
(compilerInfo elabCompiler)
2279-
[]
2280-
srcpkgDescription of
2279+
elabPkgDescription =
2280+
case PD.finalizePD
2281+
solverPkgFlags
2282+
elabEnabledSpec
2283+
(const Satisfied)
2284+
elabPlatform
2285+
(compilerInfo elabCompiler)
2286+
[]
2287+
srcpkgDescription of
22812288
Right (desc, _) -> desc
22822289
Left _ -> error "Failed to finalizePD in elaborateSolverToCommon"
2290+
22832291
elabFlagAssignment = solverPkgFlags
2292+
22842293
elabFlagDefaults =
22852294
PD.mkFlagAssignment
22862295
[ (PD.flagName flag, PD.flagDefault flag)
@@ -2329,12 +2338,15 @@ elaborateInstallPlan
23292338
if programId == "ghc" && elabBuildHaddocks
23302339
then cp{programOverrideArgs = "-haddock" : programOverrideArgs}
23312340
else cp
2332-
2341+
23332342
elabPkgSourceLocation = srcpkgSource
2343+
23342344
elabPkgSourceHash = Map.lookup srcpkgPackageId sourcePackageHashes
2335-
elabLocalToProject = isLocalToProject pkg
2345+
2346+
elabLocalToProject = isLocalToProject solverPkg
2347+
23362348
elabBuildStyle =
2337-
if shouldBuildInplaceOnly pkg
2349+
if shouldBuildInplaceOnly solverPkg
23382350
then BuildInplaceOnly OnDisk
23392351
else BuildAndInstall
23402352

@@ -2343,12 +2355,14 @@ elaborateInstallPlan
23432355
elabRegisterPackageDBStack = buildAndRegisterDbs elabStage
23442356

23452357
elabSetupScriptStyle = packageSetupScriptStyle elabPkgDescription
2358+
23462359
elabSetupScriptCliVersion =
23472360
packageSetupScriptSpecVersion
23482361
elabSetupScriptStyle
23492362
elabPkgDescription
23502363
libDepGraph
23512364
solverPkgLibDeps
2365+
23522366
elabSetupPackageDBStack = buildAndRegisterDbs (prevStage elabStage)
23532367

23542368
-- Same as corePackageDbs but with the addition of the in-place packagedb.
@@ -2362,7 +2376,7 @@ elaborateInstallPlan
23622376
elabInplaceSetupPackageDBStack = inplacePackageDbs (prevStage elabStage)
23632377

23642378
buildAndRegisterDbs stage
2365-
| shouldBuildInplaceOnly pkg = inplacePackageDbs stage
2379+
| shouldBuildInplaceOnly solverPkg = inplacePackageDbs stage
23662380
| otherwise = corePackageDbs stage
23672381

23682382
elabPkgDescriptionOverride = srcpkgDescrOverride
@@ -2420,6 +2434,7 @@ elaborateInstallPlan
24202434
| prog <- configuredPrograms elabProgramDb
24212435
]
24222436
<> perPkgOptionMapLast srcpkgPackageId packageConfigProgramPaths
2437+
24232438
elabProgramArgs =
24242439
Map.unionWith
24252440
(++)
@@ -2431,13 +2446,16 @@ elaborateInstallPlan
24312446
]
24322447
)
24332448
(perPkgOptionMapMappend srcpkgPackageId packageConfigProgramArgs)
2449+
24342450
elabProgramPathExtra = perPkgOptionNubList srcpkgPackageId packageConfigProgramPathExtra
24352451
elabConfiguredPrograms = configuredPrograms elabProgramDb
24362452
elabConfigureScriptArgs = perPkgOptionList srcpkgPackageId packageConfigConfigureArgs
2453+
24372454
elabExtraLibDirs = perPkgOptionList srcpkgPackageId packageConfigExtraLibDirs
24382455
elabExtraLibDirsStatic = perPkgOptionList srcpkgPackageId packageConfigExtraLibDirsStatic
24392456
elabExtraFrameworkDirs = perPkgOptionList srcpkgPackageId packageConfigExtraFrameworkDirs
24402457
elabExtraIncludeDirs = perPkgOptionList srcpkgPackageId packageConfigExtraIncludeDirs
2458+
24412459
elabProgPrefix = perPkgOptionMaybe srcpkgPackageId packageConfigProgPrefix
24422460
elabProgSuffix = perPkgOptionMaybe srcpkgPackageId packageConfigProgSuffix
24432461

@@ -2486,7 +2504,6 @@ elaborateInstallPlan
24862504
where
24872505
exe = fromFlagOrDefault def bothflag
24882506
lib = fromFlagOrDefault def (bothflag <> libflag)
2489-
24902507
bothflag = lookupPerPkgOption pkgid fboth
24912508
libflag = lookupPerPkgOption pkgid flib
24922509

@@ -2621,6 +2638,7 @@ elaborateInstallPlan
26212638
NonSetupLibDepSolverPlanPackage
26222639
(SolverInstallPlan.toList solverPlan)
26232640

2641+
packagesWithLibDepsDownwardClosedProperty :: (PackageIdentifier -> Bool) -> Set PackageIdentifier
26242642
packagesWithLibDepsDownwardClosedProperty property =
26252643
Set.fromList
26262644
. map packageId
@@ -2645,12 +2663,15 @@ elaborateInstallPlan
26452663
-- TODO: Drop matchPlanPkg/matchElabPkg in favor of mkCCMapping
26462664

26472665
shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId
2648-
shouldBeLocal NamedPackage{} = Nothing
2649-
shouldBeLocal (SpecificSourcePackage pkg) = case srcpkgSource pkg of
2650-
LocalUnpackedPackage _ -> Just (packageId pkg)
2651-
_ -> Nothing
2666+
shouldBeLocal (NamedPackage _ _) =
2667+
Nothing
2668+
shouldBeLocal (SpecificSourcePackage pkg) =
2669+
case srcpkgSource pkg of
2670+
LocalUnpackedPackage _ -> Just (packageId pkg)
2671+
_ -> Nothing
26522672

26532673
-- | Given a 'ElaboratedPlanPackage', report if it matches a 'ComponentName'.
2674+
-- TODO: check the role of stage here.
26542675
matchPlanPkg :: (ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
26552676
matchPlanPkg p = InstallPlan.foldPlanPackage (\(WithStage _stage ipkg) -> p (ipiComponentName ipkg)) (matchElabPkg p)
26562677

0 commit comments

Comments
 (0)