Skip to content

Commit 7faf865

Browse files
committed
refactor(cabal-install): readability improvements
1 parent a804e2d commit 7faf865

File tree

1 file changed

+95
-100
lines changed

1 file changed

+95
-100
lines changed

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

Lines changed: 95 additions & 100 deletions
Original file line numberDiff line numberDiff line change
@@ -1940,7 +1940,7 @@ elaborateInstallPlan
19401940
-- correctly.
19411941
let elab1 =
19421942
elab0
1943-
{ elabPkgOrComp = ElabComponent $ elab_comp
1943+
{ elabPkgOrComp = ElabComponent elab_comp
19441944
}
19451945
cid = case elabBuildStyle elab0 of
19461946
BuildInplaceOnly{} ->
@@ -2124,15 +2124,7 @@ elaborateInstallPlan
21242124
-> LogProgress ElaboratedConfiguredPackage
21252125
elaborateSolverToPackage
21262126
pkgWhyNotPerComponent
2127-
pkg@( SolverPackage
2128-
_stage
2129-
_qpn
2130-
(SourcePackage pkgid _gpd _srcloc _descOverride)
2131-
_flags
2132-
_stanzas
2133-
_deps0
2134-
_exe_deps0
2135-
)
2127+
pkg@SolverPackage {solverPkgSource = SourcePackage {srcpkgPackageId}}
21362128
compGraph
21372129
comps = do
21382130
-- Knot tying: the final elab includes the
@@ -2180,7 +2172,7 @@ elaborateInstallPlan
21802172

21812173
pkgInstalledId
21822174
| shouldBuildInplaceOnly pkg =
2183-
mkComponentId (prettyShow pkgid ++ "-inplace")
2175+
mkComponentId (prettyShow srcpkgPackageId ++ "-inplace")
21842176
| otherwise =
21852177
assert (isJust elabPkgSourceHash) $
21862178
hashedInstalledPackageId
@@ -2191,7 +2183,7 @@ elaborateInstallPlan
21912183

21922184
-- Need to filter out internal dependencies, because they don't
21932185
-- correspond to anything real anymore.
2194-
isExternal confid = confSrcId confid /= pkgid
2186+
isExternal confid = confSrcId confid /= srcpkgPackageId
21952187
isExternal' (WithStage stage confId) = stage /= elabStage || isExternal confId
21962188

21972189
pkgLibDependencies =
@@ -2239,15 +2231,18 @@ elaborateInstallPlan
22392231
:: SolverPackage UnresolvedPkgLoc
22402232
-> ElaboratedConfiguredPackage
22412233
elaborateSolverToCommon
2242-
pkg@( SolverPackage
2243-
stage
2244-
_qpn
2245-
(SourcePackage pkgid gdesc srcloc descOverride)
2246-
flags
2247-
stanzas
2248-
deps0
2249-
_exe_deps0
2250-
) =
2234+
pkg@SolverPackage{
2235+
solverPkgStage,
2236+
solverPkgSource = SourcePackage
2237+
{ srcpkgPackageId
2238+
, srcpkgDescription
2239+
, srcpkgSource
2240+
, srcpkgDescrOverride
2241+
},
2242+
solverPkgFlags,
2243+
solverPkgStanzas,
2244+
solverPkgLibDeps
2245+
} =
22512246
elaboratedPackage
22522247
where
22532248
elaboratedPackage = ElaboratedConfiguredPackage{..}
@@ -2260,32 +2255,32 @@ elaborateInstallPlan
22602255
elabModuleShape = error "elaborateSolverToCommon: elabModuleShape"
22612256

22622257
elabIsCanonical = True
2263-
elabPkgSourceId = pkgid
2258+
elabPkgSourceId = srcpkgPackageId
22642259

2265-
elabStage = stage
2266-
elabCompiler = toolchainCompiler (getStage toolchains stage)
2267-
elabPlatform = toolchainPlatform (getStage toolchains stage)
2268-
elabProgramDb = toolchainProgramDb (getStage toolchains stage)
2260+
elabStage = solverPkgStage
2261+
elabCompiler = toolchainCompiler (getStage toolchains solverPkgStage)
2262+
elabPlatform = toolchainPlatform (getStage toolchains solverPkgStage)
2263+
elabProgramDb = toolchainProgramDb (getStage toolchains solverPkgStage)
22692264

22702265
elabPkgDescription = case PD.finalizePD
2271-
flags
2266+
solverPkgFlags
22722267
elabEnabledSpec
22732268
(const Satisfied)
22742269
elabPlatform
22752270
(compilerInfo elabCompiler)
22762271
[]
2277-
gdesc of
2272+
srcpkgDescription of
22782273
Right (desc, _) -> desc
22792274
Left _ -> error "Failed to finalizePD in elaborateSolverToCommon"
2280-
elabFlagAssignment = flags
2275+
elabFlagAssignment = solverPkgFlags
22812276
elabFlagDefaults =
22822277
PD.mkFlagAssignment
22832278
[ (PD.flagName flag, PD.flagDefault flag)
2284-
| flag <- PD.genPackageFlags gdesc
2279+
| flag <- PD.genPackageFlags srcpkgDescription
22852280
]
22862281

2287-
elabEnabledSpec = enableStanzas stanzas
2288-
elabStanzasAvailable = stanzas
2282+
elabEnabledSpec = enableStanzas solverPkgStanzas
2283+
elabStanzasAvailable = solverPkgStanzas
22892284

22902285
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
22912286
elabStanzasRequested = optStanzaTabulate $ \o -> case o of
@@ -2299,8 +2294,8 @@ elaborateInstallPlan
22992294
BenchStanzas -> listToMaybe [v | v <- maybeToList benchmarks, _ <- PD.benchmarks elabPkgDescription]
23002295
where
23012296
tests, benchmarks :: Maybe Bool
2302-
tests = perPkgOptionMaybe pkgid packageConfigTests
2303-
benchmarks = perPkgOptionMaybe pkgid packageConfigBenchmarks
2297+
tests = perPkgOptionMaybe srcpkgPackageId packageConfigTests
2298+
benchmarks = perPkgOptionMaybe srcpkgPackageId packageConfigBenchmarks
23042299

23052300
-- This is a placeholder which will get updated by 'pruneInstallPlanPass1'
23062301
-- and 'pruneInstallPlanPass2'. We can't populate it here
@@ -2318,7 +2313,7 @@ elaborateInstallPlan
23182313
elabHaddockTargets = []
23192314

23202315
elabBuildHaddocks =
2321-
perPkgOptionFlag pkgid False packageConfigDocumentation
2316+
perPkgOptionFlag srcpkgPackageId False packageConfigDocumentation
23222317

23232318
-- `documentation: true` should imply `-haddock` for GHC
23242319
addHaddockIfDocumentationEnabled :: ConfiguredProgram -> ConfiguredProgram
@@ -2327,8 +2322,8 @@ elaborateInstallPlan
23272322
then cp{programOverrideArgs = "-haddock" : programOverrideArgs}
23282323
else cp
23292324

2330-
elabPkgSourceLocation = srcloc
2331-
elabPkgSourceHash = Map.lookup pkgid sourcePackageHashes
2325+
elabPkgSourceLocation = srcpkgSource
2326+
elabPkgSourceHash = Map.lookup srcpkgPackageId sourcePackageHashes
23322327
elabLocalToProject = isLocalToProject pkg
23332328
elabBuildStyle =
23342329
if shouldBuildInplaceOnly pkg
@@ -2345,7 +2340,7 @@ elaborateInstallPlan
23452340
elabSetupScriptStyle
23462341
elabPkgDescription
23472342
libDepGraph
2348-
deps0
2343+
solverPkgLibDeps
23492344
elabSetupPackageDBStack = buildAndRegisterDbs
23502345

23512346
inplacePackageDbs = corePackageDbs ++ [distPackageDB (compilerId elabCompiler)]
@@ -2360,49 +2355,49 @@ elaborateInstallPlan
23602355
| shouldBuildInplaceOnly pkg = inplacePackageDbs
23612356
| otherwise = corePackageDbs
23622357

2363-
elabPkgDescriptionOverride = descOverride
2358+
elabPkgDescriptionOverride = srcpkgDescrOverride
23642359

23652360
elabBuildOptions =
23662361
LBC.BuildOptions
2367-
{ withVanillaLib = perPkgOptionFlag pkgid True packageConfigVanillaLib -- TODO: [required feature]: also needs to be handled recursively
2368-
, withSharedLib = pkgid `Set.member` pkgsUseSharedLibrary
2369-
, withStaticLib = perPkgOptionFlag pkgid False packageConfigStaticLib
2362+
{ withVanillaLib = perPkgOptionFlag srcpkgPackageId True packageConfigVanillaLib -- TODO: [required feature]: also needs to be handled recursively
2363+
, withSharedLib = srcpkgPackageId `Set.member` pkgsUseSharedLibrary
2364+
, withStaticLib = perPkgOptionFlag srcpkgPackageId False packageConfigStaticLib
23702365
, withDynExe =
2371-
perPkgOptionFlag pkgid False packageConfigDynExe
2366+
perPkgOptionFlag srcpkgPackageId False packageConfigDynExe
23722367
-- We can't produce a dynamic executable if the user
23732368
-- wants to enable executable profiling but the
23742369
-- compiler doesn't support prof+dyn.
23752370
&& (okProfDyn || not profExe)
2376-
, withFullyStaticExe = perPkgOptionFlag pkgid False packageConfigFullyStaticExe
2377-
, withGHCiLib = perPkgOptionFlag pkgid False packageConfigGHCiLib -- TODO: [required feature] needs to default to enabled on windows still
2378-
, withProfExe = profExe
2379-
, withProfLib = pkgid `Set.member` pkgsUseProfilingLibrary
2380-
, withProfLibShared = pkgid `Set.member` pkgsUseProfilingLibraryShared
2381-
, exeCoverage = perPkgOptionFlag pkgid False packageConfigCoverage
2382-
, libCoverage = perPkgOptionFlag pkgid False packageConfigCoverage
2383-
, withOptimization = perPkgOptionFlag pkgid NormalOptimisation packageConfigOptimization
2384-
, splitObjs = perPkgOptionFlag pkgid False packageConfigSplitObjs
2385-
, splitSections = perPkgOptionFlag pkgid False packageConfigSplitSections
2386-
, stripLibs = perPkgOptionFlag pkgid False packageConfigStripLibs
2387-
, stripExes = perPkgOptionFlag pkgid False packageConfigStripExes
2388-
, withDebugInfo = perPkgOptionFlag pkgid NoDebugInfo packageConfigDebugInfo
2389-
, relocatable = perPkgOptionFlag pkgid False packageConfigRelocatable
2371+
, withFullyStaticExe = perPkgOptionFlag srcpkgPackageId False packageConfigFullyStaticExe
2372+
, withGHCiLib = perPkgOptionFlag srcpkgPackageId False packageConfigGHCiLib -- TODO: [required feature] needs to default to enabled on windows still
2373+
, withProfExe = perPkgOptionFlag srcpkgPackageId False packageConfigProf
2374+
, withProfLib = srcpkgPackageId `Set.member` pkgsUseProfilingLibrary
2375+
, withProfLibShared = srcpkgPackageId `Set.member` pkgsUseProfilingLibraryShared
2376+
, exeCoverage = perPkgOptionFlag srcpkgPackageId False packageConfigCoverage
2377+
, libCoverage = perPkgOptionFlag srcpkgPackageId False packageConfigCoverage
2378+
, withOptimization = perPkgOptionFlag srcpkgPackageId NormalOptimisation packageConfigOptimization
2379+
, splitObjs = perPkgOptionFlag srcpkgPackageId False packageConfigSplitObjs
2380+
, splitSections = perPkgOptionFlag srcpkgPackageId False packageConfigSplitSections
2381+
, stripLibs = perPkgOptionFlag srcpkgPackageId False packageConfigStripLibs
2382+
, stripExes = perPkgOptionFlag srcpkgPackageId False packageConfigStripExes
2383+
, withDebugInfo = perPkgOptionFlag srcpkgPackageId NoDebugInfo packageConfigDebugInfo
2384+
, relocatable = perPkgOptionFlag srcpkgPackageId False packageConfigRelocatable
23902385
, withProfLibDetail = elabProfExeDetail
23912386
, withProfExeDetail = elabProfLibDetail
23922387
}
23932388
okProfDyn = profilingDynamicSupportedOrUnknown elabCompiler
2394-
profExe = perPkgOptionFlag pkgid False packageConfigProf
2389+
profExe = perPkgOptionFlag srcpkgPackageId False packageConfigProf
23952390

23962391
( elabProfExeDetail
23972392
, elabProfLibDetail
23982393
) =
23992394
perPkgOptionLibExeFlag
2400-
pkgid
2395+
srcpkgPackageId
24012396
ProfDetailDefault
24022397
packageConfigProfDetail
24032398
packageConfigProfLibDetail
24042399

2405-
elabDumpBuildInfo = perPkgOptionFlag pkgid NoDumpBuildInfo packageConfigDumpBuildInfo
2400+
elabDumpBuildInfo = perPkgOptionFlag srcpkgPackageId NoDumpBuildInfo packageConfigDumpBuildInfo
24062401

24072402
-- Combine the configured compiler prog settings with the user-supplied
24082403
-- config. For the compiler progs any user-supplied config was taken
@@ -2414,7 +2409,7 @@ elaborateInstallPlan
24142409
[ (programId prog, programPath prog)
24152410
| prog <- configuredPrograms elabProgramDb
24162411
]
2417-
<> perPkgOptionMapLast pkgid packageConfigProgramPaths
2412+
<> perPkgOptionMapLast srcpkgPackageId packageConfigProgramPaths
24182413
elabProgramArgs =
24192414
Map.unionWith
24202415
(++)
@@ -2425,46 +2420,46 @@ elaborateInstallPlan
24252420
, not (null args)
24262421
]
24272422
)
2428-
(perPkgOptionMapMappend pkgid packageConfigProgramArgs)
2429-
elabProgramPathExtra = perPkgOptionNubList pkgid packageConfigProgramPathExtra
2423+
(perPkgOptionMapMappend srcpkgPackageId packageConfigProgramArgs)
2424+
elabProgramPathExtra = perPkgOptionNubList srcpkgPackageId packageConfigProgramPathExtra
24302425
elabConfiguredPrograms = configuredPrograms elabProgramDb
2431-
elabConfigureScriptArgs = perPkgOptionList pkgid packageConfigConfigureArgs
2432-
elabExtraLibDirs = perPkgOptionList pkgid packageConfigExtraLibDirs
2433-
elabExtraLibDirsStatic = perPkgOptionList pkgid packageConfigExtraLibDirsStatic
2434-
elabExtraFrameworkDirs = perPkgOptionList pkgid packageConfigExtraFrameworkDirs
2435-
elabExtraIncludeDirs = perPkgOptionList pkgid packageConfigExtraIncludeDirs
2436-
elabProgPrefix = perPkgOptionMaybe pkgid packageConfigProgPrefix
2437-
elabProgSuffix = perPkgOptionMaybe pkgid packageConfigProgSuffix
2438-
2439-
elabHaddockHoogle = perPkgOptionFlag pkgid False packageConfigHaddockHoogle
2440-
elabHaddockHtml = perPkgOptionFlag pkgid False packageConfigHaddockHtml
2441-
elabHaddockHtmlLocation = perPkgOptionMaybe pkgid packageConfigHaddockHtmlLocation
2442-
elabHaddockForeignLibs = perPkgOptionFlag pkgid False packageConfigHaddockForeignLibs
2443-
elabHaddockForHackage = perPkgOptionFlag pkgid Cabal.ForDevelopment packageConfigHaddockForHackage
2444-
elabHaddockExecutables = perPkgOptionFlag pkgid False packageConfigHaddockExecutables
2445-
elabHaddockTestSuites = perPkgOptionFlag pkgid False packageConfigHaddockTestSuites
2446-
elabHaddockBenchmarks = perPkgOptionFlag pkgid False packageConfigHaddockBenchmarks
2447-
elabHaddockInternal = perPkgOptionFlag pkgid False packageConfigHaddockInternal
2448-
elabHaddockCss = perPkgOptionMaybe pkgid packageConfigHaddockCss
2449-
elabHaddockLinkedSource = perPkgOptionFlag pkgid False packageConfigHaddockLinkedSource
2450-
elabHaddockQuickJump = perPkgOptionFlag pkgid False packageConfigHaddockQuickJump
2451-
elabHaddockHscolourCss = perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss
2452-
elabHaddockContents = perPkgOptionMaybe pkgid packageConfigHaddockContents
2453-
elabHaddockIndex = perPkgOptionMaybe pkgid packageConfigHaddockIndex
2454-
elabHaddockBaseUrl = perPkgOptionMaybe pkgid packageConfigHaddockBaseUrl
2455-
elabHaddockResourcesDir = perPkgOptionMaybe pkgid packageConfigHaddockResourcesDir
2456-
elabHaddockOutputDir = perPkgOptionMaybe pkgid packageConfigHaddockOutputDir
2457-
elabHaddockUseUnicode = perPkgOptionFlag pkgid False packageConfigHaddockUseUnicode
2458-
2459-
elabTestMachineLog = perPkgOptionMaybe pkgid packageConfigTestMachineLog
2460-
elabTestHumanLog = perPkgOptionMaybe pkgid packageConfigTestHumanLog
2461-
elabTestShowDetails = perPkgOptionMaybe pkgid packageConfigTestShowDetails
2462-
elabTestKeepTix = perPkgOptionFlag pkgid False packageConfigTestKeepTix
2463-
elabTestWrapper = perPkgOptionMaybe pkgid packageConfigTestWrapper
2464-
elabTestFailWhenNoTestSuites = perPkgOptionFlag pkgid False packageConfigTestFailWhenNoTestSuites
2465-
elabTestTestOptions = perPkgOptionList pkgid packageConfigTestTestOptions
2466-
2467-
elabBenchmarkOptions = perPkgOptionList pkgid packageConfigBenchmarkOptions
2426+
elabConfigureScriptArgs = perPkgOptionList srcpkgPackageId packageConfigConfigureArgs
2427+
elabExtraLibDirs = perPkgOptionList srcpkgPackageId packageConfigExtraLibDirs
2428+
elabExtraLibDirsStatic = perPkgOptionList srcpkgPackageId packageConfigExtraLibDirsStatic
2429+
elabExtraFrameworkDirs = perPkgOptionList srcpkgPackageId packageConfigExtraFrameworkDirs
2430+
elabExtraIncludeDirs = perPkgOptionList srcpkgPackageId packageConfigExtraIncludeDirs
2431+
elabProgPrefix = perPkgOptionMaybe srcpkgPackageId packageConfigProgPrefix
2432+
elabProgSuffix = perPkgOptionMaybe srcpkgPackageId packageConfigProgSuffix
2433+
2434+
elabHaddockHoogle = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockHoogle
2435+
elabHaddockHtml = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockHtml
2436+
elabHaddockHtmlLocation = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockHtmlLocation
2437+
elabHaddockForeignLibs = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockForeignLibs
2438+
elabHaddockForHackage = perPkgOptionFlag srcpkgPackageId Cabal.ForDevelopment packageConfigHaddockForHackage
2439+
elabHaddockExecutables = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockExecutables
2440+
elabHaddockTestSuites = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockTestSuites
2441+
elabHaddockBenchmarks = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockBenchmarks
2442+
elabHaddockInternal = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockInternal
2443+
elabHaddockCss = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockCss
2444+
elabHaddockLinkedSource = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockLinkedSource
2445+
elabHaddockQuickJump = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockQuickJump
2446+
elabHaddockHscolourCss = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockHscolourCss
2447+
elabHaddockContents = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockContents
2448+
elabHaddockIndex = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockIndex
2449+
elabHaddockBaseUrl = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockBaseUrl
2450+
elabHaddockResourcesDir = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockResourcesDir
2451+
elabHaddockOutputDir = perPkgOptionMaybe srcpkgPackageId packageConfigHaddockOutputDir
2452+
elabHaddockUseUnicode = perPkgOptionFlag srcpkgPackageId False packageConfigHaddockUseUnicode
2453+
2454+
elabTestMachineLog = perPkgOptionMaybe srcpkgPackageId packageConfigTestMachineLog
2455+
elabTestHumanLog = perPkgOptionMaybe srcpkgPackageId packageConfigTestHumanLog
2456+
elabTestShowDetails = perPkgOptionMaybe srcpkgPackageId packageConfigTestShowDetails
2457+
elabTestKeepTix = perPkgOptionFlag srcpkgPackageId False packageConfigTestKeepTix
2458+
elabTestWrapper = perPkgOptionMaybe srcpkgPackageId packageConfigTestWrapper
2459+
elabTestFailWhenNoTestSuites = perPkgOptionFlag srcpkgPackageId False packageConfigTestFailWhenNoTestSuites
2460+
elabTestTestOptions = perPkgOptionList srcpkgPackageId packageConfigTestTestOptions
2461+
2462+
elabBenchmarkOptions = perPkgOptionList srcpkgPackageId packageConfigBenchmarkOptions
24682463

24692464
perPkgOptionFlag :: PackageId -> a -> (PackageConfig -> Flag a) -> a
24702465
perPkgOptionMaybe :: PackageId -> (PackageConfig -> Flag a) -> Maybe a

0 commit comments

Comments
 (0)