2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE DeriveFunctor #-}
4 {-# LANGUAGE LambdaCase #-}
5 {-# LANGUAGE NamedFieldPuns #-}
6 {-# LANGUAGE RankNTypes #-}
7 {-# LANGUAGE RecordWildCards #-}
8 {-# LANGUAGE TypeFamilies #-}
11 -- /Elaborated: worked out with great care and nicety of detail; executed with great minuteness: elaborate preparations; elaborate care./
13 -- In this module we construct an install plan that includes all the information needed to execute it.
15 -- Building a project is therefore split into two phases:
17 -- 1. The construction of the install plan (which as far as possible should be pure), done here.
18 -- 2. The execution of the plan, done in "ProjectBuilding"
20 -- To achieve this we need a representation of this fully elaborated install plan; this representation
21 -- consists of two parts:
23 -- * A 'ElaboratedInstallPlan'. This is a 'GenericInstallPlan' with a
24 -- representation of source packages that includes a lot more detail about
25 -- that package's individual configuration
27 -- * A 'ElaboratedSharedConfig'. Some package configuration is the same for
28 -- every package in a plan. Rather than duplicate that info every entry in
29 -- the 'GenericInstallPlan' we keep that separately.
31 -- The division between the shared and per-package config is not set in stone
32 -- for all time. For example if we wanted to generalise the install plan to
33 -- describe a situation where we want to build some packages with GHC and some
34 -- with GHCJS then the platform and compiler would no longer be shared between
35 -- all packages but would have to be per-package (probably with some sanity
36 -- condition on the graph structure).
37 module Distribution
.Client
.ProjectPlanning
38 ( -- * Types for the elaborated install plan
40 , ElaboratedConfiguredPackage
(..)
41 , ElaboratedPlanPackage
42 , ElaboratedSharedConfig
(..)
43 , ElaboratedReadyPackage
47 -- * Reading the project configuration
48 -- $readingTheProjectConfiguration
49 , rebuildProjectConfig
51 -- * Producing the elaborated install plan
56 , AvailableTarget
(..)
57 , AvailableTargetStatus
(..)
58 , TargetRequested
(..)
59 , ComponentTarget
(..)
60 , SubComponentTarget
(..)
64 -- * Selecting a plan subset
65 , pruneInstallPlanToTargets
67 , pruneInstallPlanToDependencies
68 , CannotPruneDependencies
(..)
70 -- * Utils required for building
71 , pkgHasEphemeralBuildTargets
72 , elabBuildTargetWholeComponents
75 -- * Setup.hs CLI flags for building
76 , setupHsScriptOptions
77 , setupHsConfigureFlags
78 , setupHsConfigureArgs
88 , setupHsRegisterFlags
93 -- * Path construction
96 , storePackageInstallDirs
97 , storePackageInstallDirs
'
100 import Distribution
.Client
.Compat
.Prelude
101 import Text
.PrettyPrint
(render
)
104 import Distribution
.Client
.Config
105 import Distribution
.Client
.Dependency
106 import Distribution
.Client
.DistDirLayout
107 import Distribution
.Client
.FetchUtils
108 import Distribution
.Client
.HashValue
109 import Distribution
.Client
.HttpUtils
110 import Distribution
.Client
.JobControl
111 import Distribution
.Client
.PackageHash
112 import Distribution
.Client
.ProjectConfig
113 import Distribution
.Client
.ProjectConfig
.Legacy
114 import Distribution
.Client
.ProjectPlanOutput
115 import Distribution
.Client
.ProjectPlanning
.SetupPolicy
116 ( NonSetupLibDepSolverPlanPackage
(..)
118 , packageSetupScriptSpecVersion
119 , packageSetupScriptStyle
121 import Distribution
.Client
.ProjectPlanning
.Types
as Ty
122 import Distribution
.Client
.RebuildMonad
123 import Distribution
.Client
.Setup
hiding (cabalVersion
, packageName
)
124 import Distribution
.Client
.SetupWrapper
125 import Distribution
.Client
.Store
126 import Distribution
.Client
.Targets
(userToPackageConstraint
)
127 import Distribution
.Client
.Types
128 import Distribution
.Client
.Utils
(incVersion
)
130 import qualified Distribution
.Client
.BuildReports
.Storage
as BuildReports
131 import qualified Distribution
.Client
.IndexUtils
as IndexUtils
132 import qualified Distribution
.Client
.InstallPlan
as InstallPlan
133 import qualified Distribution
.Client
.SolverInstallPlan
as SolverInstallPlan
135 import Distribution
.CabalSpecVersion
136 import Distribution
.Utils
.LogProgress
137 import Distribution
.Utils
.MapAccum
138 import Distribution
.Utils
.NubList
140 import qualified Hackage
.Security
.Client
as Sec
142 import Distribution
.Solver
.Types
.ConstraintSource
143 import Distribution
.Solver
.Types
.InstSolverPackage
144 import Distribution
.Solver
.Types
.LabeledPackageConstraint
145 import Distribution
.Solver
.Types
.OptionalStanza
146 import Distribution
.Solver
.Types
.PkgConfigDb
147 import Distribution
.Solver
.Types
.Settings
148 import Distribution
.Solver
.Types
.SolverId
149 import Distribution
.Solver
.Types
.SolverPackage
150 import Distribution
.Solver
.Types
.SourcePackage
152 import Distribution
.ModuleName
153 import Distribution
.Package
154 import Distribution
.Simple
.Compiler
155 import Distribution
.Simple
.Flag
156 import Distribution
.Simple
.LocalBuildInfo
162 import Distribution
.Simple
.PackageIndex
(InstalledPackageIndex
)
163 import Distribution
.Simple
.Program
164 import Distribution
.Simple
.Program
.Db
165 import Distribution
.Simple
.Program
.Find
166 import Distribution
.System
168 import Distribution
.Types
.AnnotatedId
169 import Distribution
.Types
.ComponentInclude
170 import Distribution
.Types
.ComponentName
171 import Distribution
.Types
.DumpBuildInfo
172 import Distribution
.Types
.GivenComponent
173 import Distribution
.Types
.LibraryName
174 import qualified Distribution
.Types
.LocalBuildConfig
as LBC
175 import Distribution
.Types
.PackageVersionConstraint
176 import Distribution
.Types
.PkgconfigDependency
177 import Distribution
.Types
.UnqualComponentName
179 import Distribution
.Backpack
180 import Distribution
.Backpack
.ComponentsGraph
181 import Distribution
.Backpack
.ConfiguredComponent
182 import Distribution
.Backpack
.FullUnitId
183 import Distribution
.Backpack
.LinkedComponent
184 import Distribution
.Backpack
.ModuleShape
186 import Distribution
.Simple
.Utils
187 import Distribution
.Version
189 import qualified Distribution
.InstalledPackageInfo
as IPI
190 import qualified Distribution
.PackageDescription
as PD
191 import qualified Distribution
.PackageDescription
.Configuration
as PD
192 import qualified Distribution
.Simple
.Configure
as Cabal
193 import qualified Distribution
.Simple
.GHC
as GHC
194 import qualified Distribution
.Simple
.GHCJS
as GHCJS
195 import qualified Distribution
.Simple
.InstallDirs
as InstallDirs
196 import qualified Distribution
.Simple
.LocalBuildInfo
as Cabal
197 import qualified Distribution
.Simple
.Setup
as Cabal
198 import qualified Distribution
.Solver
.Types
.ComponentDeps
as CD
200 import qualified Distribution
.Compat
.Graph
as Graph
202 import Control
.Exception
(assert
)
203 import Control
.Monad
(forM
, sequence)
204 import Control
.Monad
.IO.Class
(liftIO
)
205 import Control
.Monad
.State
as State
(State
, execState
, runState
, state
)
206 import Data
.Foldable
(fold
)
207 import Data
.List
(deleteBy, groupBy)
208 import qualified Data
.List
.NonEmpty
as NE
209 import qualified Data
.Map
as Map
210 import qualified Data
.Set
as Set
211 import Distribution
.Client
.Errors
212 import Distribution
.Solver
.Types
.ProjectConfigPath
213 import System
.FilePath
214 import Text
.PrettyPrint
(colon
, comma
, fsep
, hang
, punctuate
, quotes
, text
, vcat
, ($$))
215 import qualified Text
.PrettyPrint
as Disp
217 -- | Check that an 'ElaboratedConfiguredPackage' actually makes
218 -- sense under some 'ElaboratedSharedConfig'.
219 sanityCheckElaboratedConfiguredPackage
220 :: ElaboratedSharedConfig
221 -> ElaboratedConfiguredPackage
224 sanityCheckElaboratedConfiguredPackage
226 elab
@ElaboratedConfiguredPackage
{..} =
227 ( case elabPkgOrComp
of
228 ElabPackage pkg
-> sanityCheckElaboratedPackage elab pkg
229 ElabComponent comp
-> sanityCheckElaboratedComponent elab comp
231 -- The assertion below fails occasionally for unknown reason
232 -- so it was muted until we figure it out, otherwise it severely
233 -- hinders our ability to share and test development builds of cabal-install.
234 -- Tracking issue: https://github.com/haskell/cabal/issues/6006
236 -- either a package is being built inplace, or the
237 -- 'installedPackageId' we assigned is consistent with
238 -- the 'hashedInstalledPackageId' we would compute from
239 -- the elaborated configured package
241 ( isInplaceBuildStyle elabBuildStyle
243 == hashedInstalledPackageId
244 (packageHashInputs sharedConfig elab
)
246 -- the stanzas explicitly disabled should not be available
249 optStanzaKeysFilteredByValue
(maybe False not) elabStanzasRequested `optStanzaSetIntersection` elabStanzasAvailable
251 -- either a package is built inplace, or we are not attempting to
252 -- build any test suites or benchmarks (we never build these
253 -- for remote packages!)
255 ( isInplaceBuildStyle elabBuildStyle
256 || optStanzaSetNull elabStanzasAvailable
259 sanityCheckElaboratedComponent
260 :: ElaboratedConfiguredPackage
261 -> ElaboratedComponent
264 sanityCheckElaboratedComponent
265 ElaboratedConfiguredPackage
{..}
266 ElaboratedComponent
{..} =
267 -- Should not be building bench or test if not inplace.
269 ( isInplaceBuildStyle elabBuildStyle
270 ||
case compComponentName
of
272 Just
(CLibName _
) -> True
273 Just
(CExeName _
) -> True
274 -- This is interesting: there's no way to declare a dependency
275 -- on a foreign library at the moment, but you may still want
276 -- to install these to the store
277 Just
(CFLibName _
) -> True
278 Just
(CBenchName _
) -> False
279 Just
(CTestName _
) -> False
282 sanityCheckElaboratedPackage
283 :: ElaboratedConfiguredPackage
287 sanityCheckElaboratedPackage
288 ElaboratedConfiguredPackage
{..}
289 ElaboratedPackage
{..} =
290 -- we should only have enabled stanzas that actually can be built
291 -- (according to the solver)
292 assert
(pkgStanzasEnabled `optStanzaSetIsSubset` elabStanzasAvailable
)
293 -- the stanzas that the user explicitly requested should be
294 -- enabled (by the previous test, they are also available)
296 ( optStanzaKeysFilteredByValue
(fromMaybe False) elabStanzasRequested
297 `optStanzaSetIsSubset` pkgStanzasEnabled
300 -- $readingTheProjectConfiguration
302 -- The project configuration is assembled into a ProjectConfig as follows:
304 -- CLI arguments are converted using "commandLineFlagsToProjectConfig" in the
305 -- v2 command entrypoints and passed to "establishProjectBaseContext" which
306 -- then calls "rebuildProjectConfig".
308 -- "rebuildProjectConfig" then calls "readProjectConfig" to read the project
309 -- files. Due to the presence of conditionals, this output is in the form of a
310 -- "ProjectConfigSkeleton" and will be resolved by "rebuildProjectConfig" using
311 -- "instantiateProjectConfigSkeletonFetchingCompiler".
313 -- "readProjectConfig" also loads the global configuration, which is read with
314 -- "loadConfig" and convertd to a "ProjectConfig" with "convertLegacyGlobalConfig".
316 -- *Important:* You can notice how some project config options are needed to read the
317 -- project config! This is evident by the fact that "rebuildProjectConfig"
318 -- takes "HttpTransport" and "DistDirLayout" as parameters. Two arguments are
319 -- infact determined from the CLI alone (in "establishProjectBaseContext").
320 -- Consequently, project files (including global configuration) cannot
321 -- affect those parameters!
323 -- Furthermore, the project configuration can specify a compiler to use,
324 -- which we need to resolve the conditionals in the project configuration!
325 -- To solve this, we configure the compiler from what is obtained by applying
326 -- the CLI configuration over the the configuration obtained by "flattening"
327 -- ProjectConfigSkeleton. This means collapsing all conditionals by taking
330 -- | Return the up-to-date project config and information about the local
331 -- packages within the project.
339 , [PackageSpecifier UnresolvedSourcePackage
]
344 distDirLayout
@DistDirLayout
345 { distProjectRootDirectory
347 , distProjectCacheFile
348 , distProjectCacheDirectory
352 progsearchpath
<- liftIO
$ getSystemSearchPath
354 let fileMonitorProjectConfig
= newFileMonitor
(distProjectCacheFile
"config")
356 fileMonitorProjectConfigKey
<- do
357 configPath
<- getConfigFilePath projectConfigConfigFile
361 , (projectConfigHcFlavor
, projectConfigHcPath
, projectConfigHcPkg
)
363 , packageConfigProgramPaths
364 , packageConfigProgramPathExtra
367 (projectConfig
, localPackages
) <-
368 runRebuild distProjectRootDirectory
371 fileMonitorProjectConfig
372 fileMonitorProjectConfigKey
-- todo check deps too?
374 liftIO
$ info verbosity
"Project settings changed, reconfiguring..."
375 projectConfigSkeleton
<- phaseReadProjectConfig
376 let fetchCompiler
= do
377 -- have to create the cache directory before configuring the compiler
378 liftIO
$ createDirectoryIfMissingVerbose verbosity
True distProjectCacheDirectory
379 (compiler
, Platform arch os
, _
) <- configureCompiler verbosity distDirLayout
(fst (PD
.ignoreConditions projectConfigSkeleton
) <> cliConfig
)
380 pure
(os
, arch
, compilerInfo compiler
)
382 projectConfig
<- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton
383 when (projectConfigDistDir
(projectConfigShared
$ projectConfig
) /= NoFlag
) $
385 warn verbosity
"The builddir option is not supported in project and config files. It will be ignored."
386 localPackages
<- phaseReadLocalPackages
(projectConfig
<> cliConfig
)
387 return (projectConfig
, localPackages
)
391 info verbosity
. render
. vcat
$
392 text
"this build was affected by the following (project) config files:"
393 : [text
"-" <+> docProjectConfigPath path
]
394 | Explicit path
<- Set
.toList
$ projectConfigProvenance projectConfig
397 return (projectConfig
<> cliConfig
, localPackages
)
399 ProjectConfigShared
{projectConfigHcFlavor
, projectConfigHcPath
, projectConfigHcPkg
, projectConfigIgnoreProject
, projectConfigConfigFile
} =
400 projectConfigShared cliConfig
402 PackageConfig
{packageConfigProgramPaths
, packageConfigProgramPathExtra
} =
403 projectConfigLocalPackages cliConfig
405 -- Read the cabal.project (or implicit config) and combine it with
406 -- arguments from the command line
408 phaseReadProjectConfig
:: Rebuild ProjectConfigSkeleton
409 phaseReadProjectConfig
= do
410 readProjectConfig verbosity httpTransport projectConfigIgnoreProject projectConfigConfigFile distDirLayout
412 -- Look for all the cabal packages in the project
413 -- some of which may be local src dirs, tarballs etc
415 -- NOTE: These are all packages mentioned in the project configuration.
416 -- Whether or not they will be considered local to the project will be decided by `shouldBeLocal`.
417 phaseReadLocalPackages
419 -> Rebuild
[PackageSpecifier UnresolvedSourcePackage
]
420 phaseReadLocalPackages
421 projectConfig
@ProjectConfig
422 { projectConfigShared
423 , projectConfigBuildOnly
425 pkgLocations
<- findProjectPackages distDirLayout projectConfig
426 -- Create folder only if findProjectPackages did not throw a
427 -- BadPackageLocations exception.
429 createDirectoryIfMissingVerbose verbosity
True distDirectory
430 createDirectoryIfMissingVerbose verbosity
True distProjectCacheDirectory
432 fetchAndReadSourcePackages
436 projectConfigBuildOnly
443 -> Rebuild
(Compiler
, Platform
, ProgramDb
)
447 { distProjectCacheFile
450 { projectConfigShared
=
452 { projectConfigHcFlavor
453 , projectConfigHcPath
456 , projectConfigLocalPackages
=
458 { packageConfigProgramPaths
459 , packageConfigProgramPathExtra
462 let fileMonitorCompiler
= newFileMonitor
. distProjectCacheFile
$ "compiler"
464 progsearchpath
<- liftIO
$ getSystemSearchPath
472 , packageConfigProgramPaths
473 , packageConfigProgramPathExtra
476 liftIO
$ info verbosity
"Compiler settings changed, reconfiguring..."
477 progdb
<- liftIO
$ prependProgramSearchPath verbosity
(fromNubList packageConfigProgramPathExtra
) defaultProgramDb
478 let progdb
' = userSpecifyPaths
(Map
.toList
(getMapLast packageConfigProgramPaths
)) progdb
479 result
@(_
, _
, progdb
'') <-
481 Cabal
.configCompilerEx
488 -- Note that we added the user-supplied program locations and args
489 -- for /all/ programs, not just those for the compiler prog and
490 -- compiler-related utils. In principle we don't know which programs
491 -- the compiler will configure (and it does vary between compilers).
492 -- We do know however that the compiler will only configure the
493 -- programs it cares about, and those are the ones we monitor here.
494 monitorFiles
(programsMonitorFiles progdb
'')
498 hcFlavor
= flagToMaybe projectConfigHcFlavor
499 hcPath
= flagToMaybe projectConfigHcPath
500 hcPkg
= flagToMaybe projectConfigHcPkg
502 ------------------------------------------------------------------------------
504 -- * Deciding what to do: making an 'ElaboratedInstallPlan'
506 ------------------------------------------------------------------------------
508 -- | Return an up-to-date elaborated install plan.
510 -- Two variants of the install plan are returned: with and without packages
511 -- from the store. That is, the \"improved\" plan where source packages are
512 -- replaced by pre-existing installed packages from the store (when their ids
513 -- match), and also the original elaborated plan which uses primarily source
516 -- The improved plan is what we use for building, but the original elaborated
517 -- plan is useful for reporting and configuration. For example the @freeze@
518 -- command needs the source package info to know about flag choices and
519 -- dependencies of executables and setup scripts.
526 -> [PackageSpecifier UnresolvedSourcePackage
]
527 -> Maybe InstalledPackageIndex
529 ( ElaboratedInstallPlan
-- with store packages
530 , ElaboratedInstallPlan
-- with source packages
531 , ElaboratedSharedConfig
532 , IndexUtils
.TotalIndexState
533 , IndexUtils
.ActiveRepos
535 -- ^ @(improvedPlan, elaboratedPlan, _, _, _)@
538 distDirLayout
@DistDirLayout
539 { distProjectRootDirectory
540 , distProjectCacheFile
543 { cabalStoreDirLayout
544 } = \projectConfig localPackages mbInstalledPackages
->
545 runRebuild distProjectRootDirectory
$ do
546 progsearchpath
<- liftIO
$ getSystemSearchPath
547 let projectConfigMonitored
= projectConfig
{projectConfigBuildOnly
= mempty
}
549 -- The overall improved plan is cached
552 fileMonitorImprovedPlan
553 -- react to changes in the project config,
554 -- the package .cabal files and the path
555 (projectConfigMonitored
, localPackages
, progsearchpath
)
557 -- And so is the elaborated plan that the improved plan based on
558 (elaboratedPlan
, elaboratedShared
, totalIndexState
, activeRepos
) <-
561 fileMonitorElaboratedPlan
562 ( projectConfigMonitored
567 compilerEtc
<- phaseConfigureCompiler projectConfig
568 _
<- phaseConfigurePrograms projectConfig compilerEtc
569 (solverPlan
, pkgConfigDB
, totalIndexState
, activeRepos
) <-
574 (fromMaybe mempty mbInstalledPackages
)
585 phaseMaintainPlanOutputs elaboratedPlan elaboratedShared
586 return (elaboratedPlan
, elaboratedShared
, totalIndexState
, activeRepos
)
588 -- The improved plan changes each time we install something, whereas
589 -- the underlying elaborated plan only changes when input config
590 -- changes, so it's worth caching them separately.
591 improvedPlan
<- phaseImprovePlan elaboratedPlan elaboratedShared
593 return (improvedPlan
, elaboratedPlan
, elaboratedShared
, totalIndexState
, activeRepos
)
595 fileMonitorSolverPlan
= newFileMonitorInCacheDir
"solver-plan"
596 fileMonitorSourceHashes
= newFileMonitorInCacheDir
"source-hashes"
597 fileMonitorElaboratedPlan
= newFileMonitorInCacheDir
"elaborated-plan"
598 fileMonitorImprovedPlan
= newFileMonitorInCacheDir
"improved-plan"
600 newFileMonitorInCacheDir
:: Eq a
=> FilePath -> FileMonitor a b
601 newFileMonitorInCacheDir
= newFileMonitor
. distProjectCacheFile
603 -- Configure the compiler we're using.
605 -- This is moderately expensive and doesn't change that often so we cache
608 phaseConfigureCompiler
610 -> Rebuild
(Compiler
, Platform
, ProgramDb
)
611 phaseConfigureCompiler
= configureCompiler verbosity distDirLayout
613 -- Configuring other programs.
615 -- Having configred the compiler, now we configure all the remaining
616 -- programs. This is to check we can find them, and to monitor them for
619 -- TODO: [required eventually] we don't actually do this yet.
621 -- We rely on the fact that the previous phase added the program config for
622 -- all local packages, but that all the programs configured so far are the
623 -- compiler program or related util programs.
625 phaseConfigurePrograms
627 -> (Compiler
, Platform
, ProgramDb
)
629 phaseConfigurePrograms projectConfig
(_
, _
, compilerprogdb
) = do
630 -- Users are allowed to specify program locations independently for
631 -- each package (e.g. to use a particular version of a pre-processor
632 -- for some packages). However they cannot do this for the compiler
633 -- itself as that's just not going to work. So we check for this.
635 checkBadPerPackageCompilerPaths
636 (configuredPrograms compilerprogdb
)
637 (getMapMappend
(projectConfigSpecificPackage projectConfig
))
639 -- TODO: [required eventually] find/configure other programs that the
642 -- TODO: [required eventually] find/configure all build-tools
643 -- but note that some of them may be built as part of the plan.
645 -- Run the solver to get the initial install plan.
646 -- This is expensive so we cache it independently.
650 -> (Compiler
, Platform
, ProgramDb
)
651 -> [PackageSpecifier UnresolvedSourcePackage
]
652 -> InstalledPackageIndex
653 -> Rebuild
(SolverInstallPlan
, PkgConfigDb
, IndexUtils
.TotalIndexState
, IndexUtils
.ActiveRepos
)
655 projectConfig
@ProjectConfig
656 { projectConfigShared
657 , projectConfigBuildOnly
659 (compiler
, platform
, progdb
)
664 fileMonitorSolverPlan
667 , localPackagesEnabledStanzas
670 , programDbSignature progdb
680 (sourcePkgDb
, tis
, ar
) <-
684 (solverSettingIndexState solverSettings
)
685 (solverSettingActiveRepos solverSettings
)
686 pkgConfigDB
<- getPkgConfigDb verbosity progdb
688 -- TODO: [code cleanup] it'd be better if the Compiler contained the
689 -- ConfiguredPrograms that it needs, rather than relying on the progdb
690 -- since we don't need to depend on all the programs here, just the
691 -- ones relevant for the compiler.
694 notice verbosity
"Resolving dependencies..."
696 foldProgress logMsg
(pure
. Left
) (pure
. Right
) $
702 (installedPackages
<> installedPkgIndex
)
706 localPackagesEnabledStanzas
709 reportPlanningFailure projectConfig compiler platform localPackages
710 dieWithException verbosity
$ PhaseRunSolverErr msg
711 Right plan
-> return (plan
, pkgConfigDB
, tis
, ar
)
713 corePackageDbs
:: [PackageDB
]
715 Cabal
.interpretPackageDbFlags
False (projectConfigPackageDBs projectConfigShared
)
717 withRepoCtx
:: (RepoContext
-> IO a
) -> IO a
719 projectConfigWithSolverRepoContext
722 projectConfigBuildOnly
724 solverSettings
= resolveSolverSettings projectConfig
725 logMsg message rest
= debugNoWrap verbosity message
>> rest
727 localPackagesEnabledStanzas
=
730 | pkg
<- localPackages
731 , -- TODO: misnomer: we should separate
732 -- builtin/global/inplace/local packages
733 -- and packages explicitly mentioned in the project
735 let pkgname
= pkgSpecifierTarget pkg
737 lookupLocalPackageConfig
742 lookupLocalPackageConfig
743 packageConfigBenchmarks
746 isLocal
= isJust (shouldBeLocal pkg
)
750 [ (TestStanzas
, enabled
)
751 | enabled
<- flagToList testsEnabled
753 ++ [ (BenchStanzas
, enabled
)
754 | enabled
<- flagToList benchmarksEnabled
756 |
otherwise = Map
.fromList
[(TestStanzas
, False), (BenchStanzas
, False)]
759 -- Elaborate the solver's install plan to get a fully detailed plan. This
760 -- version of the plan has the final nix-style hashed ids.
764 -> (Compiler
, Platform
, ProgramDb
)
767 -> [PackageSpecifier
(SourcePackage
(PackageLocation loc
))]
769 ( ElaboratedInstallPlan
770 , ElaboratedSharedConfig
774 { projectConfigShared
775 , projectConfigAllPackages
776 , projectConfigLocalPackages
777 , projectConfigSpecificPackage
778 , projectConfigBuildOnly
780 (compiler
, platform
, progdb
)
784 liftIO
$ debug verbosity
"Elaborating the install plan..."
786 sourcePackageHashes
<-
789 fileMonitorSourceHashes
790 (packageLocationsSignature solverPlan
)
791 $ getPackageSourceHashes verbosity withRepoCtx solverPlan
793 defaultInstallDirs
<- liftIO
$ userInstallDirTemplates compiler
794 let installDirs
= fmap Cabal
.fromFlag
$ (fmap Flag defaultInstallDirs
) <> (projectConfigInstallDirs projectConfigShared
)
795 (elaboratedPlan
, elaboratedShared
) <-
796 liftIO
. runLogProgress verbosity
$
810 projectConfigAllPackages
811 projectConfigLocalPackages
812 (getMapMappend projectConfigSpecificPackage
)
813 let instantiatedPlan
=
814 instantiateInstallPlan
819 liftIO
$ debugNoWrap verbosity
(showElaboratedInstallPlan instantiatedPlan
)
820 return (instantiatedPlan
, elaboratedShared
)
822 withRepoCtx
:: (RepoContext
-> IO a
) -> IO a
824 projectConfigWithSolverRepoContext
827 projectConfigBuildOnly
829 -- Update the files we maintain that reflect our current build environment.
830 -- In particular we maintain a JSON representation of the elaborated
831 -- install plan (but not the improved plan since that reflects the state
832 -- of the build rather than just the input environment).
834 phaseMaintainPlanOutputs
835 :: ElaboratedInstallPlan
836 -> ElaboratedSharedConfig
838 phaseMaintainPlanOutputs elaboratedPlan elaboratedShared
= liftIO
$ do
839 debug verbosity
"Updating plan.json"
840 writePlanExternalRepresentation
845 -- Improve the elaborated install plan. The elaborated plan consists
846 -- mostly of source packages (with full nix-style hashed ids). Where
847 -- corresponding installed packages already exist in the store, replace
850 -- Note that we do monitor the store's package db here, so we will redo
851 -- this improvement phase when the db changes -- including as a result of
852 -- executing a plan and installing things.
855 :: ElaboratedInstallPlan
856 -> ElaboratedSharedConfig
857 -> Rebuild ElaboratedInstallPlan
858 phaseImprovePlan elaboratedPlan elaboratedShared
= do
859 liftIO
$ debug verbosity
"Improving the install plan..."
860 storePkgIdSet
<- getStoreEntries cabalStoreDirLayout compiler
862 improveInstallPlanWithInstalledPackages
865 liftIO
$ debugNoWrap verbosity
(showElaboratedInstallPlan improvedPlan
)
866 -- TODO: [nice to have] having checked which packages from the store
867 -- we're using, it may be sensible to sanity check those packages
868 -- by loading up the compiler package db and checking everything
869 -- matches up as expected, e.g. no dangling deps, files deleted.
872 compiler
= pkgConfigCompiler elaboratedShared
874 -- | If a 'PackageSpecifier' refers to a single package, return Just that
876 reportPlanningFailure
:: ProjectConfig
-> Compiler
-> Platform
-> [PackageSpecifier UnresolvedSourcePackage
] -> IO ()
877 reportPlanningFailure projectConfig comp platform pkgSpecifiers
=
879 BuildReports
.storeLocal
881 (fromNubList
$ projectConfigSummaryFile
. projectConfigBuildOnly
$ projectConfig
)
885 -- TODO may want to handle the projectConfigLogFile paramenter here, or just remove it entirely?
887 reportFailure
= Cabal
.fromFlag
. projectConfigReportPlanningFailure
. projectConfigBuildOnly
$ projectConfig
888 pkgids
= mapMaybe theSpecifiedPackage pkgSpecifiers
890 BuildReports
.fromPlanningFailure
894 -- TODO we may want to get more flag assignments and merge them here?
895 (packageConfigFlagAssignment
. projectConfigAllPackages
$ projectConfig
)
897 theSpecifiedPackage
:: Package pkg
=> PackageSpecifier pkg
-> Maybe PackageId
898 theSpecifiedPackage pkgSpec
=
900 NamedPackage name
[PackagePropertyVersion version
] ->
901 PackageIdentifier name
<$> trivialRange version
902 NamedPackage _ _
-> Nothing
903 SpecificSourcePackage pkg
-> Just
$ packageId pkg
904 -- \| If a range includes only a single version, return Just that version.
905 trivialRange
:: VersionRange
-> Maybe Version
915 programsMonitorFiles
:: ProgramDb
-> [MonitorFilePath
]
916 programsMonitorFiles progdb
=
918 | prog
<- configuredPrograms progdb
920 monitorFileSearchPath
921 (programMonitorFiles prog
)
925 -- | Select the bits of a 'ProgramDb' to monitor for value changes.
926 -- Use 'programsMonitorFiles' for the files to monitor.
927 programDbSignature
:: ProgramDb
-> [ConfiguredProgram
]
928 programDbSignature progdb
=
930 { programMonitorFiles
= []
931 , programOverrideEnv
=
934 (programOverrideEnv prog
)
936 | prog
<- configuredPrograms progdb
945 -> Rebuild InstalledPackageIndex
946 getInstalledPackages verbosity compiler progdb platform packagedbs
= do
947 monitorFiles
. map monitorFileOrDirectory
949 ( IndexUtils
.getInstalledPackagesMonitorFiles
957 IndexUtils
.getInstalledPackages
964 --TODO: [nice to have] use this but for sanity / consistency checking
965 getPackageDBContents :: Verbosity
966 -> Compiler -> ProgramDb -> Platform
968 -> Rebuild InstalledPackageIndex
969 getPackageDBContents verbosity compiler progdb platform packagedb = do
970 monitorFiles . map monitorFileOrDirectory
971 =<< liftIO (IndexUtils.getInstalledPackagesMonitorFiles
973 [packagedb] progdb platform)
975 createPackageDBIfMissing verbosity compiler progdb packagedb
976 Cabal.getPackageDBContents verbosity compiler
982 -> (forall a
. (RepoContext
-> IO a
) -> IO a
)
983 -> Maybe IndexUtils
.TotalIndexState
984 -> Maybe IndexUtils
.ActiveRepos
985 -> Rebuild
(SourcePackageDb
, IndexUtils
.TotalIndexState
, IndexUtils
.ActiveRepos
)
986 getSourcePackages verbosity withRepoCtx idxState activeRepos
= do
987 (sourcePkgDbWithTIS
, repos
) <-
989 withRepoCtx
$ \repoctx
-> do
990 sourcePkgDbWithTIS
<- IndexUtils
.getSourcePackagesAtIndexState verbosity repoctx idxState activeRepos
991 return (sourcePkgDbWithTIS
, repoContextRepos repoctx
)
993 traverse_ needIfExists
994 . IndexUtils
.getSourcePackagesMonitorFiles
996 return sourcePkgDbWithTIS
998 getPkgConfigDb
:: Verbosity
-> ProgramDb
-> Rebuild PkgConfigDb
999 getPkgConfigDb verbosity progdb
= do
1000 dirs
<- liftIO
$ getPkgConfigDbDirs verbosity progdb
1001 -- Just monitor the dirs so we'll notice new .pc files.
1002 -- Alternatively we could monitor all the .pc files too.
1003 traverse_ monitorDirectoryStatus dirs
1004 liftIO
$ readPkgConfigDb verbosity progdb
1006 -- | Select the config values to monitor for changes package source hashes.
1007 packageLocationsSignature
1008 :: SolverInstallPlan
1009 -> [(PackageId
, PackageLocation
(Maybe FilePath))]
1010 packageLocationsSignature solverPlan
=
1011 [ (packageId pkg
, srcpkgSource pkg
)
1012 | SolverInstallPlan
.Configured
(SolverPackage
{solverPkgSource
= pkg
}) <-
1013 SolverInstallPlan
.toList solverPlan
1016 -- | Get the 'HashValue' for all the source packages where we use hashes,
1017 -- and download any packages required to do so.
1019 -- Note that we don't get hashes for local unpacked packages.
1020 getPackageSourceHashes
1022 -> (forall a
. (RepoContext
-> IO a
) -> IO a
)
1023 -> SolverInstallPlan
1024 -> Rebuild
(Map PackageId PackageSourceHash
)
1025 getPackageSourceHashes verbosity withRepoCtx solverPlan
= do
1026 -- Determine if and where to get the package's source hash from.
1028 let allPkgLocations
:: [(PackageId
, PackageLocation
(Maybe FilePath))]
1030 [ (packageId pkg
, srcpkgSource pkg
)
1031 | SolverInstallPlan
.Configured
(SolverPackage
{solverPkgSource
= pkg
}) <-
1032 SolverInstallPlan
.toList solverPlan
1035 -- Tarballs that were local in the first place.
1036 -- We'll hash these tarball files directly.
1037 localTarballPkgs
:: [(PackageId
, FilePath)]
1040 |
(pkgid
, LocalTarballPackage tarball
) <- allPkgLocations
1043 -- Tarballs from remote URLs. We must have downloaded these already
1044 -- (since we extracted the .cabal file earlier)
1047 |
(pkgid
, RemoteTarballPackage _
(Just tarball
)) <- allPkgLocations
1050 -- tarballs from source-repository-package stanzas
1051 sourceRepoTarballPkgs
=
1053 |
(pkgid
, RemoteSourceRepoPackage _
(Just tarball
)) <- allPkgLocations
1056 -- Tarballs from repositories, either where the repository provides
1057 -- hashes as part of the repo metadata, or where we will have to
1058 -- download and hash the tarball.
1059 repoTarballPkgsWithMetadataUnvalidated
:: [(PackageId
, Repo
)]
1060 repoTarballPkgsWithoutMetadata
:: [(PackageId
, Repo
)]
1061 ( repoTarballPkgsWithMetadataUnvalidated
1062 , repoTarballPkgsWithoutMetadata
1066 RepoSecure
{} -> Left
(pkgid
, repo
)
1067 _
-> Right
(pkgid
, repo
)
1068 |
(pkgid
, RepoTarballPackage repo _ _
) <- allPkgLocations
1071 (repoTarballPkgsWithMetadata
, repoTarballPkgsToDownloadWithMeta
) <- fmap partitionEithers
$
1073 withRepoCtx
$ \repoctx
-> forM repoTarballPkgsWithMetadataUnvalidated
$
1075 verifyFetchedTarball verbosity repoctx repo pkg
>>= \b -> case b
of
1076 True -> return $ Left x
1077 False -> return $ Right x
1079 -- For tarballs from repos that do not have hashes available we now have
1080 -- to check if the packages were downloaded already.
1082 ( repoTarballPkgsToDownloadWithNoMeta
1083 , repoTarballPkgsDownloaded
1085 fmap partitionEithers
$
1089 mtarball
<- checkRepoTarballFetched repo pkgid
1091 Nothing
-> return (Left
(pkgid
, repo
))
1092 Just tarball
-> return (Right
(pkgid
, tarball
))
1093 |
(pkgid
, repo
) <- repoTarballPkgsWithoutMetadata
1096 let repoTarballPkgsToDownload
= repoTarballPkgsToDownloadWithMeta
++ repoTarballPkgsToDownloadWithNoMeta
1097 ( hashesFromRepoMetadata
1098 , repoTarballPkgsNewlyDownloaded
1100 -- Avoid having to initialise the repository (ie 'withRepoCtx') if we
1101 -- don't have to. (The main cost is configuring the http client.)
1102 if null repoTarballPkgsToDownload
&& null repoTarballPkgsWithMetadata
1103 then return (Map
.empty, [])
1104 else liftIO
$ withRepoCtx
$ \repoctx
-> do
1105 -- For tarballs from repos that do have hashes available as part of the
1106 -- repo metadata we now load up the index for each repo and retrieve
1107 -- the hashes for the packages
1109 hashesFromRepoMetadata
<-
1110 Sec
.uncheckClientErrors
$ -- TODO: [code cleanup] wrap in our own exceptions
1111 fmap (Map
.fromList
. concat) $
1113 -- Reading the repo index is expensive so we group the packages by repo
1114 [ repoContextWithSecureRepo repoctx repo
$ \secureRepo
->
1115 Sec
.withIndex secureRepo
$ \repoIndex
->
1120 <$> Sec
.indexLookupHash repoIndex pkgid
-- strip off Trusted tag
1122 -- Note that hackage-security currently uses SHA256
1123 -- but this API could in principle give us some other
1124 -- choice in future.
1125 return (pkgid
, hashFromTUF hash
)
1129 map (\grp
@((_
, repo
) :| _
) -> (repo
, map fst (NE
.toList grp
)))
1130 . NE
.groupBy ((==) `on`
(remoteRepoName
. repoRemote
. snd))
1131 . sortBy (compare `on`
(remoteRepoName
. repoRemote
. snd))
1132 $ repoTarballPkgsWithMetadata
1135 -- For tarballs from repos that do not have hashes available, download
1136 -- the ones we previously determined we need.
1138 repoTarballPkgsNewlyDownloaded
<-
1141 tarball
<- fetchRepoTarball verbosity repoctx repo pkgid
1142 return (pkgid
, tarball
)
1143 |
(pkgid
, repo
) <- repoTarballPkgsToDownload
1147 ( hashesFromRepoMetadata
1148 , repoTarballPkgsNewlyDownloaded
1151 -- Hash tarball files for packages where we have to do that. This includes
1152 -- tarballs that were local in the first place, plus tarballs from repos,
1153 -- either previously cached or freshly downloaded.
1155 let allTarballFilePkgs
:: [(PackageId
, FilePath)]
1156 allTarballFilePkgs
=
1158 ++ remoteTarballPkgs
1159 ++ sourceRepoTarballPkgs
1160 ++ repoTarballPkgsDownloaded
1161 ++ repoTarballPkgsNewlyDownloaded
1162 hashesFromTarballFiles
<-
1167 srchash
<- readFileHashValue tarball
1168 return (pkgid
, srchash
)
1169 |
(pkgid
, tarball
) <- allTarballFilePkgs
1172 [ monitorFile tarball
1173 |
(_pkgid
, tarball
) <- allTarballFilePkgs
1176 -- Return the combination
1178 hashesFromRepoMetadata
1179 <> hashesFromTarballFiles
1181 -- ------------------------------------------------------------
1183 -- * Installation planning
1185 -- ------------------------------------------------------------
1192 -> InstalledPackageIndex
1195 -> [PackageSpecifier UnresolvedSourcePackage
]
1196 -> Map PackageName
(Map OptionalStanza
Bool)
1197 -> Progress
String String SolverInstallPlan
1214 -- TODO: [nice to have] disable multiple instances restriction in
1215 -- the solver, but then make sure we can cope with that in the
1217 resolverParams
:: DepResolverParams
1219 setMaxBackjumps solverSettingMaxBackjumps
1220 . setIndependentGoals solverSettingIndependentGoals
1221 . setReorderGoals solverSettingReorderGoals
1222 . setCountConflicts solverSettingCountConflicts
1223 . setFineGrainedConflicts solverSettingFineGrainedConflicts
1224 . setMinimizeConflictSet solverSettingMinimizeConflictSet
1225 -- TODO: [required eventually] should only be configurable for
1227 -- . setAvoidReinstalls solverSettingAvoidReinstalls
1229 -- TODO: [required eventually] should only be configurable for
1231 -- . setShadowPkgs solverSettingShadowPkgs
1233 . setStrongFlags solverSettingStrongFlags
1234 . setAllowBootLibInstalls solverSettingAllowBootLibInstalls
1235 . setOnlyConstrained solverSettingOnlyConstrained
1236 . setSolverVerbosity verbosity
1237 -- TODO: [required eventually] decide if we need to prefer
1238 -- installed for global packages, or prefer latest even for
1239 -- global packages. Perhaps should be configurable but with a
1240 -- different name than "upgrade-dependencies".
1241 . setPreferenceDefault
1242 ( if Cabal
.asBool solverSettingPreferOldest
1243 then PreferAllOldest
1244 else PreferLatestForSelected
1246 {-(if solverSettingUpgradeDeps
1247 then PreferAllLatest
1248 else PreferLatestForSelected)-}
1250 . removeLowerBounds solverSettingAllowOlder
1251 . removeUpperBounds solverSettingAllowNewer
1252 . addDefaultSetupDependencies
1253 ( mkDefaultSetupDeps comp platform
1254 . PD
.packageDescription
1257 . addSetupCabalMinVersionConstraint setupMinCabalVersionConstraint
1258 . addSetupCabalMaxVersionConstraint setupMaxCabalVersionConstraint
1260 -- preferences from the config file or command line
1261 [ PackageVersionPreference name ver
1262 | PackageVersionConstraint name ver
<- solverSettingPreferences
1265 -- version constraints from the config file or command line
1266 [ LabeledPackageConstraint
(userToPackageConstraint pc
) src
1267 |
(pc
, src
) <- solverSettingConstraints
1270 -- enable stanza preference unilaterally, regardless if the user asked
1271 -- accordingly or expressed no preference, to help hint the solver
1272 [ PackageStanzasPreference pkgname stanzas
1273 | pkg
<- localPackages
1274 , let pkgname
= pkgSpecifierTarget pkg
1275 stanzaM
= Map
.findWithDefault Map
.empty pkgname pkgStanzasEnable
1277 [ stanza | stanza
<- [minBound .. maxBound], Map
.lookup stanza stanzaM
/= Just
False
1279 , not (null stanzas
)
1282 -- enable stanza constraints where the user asked to enable
1283 [ LabeledPackageConstraint
1285 (scopeToplevel pkgname
)
1286 (PackagePropertyStanzas stanzas
)
1288 ConstraintSourceConfigFlagOrTarget
1289 | pkg
<- localPackages
1290 , let pkgname
= pkgSpecifierTarget pkg
1291 stanzaM
= Map
.findWithDefault Map
.empty pkgname pkgStanzasEnable
1293 [ stanza | stanza
<- [minBound .. maxBound], Map
.lookup stanza stanzaM
== Just
True
1295 , not (null stanzas
)
1298 -- TODO: [nice to have] should have checked at some point that the
1299 -- package in question actually has these flags.
1300 [ LabeledPackageConstraint
1302 (scopeToplevel pkgname
)
1303 (PackagePropertyFlags flags
)
1305 ConstraintSourceConfigFlagOrTarget
1306 |
(pkgname
, flags
) <- Map
.toList solverSettingFlagAssignments
1309 -- TODO: [nice to have] we have user-supplied flags for unspecified
1310 -- local packages (as well as specific per-package flags). For the
1311 -- former we just apply all these flags to all local targets which
1312 -- is silly. We should check if the flags are appropriate.
1313 [ LabeledPackageConstraint
1315 (scopeToplevel pkgname
)
1316 (PackagePropertyFlags flags
)
1318 ConstraintSourceConfigFlagOrTarget
1319 |
let flags
= solverSettingFlagAssignment
1320 , not (PD
.nullFlagAssignment flags
)
1321 , pkg
<- localPackages
1322 , let pkgname
= pkgSpecifierTarget pkg
1326 stdResolverParams
:: DepResolverParams
1328 -- Note: we don't use the standardInstallPolicy here, since that uses
1329 -- its own addDefaultSetupDependencies that is not appropriate for us.
1335 -- While we can talk to older Cabal versions (we need to be able to
1336 -- do so for custom Setup scripts that require older Cabal lib
1337 -- versions), we have problems talking to some older versions that
1338 -- don't support certain features.
1340 -- For example, Cabal-1.16 and older do not know about build targets.
1341 -- Even worse, 1.18 and older only supported the --constraint flag
1342 -- with source package ids, not --dependency with installed package
1343 -- ids. That is bad because we cannot reliably select the right
1344 -- dependencies in the presence of multiple instances (i.e. the
1345 -- store). See issue #3932. So we require Cabal 1.20 as a minimum.
1347 -- Moreover, lib:Cabal generally only supports the interface of
1348 -- current and past compilers; in fact recent lib:Cabal versions
1349 -- will warn when they encounter a too new or unknown GHC compiler
1350 -- version (c.f. #415). To avoid running into unsupported
1351 -- configurations we encode the compatibility matrix as lower
1352 -- bounds on lib:Cabal here (effectively corresponding to the
1353 -- respective major Cabal version bundled with the respective GHC
1356 -- GHC 9.2 needs Cabal >= 3.6
1357 -- GHC 9.0 needs Cabal >= 3.4
1358 -- GHC 8.10 needs Cabal >= 3.2
1359 -- GHC 8.8 needs Cabal >= 3.0
1360 -- GHC 8.6 needs Cabal >= 2.4
1361 -- GHC 8.4 needs Cabal >= 2.2
1362 -- GHC 8.2 needs Cabal >= 2.0
1363 -- GHC 8.0 needs Cabal >= 1.24
1364 -- GHC 7.10 needs Cabal >= 1.22
1366 -- (NB: we don't need to consider older GHCs as Cabal >= 1.20 is
1367 -- the absolute lower bound)
1369 -- TODO: long-term, this compatibility matrix should be
1370 -- stored as a field inside 'Distribution.Compiler.Compiler'
1371 setupMinCabalVersionConstraint
1372 | isGHC
, compVer
>= mkVersion
[9, 10] = mkVersion
[3, 12]
1373 | isGHC
, compVer
>= mkVersion
[9, 6] = mkVersion
[3, 10]
1374 | isGHC
, compVer
>= mkVersion
[9, 4] = mkVersion
[3, 8]
1375 | isGHC
, compVer
>= mkVersion
[9, 2] = mkVersion
[3, 6]
1376 | isGHC
, compVer
>= mkVersion
[9, 0] = mkVersion
[3, 4]
1377 | isGHC
, compVer
>= mkVersion
[8, 10] = mkVersion
[3, 2]
1378 | isGHC
, compVer
>= mkVersion
[8, 8] = mkVersion
[3, 0]
1379 | isGHC
, compVer
>= mkVersion
[8, 6] = mkVersion
[2, 4]
1380 | isGHC
, compVer
>= mkVersion
[8, 4] = mkVersion
[2, 2]
1381 | isGHC
, compVer
>= mkVersion
[8, 2] = mkVersion
[2, 0]
1382 | isGHC
, compVer
>= mkVersion
[8, 0] = mkVersion
[1, 24]
1383 | isGHC
, compVer
>= mkVersion
[7, 10] = mkVersion
[1, 22]
1384 |
otherwise = mkVersion
[1, 20]
1386 isGHC
= compFlav `
elem`
[GHC
, GHCJS
]
1387 compFlav
= compilerFlavor comp
1388 compVer
= compilerVersion comp
1390 -- As we can't predict the future, we also place a global upper
1391 -- bound on the lib:Cabal version we know how to interact with:
1393 -- The upper bound is computed by incrementing the current major
1394 -- version twice in order to allow for the current version, as
1395 -- well as the next adjacent major version (one of which will not
1396 -- be released, as only "even major" versions of Cabal are
1397 -- released to Hackage or bundled with proper GHC releases).
1399 -- For instance, if the current version of cabal-install is an odd
1400 -- development version, e.g. Cabal-2.1.0.0, then we impose an
1401 -- upper bound `setup.Cabal < 2.3`; if `cabal-install` is on a
1402 -- stable/release even version, e.g. Cabal-2.2.1.0, the upper
1403 -- bound is `setup.Cabal < 2.4`. This gives us enough flexibility
1404 -- when dealing with development snapshots of Cabal and cabal-install.
1406 setupMaxCabalVersionConstraint
=
1407 alterVersion
(take 2) $ incVersion
1 $ incVersion
1 cabalVersion
1409 ------------------------------------------------------------------------------
1411 -- * Install plan post-processing
1413 ------------------------------------------------------------------------------
1415 -- This phase goes from the InstallPlan we get from the solver and has to
1416 -- make an elaborated install plan.
1418 -- We go in two steps:
1420 -- 1. elaborate all the source packages that the solver has chosen.
1421 -- 2. swap source packages for pre-existing installed packages wherever
1424 -- We do it in this order, elaborating and then replacing, because the easiest
1425 -- way to calculate the installed package ids used for the replacement step is
1426 -- from the elaborated configuration for each package.
1428 ------------------------------------------------------------------------------
1430 -- * Install plan elaboration
1432 ------------------------------------------------------------------------------
1434 -- Note [SolverId to ConfiguredId]
1435 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1436 -- Dependency solving is a per package affair, so after we're done, we
1437 -- end up with 'SolverInstallPlan' that records in 'solverPkgLibDeps'
1438 -- and 'solverPkgExeDeps' what packages provide the libraries and executables
1439 -- needed by each component of the package (phew!) For example, if I have
1442 -- build-depends: lib
1443 -- build-tool-depends: pkg:exe1
1444 -- build-tools: alex
1446 -- After dependency solving, I find out that this library component has
1447 -- library dependencies on lib-0.2, and executable dependencies on pkg-0.1
1448 -- and alex-0.3 (other components of the package may have different
1449 -- dependencies). Note that I've "lost" the knowledge that I depend
1451 -- * specifically* on the exe1 executable from pkg.
1454 -- So, we have a this graph of packages, and we need to transform it into
1455 -- a graph of components which we are actually going to build. In particular:
1457 -- NODE changes from PACKAGE (SolverPackage) to COMPONENTS (ElaboratedConfiguredPackage)
1458 -- EDGE changes from PACKAGE DEP (SolverId) to COMPONENT DEPS (ConfiguredId)
1460 -- In both cases, what was previously a single node/edge may turn into multiple
1461 -- nodes/edges. Multiple components, because there may be multiple components
1462 -- in a package; multiple component deps, because we may depend upon multiple
1463 -- executables from the same package (and maybe, some day, multiple libraries
1464 -- from the same package.)
1466 -- Let's talk about how to do this transformation. Naively, we might consider
1467 -- just processing each package, converting it into (zero or) one or more
1468 -- components. But we also have to update the edges; this leads to
1469 -- two complications:
1471 -- 1. We don't know what the ConfiguredId of a component is until
1472 -- we've configured it, but we cannot configure a component unless
1473 -- we know the ConfiguredId of all its dependencies. Thus, we must
1474 -- process the 'SolverInstallPlan' in topological order.
1476 -- 2. When we process a package, we know the SolverIds of its
1477 -- dependencies, but we have to do some work to turn these into
1478 -- ConfiguredIds. For example, in the case of build-tool-depends, the
1479 -- SolverId isn't enough to uniquely determine the ConfiguredId we should
1480 -- elaborate to: we have to look at the executable name attached to
1481 -- the package name in the package description to figure it out.
1482 -- At the same time, we NEED to use the SolverId, because there might
1483 -- be multiple versions of the same package in the build plan
1484 -- (due to setup dependencies); we can't just look up the package name
1485 -- from the package description.
1487 -- We can adopt the following strategy:
1489 -- * When a package is transformed into components, record
1490 -- a mapping from SolverId to ALL of the components
1491 -- which were elaborated.
1493 -- * When we look up an edge, we use our knowledge of the
1494 -- component name to *filter* the list of components into
1495 -- the ones we actually wanted to refer to.
1497 -- By the way, we can tell that SolverInstallPlan is not the "right" type
1498 -- because a SolverId cannot adequately represent all possible dependency
1499 -- solver states: we may need to record foo-0.1 multiple times in
1500 -- the solver install plan with different dependencies. This imprecision in the
1501 -- type currently doesn't cause any problems because the dependency solver
1502 -- continues to enforce the single instance restriction regardless of compiler
1503 -- version. The right way to solve this is to come up with something very much
1504 -- like a 'ConfiguredId', in that it incorporates the version choices of its
1505 -- dependencies, but less fine grained.
1507 -- | Produce an elaborated install plan using the policy for local builds with
1508 -- a nix-style shared store.
1510 -- In theory should be able to make an elaborated install plan with a policy
1511 -- matching that of the classic @cabal install --user@ or @--global@
1512 elaborateInstallPlan
1520 -> SolverInstallPlan
1521 -> [PackageSpecifier
(SourcePackage
(PackageLocation loc
))]
1522 -> Map PackageId PackageSourceHash
1523 -> InstallDirs
.InstallDirTemplates
1524 -> ProjectConfigShared
1527 -> Map PackageName PackageConfig
1528 -> LogProgress
(ElaboratedInstallPlan
, ElaboratedSharedConfig
)
1529 elaborateInstallPlan
1535 distDirLayout
@DistDirLayout
{..}
1536 storeDirLayout
@StoreDirLayout
{storePackageDBStack
}
1544 perPackageConfig
= do
1545 x
<- elaboratedInstallPlan
1546 return (x
, elaboratedSharedConfig
)
1548 elaboratedSharedConfig
=
1549 ElaboratedSharedConfig
1550 { pkgConfigPlatform
= platform
1551 , pkgConfigCompiler
= compiler
1552 , pkgConfigCompilerProgs
= compilerprogdb
1553 , pkgConfigReplOptions
= mempty
1556 preexistingInstantiatedPkgs
:: Map UnitId FullUnitId
1557 preexistingInstantiatedPkgs
=
1558 Map
.fromList
(mapMaybe f
(SolverInstallPlan
.toList solverPlan
))
1560 f
(SolverInstallPlan
.PreExisting inst
)
1561 |
let ipkg
= instSolverPkgIPI inst
1562 , not (IPI
.indefinite ipkg
) =
1564 ( IPI
.installedUnitId ipkg
1566 (IPI
.installedComponentId ipkg
)
1567 (Map
.fromList
(IPI
.instantiatedWith ipkg
))
1572 elaboratedInstallPlan
1573 :: LogProgress
(InstallPlan
.GenericInstallPlan IPI
.InstalledPackageInfo ElaboratedConfiguredPackage
)
1574 elaboratedInstallPlan
=
1575 flip InstallPlan
.fromSolverInstallPlanWithProgress solverPlan
$ \mapDep planpkg
->
1577 SolverInstallPlan
.PreExisting pkg
->
1578 return [InstallPlan
.PreExisting
(instSolverPkgIPI pkg
)]
1579 SolverInstallPlan
.Configured pkg
->
1581 | shouldBuildInplaceOnly pkg
= text
"inplace"
1582 |
otherwise = Disp
.empty
1587 <+> quotes
(pretty
(packageId pkg
))
1589 $ map InstallPlan
.Configured
<$> elaborateSolverToComponents mapDep pkg
1591 -- NB: We don't INSTANTIATE packages at this point. That's
1592 -- a post-pass. This makes it simpler to compute dependencies.
1593 elaborateSolverToComponents
1594 :: (SolverId
-> [ElaboratedPlanPackage
])
1595 -> SolverPackage UnresolvedPkgLoc
1596 -> LogProgress
[ElaboratedConfiguredPackage
]
1597 elaborateSolverToComponents mapDep spkg
@(SolverPackage _ _ _ deps0 exe_deps0
) =
1598 case mkComponentsGraph
(elabEnabledSpec elab0
) pd
of
1600 let src_comps
= componentsGraphToList g
1603 (text
"Component graph for" <+> pretty pkgid
<<>> colon
)
1605 (dispComponentsWithDeps src_comps
)
1609 (Map
.empty, Map
.empty, Map
.empty)
1611 let whyNotPerComp
= why_not_per_component src_comps
1612 case NE
.nonEmpty whyNotPerComp
of
1613 Nothing
-> return comps
1614 Just notPerCompReasons
-> do
1615 checkPerPackageOk comps notPerCompReasons
1617 [ elaborateSolverToPackage notPerCompReasons spkg g
$
1618 comps
++ maybeToList setupComponent
1623 (text
"Dependency cycle between the following components:")
1625 (vcat
(map (text
. componentNameStanza
) cns
))
1627 -- You are eligible to per-component build if this list is empty
1628 why_not_per_component g
=
1629 cuz_buildtype
++ cuz_spec
++ cuz_length
++ cuz_flag
1631 -- We have to disable per-component for now with
1632 -- Configure-type scripts in order to prevent parallel
1633 -- invocation of the same `./configure` script.
1634 -- See https://github.com/haskell/cabal/issues/4548
1636 -- Moreover, at this point in time, only non-Custom setup scripts
1637 -- are supported. Implementing per-component builds with
1638 -- Custom would require us to create a new 'ElabSetup'
1639 -- type, and teach all of the code paths how to handle it.
1640 -- Once you've implemented this, swap it for the code below.
1642 case PD
.buildType
(elabPkgDescription elab0
) of
1643 PD
.Configure
-> [CuzBuildType CuzConfigureBuildType
]
1644 PD
.Custom
-> [CuzBuildType CuzCustomBuildType
]
1645 PD
.Make
-> [CuzBuildType CuzMakeBuildType
]
1647 -- cabal-format versions prior to 1.8 have different build-depends semantics
1648 -- for now it's easier to just fallback to legacy-mode when specVersion < 1.8
1649 -- see, https://github.com/haskell/cabal/issues/4121
1651 | PD
.specVersion pd
>= CabalSpecV1_8
= []
1652 |
otherwise = [CuzCabalSpecVersion
]
1653 -- In the odd corner case that a package has no components at all
1654 -- then keep it as a whole package, since otherwise it turns into
1655 -- 0 component graph nodes and effectively vanishes. We want to
1656 -- keep it around at least for error reporting purposes.
1659 |
otherwise = [CuzNoBuildableComponents
]
1660 -- For ease of testing, we let per-component builds be toggled
1663 | fromFlagOrDefault
True (projectConfigPerComponent sharedPackageConfig
) =
1665 |
otherwise = [CuzDisablePerComponent
]
1667 -- \| Sometimes a package may make use of features which are only
1668 -- supported in per-package mode. If this is the case, we should
1669 -- give an error when this occurs.
1670 checkPerPackageOk comps reasons
= do
1671 let is_sublib
(CLibName
(LSubLibName _
)) = True
1673 when (any (matchElabPkg is_sublib
) comps
) $
1675 text
"Internal libraries only supported with per-component builds."
1676 $$ text
"Per-component builds were disabled because"
1677 <+> fsep
(punctuate comma
$ map (text
. whyNotPerComponent
) $ toList reasons
)
1678 -- TODO: Maybe exclude Backpack too
1680 elab0
= elaborateSolverToCommon spkg
1681 pkgid
= elabPkgSourceId elab0
1682 pd
= elabPkgDescription elab0
1684 -- TODO: This is just a skeleton to get elaborateSolverToPackage
1685 -- working correctly
1686 -- TODO: When we actually support building these components, we
1687 -- have to add dependencies on this from all other components
1688 setupComponent
:: Maybe ElaboratedConfiguredPackage
1690 | PD
.buildType
(elabPkgDescription elab0
) == PD
.Custom
=
1693 { elabModuleShape
= emptyModuleShape
1694 , elabUnitId
= notImpl
"elabUnitId"
1695 , elabComponentId
= notImpl
"elabComponentId"
1696 , elabLinkedInstantiatedWith
= Map
.empty
1697 , elabInstallDirs
= notImpl
"elabInstallDirs"
1698 , elabPkgOrComp
= ElabComponent
(ElaboratedComponent
{..})
1703 compSolverName
= CD
.ComponentSetup
1704 compComponentName
= Nothing
1706 dep_pkgs
= elaborateLibSolverId mapDep
=<< CD
.setupDeps deps0
1708 compLibDependencies
=
1709 -- MP: No idea what this function does
1710 map (\cid
-> (configuredId cid
, False)) dep_pkgs
1711 compLinkedLibDependencies
= notImpl
"compLinkedLibDependencies"
1712 compOrderLibDependencies
= notImpl
"compOrderLibDependencies"
1715 compExeDependencies
:: [a
]
1716 compExeDependencies
= []
1718 compExeDependencyPaths
:: [a
]
1719 compExeDependencyPaths
= []
1721 compPkgConfigDependencies
:: [a
]
1722 compPkgConfigDependencies
= []
1726 "Distribution.Client.ProjectPlanning.setupComponent: "
1728 ++ " not implemented yet"
1731 :: ( ConfiguredComponentMap
1732 , LinkedComponentMap
1733 , Map ComponentId
FilePath
1737 ( ( ConfiguredComponentMap
1738 , LinkedComponentMap
1739 , Map ComponentId
FilePath
1741 , ElaboratedConfiguredPackage
1743 buildComponent
(cc_map
, lc_map
, exe_map
) comp
=
1745 ( text
"In the stanza"
1746 <+> quotes
(text
(componentNameStanza cname
))
1749 -- 1. Configure the component, but with a place holder ComponentId.
1751 toConfiguredComponent
1753 (error "Distribution.Client.ProjectPlanning.cc_cid: filled in later")
1754 (Map
.unionWith Map
.union external_lib_cc_map cc_map
)
1755 (Map
.unionWith Map
.union external_exe_cc_map cc_map
)
1759 let cid
' = annotatedIdToConfiguredId
. ci_ann_id
$ cid
1760 in (cid
', False) -- filled in later in pruneInstallPlanPhase2)
1761 -- 2. Read out the dependencies from the ConfiguredComponent cc0
1762 let compLibDependencies
=
1763 -- Nub because includes can show up multiple times
1769 compExeDependencies
=
1771 annotatedIdToConfiguredId
1773 compExeDependencyPaths
=
1774 [ (annotatedIdToConfiguredId aid
', path
)
1775 | aid
' <- cc_exe_deps cc0
1776 , Just paths
<- [Map
.lookup (ann_id aid
') exe_map1
]
1779 elab_comp
= ElaboratedComponent
{..}
1781 -- 3. Construct a preliminary ElaboratedConfiguredPackage,
1782 -- and use this to compute the component ID. Fix up cc_id
1786 { elabPkgOrComp
= ElabComponent
$ elab_comp
1788 cid
= case elabBuildStyle elab0
of
1789 BuildInplaceOnly
{} ->
1793 ++ ( case Cabal
.componentNameString cname
of
1795 Just s
-> "-" ++ prettyShow s
1798 hashedInstalledPackageId
1800 elaboratedSharedConfig
1803 cc
= cc0
{cc_ann_id
= fmap (const cid
) (cc_ann_id cc0
)}
1804 infoProgress
$ dispConfiguredComponent cc
1806 -- 4. Perform mix-in linking
1807 let lookup_uid def_uid
=
1808 case Map
.lookup (unDefUnitId def_uid
) preexistingInstantiatedPkgs
of
1810 Nothing
-> error ("lookup_uid: " ++ prettyShow def_uid
)
1816 (elabPkgSourceId elab0
)
1817 (Map
.union external_lc_map lc_map
)
1819 infoProgress
$ dispLinkedComponent lc
1820 -- NB: elab is setup to be the correct form for an
1821 -- indefinite library, or a definite library with no holes.
1822 -- We will modify it in 'instantiateInstallPlan' to handle
1823 -- instantiated packages.
1825 -- 5. Construct the final ElaboratedConfiguredPackage
1829 { elabModuleShape
= lc_shape lc
1830 , elabUnitId
= abstractUnitId
(lc_uid lc
)
1831 , elabComponentId
= lc_cid lc
1832 , elabLinkedInstantiatedWith
= Map
.fromList
(lc_insts lc
)
1836 { compLinkedLibDependencies
= ordNub
(map ci_id
(lc_includes lc
))
1837 , compOrderLibDependencies
=
1840 (abstractUnitId
. ci_id
)
1841 (lc_includes lc
++ lc_sig_includes lc
)
1851 elaboratedSharedConfig
1855 -- 6. Construct the updated local maps
1856 let cc_map
' = extendConfiguredComponentMap cc cc_map
1857 lc_map
' = extendLinkedComponentMap lc lc_map
1858 exe_map
' = Map
.insert cid
(inplace_bin_dir elab
) exe_map
1860 return ((cc_map
', lc_map
', exe_map
'), elab
)
1862 compLinkedLibDependencies
= error "buildComponent: compLinkedLibDependencies"
1863 compOrderLibDependencies
= error "buildComponent: compOrderLibDependencies"
1865 cname
= Cabal
.componentName comp
1866 compComponentName
= Just cname
1867 compSolverName
= CD
.componentNameToComponent cname
1869 -- NB: compLinkedLibDependencies and
1870 -- compOrderLibDependencies are defined when we define
1872 external_lib_dep_sids
= CD
.select
(== compSolverName
) deps0
1873 external_exe_dep_sids
= CD
.select
(== compSolverName
) exe_deps0
1875 external_lib_dep_pkgs
= concatMap mapDep external_lib_dep_sids
1877 -- Combine library and build-tool dependencies, for backwards
1878 -- compatibility (See issue #5412 and the documentation for
1879 -- InstallPlan.fromSolverInstallPlan), but prefer the versions
1880 -- specified as build-tools.
1881 external_exe_dep_pkgs
=
1883 ordNubBy
(pkgName
. packageId
) $
1884 external_exe_dep_sids
++ external_lib_dep_sids
1888 [ (getComponentId pkg
, paths
)
1889 | pkg
<- external_exe_dep_pkgs
1890 , let paths
= planPackageExePaths pkg
1892 exe_map1
= Map
.union external_exe_map
$ fmap (\x
-> [x
]) exe_map
1894 external_lib_cc_map
=
1895 Map
.fromListWith Map
.union $
1896 map mkCCMapping external_lib_dep_pkgs
1897 external_exe_cc_map
=
1898 Map
.fromListWith Map
.union $
1899 map mkCCMapping external_exe_dep_pkgs
1902 map mkShapeMapping
$
1903 external_lib_dep_pkgs
++ concatMap mapDep external_exe_dep_sids
1905 compPkgConfigDependencies
=
1909 "compPkgConfigDependencies: impossible! "
1912 ++ prettyShow
(elabPkgSourceId elab0
)
1914 (pkgConfigDbPkgVersion pkgConfigDB pn
)
1916 | PkgconfigDependency pn _
<-
1918 (Cabal
.componentBuildInfo comp
)
1921 inplace_bin_dir elab
=
1924 elaboratedSharedConfig
1926 $ case Cabal
.componentNameString cname
of
1927 Just n
-> prettyShow n
1930 -- \| Given a 'SolverId' referencing a dependency on a library, return
1931 -- the 'ElaboratedPlanPackage' corresponding to the library. This
1932 -- returns at most one result.
1933 elaborateLibSolverId
1934 :: (SolverId
-> [ElaboratedPlanPackage
])
1936 -> [ElaboratedPlanPackage
]
1937 elaborateLibSolverId mapDep
= filter (matchPlanPkg
(== (CLibName LMainLibName
))) . mapDep
1939 -- \| Given an 'ElaboratedPlanPackage', return the paths to where the
1940 -- executables that this package represents would be installed.
1941 -- The only case where multiple paths can be returned is the inplace
1942 -- monolithic package one, since there can be multiple exes and each one
1943 -- has its own directory.
1944 planPackageExePaths
:: ElaboratedPlanPackage
-> [FilePath]
1945 planPackageExePaths
=
1946 -- Pre-existing executables are assumed to be in PATH
1947 -- already. In fact, this should be impossible.
1948 InstallPlan
.foldPlanPackage
(const []) $ \elab
->
1950 executables
:: [FilePath]
1952 case elabPkgOrComp elab
of
1953 -- Monolithic mode: all exes of the package
1955 unUnqualComponentName
. PD
.exeName
1956 <$> PD
.executables
(elabPkgDescription elab
)
1957 -- Per-component mode: just the selected exe
1958 ElabComponent comp
->
1960 Cabal
.componentNameString
1961 (compComponentName comp
) of
1962 Just
(Just n
) -> [prettyShow n
]
1967 elaboratedSharedConfig
1971 elaborateSolverToPackage
1972 :: NE
.NonEmpty NotPerComponentReason
1973 -> SolverPackage UnresolvedPkgLoc
1975 -> [ElaboratedConfiguredPackage
]
1976 -> ElaboratedConfiguredPackage
1977 elaborateSolverToPackage
1978 pkgWhyNotPerComponent
1980 (SourcePackage pkgid _gpd _srcloc _descOverride
)
1988 -- Knot tying: the final elab includes the
1989 -- pkgInstalledId, which is calculated by hashing many
1990 -- of the other fields of the elaboratedPackage.
1993 elab0
@ElaboratedConfiguredPackage
{..} =
1994 elaborateSolverToCommon pkg
1998 { elabUnitId
= newSimpleUnitId pkgInstalledId
1999 , elabComponentId
= pkgInstalledId
2000 , elabLinkedInstantiatedWith
= Map
.empty
2001 , elabPkgOrComp
= ElabPackage
$ ElaboratedPackage
{..}
2002 , elabModuleShape
= modShape
2011 elaboratedSharedConfig
2015 modShape
= case find (matchElabPkg
(== (CLibName LMainLibName
))) comps
of
2016 Nothing
-> emptyModuleShape
2017 Just e
-> Ty
.elabModuleShape e
2020 | shouldBuildInplaceOnly pkg
=
2021 mkComponentId
(prettyShow pkgid
++ "-inplace")
2023 assert
(isJust elabPkgSourceHash
) $
2024 hashedInstalledPackageId
2026 elaboratedSharedConfig
2027 elab
-- recursive use of elab
2030 -- Need to filter out internal dependencies, because they don't
2031 -- correspond to anything real anymore.
2032 isExt confid
= confSrcId confid
/= pkgid
2033 filterExt
= filter isExt
2035 filterExt
' :: [(ConfiguredId
, a
)] -> [(ConfiguredId
, a
)]
2036 filterExt
' = filter (isExt
. fst)
2038 pkgLibDependencies
=
2039 buildComponentDeps
(filterExt
' . compLibDependencies
)
2040 pkgExeDependencies
=
2041 buildComponentDeps
(filterExt
. compExeDependencies
)
2042 pkgExeDependencyPaths
=
2043 buildComponentDeps
(filterExt
' . compExeDependencyPaths
)
2045 -- TODO: Why is this flat?
2046 pkgPkgConfigDependencies
=
2047 CD
.flatDeps
$ buildComponentDeps compPkgConfigDependencies
2049 pkgDependsOnSelfLib
=
2051 [ (CD
.componentNameToComponent cn
, [()])
2052 | Graph
.N _ cn _
<- fromMaybe [] mb_closure
2055 mb_closure
= Graph
.revClosure compGraph
[k | k
<- Graph
.keys compGraph
, is_lib k
]
2056 -- NB: the sublib case should not occur, because sub-libraries
2057 -- are not supported without per-component builds
2058 is_lib
(CLibName _
) = True
2061 buildComponentDeps
:: Monoid a
=> (ElaboratedComponent
-> a
) -> CD
.ComponentDeps a
2062 buildComponentDeps f
=
2064 [ (compSolverName comp
, f comp
)
2065 | ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabComponent comp
} <- comps
2068 -- NB: This is not the final setting of 'pkgStanzasEnabled'.
2069 -- See [Sticky enabled testsuites]; we may enable some extra
2070 -- stanzas opportunistically when it is cheap to do so.
2072 -- However, we start off by enabling everything that was
2073 -- requested, so that we can maintain an invariant that
2074 -- pkgStanzasEnabled is a superset of elabStanzasRequested
2075 pkgStanzasEnabled
= optStanzaKeysFilteredByValue
(fromMaybe False) elabStanzasRequested
2077 elaborateSolverToCommon
2078 :: SolverPackage UnresolvedPkgLoc
2079 -> ElaboratedConfiguredPackage
2080 elaborateSolverToCommon
2082 (SourcePackage pkgid gdesc srcloc descOverride
)
2090 elaboratedPackage
= ElaboratedConfiguredPackage
{..}
2092 -- These get filled in later
2093 elabUnitId
= error "elaborateSolverToCommon: elabUnitId"
2094 elabComponentId
= error "elaborateSolverToCommon: elabComponentId"
2095 elabInstantiatedWith
= Map
.empty
2096 elabLinkedInstantiatedWith
= error "elaborateSolverToCommon: elabLinkedInstantiatedWith"
2097 elabPkgOrComp
= error "elaborateSolverToCommon: elabPkgOrComp"
2098 elabInstallDirs
= error "elaborateSolverToCommon: elabInstallDirs"
2099 elabModuleShape
= error "elaborateSolverToCommon: elabModuleShape"
2101 elabIsCanonical
= True
2102 elabPkgSourceId
= pkgid
2103 elabPkgDescription
= case PD
.finalizePD
2108 (compilerInfo compiler
)
2111 Right
(desc
, _
) -> desc
2112 Left _
-> error "Failed to finalizePD in elaborateSolverToCommon"
2113 elabFlagAssignment
= flags
2116 [ (PD
.flagName flag
, PD
.flagDefault flag
)
2117 | flag
<- PD
.genPackageFlags gdesc
2120 elabEnabledSpec
= enableStanzas stanzas
2121 elabStanzasAvailable
= stanzas
2123 elabStanzasRequested
:: OptionalStanzaMap
(Maybe Bool)
2124 elabStanzasRequested
= optStanzaTabulate
$ \o
-> case o
of
2125 -- NB: even if a package stanza is requested, if the package
2126 -- doesn't actually have any of that stanza we omit it from
2127 -- the request, to ensure that we don't decide that this
2128 -- package needs to be rebuilt. (It needs to be done here,
2129 -- because the ElaboratedConfiguredPackage is where we test
2130 -- whether or not there have been changes.)
2131 TestStanzas
-> listToMaybe [v | v
<- maybeToList tests
, _
<- PD
.testSuites elabPkgDescription
]
2132 BenchStanzas
-> listToMaybe [v | v
<- maybeToList benchmarks
, _
<- PD
.benchmarks elabPkgDescription
]
2134 tests
, benchmarks
:: Maybe Bool
2135 tests
= perPkgOptionMaybe pkgid packageConfigTests
2136 benchmarks
= perPkgOptionMaybe pkgid packageConfigBenchmarks
2138 -- This is a placeholder which will get updated by 'pruneInstallPlanPass1'
2139 -- and 'pruneInstallPlanPass2'. We can't populate it here
2140 -- because whether or not tests/benchmarks should be enabled
2141 -- is heuristically calculated based on whether or not the
2142 -- dependencies of the test suite have already been installed,
2143 -- but this function doesn't know what is installed (since
2144 -- we haven't improved the plan yet), so we do it in another pass.
2145 -- Check the comments of those functions for more details.
2146 elabConfigureTargets
= []
2147 elabBuildTargets
= []
2148 elabTestTargets
= []
2149 elabBenchTargets
= []
2151 elabHaddockTargets
= []
2154 perPkgOptionFlag pkgid
False packageConfigDocumentation
2156 elabPkgSourceLocation
= srcloc
2157 elabPkgSourceHash
= Map
.lookup pkgid sourcePackageHashes
2158 elabLocalToProject
= isLocalToProject pkg
2160 if shouldBuildInplaceOnly pkg
2161 then BuildInplaceOnly OnDisk
2162 else BuildAndInstall
2163 elabPackageDbs
= projectConfigPackageDBs sharedPackageConfig
2164 elabBuildPackageDBStack
= buildAndRegisterDbs
2165 elabRegisterPackageDBStack
= buildAndRegisterDbs
2167 elabSetupScriptStyle
= packageSetupScriptStyle elabPkgDescription
2168 elabSetupScriptCliVersion
=
2169 packageSetupScriptSpecVersion
2170 elabSetupScriptStyle
2174 elabSetupPackageDBStack
= buildAndRegisterDbs
2176 elabInplaceBuildPackageDBStack
= inplacePackageDbs
2177 elabInplaceRegisterPackageDBStack
= inplacePackageDbs
2178 elabInplaceSetupPackageDBStack
= inplacePackageDbs
2181 | shouldBuildInplaceOnly pkg
= inplacePackageDbs
2182 |
otherwise = corePackageDbs
2184 elabPkgDescriptionOverride
= descOverride
2188 { withVanillaLib
= perPkgOptionFlag pkgid
True packageConfigVanillaLib
-- TODO: [required feature]: also needs to be handled recursively
2189 , withSharedLib
= pkgid `Set
.member` pkgsUseSharedLibrary
2190 , withStaticLib
= perPkgOptionFlag pkgid
False packageConfigStaticLib
2191 , withDynExe
= perPkgOptionFlag pkgid
False packageConfigDynExe
2192 , withFullyStaticExe
= perPkgOptionFlag pkgid
False packageConfigFullyStaticExe
2193 , withGHCiLib
= perPkgOptionFlag pkgid
False packageConfigGHCiLib
-- TODO: [required feature] needs to default to enabled on windows still
2194 , withProfExe
= perPkgOptionFlag pkgid
False packageConfigProf
2195 , withProfLib
= pkgid `Set
.member` pkgsUseProfilingLibrary
2196 , exeCoverage
= perPkgOptionFlag pkgid
False packageConfigCoverage
2197 , libCoverage
= perPkgOptionFlag pkgid
False packageConfigCoverage
2198 , withOptimization
= perPkgOptionFlag pkgid NormalOptimisation packageConfigOptimization
2199 , splitObjs
= perPkgOptionFlag pkgid
False packageConfigSplitObjs
2200 , splitSections
= perPkgOptionFlag pkgid
False packageConfigSplitSections
2201 , stripLibs
= perPkgOptionFlag pkgid
False packageConfigStripLibs
2202 , stripExes
= perPkgOptionFlag pkgid
False packageConfigStripExes
2203 , withDebugInfo
= perPkgOptionFlag pkgid NoDebugInfo packageConfigDebugInfo
2204 , relocatable
= perPkgOptionFlag pkgid
False packageConfigRelocatable
2205 , withProfLibDetail
= elabProfExeDetail
2206 , withProfExeDetail
= elabProfLibDetail
2212 perPkgOptionLibExeFlag
2215 packageConfigProfDetail
2216 packageConfigProfLibDetail
2218 elabDumpBuildInfo
= perPkgOptionFlag pkgid NoDumpBuildInfo packageConfigDumpBuildInfo
2220 -- Combine the configured compiler prog settings with the user-supplied
2221 -- config. For the compiler progs any user-supplied config was taken
2222 -- into account earlier when configuring the compiler so its ok that
2223 -- our configured settings for the compiler override the user-supplied
2227 [ (programId prog
, programPath prog
)
2228 | prog
<- configuredPrograms compilerprogdb
2230 <> perPkgOptionMapLast pkgid packageConfigProgramPaths
2233 [ (programId prog
, args
)
2234 | prog
<- configuredPrograms compilerprogdb
2235 , let args
= programOverrideArgs prog
2238 <> perPkgOptionMapMappend pkgid packageConfigProgramArgs
2239 elabProgramPathExtra
= perPkgOptionNubList pkgid packageConfigProgramPathExtra
2240 elabConfigureScriptArgs
= perPkgOptionList pkgid packageConfigConfigureArgs
2241 elabExtraLibDirs
= perPkgOptionList pkgid packageConfigExtraLibDirs
2242 elabExtraLibDirsStatic
= perPkgOptionList pkgid packageConfigExtraLibDirsStatic
2243 elabExtraFrameworkDirs
= perPkgOptionList pkgid packageConfigExtraFrameworkDirs
2244 elabExtraIncludeDirs
= perPkgOptionList pkgid packageConfigExtraIncludeDirs
2245 elabProgPrefix
= perPkgOptionMaybe pkgid packageConfigProgPrefix
2246 elabProgSuffix
= perPkgOptionMaybe pkgid packageConfigProgSuffix
2248 elabHaddockHoogle
= perPkgOptionFlag pkgid
False packageConfigHaddockHoogle
2249 elabHaddockHtml
= perPkgOptionFlag pkgid
False packageConfigHaddockHtml
2250 elabHaddockHtmlLocation
= perPkgOptionMaybe pkgid packageConfigHaddockHtmlLocation
2251 elabHaddockForeignLibs
= perPkgOptionFlag pkgid
False packageConfigHaddockForeignLibs
2252 elabHaddockForHackage
= perPkgOptionFlag pkgid Cabal
.ForDevelopment packageConfigHaddockForHackage
2253 elabHaddockExecutables
= perPkgOptionFlag pkgid
False packageConfigHaddockExecutables
2254 elabHaddockTestSuites
= perPkgOptionFlag pkgid
False packageConfigHaddockTestSuites
2255 elabHaddockBenchmarks
= perPkgOptionFlag pkgid
False packageConfigHaddockBenchmarks
2256 elabHaddockInternal
= perPkgOptionFlag pkgid
False packageConfigHaddockInternal
2257 elabHaddockCss
= perPkgOptionMaybe pkgid packageConfigHaddockCss
2258 elabHaddockLinkedSource
= perPkgOptionFlag pkgid
False packageConfigHaddockLinkedSource
2259 elabHaddockQuickJump
= perPkgOptionFlag pkgid
False packageConfigHaddockQuickJump
2260 elabHaddockHscolourCss
= perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss
2261 elabHaddockContents
= perPkgOptionMaybe pkgid packageConfigHaddockContents
2262 elabHaddockIndex
= perPkgOptionMaybe pkgid packageConfigHaddockIndex
2263 elabHaddockBaseUrl
= perPkgOptionMaybe pkgid packageConfigHaddockBaseUrl
2264 elabHaddockLib
= perPkgOptionMaybe pkgid packageConfigHaddockLib
2265 elabHaddockOutputDir
= perPkgOptionMaybe pkgid packageConfigHaddockOutputDir
2267 elabTestMachineLog
= perPkgOptionMaybe pkgid packageConfigTestMachineLog
2268 elabTestHumanLog
= perPkgOptionMaybe pkgid packageConfigTestHumanLog
2269 elabTestShowDetails
= perPkgOptionMaybe pkgid packageConfigTestShowDetails
2270 elabTestKeepTix
= perPkgOptionFlag pkgid
False packageConfigTestKeepTix
2271 elabTestWrapper
= perPkgOptionMaybe pkgid packageConfigTestWrapper
2272 elabTestFailWhenNoTestSuites
= perPkgOptionFlag pkgid
False packageConfigTestFailWhenNoTestSuites
2273 elabTestTestOptions
= perPkgOptionList pkgid packageConfigTestTestOptions
2275 elabBenchmarkOptions
= perPkgOptionList pkgid packageConfigBenchmarkOptions
2277 perPkgOptionFlag
:: PackageId
-> a
-> (PackageConfig
-> Flag a
) -> a
2278 perPkgOptionMaybe
:: PackageId
-> (PackageConfig
-> Flag a
) -> Maybe a
2279 perPkgOptionList
:: PackageId
-> (PackageConfig
-> [a
]) -> [a
]
2281 perPkgOptionFlag pkgid def f
= fromFlagOrDefault def
(lookupPerPkgOption pkgid f
)
2282 perPkgOptionMaybe pkgid f
= flagToMaybe
(lookupPerPkgOption pkgid f
)
2283 perPkgOptionList pkgid f
= lookupPerPkgOption pkgid f
2284 perPkgOptionNubList pkgid f
= fromNubList
(lookupPerPkgOption pkgid f
)
2285 perPkgOptionMapLast pkgid f
= getMapLast
(lookupPerPkgOption pkgid f
)
2286 perPkgOptionMapMappend pkgid f
= getMapMappend
(lookupPerPkgOption pkgid f
)
2288 perPkgOptionLibExeFlag pkgid def fboth flib
= (exe
, lib
)
2290 exe
= fromFlagOrDefault def bothflag
2291 lib
= fromFlagOrDefault def
(bothflag
<> libflag
)
2293 bothflag
= lookupPerPkgOption pkgid fboth
2294 libflag
= lookupPerPkgOption pkgid flib
2297 :: (Package pkg
, Monoid m
)
2299 -> (PackageConfig
-> m
)
2301 lookupPerPkgOption pkg f
=
2302 -- This is where we merge the options from the project config that
2303 -- apply to all packages, all project local packages, and to specific
2305 global `mappend` local `mappend` perpkg
2307 global
= f allPackagesConfig
2309 | isLocalToProject pkg
=
2310 f localPackagesConfig
2313 perpkg
= maybe mempty f
(Map
.lookup (packageName pkg
) perPackageConfig
)
2317 ++ [distPackageDB
(compilerId compiler
)]
2319 corePackageDbs
= storePackageDBStack compiler
(projectConfigPackageDBs sharedPackageConfig
)
2321 -- For this local build policy, every package that lives in a local source
2322 -- dir (as opposed to a tarball), or depends on such a package, will be
2323 -- built inplace into a shared dist dir. Tarball packages that depend on
2324 -- source dir packages will also get unpacked locally.
2325 shouldBuildInplaceOnly
:: SolverPackage loc
-> Bool
2326 shouldBuildInplaceOnly pkg
=
2329 pkgsToBuildInplaceOnly
2331 pkgsToBuildInplaceOnly
:: Set PackageId
2332 pkgsToBuildInplaceOnly
=
2335 SolverInstallPlan
.reverseDependencyClosure
2337 (map PlannedId
(Set
.toList pkgsLocalToProject
))
2339 isLocalToProject
:: Package pkg
=> pkg
-> Bool
2340 isLocalToProject pkg
=
2345 pkgsLocalToProject
:: Set PackageId
2346 pkgsLocalToProject
=
2347 Set
.fromList
(catMaybes (map shouldBeLocal localPackages
))
2348 -- TODO: localPackages is a misnomer, it's all project packages
2349 -- here is where we decide which ones will be local!
2351 pkgsUseSharedLibrary
:: Set PackageId
2352 pkgsUseSharedLibrary
=
2353 packagesWithLibDepsDownwardClosedProperty needsSharedLib
2355 needsSharedLib pkg
=
2357 compilerShouldUseSharedLibByDefault
2358 (liftM2 (||
) pkgSharedLib pkgDynExe
)
2360 pkgid
= packageId pkg
2361 pkgSharedLib
= perPkgOptionMaybe pkgid packageConfigSharedLib
2362 pkgDynExe
= perPkgOptionMaybe pkgid packageConfigDynExe
2364 -- TODO: [code cleanup] move this into the Cabal lib. It's currently open
2365 -- coded in Distribution.Simple.Configure, but should be made a proper
2366 -- function of the Compiler or CompilerInfo.
2367 compilerShouldUseSharedLibByDefault
=
2368 case compilerFlavor compiler
of
2369 GHC
-> GHC
.isDynamic compiler
2370 GHCJS
-> GHCJS
.isDynamic compiler
2373 pkgsUseProfilingLibrary
:: Set PackageId
2374 pkgsUseProfilingLibrary
=
2375 packagesWithLibDepsDownwardClosedProperty needsProfilingLib
2377 needsProfilingLib pkg
=
2378 fromFlagOrDefault
False (profBothFlag
<> profLibFlag
)
2380 pkgid
= packageId pkg
2381 profBothFlag
= lookupPerPkgOption pkgid packageConfigProf
2382 profLibFlag
= lookupPerPkgOption pkgid packageConfigProfLib
2383 -- TODO: [code cleanup] unused: the old deprecated packageConfigProfExe
2386 Graph
.fromDistinctList
$
2388 NonSetupLibDepSolverPlanPackage
2389 (SolverInstallPlan
.toList solverPlan
)
2391 packagesWithLibDepsDownwardClosedProperty property
=
2398 | pkg
<- SolverInstallPlan
.toList solverPlan
2399 , property pkg
-- just the packages that satisfy the property
2400 -- TODO: [nice to have] this does not check the config consistency,
2401 -- e.g. a package explicitly turning off profiling, but something
2402 -- depending on it that needs profiling. This really needs a separate
2403 -- package config validation/resolution pass.
2406 -- TODO: [nice to have] config consistency checking:
2407 -- + profiling libs & exes, exe needs lib, recursive
2408 -- + shared libs & exes, exe needs lib, recursive
2409 -- + vanilla libs & exes, exe needs lib, recursive
2410 -- + ghci or shared lib needed by TH, recursive, ghc version dependent
2412 -- TODO: Drop matchPlanPkg/matchElabPkg in favor of mkCCMapping
2414 shouldBeLocal
:: PackageSpecifier
(SourcePackage
(PackageLocation loc
)) -> Maybe PackageId
2415 shouldBeLocal NamedPackage
{} = Nothing
2416 shouldBeLocal
(SpecificSourcePackage pkg
) = case srcpkgSource pkg
of
2417 LocalUnpackedPackage _
-> Just
(packageId pkg
)
2420 -- | Given a 'ElaboratedPlanPackage', report if it matches a 'ComponentName'.
2421 matchPlanPkg
:: (ComponentName
-> Bool) -> ElaboratedPlanPackage
-> Bool
2422 matchPlanPkg p
= InstallPlan
.foldPlanPackage
(p
. ipiComponentName
) (matchElabPkg p
)
2424 -- | Get the appropriate 'ComponentName' which identifies an installed
2426 ipiComponentName
:: IPI
.InstalledPackageInfo
-> ComponentName
2427 ipiComponentName
= CLibName
. IPI
.sourceLibName
2429 -- | Given a 'ElaboratedConfiguredPackage', report if it matches a
2431 matchElabPkg
:: (ComponentName
-> Bool) -> ElaboratedConfiguredPackage
-> Bool
2432 matchElabPkg p elab
=
2433 case elabPkgOrComp elab
of
2434 ElabComponent comp
-> maybe False p
(compComponentName comp
)
2436 -- So, what should we do here? One possibility is to
2437 -- unconditionally return 'True', because whatever it is
2438 -- that we're looking for, it better be in this package.
2439 -- But this is a bit dodgy if the package doesn't actually
2440 -- have, e.g., a library. Fortunately, it's not possible
2441 -- for the build of the library/executables to be toggled
2442 -- by 'pkgStanzasEnabled', so the only thing we have to
2443 -- test is if the component in question is *buildable.*
2446 (Cabal
.pkgBuildableComponents
(elabPkgDescription elab
))
2448 -- | Given an 'ElaboratedPlanPackage', generate the mapping from 'PackageName'
2449 -- and 'ComponentName' to the 'ComponentId' that should be used
2452 :: ElaboratedPlanPackage
2453 -> (PackageName
, Map ComponentName
(AnnotatedId ComponentId
))
2455 InstallPlan
.foldPlanPackage
2459 (ipiComponentName ipkg
)
2462 { ann_id
= IPI
.installedComponentId ipkg
2463 , ann_pid
= packageId ipkg
2464 , ann_cname
= IPI
.sourceComponentName ipkg
2472 { ann_id
= elabComponentId elab
2473 , ann_pid
= packageId elab
2476 in ( packageName elab
2477 , case elabPkgOrComp elab
of
2478 ElabComponent comp
->
2479 case compComponentName comp
of
2480 Nothing
-> Map
.empty
2481 Just n
-> Map
.singleton n
(mk_aid n
)
2485 (\comp
-> let cn
= Cabal
.componentName comp
in (cn
, mk_aid cn
))
2486 (Cabal
.pkgBuildableComponents
(elabPkgDescription elab
))
2489 -- | Given an 'ElaboratedPlanPackage', generate the mapping from 'ComponentId'
2490 -- to the shape of this package, as per mix-in linking.
2492 :: ElaboratedPlanPackage
2493 -> (ComponentId
, (OpenUnitId
, ModuleShape
))
2494 mkShapeMapping dpkg
=
2495 (getComponentId dpkg
, (indef_uid
, shape
))
2498 InstallPlan
.foldPlanPackage
2500 (liftM2 (,) IPI
.installedComponentId shapeInstalledPackage
)
2501 (liftM2 (,) elabComponentId elabModuleShape
)
2507 [ (req
, OpenModuleVar req
)
2508 | req
<- Set
.toList
(modShapeRequires shape
)
2512 -- | Get the bin\/ directories that a package's executables should reside in.
2514 -- The result may be empty if the package does not build any executables.
2516 -- The result may have several entries if this is an inplace build of a package
2517 -- with multiple executables.
2520 -> ElaboratedSharedConfig
2521 -> ElaboratedConfiguredPackage
2523 binDirectories layout config package
= case elabBuildStyle package
of
2524 -- quick sanity check: no sense returning a bin directory if we're not going
2525 -- to put any executables in it, that will just clog up the PATH
2526 _ | noExecutables
-> []
2527 BuildAndInstall
-> [installedBinDirectory package
]
2528 BuildInplaceOnly
{} -> map (root
</>) $ case elabPkgOrComp package
of
2529 ElabComponent comp
-> case compSolverName comp
of
2530 CD
.ComponentExe n
-> [prettyShow n
]
2533 map (prettyShow
. PD
.exeName
)
2535 . elabPkgDescription
2538 noExecutables
= null . PD
.executables
. elabPkgDescription
$ package
2540 distBuildDirectory layout
(elabDistDirParams config package
)
2543 type InstS
= Map UnitId ElaboratedPlanPackage
2544 type InstM a
= State InstS a
2547 :: ElaboratedPlanPackage
2549 getComponentId
(InstallPlan
.PreExisting dipkg
) = IPI
.installedComponentId dipkg
2550 getComponentId
(InstallPlan
.Configured elab
) = elabComponentId elab
2551 getComponentId
(InstallPlan
.Installed elab
) = elabComponentId elab
2553 extractElabBuildStyle
2554 :: InstallPlan
.GenericPlanPackage ipkg ElaboratedConfiguredPackage
2556 extractElabBuildStyle
(InstallPlan
.Configured elab
) = elabBuildStyle elab
2557 extractElabBuildStyle _
= BuildAndInstall
2559 -- instantiateInstallPlan is responsible for filling out an InstallPlan
2560 -- with all of the extra Configured packages that would be generated by
2561 -- recursively instantiating the dependencies of packages.
2563 -- Suppose we are compiling the following packages:
2569 -- dependency f[H=containers:Data.Map]
2571 -- At entry, we have an InstallPlan with a single plan package per
2572 -- actual source package, e.g., only (indefinite!) f and g. The job of
2573 -- instantiation is to turn this into three plan packages: each of the
2574 -- packages as before, but also a new, definite package f[H=containers:Data.Map]
2576 -- How do we do this? The general strategy is to iterate over every
2577 -- package in the existing plan and recursively create new entries for
2578 -- each of its dependencies which is an instantiated package (e.g.,
2579 -- f[H=p:G]). This process must be recursive, as f itself may depend on
2580 -- OTHER packages which it instantiated using its hole H.
2584 -- * We have to keep track of whether or not we are instantiating with
2585 -- inplace packages, because instantiating a non-inplace package with
2586 -- an inplace packages makes it inplace (since it depends on
2587 -- something in the inplace store)! The rule is that if any of the
2588 -- modules in an instantiation are inplace, then the instantiated
2589 -- unit itself must be inplace. There is then a bunch of faffing
2590 -- about to keep track of BuildStyle.
2592 -- * ElaboratedConfiguredPackage was never really designed for post
2593 -- facto instantiation, so some of the steps for generating new
2594 -- instantiations are a little fraught. For example, the act of
2595 -- flipping a package to be inplace involves faffing about with four
2596 -- fields, because these fields are precomputed. A good refactor
2597 -- would be to reduce the amount of precomputation to simplify the
2600 -- * We use the state monad to cache already instantiated modules, so
2601 -- we don't instantiate the same thing multiple times.
2603 instantiateInstallPlan
:: StoreDirLayout
-> InstallDirs
.InstallDirTemplates
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
2604 instantiateInstallPlan storeDirLayout defaultInstallDirs elaboratedShared plan
=
2606 (IndependentGoals
False)
2607 (Graph
.fromDistinctList
(Map
.elems ready_map
))
2609 pkgs
= InstallPlan
.toList plan
2611 cmap
= Map
.fromList
[(getComponentId pkg
, pkg
) | pkg
<- pkgs
]
2615 -> Map ModuleName
(Module
, BuildStyle
)
2616 -> InstM
(DefUnitId
, BuildStyle
)
2617 instantiateUnitId cid insts
= state
$ \s
->
2618 case Map
.lookup uid s
of
2621 -- TODO: I don't think the knot tying actually does
2625 (instantiateComponent uid cid insts
)
2626 (Map
.insert uid r s
)
2627 in ((def_uid
, extractElabBuildStyle r
), Map
.insert uid r s
')
2628 Just r
-> ((def_uid
, extractElabBuildStyle r
), s
)
2630 def_uid
= mkDefUnitId cid
(fmap fst insts
)
2631 uid
= unDefUnitId def_uid
2633 -- No need to InplaceT; the inplace-ness is properly computed for
2634 -- the ElaboratedPlanPackage, so that will implicitly pass it on
2635 instantiateComponent
2638 -> Map ModuleName
(Module
, BuildStyle
)
2639 -> InstM ElaboratedPlanPackage
2640 instantiateComponent uid cid insts
2641 | Just planpkg
<- Map
.lookup cid cmap
=
2643 InstallPlan
.Configured
2644 ( elab0
@ElaboratedConfiguredPackage
2645 { elabPkgOrComp
= ElabComponent comp
2649 traverse
(fmap fst . substUnitId insts
) (compLinkedLibDependencies comp
)
2650 let build_style
= fold
(fmap snd insts
)
2651 let getDep
(Module dep_uid _
) = [dep_uid
]
2653 fixupBuildStyle build_style
$
2656 , elabComponentId
= cid
2657 , elabInstantiatedWith
= fmap fst insts
2658 , elabIsCanonical
= Map
.null (fmap fst insts
)
2662 { compOrderLibDependencies
=
2663 (if Map
.null insts
then [] else [newSimpleUnitId cid
])
2667 (deps
++ concatMap (getDep
. fst) (Map
.elems insts
))
2680 return $ InstallPlan
.Configured elab
2682 |
otherwise = error ("instantiateComponent: " ++ prettyShow cid
)
2684 substUnitId
:: Map ModuleName
(Module
, BuildStyle
) -> OpenUnitId
-> InstM
(DefUnitId
, BuildStyle
)
2685 substUnitId _
(DefiniteUnitId uid
) =
2686 -- This COULD actually, secretly, be an inplace package, but in
2687 -- that case it doesn't matter as it's already been recorded
2688 -- in the package that depends on this
2689 return (uid
, BuildAndInstall
)
2690 substUnitId subst
(IndefFullUnitId cid insts
) = do
2691 insts
' <- substSubst subst insts
2692 instantiateUnitId cid insts
'
2694 -- NB: NOT composition
2696 :: Map ModuleName
(Module
, BuildStyle
)
2697 -> Map ModuleName OpenModule
2698 -> InstM
(Map ModuleName
(Module
, BuildStyle
))
2699 substSubst subst insts
= traverse
(substModule subst
) insts
2701 substModule
:: Map ModuleName
(Module
, BuildStyle
) -> OpenModule
-> InstM
(Module
, BuildStyle
)
2702 substModule subst
(OpenModuleVar mod_name
)
2703 | Just m
<- Map
.lookup mod_name subst
= return m
2704 |
otherwise = error "substModule: non-closing substitution"
2705 substModule subst
(OpenModule uid mod_name
) = do
2706 (uid
', build_style
) <- substUnitId subst uid
2707 return (Module uid
' mod_name
, build_style
)
2709 indefiniteUnitId
:: ComponentId
-> InstM UnitId
2710 indefiniteUnitId cid
= do
2711 let uid
= newSimpleUnitId cid
2712 r
<- indefiniteComponent uid cid
2713 state
$ \s
-> (uid
, Map
.insert uid r s
)
2715 indefiniteComponent
:: UnitId
-> ComponentId
-> InstM ElaboratedPlanPackage
2716 indefiniteComponent _uid cid
2717 -- Only need Configured; this phase happens before improvement, so
2718 -- there shouldn't be any Installed packages here.
2719 | Just
(InstallPlan
.Configured epkg
) <- Map
.lookup cid cmap
2720 , ElabComponent elab_comp
<- elabPkgOrComp epkg
=
2722 -- We need to do a little more processing of the includes: some
2723 -- of them are fully definite even without substitution. We
2724 -- want to build those too; see #5634.
2726 -- This code mimics similar code in Distribution.Backpack.ReadyComponent;
2727 -- however, unlike the conversion from LinkedComponent to
2728 -- ReadyComponent, this transformation is done *without*
2729 -- changing the type in question; and what we are simply
2730 -- doing is enforcing tighter invariants on the data
2731 -- structure in question. The new invariant is that there
2732 -- is no IndefFullUnitId in compLinkedLibDependencies that actually
2733 -- has no holes. We couldn't specify this invariant when
2734 -- we initially created the ElaboratedPlanPackage because
2735 -- we have no way of actually reifying the UnitId into a
2736 -- DefiniteUnitId (that's what substUnitId does!)
2737 new_deps
<- for
(compLinkedLibDependencies elab_comp
) $ \uid
->
2738 if Set
.null (openUnitIdFreeHoles uid
)
2739 then fmap (DefiniteUnitId
. fst) (substUnitId Map
.empty uid
)
2741 -- NB: no fixupBuildStyle needed here, as if the indefinite
2742 -- component depends on any inplace packages, it itself must
2743 -- be indefinite! There is no substitution here, we can't
2744 -- post facto add inplace deps
2745 return . InstallPlan
.Configured
$
2750 { compLinkedLibDependencies
= new_deps
2751 , -- I think this is right: any new definite unit ids we
2752 -- minted in the phase above need to be built before us.
2753 -- Add 'em in. This doesn't remove any old dependencies
2754 -- on the indefinite package; they're harmless.
2755 compOrderLibDependencies
=
2757 compOrderLibDependencies elab_comp
2758 ++ [unDefUnitId d | DefiniteUnitId d
<- new_deps
]
2761 | Just planpkg
<- Map
.lookup cid cmap
=
2763 |
otherwise = error ("indefiniteComponent: " ++ prettyShow cid
)
2765 fixupBuildStyle BuildAndInstall elab
= elab
2766 fixupBuildStyle _
(elab
@ElaboratedConfiguredPackage
{elabBuildStyle
= BuildInplaceOnly
{}}) = elab
2767 fixupBuildStyle t
@(BuildInplaceOnly
{}) elab
=
2769 { elabBuildStyle
= t
2770 , elabBuildPackageDBStack
= elabInplaceBuildPackageDBStack elab
2771 , elabRegisterPackageDBStack
= elabInplaceRegisterPackageDBStack elab
2772 , elabSetupPackageDBStack
= elabInplaceSetupPackageDBStack elab
2775 ready_map
= execState work Map
.empty
2777 work
= for_ pkgs
$ \pkg
->
2779 InstallPlan
.Configured elab
2780 |
not (Map
.null (elabLinkedInstantiatedWith elab
)) ->
2781 indefiniteUnitId
(elabComponentId elab
)
2784 instantiateUnitId
(getComponentId pkg
) Map
.empty
2787 ---------------------------
2791 -- Refer to ProjectPlanning.Types for details of these important types:
2793 -- data ComponentTarget = ...
2794 -- data SubComponentTarget = ...
2796 -- One step in the build system is to translate higher level intentions like
2797 -- "build this package", "test that package", or "repl that component" into
2798 -- a more detailed specification of exactly which components to build (or other
2799 -- actions like repl or build docs). This translation is somewhat different for
2800 -- different commands. For example "test" for a package will build a different
2801 -- set of components than "build". In addition, the translation of these
2802 -- intentions can fail. For example "run" for a package is only unambiguous
2803 -- when the package has a single executable.
2805 -- So we need a little bit of infrastructure to make it easy for the command
2806 -- implementations to select what component targets are meant when a user asks
2807 -- to do something with a package or component. To do this (and to be able to
2808 -- produce good error messages for mistakes and when targets are not available)
2809 -- we need to gather and summarise accurate information about all the possible
2810 -- targets, both available and unavailable. Then a command implementation can
2811 -- decide which of the available component targets should be selected.
2813 -- | An available target represents a component within a package that a user
2814 -- command could plausibly refer to. In this sense, all the components defined
2815 -- within the package are things the user could refer to, whether or not it
2816 -- would actually be possible to build that component.
2818 -- In particular the available target contains an 'AvailableTargetStatus' which
2819 -- informs us about whether it's actually possible to select this component to
2820 -- be built, and if not why not. This detail makes it possible for command
2821 -- implementations (like @build@, @test@ etc) to accurately report why a target
2824 -- Note that the type parameter is used to help enforce that command
2825 -- implementations can only select targets that can actually be built (by
2826 -- forcing them to return the @k@ value for the selected targets).
2827 -- In particular 'resolveTargets' makes use of this (with @k@ as
2828 -- @('UnitId', ComponentName')@) to identify the targets thus selected.
2829 data AvailableTarget k
= AvailableTarget
2830 { availableTargetPackageId
:: PackageId
2831 , availableTargetComponentName
:: ComponentName
2832 , availableTargetStatus
:: AvailableTargetStatus k
2833 , availableTargetLocalToProject
:: Bool
2835 deriving (Eq
, Show, Functor
)
2837 -- | The status of a an 'AvailableTarget' component. This tells us whether
2838 -- it's actually possible to select this component to be built, and if not
2840 data AvailableTargetStatus k
2841 = -- | When the user does @tests: False@
2842 TargetDisabledByUser
2843 |
-- | When the solver could not enable tests
2844 TargetDisabledBySolver
2845 |
-- | When the component has @buildable: False@
2847 |
-- | When the component is non-core in a non-local package
2849 |
-- | The target can or should be built
2850 TargetBuildable k TargetRequested
2851 deriving (Eq
, Ord
, Show, Functor
)
2853 -- | This tells us whether a target ought to be built by default, or only if
2854 -- specifically requested. The policy is that components like libraries and
2855 -- executables are built by default by @build@, but test suites and benchmarks
2856 -- are not, unless this is overridden in the project configuration.
2857 data TargetRequested
2858 = -- | To be built by default
2859 TargetRequestedByDefault
2860 |
-- | Not to be built by default
2861 TargetNotRequestedByDefault
2862 deriving (Eq
, Ord
, Show)
2864 -- | Given the install plan, produce the set of 'AvailableTarget's for each
2865 -- package-component pair.
2867 -- Typically there will only be one such target for each component, but for
2868 -- example if we have a plan with both normal and profiling variants of a
2869 -- component then we would get both as available targets, or similarly if we
2870 -- had a plan that contained two instances of the same version of a package.
2871 -- This approach makes it relatively easy to select all instances\/variants
2874 :: ElaboratedInstallPlan
2876 (PackageId
, ComponentName
)
2877 [AvailableTarget
(UnitId
, ComponentName
)]
2878 availableTargets installPlan
=
2880 [ (pkgid
, cname
, fake
, target
)
2881 | pkg
<- InstallPlan
.toList installPlan
2882 , (pkgid
, cname
, fake
, target
) <- case pkg
of
2883 InstallPlan
.PreExisting ipkg
-> availableInstalledTargets ipkg
2884 InstallPlan
.Installed elab
-> availableSourceTargets elab
2885 InstallPlan
.Configured elab
-> availableSourceTargets elab
2890 [ ((pkgid
, cname
), [target
])
2891 |
(pkgid
, cname
, fake
, target
) <- rs
2896 [ ((pkgid
, cname
), [target
])
2897 |
(pkgid
, cname
, fake
, target
) <- rs
2902 -- The normal targets mask the fake ones. We get all instances of the
2903 -- normal ones and only one copy of the fake ones (as there are many
2904 -- duplicates of the fake ones). See 'availableSourceTargets' below for
2905 -- more details on this fake stuff is about.
2907 availableInstalledTargets
2908 :: IPI
.InstalledPackageInfo
2912 , AvailableTarget
(UnitId
, ComponentName
)
2915 availableInstalledTargets ipkg
=
2916 let unitid
= installedUnitId ipkg
2917 cname
= CLibName LMainLibName
2918 status
= TargetBuildable
(unitid
, cname
) TargetRequestedByDefault
2919 target
= AvailableTarget
(packageId ipkg
) cname status
False
2921 in [(packageId ipkg
, cname
, fake
, target
)]
2923 availableSourceTargets
2924 :: ElaboratedConfiguredPackage
2928 , AvailableTarget
(UnitId
, ComponentName
)
2931 availableSourceTargets elab
=
2932 -- We have a somewhat awkward problem here. We need to know /all/ the
2933 -- components from /all/ the packages because these are the things that
2934 -- users could refer to. Unfortunately, at this stage the elaborated install
2935 -- plan does /not/ contain all components: some components have already
2936 -- been deleted because they cannot possibly be built. This is the case
2937 -- for components that are marked @buildable: False@ in their .cabal files.
2938 -- (It's not unreasonable that the unbuildable components have been pruned
2939 -- as the plan invariant is considerably simpler if all nodes can be built)
2941 -- We can recover the missing components but it's not exactly elegant. For
2942 -- a graph node corresponding to a component we still have the information
2943 -- about the package that it came from, and this includes the names of
2944 -- /all/ the other components in the package. So in principle this lets us
2945 -- find the names of all components, plus full details of the buildable
2948 -- Consider for example a package with 3 exe components: foo, bar and baz
2949 -- where foo and bar are buildable, but baz is not. So the plan contains
2950 -- nodes for the components foo and bar. Now we look at each of these two
2951 -- nodes and look at the package they come from and the names of the
2952 -- components in this package. This will give us the names foo, bar and
2953 -- baz, twice (once for each of the two buildable components foo and bar).
2955 -- We refer to these reconstructed missing components as fake targets.
2956 -- It is an invariant that they are not available to be built.
2958 -- To produce the final set of targets we put the fake targets in a finite
2959 -- map (thus eliminating the duplicates) and then we overlay that map with
2960 -- the normal buildable targets. (This is done above in 'availableTargets'.)
2962 [ (packageId elab
, cname
, fake
, target
)
2963 | component
<- pkgComponents
(elabPkgDescription elab
)
2964 , let cname
= componentName component
2965 status
= componentAvailableTargetStatus component
2968 { availableTargetPackageId
= packageId elab
2969 , availableTargetComponentName
= cname
2970 , availableTargetStatus
= status
2971 , availableTargetLocalToProject
= elabLocalToProject elab
2973 fake
= isFakeTarget cname
2974 , -- TODO: The goal of this test is to exclude "instantiated"
2975 -- packages as available targets. This means that you can't
2976 -- ask for a particular instantiated component to be built;
2977 -- it will only get built by a dependency. Perhaps the
2978 -- correct way to implement this is to run selection
2979 -- prior to instantiating packages. If you refactor
2980 -- this, then you can delete this test.
2981 elabIsCanonical elab
2982 , -- Filter out some bogus parts of the cross product that are never needed
2984 TargetBuildable
{} | fake
-> False
2988 isFakeTarget cname
=
2989 case elabPkgOrComp elab
of
2990 ElabPackage _
-> False
2991 ElabComponent elabComponent
->
2992 compComponentName elabComponent
2995 componentAvailableTargetStatus
2996 :: Component
-> AvailableTargetStatus
(UnitId
, ComponentName
)
2997 componentAvailableTargetStatus component
=
2998 case componentOptionalStanza
$ CD
.componentNameToComponent cname
of
2999 -- it is not an optional stanza, so a library, exe or foreign lib
3001 |
not buildable
-> TargetNotBuildable
3004 (elabUnitId elab
, cname
)
3005 TargetRequestedByDefault
3006 -- it is not an optional stanza, so a testsuite or benchmark
3008 case ( optStanzaLookup stanza
(elabStanzasRequested elab
) -- TODO
3009 , optStanzaSetMember stanza
(elabStanzasAvailable elab
)
3011 _ |
not withinPlan
-> TargetNotLocal
3012 (Just
False, _
) -> TargetDisabledByUser
3013 (Nothing
, False) -> TargetDisabledBySolver
3014 _ |
not buildable
-> TargetNotBuildable
3015 (Just
True, True) ->
3017 (elabUnitId elab
, cname
)
3018 TargetRequestedByDefault
3021 (elabUnitId elab
, cname
)
3022 TargetNotRequestedByDefault
3023 (Just
True, False) ->
3024 error $ "componentAvailableTargetStatus: impossible; cname=" ++ prettyShow cname
3026 cname
= componentName component
3027 buildable
= PD
.buildable
(componentBuildInfo component
)
3029 elabLocalToProject elab
3030 ||
case elabPkgOrComp elab
of
3031 ElabComponent elabComponent
->
3032 compComponentName elabComponent
== Just cname
3034 case componentName component
of
3035 CLibName
(LMainLibName
) -> True
3037 -- TODO: what about sub-libs and foreign libs?
3040 -- | Merge component targets that overlap each other. Specially when we have
3041 -- multiple targets for the same component and one of them refers to the whole
3042 -- component (rather than a module or file within) then all the other targets
3043 -- for that component are subsumed.
3045 -- We also allow for information associated with each component target, and
3046 -- whenever we targets subsume each other we aggregate their associated info.
3047 nubComponentTargets
:: [(ComponentTarget
, a
)] -> [(ComponentTarget
, NonEmpty a
)]
3048 nubComponentTargets
=
3049 concatMap (wholeComponentOverrides
. map snd)
3050 . groupBy ((==) `on`
fst)
3051 . sortBy (compare `on`
fst)
3052 . map (\t@((ComponentTarget cname _
, _
)) -> (cname
, t
))
3053 . map compatSubComponentTargets
3055 -- If we're building the whole component then that the only target all we
3056 -- need, otherwise we can have several targets within the component.
3057 wholeComponentOverrides
3058 :: [(ComponentTarget
, a
)]
3059 -> [(ComponentTarget
, NonEmpty a
)]
3060 wholeComponentOverrides ts
=
3061 case [ta | ta
@(ComponentTarget _ WholeComponent
, _
) <- ts
] of
3064 -- Delete tuple (t, x) from original list to avoid duplicates.
3065 -- Use 'deleteBy', to avoid additional Class constraint on 'nubComponentTargets'.
3066 ts
' = deleteBy (\(t1
, _
) (t2
, _
) -> t1
== t2
) (t
, x
) ts
3068 [(t
, x
:|
map snd ts
')]
3069 [] -> [(t
, x
:|
[]) |
(t
, x
) <- ts
]
3071 -- Not all Cabal Setup.hs versions support sub-component targets, so switch
3072 -- them over to the whole component
3073 compatSubComponentTargets
:: (ComponentTarget
, a
) -> (ComponentTarget
, a
)
3074 compatSubComponentTargets target
@(ComponentTarget cname _subtarget
, x
)
3075 |
not setupHsSupportsSubComponentTargets
=
3076 (ComponentTarget cname WholeComponent
, x
)
3077 |
otherwise = target
3079 -- Actually the reality is that no current version of Cabal's Setup.hs
3080 -- build command actually support building specific files or modules.
3081 setupHsSupportsSubComponentTargets
= False
3083 -- TODO: when that changes, adjust this test, e.g.
3084 -- \| pkgSetupScriptCliVersion >= Version [x,y] []
3086 pkgHasEphemeralBuildTargets
:: ElaboratedConfiguredPackage
-> Bool
3087 pkgHasEphemeralBuildTargets elab
=
3088 (not . null) (elabReplTarget elab
)
3089 ||
(not . null) (elabTestTargets elab
)
3090 ||
(not . null) (elabBenchTargets elab
)
3091 ||
(not . null) (elabHaddockTargets elab
)
3093 [ () | ComponentTarget _ subtarget
<- elabBuildTargets elab
, subtarget
/= WholeComponent
3096 -- | The components that we'll build all of, meaning that after they're built
3097 -- we can skip building them again (unlike with building just some modules or
3098 -- other files within a component).
3099 elabBuildTargetWholeComponents
3100 :: ElaboratedConfiguredPackage
3101 -> Set ComponentName
3102 elabBuildTargetWholeComponents elab
=
3104 [cname | ComponentTarget cname WholeComponent
<- elabBuildTargets elab
]
3106 ------------------------------------------------------------------------------
3108 -- * Install plan pruning
3110 ------------------------------------------------------------------------------
3112 -- | How 'pruneInstallPlanToTargets' should interpret the per-package
3113 -- 'ComponentTarget's: as build, repl or haddock targets.
3115 = TargetActionConfigure
3120 | TargetActionHaddock
3122 -- | Given a set of per-package\/per-component targets, take the subset of the
3123 -- install plan needed to build those targets. Also, update the package config
3124 -- to specify which optional stanzas to enable, and which targets within each
3125 -- package to build.
3127 -- NB: Pruning happens after improvement, which is important because we
3128 -- will prune differently depending on what is already installed (to
3129 -- implement "sticky" test suite enabling behavior).
3130 pruneInstallPlanToTargets
3132 -> Map UnitId
[ComponentTarget
]
3133 -> ElaboratedInstallPlan
3134 -> ElaboratedInstallPlan
3135 pruneInstallPlanToTargets targetActionType perPkgTargetsMap elaboratedPlan
=
3136 InstallPlan
.new
(InstallPlan
.planIndepGoals elaboratedPlan
)
3137 . Graph
.fromDistinctList
3138 -- We have to do the pruning in two passes
3139 . pruneInstallPlanPass2
3140 . pruneInstallPlanPass1
3141 -- Set the targets that will be the roots for pruning
3142 . setRootTargets targetActionType perPkgTargetsMap
3143 . InstallPlan
.toList
3146 -- | This is a temporary data type, where we temporarily
3147 -- override the graph dependencies of an 'ElaboratedPackage',
3148 -- so we can take a closure over them. We'll throw out the
3149 -- overridden dependencies when we're done so it's strictly temporary.
3151 -- For 'ElaboratedComponent', this the cached unit IDs always
3152 -- coincide with the real thing.
3153 data PrunedPackage
= PrunedPackage ElaboratedConfiguredPackage
[UnitId
]
3155 instance Package PrunedPackage
where
3156 packageId
(PrunedPackage elab _
) = packageId elab
3158 instance HasUnitId PrunedPackage
where
3159 installedUnitId
= Graph
.nodeKey
3161 instance Graph
.IsNode PrunedPackage
where
3162 type Key PrunedPackage
= UnitId
3163 nodeKey
(PrunedPackage elab _
) = Graph
.nodeKey elab
3164 nodeNeighbors
(PrunedPackage _ deps
) = deps
3166 fromPrunedPackage
:: PrunedPackage
-> ElaboratedConfiguredPackage
3167 fromPrunedPackage
(PrunedPackage elab _
) = elab
3169 -- | Set the build targets based on the user targets (but not rev deps yet).
3170 -- This is required before we can prune anything.
3173 -> Map UnitId
[ComponentTarget
]
3174 -> [ElaboratedPlanPackage
]
3175 -> [ElaboratedPlanPackage
]
3176 setRootTargets targetAction perPkgTargetsMap
=
3177 assert
(not (Map
.null perPkgTargetsMap
)) $
3178 assert
(all (not . null) (Map
.elems perPkgTargetsMap
)) $
3179 map (mapConfiguredPackage setElabBuildTargets
)
3181 -- Set the targets we'll build for this package/component. This is just
3182 -- based on the root targets from the user, not targets implied by reverse
3183 -- dependencies. Those comes in the second pass once we know the rev deps.
3185 setElabBuildTargets elab
=
3186 case ( Map
.lookup (installedUnitId elab
) perPkgTargetsMap
3189 (Nothing
, _
) -> elab
3190 (Just tgts
, TargetActionConfigure
) -> elab
{elabConfigureTargets
= tgts
}
3191 (Just tgts
, TargetActionBuild
) -> elab
{elabBuildTargets
= tgts
}
3192 (Just tgts
, TargetActionTest
) -> elab
{elabTestTargets
= tgts
}
3193 (Just tgts
, TargetActionBench
) -> elab
{elabBenchTargets
= tgts
}
3194 (Just tgts
, TargetActionRepl
) ->
3196 { elabReplTarget
= tgts
3197 , elabBuildHaddocks
= False
3198 , elabBuildStyle
= BuildInplaceOnly InMemory
3200 (Just tgts
, TargetActionHaddock
) ->
3202 setElabHaddockTargets
3204 { elabHaddockTargets
= tgts
3205 , elabBuildHaddocks
= True
3210 setElabHaddockTargets tgt elab
3211 | isTestComponentTarget tgt
= elab
{elabHaddockTestSuites
= True}
3212 | isBenchComponentTarget tgt
= elab
{elabHaddockBenchmarks
= True}
3213 | isForeignLibComponentTarget tgt
= elab
{elabHaddockForeignLibs
= True}
3214 | isExeComponentTarget tgt
= elab
{elabHaddockExecutables
= True}
3215 | isSubLibComponentTarget tgt
= elab
{elabHaddockInternal
= True}
3218 -- | Assuming we have previously set the root build targets (i.e. the user
3219 -- targets but not rev deps yet), the first pruning pass does two things:
3221 -- * A first go at determining which optional stanzas (testsuites, benchmarks)
3222 -- are needed. We have a second go in the next pass.
3223 -- * Take the dependency closure using pruned dependencies. We prune deps that
3224 -- are used only by unneeded optional stanzas. These pruned deps are only
3225 -- used for the dependency closure and are not persisted in this pass.
3226 pruneInstallPlanPass1
3227 :: [ElaboratedPlanPackage
]
3228 -> [ElaboratedPlanPackage
]
3229 pruneInstallPlanPass1 pkgs
3230 -- if there are repl targets, we need to do a bit more work
3231 -- See Note [Pruning for Multi Repl]
3232 | anyMultiReplTarget
= graph_with_repl_targets
3233 -- otherwise we'll do less
3234 |
otherwise = pruned_packages
3236 pkgs
' :: [InstallPlan
.GenericPlanPackage IPI
.InstalledPackageInfo PrunedPackage
]
3237 pkgs
' = map (mapConfiguredPackage prune
) pkgs
3239 prune
:: ElaboratedConfiguredPackage
-> PrunedPackage
3240 prune elab
= PrunedPackage elab
' (pruneOptionalDependencies elab
')
3242 elab
' = addOptionalStanzas elab
3244 graph
= Graph
.fromDistinctList pkgs
'
3247 roots
= mapMaybe find_root pkgs
'
3249 -- Make a closed graph by calculating the closure from the roots
3250 pruned_packages
:: [ElaboratedPlanPackage
]
3251 pruned_packages
= map (mapConfiguredPackage fromPrunedPackage
) (fromMaybe [] $ Graph
.closure graph roots
)
3253 closed_graph
:: Graph
.Graph ElaboratedPlanPackage
3254 closed_graph
= Graph
.fromDistinctList pruned_packages
3256 -- whether any package has repl targets enabled, and we need to use multi-repl.
3257 anyMultiReplTarget
:: Bool
3258 anyMultiReplTarget
= length repls
> 1
3260 repls
= filter is_repl_gpp pkgs
'
3261 is_repl_gpp
(InstallPlan
.Configured pkg
) = is_repl_pp pkg
3262 is_repl_gpp _
= False
3264 is_repl_pp
(PrunedPackage elab _
) = not (null (elabReplTarget elab
))
3266 -- Anything which is inplace and left after pruning could be a repl target, then just need to check the
3267 -- reverse closure after calculating roots to capture dependencies which are on the path between roots.
3268 -- In order to start a multi-repl session with all the desired targets we need to load all these components into
3269 -- the repl at once to satisfy the closure property.
3270 all_desired_repl_targets
= Set
.fromList
[elabUnitId cp | InstallPlan
.Configured cp
<- fromMaybe [] $ Graph
.revClosure closed_graph roots
]
3272 add_repl_target
:: ElaboratedConfiguredPackage
-> ElaboratedConfiguredPackage
3274 | elabUnitId ecp `Set
.member` all_desired_repl_targets
=
3276 { elabReplTarget
= maybeToList (ComponentTarget
<$> (elabComponentName ecp
) <*> pure WholeComponent
)
3277 , elabBuildStyle
= BuildInplaceOnly InMemory
3281 -- Add the repl target information to the ElaboratedPlanPackages
3282 graph_with_repl_targets
3283 | anyMultiReplTarget
= map (mapConfiguredPackage add_repl_target
) (Graph
.toList closed_graph
)
3284 |
otherwise = Graph
.toList closed_graph
3286 is_root
:: PrunedPackage
-> Maybe UnitId
3287 is_root
(PrunedPackage elab _
) =
3290 [ null (elabConfigureTargets elab
)
3291 , null (elabBuildTargets elab
)
3292 , null (elabTestTargets elab
)
3293 , null (elabBenchTargets elab
)
3294 , null (elabReplTarget elab
)
3295 , null (elabHaddockTargets elab
)
3297 then Just
(installedUnitId elab
)
3300 find_root
(InstallPlan
.Configured pkg
) = is_root pkg
3301 -- When using the extra-packages stanza we need to
3302 -- look at installed packages as well.
3303 find_root
(InstallPlan
.Installed pkg
) = is_root pkg
3304 find_root _
= Nothing
3306 -- Note [Sticky enabled testsuites]
3307 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3308 -- The testsuite and benchmark targets are somewhat special in that we need
3309 -- to configure the packages with them enabled, and we need to do that even
3310 -- if we only want to build one of several testsuites.
3312 -- There are two cases in which we will enable the testsuites (or
3313 -- benchmarks): if one of the targets is a testsuite, or if all of the
3314 -- testsuite dependencies are already cached in the store. The rationale
3315 -- for the latter is to minimise how often we have to reconfigure due to
3316 -- the particular targets we choose to build. Otherwise choosing to build
3317 -- a testsuite target, and then later choosing to build an exe target
3318 -- would involve unnecessarily reconfiguring the package with testsuites
3319 -- disabled. Technically this introduces a little bit of stateful
3320 -- behaviour to make this "sticky", but it should be benign.
3322 -- Decide whether or not to enable testsuites and benchmarks.
3323 -- See [Sticky enabled testsuites]
3324 addOptionalStanzas
:: ElaboratedConfiguredPackage
-> ElaboratedConfiguredPackage
3325 addOptionalStanzas elab
@ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabPackage pkg
} =
3327 { elabPkgOrComp
= ElabPackage
(pkg
{pkgStanzasEnabled
= stanzas
})
3330 stanzas
:: OptionalStanzaSet
3331 -- By default, we enabled all stanzas requested by the user,
3332 -- as per elabStanzasRequested, done in
3333 -- 'elaborateSolverToPackage'
3335 pkgStanzasEnabled pkg
3336 -- optionalStanzasRequiredByTargets has to be done at
3337 -- prune-time because it depends on 'elabTestTargets'
3338 -- et al, which is done by 'setRootTargets' at the
3339 -- beginning of pruning.
3340 <> optionalStanzasRequiredByTargets elab
3341 -- optionalStanzasWithDepsAvailable has to be done at
3342 -- prune-time because it depends on what packages are
3343 -- installed, which is not known until after improvement
3344 -- (pruning is done after improvement)
3345 <> optionalStanzasWithDepsAvailable availablePkgs elab pkg
3346 addOptionalStanzas elab
= elab
3348 -- Calculate package dependencies but cut out those needed only by
3349 -- optional stanzas that we've determined we will not enable.
3350 -- These pruned deps are not persisted in this pass since they're based on
3351 -- the optional stanzas and we'll make further tweaks to the optional
3352 -- stanzas in the next pass.
3354 pruneOptionalDependencies
:: ElaboratedConfiguredPackage
-> [UnitId
]
3355 pruneOptionalDependencies elab
@ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabComponent _
} =
3356 InstallPlan
.depends elab
-- no pruning
3357 pruneOptionalDependencies ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabPackage pkg
} =
3358 (CD
.flatDeps
. CD
.filterDeps keepNeeded
) (pkgOrderDependencies pkg
)
3360 keepNeeded
(CD
.ComponentTest _
) _
= TestStanzas `optStanzaSetMember` stanzas
3361 keepNeeded
(CD
.ComponentBench _
) _
= BenchStanzas `optStanzaSetMember` stanzas
3362 keepNeeded _ _
= True
3363 stanzas
= pkgStanzasEnabled pkg
3365 optionalStanzasRequiredByTargets
3366 :: ElaboratedConfiguredPackage
3367 -> OptionalStanzaSet
3368 optionalStanzasRequiredByTargets pkg
=
3369 optStanzaSetFromList
3371 | ComponentTarget cname _
<-
3372 elabBuildTargets pkg
3373 ++ elabTestTargets pkg
3374 ++ elabBenchTargets pkg
3375 ++ elabReplTarget pkg
3376 ++ elabHaddockTargets pkg
3379 componentOptionalStanza
$
3380 CD
.componentNameToComponent cname
3385 [ installedUnitId pkg
3386 | InstallPlan
.PreExisting pkg
<- pkgs
3390 Note [Pruning for Multi Repl]
3391 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3393 For a multi-repl session, where we load more than one component into a GHCi repl,
3394 it is required to uphold the so-called *closure property*.
3395 This property, whose exact Note you can read in the GHC codebase, states
3398 \* If a component you want to load into a repl session transitively depends on a
3399 component which transitively depends on another component you want to
3400 load into the repl, then this component needs to be loaded
3401 into the repl session as well.
3403 We make sure here, that this property is upheld, by calculating the
3404 graph of components that we need to load into the repl given the set of 'roots' which
3405 are the targets specified by the user.
3407 Practically, this is simply achieved by traversing all dependencies of
3408 our roots (graph closure), and then from this closed graph, we calculate
3409 the reverse closure, which gives us all components that depend on
3410 'roots'. Thus, the result is a list of components that we need to load
3411 into the repl to uphold the closure property.
3414 -- | Given a set of already installed packages @availablePkgs@,
3415 -- determine the set of available optional stanzas from @pkg@
3416 -- which have all of their dependencies already installed. This is used
3417 -- to implement "sticky" testsuites, where once we have installed
3418 -- all of the deps needed for the test suite, we go ahead and
3419 -- enable it always.
3420 optionalStanzasWithDepsAvailable
3422 -> ElaboratedConfiguredPackage
3423 -> ElaboratedPackage
3424 -> OptionalStanzaSet
3425 optionalStanzasWithDepsAvailable availablePkgs elab pkg
=
3426 optStanzaSetFromList
3428 | stanza
<- optStanzaSetToList
(elabStanzasAvailable elab
)
3429 , let deps
:: [UnitId
]
3432 (optionalStanzaDeps stanza
)
3433 -- TODO: probably need to select other
3434 -- dep types too eventually
3435 (pkgOrderDependencies pkg
)
3436 , all (`Set
.member` availablePkgs
) deps
3439 optionalStanzaDeps TestStanzas
(CD
.ComponentTest _
) = True
3440 optionalStanzaDeps BenchStanzas
(CD
.ComponentBench _
) = True
3441 optionalStanzaDeps _ _
= False
3443 -- The second pass does three things:
3446 -- * A second go at deciding which optional stanzas to enable.
3448 -- * Prune the dependencies based on the final choice of optional stanzas.
3450 -- * Extend the targets within each package to build, now we know the reverse
3452 -- dependencies, ie we know which libs are needed as deps by other packages.
3454 -- Achieving sticky behaviour with enabling\/disabling optional stanzas is
3455 -- tricky. The first approximation was handled by the first pass above, but
3456 -- it's not quite enough. That pass will enable stanzas if all of the deps
3457 -- of the optional stanza are already installed /in the store/. That's important
3458 -- but it does not account for dependencies that get built inplace as part of
3459 -- the project. We cannot take those inplace build deps into account in the
3460 -- pruning pass however because we don't yet know which ones we're going to
3461 -- build. Once we do know, we can have another go and enable stanzas that have
3462 -- all their deps available. Now we can consider all packages in the pruned
3463 -- plan to be available, including ones we already decided to build from
3466 -- Deciding which targets to build depends on knowing which packages have
3467 -- reverse dependencies (ie are needed). This requires the result of first
3468 -- pass, which is another reason we have to split it into two passes.
3470 -- Note that just because we might enable testsuites or benchmarks (in the
3471 -- first or second pass) doesn't mean that we build all (or even any) of them.
3472 -- That depends on which targets we picked in the first pass.
3474 pruneInstallPlanPass2
3475 :: [ElaboratedPlanPackage
]
3476 -> [ElaboratedPlanPackage
]
3477 pruneInstallPlanPass2 pkgs
=
3478 map (mapConfiguredPackage setStanzasDepsAndTargets
) pkgs
3480 setStanzasDepsAndTargets elab
=
3482 { elabBuildTargets
=
3484 elabBuildTargets elab
3485 ++ libTargetsRequiredForRevDeps
3486 ++ exeTargetsRequiredForRevDeps
3488 case elabPkgOrComp elab
of
3491 pkgStanzasEnabled pkg
3492 <> optionalStanzasWithDepsAvailable availablePkgs elab pkg
3494 keepNeeded
:: CD
.Component
-> a
-> Bool
3495 keepNeeded
(CD
.ComponentTest _
) _
= TestStanzas `optStanzaSetMember` stanzas
3496 keepNeeded
(CD
.ComponentBench _
) _
= BenchStanzas `optStanzaSetMember` stanzas
3497 keepNeeded _ _
= True
3500 { pkgStanzasEnabled
=
3502 , pkgLibDependencies
=
3503 CD
.mapDeps
(\_
-> map addInternal
) $
3504 CD
.filterDeps keepNeeded
(pkgLibDependencies pkg
)
3505 , pkgExeDependencies
=
3506 CD
.filterDeps keepNeeded
(pkgExeDependencies pkg
)
3507 , pkgExeDependencyPaths
=
3508 CD
.filterDeps keepNeeded
(pkgExeDependencyPaths pkg
)
3510 ElabComponent comp
->
3513 { compLibDependencies
= map addInternal
(compLibDependencies comp
)
3517 -- We initially assume that all the dependencies are external (hence the boolean is always
3518 -- False) and here we correct the dependencies so the right packages are marked promised.
3519 addInternal
(cid
, _
) = (cid
, (cid `Set
.member` inMemoryTargets
))
3521 libTargetsRequiredForRevDeps
=
3523 | installedUnitId elab `Set
.member` hasReverseLibDeps
3524 , let c
= ComponentTarget
(CLibName Cabal
.defaultLibName
) WholeComponent
3525 , -- Don't enable building for anything which is being build in memory
3526 elabBuildStyle elab
/= BuildInplaceOnly InMemory
3528 exeTargetsRequiredForRevDeps
=
3529 -- TODO: allow requesting executable with different name
3530 -- than package name
3533 packageNameToUnqualComponentName
$
3535 elabPkgSourceId elab
3538 | installedUnitId elab `Set
.member` hasReverseExeDeps
3541 availablePkgs
:: Set UnitId
3542 availablePkgs
= Set
.fromList
(map installedUnitId pkgs
)
3544 inMemoryTargets
:: Set ConfiguredId
3545 inMemoryTargets
= do
3548 | InstallPlan
.Configured pkg
<- pkgs
3549 , BuildInplaceOnly InMemory
<- [elabBuildStyle pkg
]
3552 hasReverseLibDeps
:: Set UnitId
3556 | InstallPlan
.Configured pkg
<- pkgs
3557 , depid
<- elabOrderLibDependencies pkg
3560 hasReverseExeDeps
:: Set UnitId
3564 | InstallPlan
.Configured pkg
<- pkgs
3565 , depid
<- elabOrderExeDependencies pkg
3568 mapConfiguredPackage
3569 :: (srcpkg
-> srcpkg
')
3570 -> InstallPlan
.GenericPlanPackage ipkg srcpkg
3571 -> InstallPlan
.GenericPlanPackage ipkg srcpkg
'
3572 mapConfiguredPackage f
(InstallPlan
.Configured pkg
) =
3573 InstallPlan
.Configured
(f pkg
)
3574 mapConfiguredPackage f
(InstallPlan
.Installed pkg
) =
3575 InstallPlan
.Installed
(f pkg
)
3576 mapConfiguredPackage _
(InstallPlan
.PreExisting pkg
) =
3577 InstallPlan
.PreExisting pkg
3579 ------------------------------------
3580 -- Support for --only-dependencies
3583 -- | Try to remove the given targets from the install plan.
3585 -- This is not always possible.
3586 pruneInstallPlanToDependencies
3588 -> ElaboratedInstallPlan
3590 CannotPruneDependencies
3591 ElaboratedInstallPlan
3592 pruneInstallPlanToDependencies pkgTargets installPlan
=
3595 (isJust . InstallPlan
.lookup installPlan
)
3596 (Set
.toList pkgTargets
)
3598 $ fmap (InstallPlan
.new
(InstallPlan
.planIndepGoals installPlan
))
3600 . Graph
.fromDistinctList
3601 . filter (\pkg
-> installedUnitId pkg `Set
.notMember` pkgTargets
)
3602 . InstallPlan
.toList
3605 -- Our strategy is to remove the packages we don't want and then check
3606 -- if the remaining graph is broken or not, ie any packages with dangling
3607 -- dependencies. If there are then we cannot prune the given targets.
3609 :: Graph
.Graph ElaboratedPlanPackage
3611 CannotPruneDependencies
3612 (Graph
.Graph ElaboratedPlanPackage
)
3613 checkBrokenDeps graph
=
3614 case Graph
.broken graph
of
3618 CannotPruneDependencies
3619 [ (pkg
, missingDeps
)
3620 |
(pkg
, missingDepIds
) <- brokenPackages
3621 , let missingDeps
= mapMaybe lookupDep missingDepIds
3624 -- lookup in the original unpruned graph
3625 lookupDep
= InstallPlan
.lookup installPlan
3627 -- | It is not always possible to prune to only the dependencies of a set of
3628 -- targets. It may be the case that removing a package leaves something else
3629 -- that still needed the pruned package.
3631 -- This lists all the packages that would be broken, and their dependencies
3632 -- that would be missing if we did prune.
3633 newtype CannotPruneDependencies
3634 = CannotPruneDependencies
3635 [ ( ElaboratedPlanPackage
3636 , [ElaboratedPlanPackage
]
3641 -- The other aspects of our Setup.hs policy lives here where we decide on
3642 -- the 'SetupScriptOptions'.
3644 -- Our current policy for the 'SetupCustomImplicitDeps' case is that we
3645 -- try to make the implicit deps cover everything, and we don't allow the
3646 -- compiler to pick up other deps. This may or may not be sustainable, and
3647 -- we might have to allow the deps to be non-exclusive, but that itself would
3648 -- be tricky since we would have to allow the Setup access to all the packages
3649 -- in the store and local dbs.
3651 setupHsScriptOptions
3652 :: ElaboratedReadyPackage
3653 -> ElaboratedInstallPlan
3654 -> ElaboratedSharedConfig
3660 -> SetupScriptOptions
3661 -- TODO: Fix this so custom is a separate component. Custom can ALWAYS
3662 -- be a separate component!!!
3663 setupHsScriptOptions
3664 (ReadyPackage elab
@ElaboratedConfiguredPackage
{..})
3666 ElaboratedSharedConfig
{..}
3673 { useCabalVersion
= thisVersion elabSetupScriptCliVersion
3674 , useCabalSpecVersion
= Just elabSetupScriptCliVersion
3675 , useCompiler
= Just pkgConfigCompiler
3676 , usePlatform
= Just pkgConfigPlatform
3677 , usePackageDB
= elabSetupPackageDBStack
3678 , usePackageIndex
= Nothing
3681 |
(ConfiguredId srcid
(Just
(CLibName LMainLibName
)) uid
, _
) <-
3682 elabSetupDependencies elab
3684 , useDependenciesExclusive
= True
3685 , useVersionMacros
= elabSetupScriptStyle
== SetupCustomExplicitDeps
3686 , useProgramDb
= pkgConfigCompilerProgs
3687 , useDistPref
= builddir
3688 , useLoggingHandle
= Nothing
-- this gets set later
3689 , useWorkingDir
= Just srcdir
3690 , useExtraPathEnv
= elabExeDependencyPaths elab
++ elabProgramPathExtra
3691 , -- note that the above adds the extra-prog-path directly following the elaborated
3692 -- dep paths, so that it overrides the normal path, but _not_ the elaborated extensions
3693 -- for build-tools-depends.
3694 useExtraEnvOverrides
= dataDirsEnvironmentForPlan distdir plan
3695 , useWin32CleanHack
= False -- TODO: [required eventually]
3696 , forceExternalSetupMethod
= isParallelBuild
3697 , setupCacheLock
= Just cacheLock
3698 , isInteractive
= False
3701 -- | To be used for the input for elaborateInstallPlan.
3703 -- TODO: [code cleanup] make InstallDirs.defaultInstallDirs pure.
3704 userInstallDirTemplates
3706 -> IO InstallDirs
.InstallDirTemplates
3707 userInstallDirTemplates compiler
= do
3708 InstallDirs
.defaultInstallDirs
3709 (compilerFlavor compiler
)
3710 True -- user install
3713 storePackageInstallDirs
3716 -> InstalledPackageId
3717 -> InstallDirs
.InstallDirs
FilePath
3718 storePackageInstallDirs storeDirLayout compiler ipkgid
=
3719 storePackageInstallDirs
' storeDirLayout compiler
$ newSimpleUnitId ipkgid
3721 storePackageInstallDirs
'
3725 -> InstallDirs
.InstallDirs
FilePath
3726 storePackageInstallDirs
'
3728 { storePackageDirectory
3733 InstallDirs
.InstallDirs
{..}
3735 store
= storeDirectory compiler
3736 prefix
= storePackageDirectory compiler unitid
3737 bindir
= prefix
</> "bin"
3738 libdir
= prefix
</> "lib"
3740 -- Note: on macOS, we place libraries into
3741 -- @store/lib@ to work around the load
3742 -- command size limit of macOSs mach-o linker.
3743 -- See also @PackageHash.hashedInstalledPackageIdVeryShort@
3745 | buildOS
== OSX
= store
</> "lib"
3746 |
otherwise = libdir
3748 libexecdir
= prefix
</> "libexec"
3750 includedir
= libdir
</> "include"
3751 datadir
= prefix
</> "share"
3753 docdir
= datadir
</> "doc"
3754 mandir
= datadir
</> "man"
3755 htmldir
= docdir
</> "html"
3756 haddockdir
= htmldir
3757 sysconfdir
= prefix
</> "etc"
3761 -> InstallDirs
.InstallDirTemplates
3762 -> ElaboratedSharedConfig
3763 -> ElaboratedConfiguredPackage
3764 -> InstallDirs
.InstallDirs
FilePath
3765 computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
3766 | isInplaceBuildStyle
(elabBuildStyle elab
) =
3767 -- use the ordinary default install dirs
3768 ( InstallDirs
.absoluteInstallDirs
3769 (elabPkgSourceId elab
)
3771 (compilerInfo
(pkgConfigCompiler elaboratedShared
))
3772 InstallDirs
.NoCopyDest
3773 (pkgConfigPlatform elaboratedShared
)
3776 { -- absoluteInstallDirs sets these as 'undefined' but we have
3777 -- to use them as "Setup.hs configure" args
3778 InstallDirs
.libsubdir
= ""
3779 , InstallDirs
.libexecsubdir
= ""
3780 , InstallDirs
.datasubdir
= ""
3783 -- use special simplified install dirs
3784 storePackageInstallDirs
'
3786 (pkgConfigCompiler elaboratedShared
)
3789 -- TODO: [code cleanup] perhaps reorder this code
3790 -- based on the ElaboratedInstallPlan + ElaboratedSharedConfig,
3791 -- make the various Setup.hs {configure,build,copy} flags
3793 setupHsConfigureFlags
3794 :: ElaboratedInstallPlan
3795 -> ElaboratedReadyPackage
3796 -> ElaboratedSharedConfig
3799 -> Cabal
.ConfigFlags
3800 setupHsConfigureFlags
3802 (ReadyPackage elab
@ElaboratedConfiguredPackage
{..})
3803 sharedConfig
@ElaboratedSharedConfig
{..}
3806 sanityCheckElaboratedConfiguredPackage
3809 (Cabal
.ConfigFlags
{..})
3816 , configFullyStaticExe
3818 , -- , configProfExe -- overridden
3820 , -- , configProf -- overridden
3822 , configProfLibDetail
3826 , configOptimization
3827 , configSplitSections
3832 } = LBC
.buildOptionsConfigFlags elabBuildOptions
3833 configProfExe
= mempty
3834 configProf
= toFlag
$ LBC
.withProfExe elabBuildOptions
3836 configArgs
= mempty
-- unused, passed via args
3837 configDistPref
= toFlag builddir
3838 configCabalFilePath
= mempty
3839 configVerbosity
= toFlag verbosity
3841 configInstantiateWith
= Map
.toList elabInstantiatedWith
3843 configDeterministic
= mempty
-- doesn't matter, configIPID/configCID overridese
3844 configIPID
= case elabPkgOrComp
of
3845 ElabPackage pkg
-> toFlag
(prettyShow
(pkgInstalledId pkg
))
3846 ElabComponent _
-> mempty
3847 configCID
= case elabPkgOrComp
of
3848 ElabPackage _
-> mempty
3849 ElabComponent _
-> toFlag elabComponentId
3851 configProgramPaths
= Map
.toList elabProgramPaths
3853 |
{- elabSetupScriptCliVersion < mkVersion [1,24,3] -} True =
3854 -- workaround for <https://github.com/haskell/cabal/issues/4010>
3856 -- It turns out, that even with Cabal 2.0, there's still cases such as e.g.
3857 -- custom Setup.hs scripts calling out to GHC even when going via
3858 -- @runProgram ghcProgram@, as e.g. happy does in its
3859 -- <http://hackage.haskell.org/package/happy-1.19.5/src/Setup.lhs>
3860 -- (see also <https://github.com/haskell/cabal/pull/4433#issuecomment-299396099>)
3862 -- So for now, let's pass the rather harmless and idempotent
3863 -- `-hide-all-packages` flag to all invocations (which has
3864 -- the benefit that every GHC invocation starts with a
3865 -- consistently well-defined clean slate) until we find a
3871 ["-hide-all-packages"]
3873 configProgramPathExtra
= toNubList elabProgramPathExtra
3874 configHcFlavor
= toFlag
(compilerFlavor pkgConfigCompiler
)
3875 configHcPath
= mempty
-- we use configProgramPaths instead
3876 configHcPkg
= mempty
-- we use configProgramPaths instead
3877 configDumpBuildInfo
= toFlag elabDumpBuildInfo
3879 configConfigurationsFlags
= elabFlagAssignment
3880 configConfigureArgs
= elabConfigureScriptArgs
3881 configExtraLibDirs
= elabExtraLibDirs
3882 configExtraLibDirsStatic
= elabExtraLibDirsStatic
3883 configExtraFrameworkDirs
= elabExtraFrameworkDirs
3884 configExtraIncludeDirs
= elabExtraIncludeDirs
3885 configProgPrefix
= maybe mempty toFlag elabProgPrefix
3886 configProgSuffix
= maybe mempty toFlag elabProgSuffix
3890 (toFlag
. InstallDirs
.toPathTemplate
)
3893 -- we only use configDependencies, unless we're talking to an old Cabal
3894 -- in which case we use configConstraints
3895 -- NB: This does NOT use InstallPlan.depends, which includes executable
3896 -- dependencies which should NOT be fed in here (also you don't have
3897 -- enough info anyway)
3899 configDependencies
=
3900 [ cidToGivenComponent cid
3901 |
(cid
, is_internal
) <- elabLibDependencies elab
3905 configPromisedDependencies
=
3906 [ cidToGivenComponent cid
3907 |
(cid
, is_internal
) <- elabLibDependencies elab
3912 case elabPkgOrComp
of
3914 [ thisPackageVersionConstraint srcid
3915 |
(ConfiguredId srcid _ _uid
, _
) <- elabLibDependencies elab
3917 ElabComponent _
-> []
3919 -- explicitly clear, then our package db stack
3920 -- TODO: [required eventually] have to do this differently for older Cabal versions
3921 configPackageDBs
= Nothing
: map Just elabBuildPackageDBStack
3923 configTests
= case elabPkgOrComp
of
3924 ElabPackage pkg
-> toFlag
(TestStanzas `optStanzaSetMember` pkgStanzasEnabled pkg
)
3925 ElabComponent _
-> mempty
3926 configBenchmarks
= case elabPkgOrComp
of
3927 ElabPackage pkg
-> toFlag
(BenchStanzas `optStanzaSetMember` pkgStanzasEnabled pkg
)
3928 ElabComponent _
-> mempty
3930 configExactConfiguration
= toFlag
True
3931 configFlagError
= mempty
-- TODO: [research required] appears not to be implemented
3932 configScratchDir
= mempty
-- never use
3933 configUserInstall
= mempty
-- don't rely on defaults
3934 configPrograms_
= mempty
-- never use, shouldn't exist
3935 configUseResponseFiles
= mempty
3936 configAllowDependingOnPrivateLibs
= Flag
$ not $ libraryVisibilitySupported pkgConfigCompiler
3938 cidToGivenComponent
:: ConfiguredId
-> GivenComponent
3939 cidToGivenComponent
(ConfiguredId srcid mb_cn cid
) = GivenComponent
(packageName srcid
) ln cid
3942 Just
(CLibName lname
) -> lname
3943 Just _
-> error "non-library dependency"
3944 Nothing
-> LMainLibName
3946 configCoverageFor
= determineCoverageFor elabPkgSourceId plan
3948 setupHsConfigureArgs
3949 :: ElaboratedConfiguredPackage
3951 setupHsConfigureArgs
(ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabPackage _
}) = []
3952 setupHsConfigureArgs elab
@(ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabComponent comp
}) =
3953 [showComponentTarget
(packageId elab
) (ComponentTarget cname WholeComponent
)]
3957 (error "setupHsConfigureArgs: trying to configure setup")
3958 (compComponentName comp
)
3962 -> ElaboratedConfiguredPackage
3963 -> ElaboratedSharedConfig
3967 setupHsBuildFlags par_strat elab _ verbosity builddir
=
3969 { buildProgramPaths
= mempty
-- unused, set at configure time
3970 , buildProgramArgs
= mempty
-- unused, set at configure time
3971 , buildVerbosity
= toFlag verbosity
3972 , buildDistPref
= toFlag builddir
3973 , buildNumJobs
= mempty
-- TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs),
3974 , buildUseSemaphore
=
3975 if elabSetupScriptCliVersion elab
>= mkVersion
[3, 11, 0, 0]
3976 then -- Cabal 3.11 is the first version that supports parallelism semaphores
3979 , buildArgs
= mempty
-- unused, passed via args not flags
3980 , buildCabalFilePath
= mempty
3983 setupHsBuildArgs
:: ElaboratedConfiguredPackage
-> [String]
3984 setupHsBuildArgs elab
@(ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabPackage _
})
3985 -- Fix for #3335, don't pass build arguments if it's not supported
3986 | elabSetupScriptCliVersion elab
>= mkVersion
[1, 17] =
3987 map (showComponentTarget
(packageId elab
)) (elabBuildTargets elab
)
3990 setupHsBuildArgs
(ElaboratedConfiguredPackage
{elabPkgOrComp
= ElabComponent _
}) =
3994 :: ElaboratedConfiguredPackage
3998 setupHsTestFlags
(ElaboratedConfiguredPackage
{..}) verbosity builddir
=
4000 { testDistPref
= toFlag builddir
4001 , testVerbosity
= toFlag verbosity
4002 , testMachineLog
= maybe mempty toFlag elabTestMachineLog
4003 , testHumanLog
= maybe mempty toFlag elabTestHumanLog
4004 , testShowDetails
= maybe (Flag Cabal
.Always
) toFlag elabTestShowDetails
4005 , testKeepTix
= toFlag elabTestKeepTix
4006 , testWrapper
= maybe mempty toFlag elabTestWrapper
4007 , testFailWhenNoTestSuites
= toFlag elabTestFailWhenNoTestSuites
4008 , testOptions
= elabTestTestOptions
4011 setupHsTestArgs
:: ElaboratedConfiguredPackage
-> [String]
4012 -- TODO: Does the issue #3335 affects test as well
4013 setupHsTestArgs elab
=
4014 mapMaybe (showTestComponentTarget
(packageId elab
)) (elabTestTargets elab
)
4017 :: ElaboratedConfiguredPackage
4018 -> ElaboratedSharedConfig
4021 -> Cabal
.BenchmarkFlags
4022 setupHsBenchFlags
(ElaboratedConfiguredPackage
{..}) _ verbosity builddir
=
4023 Cabal
.BenchmarkFlags
4024 { benchmarkDistPref
= toFlag builddir
4025 , benchmarkVerbosity
= toFlag verbosity
4026 , benchmarkOptions
= elabBenchmarkOptions
4029 setupHsBenchArgs
:: ElaboratedConfiguredPackage
-> [String]
4030 setupHsBenchArgs elab
=
4031 mapMaybe (showBenchComponentTarget
(packageId elab
)) (elabBenchTargets elab
)
4034 :: ElaboratedConfiguredPackage
4035 -> ElaboratedSharedConfig
4039 setupHsReplFlags _ sharedConfig verbosity builddir
=
4041 { replProgramPaths
= mempty
-- unused, set at configure time
4042 , replProgramArgs
= mempty
-- unused, set at configure time
4043 , replVerbosity
= toFlag verbosity
4044 , replDistPref
= toFlag builddir
4045 , replReload
= mempty
-- only used as callback from repl
4046 , replReplOptions
= pkgConfigReplOptions sharedConfig
-- runtime override for repl flags
4049 setupHsReplArgs
:: ElaboratedConfiguredPackage
-> [String]
4050 setupHsReplArgs elab
=
4051 map (\t -> showComponentTarget
(packageId elab
) t
) (elabReplTarget elab
)
4054 :: ElaboratedConfiguredPackage
4055 -> ElaboratedSharedConfig
4060 setupHsCopyFlags _ _ verbosity builddir destdir
=
4062 { copyArgs
= [] -- TODO: could use this to only copy what we enabled
4063 , copyDest
= toFlag
(InstallDirs
.CopyTo destdir
)
4064 , copyDistPref
= toFlag builddir
4065 , copyVerbosity
= toFlag verbosity
4066 , copyCabalFilePath
= mempty
4069 setupHsRegisterFlags
4070 :: ElaboratedConfiguredPackage
4071 -> ElaboratedSharedConfig
4075 -> Cabal
.RegisterFlags
4076 setupHsRegisterFlags
4077 ElaboratedConfiguredPackage
{..}
4083 { regPackageDB
= mempty
-- misfeature
4084 , regGenScript
= mempty
-- never use
4085 , regGenPkgConf
= toFlag
(Just pkgConfFile
)
4086 , regInPlace
= case elabBuildStyle
of
4087 BuildInplaceOnly
{} -> toFlag
True
4088 BuildAndInstall
-> toFlag
False
4089 , regPrintId
= mempty
-- never use
4090 , regDistPref
= toFlag builddir
4092 , regVerbosity
= toFlag verbosity
4093 , regCabalFilePath
= mempty
4097 :: ElaboratedConfiguredPackage
4098 -> ElaboratedSharedConfig
4101 -> Cabal
.HaddockFlags
4102 setupHsHaddockFlags
(ElaboratedConfiguredPackage
{..}) (ElaboratedSharedConfig
{..}) verbosity builddir
=
4104 { haddockProgramPaths
=
4105 case lookupProgram haddockProgram pkgConfigCompilerProgs
of
4109 ( programName haddockProgram
4110 , locationPath
(programLocation prg
)
4113 , haddockProgramArgs
= mempty
-- unused, set at configure time
4114 , haddockHoogle
= toFlag elabHaddockHoogle
4115 , haddockHtml
= toFlag elabHaddockHtml
4116 , haddockHtmlLocation
= maybe mempty toFlag elabHaddockHtmlLocation
4117 , haddockForHackage
= toFlag elabHaddockForHackage
4118 , haddockForeignLibs
= toFlag elabHaddockForeignLibs
4119 , haddockExecutables
= toFlag elabHaddockExecutables
4120 , haddockTestSuites
= toFlag elabHaddockTestSuites
4121 , haddockBenchmarks
= toFlag elabHaddockBenchmarks
4122 , haddockInternal
= toFlag elabHaddockInternal
4123 , haddockCss
= maybe mempty toFlag elabHaddockCss
4124 , haddockLinkedSource
= toFlag elabHaddockLinkedSource
4125 , haddockQuickJump
= toFlag elabHaddockQuickJump
4126 , haddockHscolourCss
= maybe mempty toFlag elabHaddockHscolourCss
4127 , haddockContents
= maybe mempty toFlag elabHaddockContents
4128 , haddockDistPref
= toFlag builddir
4129 , haddockKeepTempFiles
= mempty
-- TODO: from build settings
4130 , haddockVerbosity
= toFlag verbosity
4131 , haddockCabalFilePath
= mempty
4132 , haddockIndex
= maybe mempty toFlag elabHaddockIndex
4133 , haddockBaseUrl
= maybe mempty toFlag elabHaddockBaseUrl
4134 , haddockLib
= maybe mempty toFlag elabHaddockLib
4135 , haddockOutputDir
= maybe mempty toFlag elabHaddockOutputDir
4136 , haddockArgs
= mempty
4139 setupHsHaddockArgs
:: ElaboratedConfiguredPackage
-> [String]
4140 -- TODO: Does the issue #3335 affects test as well
4141 setupHsHaddockArgs elab
=
4142 map (showComponentTarget
(packageId elab
)) (elabHaddockTargets elab
)
4144 ------------------------------------------------------------------------------
4146 -- * Sharing installed packages
4148 ------------------------------------------------------------------------------
4151 -- Nix style store management for tarball packages
4153 -- So here's our strategy:
4155 -- We use a per-user nix-style hashed store, but /only/ for tarball packages.
4156 -- So that includes packages from hackage repos (and other http and local
4157 -- tarballs). For packages in local directories we do not register them into
4158 -- the shared store by default, we just build them locally inplace.
4160 -- The reason we do it like this is that it's easy to make stable hashes for
4161 -- tarball packages, and these packages benefit most from sharing. By contrast
4162 -- unpacked dir packages are harder to hash and they tend to change more
4163 -- frequently so there's less benefit to sharing them.
4165 -- When using the nix store approach we have to run the solver *without*
4166 -- looking at the packages installed in the store, just at the source packages
4167 -- (plus core\/global installed packages). Then we do a post-processing pass
4168 -- to replace configured packages in the plan with pre-existing ones, where
4169 -- possible. Where possible of course means where the nix-style package hash
4170 -- equals one that's already in the store.
4172 -- One extra wrinkle is that unless we know package tarball hashes upfront, we
4173 -- will have to download the tarballs to find their hashes. So we have two
4174 -- options: delay replacing source with pre-existing installed packages until
4175 -- the point during the execution of the install plan where we have the
4176 -- tarball, or try to do as much up-front as possible and then check again
4177 -- during plan execution. The former isn't great because we would end up
4178 -- telling users we're going to re-install loads of packages when in fact we
4179 -- would just share them. It'd be better to give as accurate a prediction as
4180 -- we can. The latter is better for users, but we do still have to check
4181 -- during plan execution because it's important that we don't replace existing
4182 -- installed packages even if they have the same package hash, because we
4183 -- don't guarantee ABI stability.
4185 -- TODO: [required eventually] for safety of concurrent installs, we must make sure we register but
4186 -- not replace installed packages with ghc-pkg.
4189 :: ElaboratedSharedConfig
4190 -> ElaboratedConfiguredPackage
4191 -> PackageHashInputs
4194 elab
@( ElaboratedConfiguredPackage
4195 { elabPkgSourceHash
= Just srchash
4199 { pkgHashPkgId
= packageId elab
4200 , pkgHashComponent
=
4201 case elabPkgOrComp elab
of
4202 ElabPackage _
-> Nothing
4203 ElabComponent comp
-> Just
(compSolverName comp
)
4204 , pkgHashSourceHash
= srchash
4205 , pkgHashPkgConfigDeps
= Set
.fromList
(elabPkgConfigDependencies elab
)
4206 , pkgHashDirectDeps
=
4207 case elabPkgOrComp elab
of
4208 ElabPackage
(ElaboratedPackage
{..}) ->
4211 |
(dep
, _
) <- CD
.select relevantDeps pkgLibDependencies
4214 | dep
<- CD
.select relevantDeps pkgExeDependencies
4216 ElabComponent comp
->
4220 ( map fst (compLibDependencies comp
)
4221 ++ compExeDependencies comp
4224 , pkgHashOtherConfig
= packageHashConfigInputs pkgshared elab
4227 -- Obviously the main deps are relevant
4228 relevantDeps CD
.ComponentLib
= True
4229 relevantDeps
(CD
.ComponentSubLib _
) = True
4230 relevantDeps
(CD
.ComponentFLib _
) = True
4231 relevantDeps
(CD
.ComponentExe _
) = True
4232 -- Setup deps can affect the Setup.hs behaviour and thus what is built
4233 relevantDeps CD
.ComponentSetup
= True
4234 -- However testsuites and benchmarks do not get installed and should not
4235 -- affect the result, so we do not include them.
4236 relevantDeps
(CD
.ComponentTest _
) = False
4237 relevantDeps
(CD
.ComponentBench _
) = False
4238 packageHashInputs _ pkg
=
4240 "packageHashInputs: only for packages with source hashes. "
4241 ++ prettyShow
(packageId pkg
)
4243 packageHashConfigInputs
4244 :: ElaboratedSharedConfig
4245 -> ElaboratedConfiguredPackage
4246 -> PackageHashConfigInputs
4247 packageHashConfigInputs shared
@ElaboratedSharedConfig
{..} pkg
=
4248 PackageHashConfigInputs
4249 { pkgHashCompilerId
= compilerId pkgConfigCompiler
4250 , pkgHashCompilerABI
= compilerAbiTag pkgConfigCompiler
4251 , pkgHashPlatform
= pkgConfigPlatform
4252 , pkgHashFlagAssignment
= elabFlagAssignment
4253 , pkgHashConfigureScriptArgs
= elabConfigureScriptArgs
4254 , pkgHashVanillaLib
= withVanillaLib
4255 , pkgHashSharedLib
= withSharedLib
4256 , pkgHashDynExe
= withDynExe
4257 , pkgHashFullyStaticExe
= withFullyStaticExe
4258 , pkgHashGHCiLib
= withGHCiLib
4259 , pkgHashProfLib
= withProfLib
4260 , pkgHashProfExe
= withProfExe
4261 , pkgHashProfLibDetail
= withProfLibDetail
4262 , pkgHashProfExeDetail
= withProfExeDetail
4263 , pkgHashCoverage
= exeCoverage
4264 , pkgHashOptimization
= withOptimization
4265 , pkgHashSplitSections
= splitSections
4266 , pkgHashSplitObjs
= splitObjs
4267 , pkgHashStripLibs
= stripLibs
4268 , pkgHashStripExes
= stripExes
4269 , pkgHashDebugInfo
= withDebugInfo
4270 , pkgHashProgramArgs
= elabProgramArgs
4271 , pkgHashExtraLibDirs
= elabExtraLibDirs
4272 , pkgHashExtraLibDirsStatic
= elabExtraLibDirsStatic
4273 , pkgHashExtraFrameworkDirs
= elabExtraFrameworkDirs
4274 , pkgHashExtraIncludeDirs
= elabExtraIncludeDirs
4275 , pkgHashProgPrefix
= elabProgPrefix
4276 , pkgHashProgSuffix
= elabProgSuffix
4277 , pkgHashPackageDbs
= elabPackageDbs
4278 , pkgHashDocumentation
= elabBuildHaddocks
4279 , pkgHashHaddockHoogle
= elabHaddockHoogle
4280 , pkgHashHaddockHtml
= elabHaddockHtml
4281 , pkgHashHaddockHtmlLocation
= elabHaddockHtmlLocation
4282 , pkgHashHaddockForeignLibs
= elabHaddockForeignLibs
4283 , pkgHashHaddockExecutables
= elabHaddockExecutables
4284 , pkgHashHaddockTestSuites
= elabHaddockTestSuites
4285 , pkgHashHaddockBenchmarks
= elabHaddockBenchmarks
4286 , pkgHashHaddockInternal
= elabHaddockInternal
4287 , pkgHashHaddockCss
= elabHaddockCss
4288 , pkgHashHaddockLinkedSource
= elabHaddockLinkedSource
4289 , pkgHashHaddockQuickJump
= elabHaddockQuickJump
4290 , pkgHashHaddockContents
= elabHaddockContents
4291 , pkgHashHaddockIndex
= elabHaddockIndex
4292 , pkgHashHaddockBaseUrl
= elabHaddockBaseUrl
4293 , pkgHashHaddockLib
= elabHaddockLib
4294 , pkgHashHaddockOutputDir
= elabHaddockOutputDir
4297 ElaboratedConfiguredPackage
{..} = normaliseConfiguredPackage shared pkg
4298 LBC
.BuildOptions
{..} = elabBuildOptions
4300 -- | Given the 'InstalledPackageIndex' for a nix-style package store, and an
4301 -- 'ElaboratedInstallPlan', replace configured source packages by installed
4302 -- packages from the store whenever they exist.
4303 improveInstallPlanWithInstalledPackages
4305 -> ElaboratedInstallPlan
4306 -> ElaboratedInstallPlan
4307 improveInstallPlanWithInstalledPackages installedPkgIdSet
=
4308 InstallPlan
.installed canPackageBeImproved
4310 canPackageBeImproved pkg
=
4311 installedUnitId pkg `Set
.member` installedPkgIdSet
4313 -- TODO: sanity checks:
4314 -- \* the installed package must have the expected deps etc
4315 -- \* the installed package must not be broken, valid dep closure
4317 -- TODO: decide what to do if we encounter broken installed packages,
4318 -- since overwriting is never safe.
4320 -- Path construction
4323 -- | The path to the directory that contains a specific executable.
4324 -- NB: For inplace NOT InstallPaths.bindir installDirs; for an
4325 -- inplace build those values are utter nonsense. So we
4326 -- have to guess where the directory is going to be.
4327 -- Fortunately this is "stable" part of Cabal API.
4328 -- But the way we get the build directory is A HORRIBLE
4332 -> ElaboratedSharedConfig
4333 -> ElaboratedConfiguredPackage
4336 binDirectoryFor layout config package exe
= case elabBuildStyle package
of
4337 BuildAndInstall
-> installedBinDirectory package
4338 BuildInplaceOnly
{} -> inplaceBinRoot layout config package
</> exe
4340 -- package has been built and installed.
4341 installedBinDirectory
:: ElaboratedConfiguredPackage
-> FilePath
4342 installedBinDirectory
= InstallDirs
.bindir
. elabInstallDirs
4344 -- | The path to the @build@ directory for an inplace build.
4347 -> ElaboratedSharedConfig
4348 -> ElaboratedConfiguredPackage
4350 inplaceBinRoot layout config package
=
4351 distBuildDirectory layout
(elabDistDirParams config package
)
4354 --------------------------------------------------------------------------------
4355 -- Configure --coverage-for flags
4357 -- The list of non-pre-existing libraries without module holes, i.e. the
4358 -- main library and sub-libraries components of all the local packages in
4359 -- the project that do not require instantiations or are instantiations.
4360 determineCoverageFor
4362 -- ^ The 'PackageId' of the package or component being configured
4363 -> ElaboratedInstallPlan
4365 determineCoverageFor configuredPkgSourceId plan
=
4369 InstallPlan
.Installed elab
4370 | shouldCoverPkg elab
-> Just
$ elabUnitId elab
4371 InstallPlan
.Configured elab
4372 | shouldCoverPkg elab
-> Just
$ elabUnitId elab
4376 $ InstallPlan
.toGraph plan
4378 shouldCoverPkg elab
@ElaboratedConfiguredPackage
{elabModuleShape
, elabPkgSourceId
, elabLocalToProject
} =
4380 && not (isIndefiniteOrInstantiation elabModuleShape
)
4381 -- TODO(#9493): We can only cover libraries in the same package
4383 && configuredPkgSourceId
== elabPkgSourceId
4384 -- Libraries only! We don't cover testsuite modules, so we never need
4385 -- the paths to their mix dirs. Furthermore, we do not install testsuites...
4386 && maybe False (\case CLibName
{} -> True; CNotLibName
{} -> False) (elabComponentName elab
)
4388 isIndefiniteOrInstantiation
:: ModuleShape
-> Bool
4389 isIndefiniteOrInstantiation
= not . Set
.null . modShapeRequires