Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Distribution.Client.ProjectOrchestration
Description
This module deals with building and incrementally rebuilding a collection
of packages. It is what backs the cabal build
and configure
commands,
as well as being a core part of run
, test
, bench
and others.
The primary thing is in fact rebuilding (and trying to make that quick by not redoing unnecessary work), so building from scratch is just a special case.
The build process and the code can be understood by breaking it down into three major parts:
- The
ElaboratedInstallPlan
type - The "what to do" phase, where we look at the all input configuration
(project files, .cabal files, command line etc) and produce a detailed
plan of what to do -- the
ElaboratedInstallPlan
. - The "do it" phase, where we take the
ElaboratedInstallPlan
and we re-execute it.
As far as possible, the "what to do" phase embodies all the policy, leaving the "do it" phase policy free. The first phase contains more of the complicated logic, but it is contained in code that is either pure or just has read effects (except cache updates). Then the second phase does all the actions to build packages, but as far as possible it just follows the instructions and avoids any logic for deciding what to do (apart from recompilation avoidance in executing the plan).
This division helps us keep the code under control, making it easier to
understand, test and debug. So when you are extending these modules, please
think about which parts of your change belong in which part. It is
perfectly ok to extend the description of what to do (i.e. the
ElaboratedInstallPlan
) if that helps keep the policy decisions in the
first phase. Also, the second phase does not have direct access to any of
the input configuration anyway; all the information has to flow via the
ElaboratedInstallPlan
.
Synopsis
- data CurrentCommand
- establishProjectBaseContext :: Verbosity -> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
- establishProjectBaseContextWithRoot :: Verbosity -> ProjectConfig -> ProjectRoot -> CurrentCommand -> IO ProjectBaseContext
- data ProjectBaseContext = ProjectBaseContext {}
- data BuildTimeSettings = BuildTimeSettings {
- buildSettingDryRun :: Bool
- buildSettingOnlyDeps :: Bool
- buildSettingOnlyDownload :: Bool
- buildSettingSummaryFile :: [PathTemplate]
- buildSettingLogFile :: Maybe (Compiler -> Platform -> PackageId -> UnitId -> FilePath)
- buildSettingLogVerbosity :: Verbosity
- buildSettingBuildReports :: ReportLevel
- buildSettingReportPlanningFailure :: Bool
- buildSettingSymlinkBinDir :: [FilePath]
- buildSettingNumJobs :: ParStratInstall
- buildSettingKeepGoing :: Bool
- buildSettingOfflineMode :: Bool
- buildSettingKeepTempFiles :: Bool
- buildSettingRemoteRepos :: [RemoteRepo]
- buildSettingLocalNoIndexRepos :: [LocalRepo]
- buildSettingCacheDir :: FilePath
- buildSettingHttpTransport :: Maybe String
- buildSettingIgnoreExpiry :: Bool
- buildSettingProgPathExtra :: [FilePath]
- buildSettingHaddockOpen :: Bool
- commandLineFlagsToProjectConfig :: GlobalFlags -> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
- withInstallPlan :: Verbosity -> ProjectBaseContext -> (ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a) -> IO a
- runProjectPreBuildPhase :: Verbosity -> ProjectBaseContext -> (ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap)) -> IO ProjectBuildContext
- data ProjectBuildContext = ProjectBuildContext {}
- readTargetSelectors :: [PackageSpecifier (SourcePackage (PackageLocation a))] -> Maybe ComponentKindFilter -> [String] -> IO (Either [TargetSelectorProblem] [TargetSelector])
- reportTargetSelectorProblems :: Verbosity -> [TargetSelectorProblem] -> IO a
- resolveTargets :: forall err. (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k) -> ElaboratedInstallPlan -> Maybe SourcePackageDb -> [TargetSelector] -> Either [TargetProblem err] TargetsMap
- type TargetsMap = Map UnitId [(ComponentTarget, NonEmpty TargetSelector)]
- allTargetSelectors :: TargetsMap -> [TargetSelector]
- uniqueTargetSelectors :: TargetsMap -> [TargetSelector]
- data TargetSelector
- = TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKindFilter)
- | TargetPackageNamed PackageName (Maybe ComponentKindFilter)
- | TargetAllPackages (Maybe ComponentKindFilter)
- | TargetComponent PackageId ComponentName SubComponentTarget
- | TargetComponentUnknown PackageName (Either UnqualComponentName ComponentName) SubComponentTarget
- data TargetImplicitCwd
- type PackageId = PackageIdentifier
- data AvailableTarget k = AvailableTarget {}
- data AvailableTargetStatus k
- data TargetRequested
- data ComponentName where
- CLibName LibraryName
- CNotLibName NotLibComponentName
- pattern CBenchName :: UnqualComponentName -> ComponentName
- pattern CTestName :: UnqualComponentName -> ComponentName
- pattern CExeName :: UnqualComponentName -> ComponentName
- pattern CFLibName :: UnqualComponentName -> ComponentName
- data ComponentKind
- data ComponentTarget = ComponentTarget ComponentName SubComponentTarget
- data SubComponentTarget
- selectComponentTargetBasic :: SubComponentTarget -> AvailableTarget k -> Either (TargetProblem a) k
- distinctTargetComponents :: TargetsMap -> Set (UnitId, ComponentName)
- filterTargetsKind :: ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
- filterTargetsKindWith :: (ComponentKind -> Bool) -> [AvailableTarget k] -> [AvailableTarget k]
- selectBuildableTargets :: [AvailableTarget k] -> [k]
- selectBuildableTargetsWith :: (TargetRequested -> Bool) -> [AvailableTarget k] -> [k]
- selectBuildableTargets' :: [AvailableTarget k] -> ([k], [AvailableTarget ()])
- selectBuildableTargetsWith' :: (TargetRequested -> Bool) -> [AvailableTarget k] -> ([k], [AvailableTarget ()])
- forgetTargetsDetail :: [AvailableTarget k] -> [AvailableTarget ()]
- pruneInstallPlanToTargets :: TargetAction -> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
- data TargetAction
- pruneInstallPlanToDependencies :: Set UnitId -> ElaboratedInstallPlan -> Either CannotPruneDependencies ElaboratedInstallPlan
- newtype CannotPruneDependencies = CannotPruneDependencies [(ElaboratedPlanPackage, [ElaboratedPlanPackage])]
- printPlan :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
- runProjectBuildPhase :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO BuildOutcomes
- runProjectPostBuildPhase :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> BuildOutcomes -> IO ()
- dieOnBuildFailures :: Verbosity -> CurrentCommand -> ElaboratedInstallPlan -> BuildOutcomes -> IO ()
- establishDummyProjectBaseContext :: Verbosity -> ProjectConfig -> DistDirLayout -> [PackageSpecifier UnresolvedSourcePackage] -> CurrentCommand -> IO ProjectBaseContext
- establishDummyDistDirLayout :: Verbosity -> ProjectConfig -> FilePath -> IO DistDirLayout
Discovery phase: what is in the project?
data CurrentCommand Source #
Tracks what command is being executed, because we need to hide this somewhere for cases that need special handling (usually for error reporting).
Constructors
InstallCommand | |
HaddockCommand | |
BuildCommand | |
ReplCommand | |
OtherCommand |
Instances
Show CurrentCommand Source # | |
Defined in Distribution.Client.ProjectOrchestration Methods showsPrec :: Int -> CurrentCommand -> ShowS # show :: CurrentCommand -> String # showList :: [CurrentCommand] -> ShowS # | |
Eq CurrentCommand Source # | |
Defined in Distribution.Client.ProjectOrchestration Methods (==) :: CurrentCommand -> CurrentCommand -> Bool # (/=) :: CurrentCommand -> CurrentCommand -> Bool # |
establishProjectBaseContext :: Verbosity -> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext Source #
establishProjectBaseContextWithRoot :: Verbosity -> ProjectConfig -> ProjectRoot -> CurrentCommand -> IO ProjectBaseContext Source #
Like establishProjectBaseContext
but doesn't search for project root.
data ProjectBaseContext Source #
This holds the context of a project prior to solving: the content of the
cabal.project
, cabal/config
and all the local package .cabal
files.
Constructors
ProjectBaseContext | |
Fields
|
data BuildTimeSettings Source #
Resolved configuration for things that affect how we build and not the
value of the things we build. The idea is that this is easier to use than
the raw configuration because in the raw configuration everything is
optional (monoidial). In the BuildTimeSettings
every field is filled in,
if only with the defaults.
Use resolveBuildTimeSettings
to make one from the project config (by
applying defaults etc).
Constructors
commandLineFlagsToProjectConfig :: GlobalFlags -> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig Source #
Convert configuration from the cabal configure
or cabal build
command
line into a ProjectConfig
value that can combined with configuration from
other sources.
At the moment this uses the legacy command line flag types. See
LegacyProjectConfig
for an explanation.
Pre-build phase: decide what to do.
withInstallPlan :: Verbosity -> ProjectBaseContext -> (ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a) -> IO a Source #
Pre-build phase: decide what to do.
runProjectPreBuildPhase :: Verbosity -> ProjectBaseContext -> (ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap)) -> IO ProjectBuildContext Source #
data ProjectBuildContext Source #
This holds the context between the pre-build, build and post-build phases.
Constructors
ProjectBuildContext | |
Fields
|
Selecting what targets we mean
Arguments
:: [PackageSpecifier (SourcePackage (PackageLocation a))] | |
-> Maybe ComponentKindFilter | This parameter is used when there are ambiguous selectors.
If it is |
-> [String] | |
-> IO (Either [TargetSelectorProblem] [TargetSelector]) |
Parse a bunch of command line args as TargetSelector
s, failing with an
error if any are unrecognised. The possible target selectors are based on
the available packages (and their locations).
reportTargetSelectorProblems :: Verbosity -> [TargetSelectorProblem] -> IO a Source #
Throw an exception with a formatted message if there are any problems.
resolveTargets :: forall err. (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k) -> ElaboratedInstallPlan -> Maybe SourcePackageDb -> [TargetSelector] -> Either [TargetProblem err] TargetsMap Source #
Given a set of TargetSelector
s, resolve which UnitId
s and
ComponentTarget
s they ought to refer to.
The idea is that every user target identifies one or more roots in the
ElaboratedInstallPlan
, which we will use to determine the closure
of what packages need to be built, dropping everything from the plan
that is unnecessary. This closure and pruning is done by
pruneInstallPlanToTargets
and this needs to be told the roots in terms
of UnitId
s and the ComponentTarget
s within those.
This means we first need to translate the TargetSelector
s into the
UnitId
s and ComponentTarget
s. This translation has to be different for
the different command line commands, like build
, repl
etc. For example
the command build pkgfoo
could select a different set of components in
pkgfoo than repl pkgfoo
. The build
command would select any library and
all executables, whereas repl
would select the library or a single
executable. Furthermore, both of these examples could fail, and fail in
different ways and each needs to be able to produce helpful error messages.
So resolveTargets
takes two helpers: one to select the targets to be used
by user targets that refer to a whole package (TargetPackage
), and
another to check user targets that refer to a component (or a module or
file within a component). These helpers can fail, and use their own error
type. Both helpers get given the AvailableTarget
info about the
component(s).
While commands vary quite a bit in their behaviour about which components to
select for a whole-package target, most commands have the same behaviour for
checking a user target that refers to a specific component. To help with
this commands can use selectComponentTargetBasic
, either directly or as
a basis for their own selectComponentTarget
implementation.
type TargetsMap = Map UnitId [(ComponentTarget, NonEmpty TargetSelector)] Source #
The set of components to build, represented as a mapping from UnitId
s
to the ComponentTarget
s within the unit that will be selected
(e.g. selected to build, test or repl).
Associated with each ComponentTarget
is the set of TargetSelector
s that
matched this target. Typically this is exactly one, but in general it is
possible to for different selectors to match the same target. This extra
information is primarily to help make helpful error messages.
allTargetSelectors :: TargetsMap -> [TargetSelector] Source #
Get all target selectors.
uniqueTargetSelectors :: TargetsMap -> [TargetSelector] Source #
Get all unique target selectors.
data TargetSelector Source #
A target selector is expression selecting a set of components (as targets
for a actions like build
, run
, test
etc). A target selector
corresponds to the user syntax for referring to targets on the command line.
From the users point of view a target can be many things: packages, dirs, component names, files etc. Internally we consider a target to be a specific component (or module/file within a component), and all the users' notions of targets are just different ways of referring to these component targets.
So target selectors are expressions in the sense that they are interpreted
to refer to one or more components. For example a TargetPackage
gets
interpreted differently by different commands to refer to all or a subset
of components within the package.
The syntax has lots of optional parts:
[ package name | package dir | package .cabal file ] [ [lib:|exe:] component name ] [ module name | source file ]
Constructors
TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKindFilter) | One (or more) packages as a whole, or all the components of a particular kind within the package(s). These are always packages that are local to the project. In the case that there is more than one, they all share the same directory location. |
TargetPackageNamed PackageName (Maybe ComponentKindFilter) | A package specified by name. This may refer to |
TargetAllPackages (Maybe ComponentKindFilter) | All packages, or all components of a particular kind in all packages. |
TargetComponent PackageId ComponentName SubComponentTarget | A specific component in a package within the project. |
TargetComponentUnknown PackageName (Either UnqualComponentName ComponentName) SubComponentTarget | A component in a package, but where it cannot be verified that the package has such a component, or because the package is itself not known. |
Instances
data TargetImplicitCwd Source #
Does this TargetPackage
selector arise from syntax referring to a
package in the current directory (e.g. tests
or no giving no explicit
target at all) or does it come from syntax referring to a package name
or location.
Constructors
TargetImplicitCwd | |
TargetExplicitNamed |
Instances
type PackageId = PackageIdentifier #
Type alias so we can use the shorter name PackageId.
data AvailableTarget k Source #
An available target represents a component within a package that a user command could plausibly refer to. In this sense, all the components defined within the package are things the user could refer to, whether or not it would actually be possible to build that component.
In particular the available target contains an AvailableTargetStatus
which
informs us about whether it's actually possible to select this component to
be built, and if not why not. This detail makes it possible for command
implementations (like build
, test
etc) to accurately report why a target
cannot be used.
Note that the type parameter is used to help enforce that command
implementations can only select targets that can actually be built (by
forcing them to return the k
value for the selected targets).
In particular resolveTargets
makes use of this (with k
as
(
) to identify the targets thus selected.UnitId
, ComponentName')
Constructors
AvailableTarget | |
Instances
Functor AvailableTarget Source # | |
Defined in Distribution.Client.ProjectPlanning Methods fmap :: (a -> b) -> AvailableTarget a -> AvailableTarget b # (<$) :: a -> AvailableTarget b -> AvailableTarget a # | |
Show k => Show (AvailableTarget k) Source # | |
Defined in Distribution.Client.ProjectPlanning Methods showsPrec :: Int -> AvailableTarget k -> ShowS # show :: AvailableTarget k -> String # showList :: [AvailableTarget k] -> ShowS # | |
Eq k => Eq (AvailableTarget k) Source # | |
Defined in Distribution.Client.ProjectPlanning Methods (==) :: AvailableTarget k -> AvailableTarget k -> Bool # (/=) :: AvailableTarget k -> AvailableTarget k -> Bool # |
data AvailableTargetStatus k Source #
The status of a an AvailableTarget
component. This tells us whether
it's actually possible to select this component to be built, and if not
why not.
Constructors
TargetDisabledByUser | When the user does |
TargetDisabledBySolver | When the solver could not enable tests |
TargetNotBuildable | When the component has |
TargetNotLocal | When the component is non-core in a non-local package |
TargetBuildable k TargetRequested | The target can or should be built |
Instances
data TargetRequested Source #
This tells us whether a target ought to be built by default, or only if
specifically requested. The policy is that components like libraries and
executables are built by default by build
, but test suites and benchmarks
are not, unless this is overridden in the project configuration.
Constructors
TargetRequestedByDefault | To be built by default |
TargetNotRequestedByDefault | Not to be built by default |
Instances
Show TargetRequested Source # | |
Defined in Distribution.Client.ProjectPlanning Methods showsPrec :: Int -> TargetRequested -> ShowS # show :: TargetRequested -> String # showList :: [TargetRequested] -> ShowS # | |
Eq TargetRequested Source # | |
Defined in Distribution.Client.ProjectPlanning Methods (==) :: TargetRequested -> TargetRequested -> Bool # (/=) :: TargetRequested -> TargetRequested -> Bool # | |
Ord TargetRequested Source # | |
Defined in Distribution.Client.ProjectPlanning Methods compare :: TargetRequested -> TargetRequested -> Ordering # (<) :: TargetRequested -> TargetRequested -> Bool # (<=) :: TargetRequested -> TargetRequested -> Bool # (>) :: TargetRequested -> TargetRequested -> Bool # (>=) :: TargetRequested -> TargetRequested -> Bool # max :: TargetRequested -> TargetRequested -> TargetRequested # min :: TargetRequested -> TargetRequested -> TargetRequested # |
data ComponentName #
Constructors
CLibName LibraryName | |
CNotLibName NotLibComponentName |
Bundled Patterns
pattern CBenchName :: UnqualComponentName -> ComponentName | |
pattern CTestName :: UnqualComponentName -> ComponentName | |
pattern CExeName :: UnqualComponentName -> ComponentName | |
pattern CFLibName :: UnqualComponentName -> ComponentName |
Instances
data ComponentKind Source #
Instances
data ComponentTarget Source #
Specific targets within a package or component to act on e.g. to build, haddock or open a repl.
Constructors
ComponentTarget ComponentName SubComponentTarget |
Instances
data SubComponentTarget Source #
Either the component as a whole or detail about a file or module target within a component.
Constructors
WholeComponent | The component as a whole |
ModuleTarget ModuleName | A specific module within a component. |
FileTarget FilePath | A specific file within a component. Note that this does not carry the file extension. |
Instances
selectComponentTargetBasic :: SubComponentTarget -> AvailableTarget k -> Either (TargetProblem a) k Source #
A basic selectComponentTarget
implementation to use or pass to
resolveTargets
, that does the basic checks that the component is
buildable and isn't a test suite or benchmark that is disabled. This
can also be used to do these basic checks as part of a custom impl that
distinctTargetComponents :: TargetsMap -> Set (UnitId, ComponentName) Source #
Utility used by repl and run to check if the targets spans multiple components, since those commands do not support multiple components.
Utils for selecting targets
filterTargetsKind :: ComponentKind -> [AvailableTarget k] -> [AvailableTarget k] Source #
filterTargetsKindWith :: (ComponentKind -> Bool) -> [AvailableTarget k] -> [AvailableTarget k] Source #
selectBuildableTargets :: [AvailableTarget k] -> [k] Source #
selectBuildableTargetsWith :: (TargetRequested -> Bool) -> [AvailableTarget k] -> [k] Source #
selectBuildableTargets' :: [AvailableTarget k] -> ([k], [AvailableTarget ()]) Source #
selectBuildableTargetsWith' :: (TargetRequested -> Bool) -> [AvailableTarget k] -> ([k], [AvailableTarget ()]) Source #
forgetTargetsDetail :: [AvailableTarget k] -> [AvailableTarget ()] Source #
Adjusting the plan
pruneInstallPlanToTargets :: TargetAction -> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan Source #
Wrapper around pruneInstallPlanToTargets
that adjusts
for the extra unneeded info in the TargetsMap
.
data TargetAction Source #
How pruneInstallPlanToTargets
should interpret the per-package
ComponentTarget
s: as build, repl or haddock targets.
pruneInstallPlanToDependencies :: Set UnitId -> ElaboratedInstallPlan -> Either CannotPruneDependencies ElaboratedInstallPlan Source #
Try to remove the given targets from the install plan.
This is not always possible.
newtype CannotPruneDependencies Source #
It is not always possible to prune to only the dependencies of a set of targets. It may be the case that removing a package leaves something else that still needed the pruned package.
This lists all the packages that would be broken, and their dependencies that would be missing if we did prune.
Constructors
CannotPruneDependencies [(ElaboratedPlanPackage, [ElaboratedPlanPackage])] |
Instances
Show CannotPruneDependencies Source # | |
Defined in Distribution.Client.ProjectPlanning Methods showsPrec :: Int -> CannotPruneDependencies -> ShowS # show :: CannotPruneDependencies -> String # showList :: [CannotPruneDependencies] -> ShowS # |
printPlan :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO () Source #
Print a user-oriented presentation of the install plan, indicating what will be built.
Build phase: now do it.
runProjectBuildPhase :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO BuildOutcomes Source #
Build phase: now do it.
Execute all or parts of the description of what to do to build or rebuild the various packages needed.
Post build actions
runProjectPostBuildPhase :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> BuildOutcomes -> IO () Source #
Post-build phase: various administrative tasks
Update bits of state based on the build outcomes and report any failures.
dieOnBuildFailures :: Verbosity -> CurrentCommand -> ElaboratedInstallPlan -> BuildOutcomes -> IO () Source #
If there are build failures then report them and throw an exception.
Dummy projects
establishDummyProjectBaseContext Source #
Arguments
:: Verbosity | |
-> ProjectConfig | Project configuration including the global config if needed |
-> DistDirLayout | Where to put the dist directory |
-> [PackageSpecifier UnresolvedSourcePackage] | The packages to be included in the project |
-> CurrentCommand | |
-> IO ProjectBaseContext |
Create a dummy project context, without a .cabal or a .cabal.project file (a place where to put a temporary dist directory is still needed)