never executed always true always false
1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2
3 -- | Handling project configuration, types.
4 --
5 module Distribution.Client.ProjectConfig.Types (
6
7 -- * Types for project config
8 ProjectConfig(..),
9 ProjectConfigBuildOnly(..),
10 ProjectConfigShared(..),
11 ProjectConfigProvenance(..),
12 PackageConfig(..),
13
14 -- * Resolving configuration
15 SolverSettings(..),
16 BuildTimeSettings(..),
17
18 -- * Extra useful Monoids
19 MapLast(..),
20 MapMappend(..),
21 ) where
22
23 import Distribution.Client.Compat.Prelude
24 import Prelude ()
25
26 import Distribution.Client.Types.Repo ( RemoteRepo, LocalRepo )
27 import Distribution.Client.Types.AllowNewer ( AllowNewer(..), AllowOlder(..) )
28 import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy ( WriteGhcEnvironmentFilesPolicy )
29 import Distribution.Client.Dependency.Types
30 ( PreSolver )
31 import Distribution.Client.Targets
32 ( UserConstraint )
33 import Distribution.Client.BuildReports.Types
34 ( ReportLevel(..) )
35 import Distribution.Client.Types.SourceRepo (SourceRepoList)
36
37 import Distribution.Client.IndexUtils.IndexState
38 ( TotalIndexState )
39 import Distribution.Client.IndexUtils.ActiveRepos
40 ( ActiveRepos )
41
42 import Distribution.Client.CmdInstall.ClientInstallFlags
43 ( ClientInstallFlags(..) )
44
45 import Distribution.Solver.Types.Settings
46 import Distribution.Solver.Types.ConstraintSource
47
48 import Distribution.Package
49 ( PackageName, PackageId, UnitId )
50 import Distribution.Types.PackageVersionConstraint
51 ( PackageVersionConstraint )
52 import Distribution.Version
53 ( Version )
54 import Distribution.System
55 ( Platform )
56 import Distribution.PackageDescription
57 ( FlagAssignment )
58 import Distribution.Simple.Compiler
59 ( Compiler, CompilerFlavor
60 , OptimisationLevel(..), ProfDetailLevel, DebugInfoLevel(..) )
61 import Distribution.Simple.Setup
62 ( Flag, HaddockTarget(..), TestShowDetails(..) )
63 import Distribution.Simple.InstallDirs
64 ( PathTemplate )
65 import Distribution.Utils.NubList
66 ( NubList )
67
68 import qualified Data.Map as Map
69
70 -------------------------------
71 -- Project config types
72 --
73
74 -- | This type corresponds directly to what can be written in the
75 -- @cabal.project@ file. Other sources of configuration can also be injected
76 -- into this type, such as the user-wide @~/.cabal/config@ file and the
77 -- command line of @cabal configure@ or @cabal build@.
78 --
79 -- Since it corresponds to the external project file it is an instance of
80 -- 'Monoid' and all the fields can be empty. This also means there has to
81 -- be a step where we resolve configuration. At a minimum resolving means
82 -- applying defaults but it can also mean merging information from multiple
83 -- sources. For example for package-specific configuration the project file
84 -- can specify configuration that applies to all local packages, and then
85 -- additional configuration for a specific package.
86 --
87 -- Future directions: multiple profiles, conditionals. If we add these
88 -- features then the gap between configuration as written in the config file
89 -- and resolved settings we actually use will become even bigger.
90 --
91 data ProjectConfig
92 = ProjectConfig {
93
94 -- | Packages in this project, including local dirs, local .cabal files
95 -- local and remote tarballs. When these are file globs, they must
96 -- match at least one package.
97 projectPackages :: [String],
98
99 -- | Like 'projectConfigPackageGlobs' but /optional/ in the sense that
100 -- file globs are allowed to match nothing. The primary use case for
101 -- this is to be able to say @optional-packages: */@ to automagically
102 -- pick up deps that we unpack locally without erroring when
103 -- there aren't any.
104 projectPackagesOptional :: [String],
105
106 -- | Packages in this project from remote source repositories.
107 projectPackagesRepo :: [SourceRepoList],
108
109 -- | Packages in this project from hackage repositories.
110 projectPackagesNamed :: [PackageVersionConstraint],
111
112 -- See respective types for an explanation of what these
113 -- values are about:
114 projectConfigBuildOnly :: ProjectConfigBuildOnly,
115 projectConfigShared :: ProjectConfigShared,
116 projectConfigProvenance :: Set ProjectConfigProvenance,
117
118 -- | Configuration to be applied to *all* packages,
119 -- whether named in `cabal.project` or not.
120 projectConfigAllPackages :: PackageConfig,
121
122 -- | Configuration to be applied to *local* packages; i.e.,
123 -- any packages which are explicitly named in `cabal.project`.
124 projectConfigLocalPackages :: PackageConfig,
125 projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
126 }
127 deriving (Eq, Show, Generic, Typeable)
128
129 -- | That part of the project configuration that only affects /how/ we build
130 -- and not the /value/ of the things we build. This means this information
131 -- does not need to be tracked for changes since it does not affect the
132 -- outcome.
133 --
134 data ProjectConfigBuildOnly
135 = ProjectConfigBuildOnly {
136 projectConfigVerbosity :: Flag Verbosity,
137 projectConfigDryRun :: Flag Bool,
138 projectConfigOnlyDeps :: Flag Bool,
139 projectConfigOnlyDownload :: Flag Bool,
140 projectConfigSummaryFile :: NubList PathTemplate,
141 projectConfigLogFile :: Flag PathTemplate,
142 projectConfigBuildReports :: Flag ReportLevel,
143 projectConfigReportPlanningFailure :: Flag Bool,
144 projectConfigSymlinkBinDir :: Flag FilePath,
145 projectConfigOneShot :: Flag Bool,
146 projectConfigNumJobs :: Flag (Maybe Int),
147 projectConfigKeepGoing :: Flag Bool,
148 projectConfigOfflineMode :: Flag Bool,
149 projectConfigKeepTempFiles :: Flag Bool,
150 projectConfigHttpTransport :: Flag String,
151 projectConfigIgnoreExpiry :: Flag Bool,
152 projectConfigCacheDir :: Flag FilePath,
153 projectConfigLogsDir :: Flag FilePath,
154 projectConfigClientInstallFlags :: ClientInstallFlags
155 }
156 deriving (Eq, Show, Generic)
157
158
159 -- | Project configuration that is shared between all packages in the project.
160 -- In particular this includes configuration that affects the solver.
161 --
162 data ProjectConfigShared
163 = ProjectConfigShared {
164 projectConfigDistDir :: Flag FilePath,
165 projectConfigConfigFile :: Flag FilePath,
166 projectConfigProjectFile :: Flag FilePath,
167 projectConfigIgnoreProject :: Flag Bool,
168 projectConfigHcFlavor :: Flag CompilerFlavor,
169 projectConfigHcPath :: Flag FilePath,
170 projectConfigHcPkg :: Flag FilePath,
171 projectConfigHaddockIndex :: Flag PathTemplate,
172
173 -- Things that only make sense for manual mode, not --local mode
174 -- too much control!
175 --projectConfigUserInstall :: Flag Bool,
176 --projectConfigInstallDirs :: InstallDirs (Flag PathTemplate),
177 --TODO: [required eventually] decide what to do with InstallDirs
178 -- currently we don't allow it to be specified in the config file
179 --projectConfigPackageDBs :: [Maybe PackageDB],
180
181 -- configuration used both by the solver and other phases
182 projectConfigRemoteRepos :: NubList RemoteRepo, -- ^ Available Hackage servers.
183 projectConfigLocalNoIndexRepos :: NubList LocalRepo,
184 projectConfigActiveRepos :: Flag ActiveRepos,
185 projectConfigIndexState :: Flag TotalIndexState,
186 projectConfigStoreDir :: Flag FilePath,
187
188 -- solver configuration
189 projectConfigConstraints :: [(UserConstraint, ConstraintSource)],
190 projectConfigPreferences :: [PackageVersionConstraint],
191 projectConfigCabalVersion :: Flag Version, --TODO: [required eventually] unused
192 projectConfigSolver :: Flag PreSolver,
193 projectConfigAllowOlder :: Maybe AllowOlder,
194 projectConfigAllowNewer :: Maybe AllowNewer,
195 projectConfigWriteGhcEnvironmentFilesPolicy
196 :: Flag WriteGhcEnvironmentFilesPolicy,
197 projectConfigMaxBackjumps :: Flag Int,
198 projectConfigReorderGoals :: Flag ReorderGoals,
199 projectConfigCountConflicts :: Flag CountConflicts,
200 projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts,
201 projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet,
202 projectConfigStrongFlags :: Flag StrongFlags,
203 projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls,
204 projectConfigOnlyConstrained :: Flag OnlyConstrained,
205 projectConfigPerComponent :: Flag Bool,
206 projectConfigIndependentGoals :: Flag IndependentGoals,
207
208 projectConfigProgPathExtra :: NubList FilePath
209
210 -- More things that only make sense for manual mode, not --local mode
211 -- too much control!
212 --projectConfigShadowPkgs :: Flag Bool,
213 --projectConfigReinstall :: Flag Bool,
214 --projectConfigAvoidReinstalls :: Flag Bool,
215 --projectConfigOverrideReinstall :: Flag Bool,
216 --projectConfigUpgradeDeps :: Flag Bool
217 }
218 deriving (Eq, Show, Generic)
219
220
221 -- | Specifies the provenance of project configuration, whether defaults were
222 -- used or if the configuration was read from an explicit file path.
223 data ProjectConfigProvenance
224
225 -- | The configuration is implicit due to no explicit configuration
226 -- being found. See 'Distribution.Client.ProjectConfig.readProjectConfig'
227 -- for how implicit configuration is determined.
228 = Implicit
229
230 -- | The path the project configuration was explicitly read from.
231 -- | The configuration was explicitly read from the specified 'FilePath'.
232 | Explicit FilePath
233 deriving (Eq, Ord, Show, Generic)
234
235
236 -- | Project configuration that is specific to each package, that is where we
237 -- can in principle have different values for different packages in the same
238 -- project.
239 --
240 data PackageConfig
241 = PackageConfig {
242 packageConfigProgramPaths :: MapLast String FilePath,
243 packageConfigProgramArgs :: MapMappend String [String],
244 packageConfigProgramPathExtra :: NubList FilePath,
245 packageConfigFlagAssignment :: FlagAssignment,
246 packageConfigVanillaLib :: Flag Bool,
247 packageConfigSharedLib :: Flag Bool,
248 packageConfigStaticLib :: Flag Bool,
249 packageConfigDynExe :: Flag Bool,
250 packageConfigFullyStaticExe :: Flag Bool,
251 packageConfigProf :: Flag Bool, --TODO: [code cleanup] sort out
252 packageConfigProfLib :: Flag Bool, -- this duplication
253 packageConfigProfExe :: Flag Bool, -- and consistency
254 packageConfigProfDetail :: Flag ProfDetailLevel,
255 packageConfigProfLibDetail :: Flag ProfDetailLevel,
256 packageConfigConfigureArgs :: [String],
257 packageConfigOptimization :: Flag OptimisationLevel,
258 packageConfigProgPrefix :: Flag PathTemplate,
259 packageConfigProgSuffix :: Flag PathTemplate,
260 packageConfigExtraLibDirs :: [FilePath],
261 packageConfigExtraFrameworkDirs :: [FilePath],
262 packageConfigExtraIncludeDirs :: [FilePath],
263 packageConfigGHCiLib :: Flag Bool,
264 packageConfigSplitSections :: Flag Bool,
265 packageConfigSplitObjs :: Flag Bool,
266 packageConfigStripExes :: Flag Bool,
267 packageConfigStripLibs :: Flag Bool,
268 packageConfigTests :: Flag Bool,
269 packageConfigBenchmarks :: Flag Bool,
270 packageConfigCoverage :: Flag Bool,
271 packageConfigRelocatable :: Flag Bool,
272 packageConfigDebugInfo :: Flag DebugInfoLevel,
273 packageConfigRunTests :: Flag Bool, --TODO: [required eventually] use this
274 packageConfigDocumentation :: Flag Bool, --TODO: [required eventually] use this
275 -- Haddock options
276 packageConfigHaddockHoogle :: Flag Bool, --TODO: [required eventually] use this
277 packageConfigHaddockHtml :: Flag Bool, --TODO: [required eventually] use this
278 packageConfigHaddockHtmlLocation :: Flag String, --TODO: [required eventually] use this
279 packageConfigHaddockForeignLibs :: Flag Bool, --TODO: [required eventually] use this
280 packageConfigHaddockExecutables :: Flag Bool, --TODO: [required eventually] use this
281 packageConfigHaddockTestSuites :: Flag Bool, --TODO: [required eventually] use this
282 packageConfigHaddockBenchmarks :: Flag Bool, --TODO: [required eventually] use this
283 packageConfigHaddockInternal :: Flag Bool, --TODO: [required eventually] use this
284 packageConfigHaddockCss :: Flag FilePath, --TODO: [required eventually] use this
285 packageConfigHaddockLinkedSource :: Flag Bool, --TODO: [required eventually] use this
286 packageConfigHaddockQuickJump :: Flag Bool, --TODO: [required eventually] use this
287 packageConfigHaddockHscolourCss :: Flag FilePath, --TODO: [required eventually] use this
288 packageConfigHaddockContents :: Flag PathTemplate, --TODO: [required eventually] use this
289 packageConfigHaddockForHackage :: Flag HaddockTarget,
290 -- Test options
291 packageConfigTestHumanLog :: Flag PathTemplate,
292 packageConfigTestMachineLog :: Flag PathTemplate,
293 packageConfigTestShowDetails :: Flag TestShowDetails,
294 packageConfigTestKeepTix :: Flag Bool,
295 packageConfigTestWrapper :: Flag FilePath,
296 packageConfigTestFailWhenNoTestSuites :: Flag Bool,
297 packageConfigTestTestOptions :: [PathTemplate],
298 -- Benchmark options
299 packageConfigBenchmarkOptions :: [PathTemplate]
300 }
301 deriving (Eq, Show, Generic)
302
303 instance Binary ProjectConfig
304 instance Binary ProjectConfigBuildOnly
305 instance Binary ProjectConfigShared
306 instance Binary ProjectConfigProvenance
307 instance Binary PackageConfig
308
309 instance Structured ProjectConfig
310 instance Structured ProjectConfigBuildOnly
311 instance Structured ProjectConfigShared
312 instance Structured ProjectConfigProvenance
313 instance Structured PackageConfig
314
315 -- | Newtype wrapper for 'Map' that provides a 'Monoid' instance that takes
316 -- the last value rather than the first value for overlapping keys.
317 newtype MapLast k v = MapLast { getMapLast :: Map k v }
318 deriving (Eq, Show, Functor, Generic, Binary, Typeable)
319
320 instance (Structured k, Structured v) => Structured (MapLast k v)
321
322 instance Ord k => Monoid (MapLast k v) where
323 mempty = MapLast Map.empty
324 mappend = (<>)
325
326 instance Ord k => Semigroup (MapLast k v) where
327 MapLast a <> MapLast b = MapLast $ Map.union b a
328 -- rather than Map.union which is the normal Map monoid instance
329
330
331 -- | Newtype wrapper for 'Map' that provides a 'Monoid' instance that
332 -- 'mappend's values of overlapping keys rather than taking the first.
333 newtype MapMappend k v = MapMappend { getMapMappend :: Map k v }
334 deriving (Eq, Show, Functor, Generic, Binary, Typeable)
335
336 instance (Structured k, Structured v) => Structured (MapMappend k v)
337
338 instance (Semigroup v, Ord k) => Monoid (MapMappend k v) where
339 mempty = MapMappend Map.empty
340 mappend = (<>)
341
342 instance (Semigroup v, Ord k) => Semigroup (MapMappend k v) where
343 MapMappend a <> MapMappend b = MapMappend (Map.unionWith (<>) a b)
344 -- rather than Map.union which is the normal Map monoid instance
345
346
347 instance Monoid ProjectConfig where
348 mempty = gmempty
349 mappend = (<>)
350
351 instance Semigroup ProjectConfig where
352 (<>) = gmappend
353
354
355 instance Monoid ProjectConfigBuildOnly where
356 mempty = gmempty
357 mappend = (<>)
358
359 instance Semigroup ProjectConfigBuildOnly where
360 (<>) = gmappend
361
362
363 instance Monoid ProjectConfigShared where
364 mempty = gmempty
365 mappend = (<>)
366
367 instance Semigroup ProjectConfigShared where
368 (<>) = gmappend
369
370
371 instance Monoid PackageConfig where
372 mempty = gmempty
373 mappend = (<>)
374
375 instance Semigroup PackageConfig where
376 (<>) = gmappend
377
378 ----------------------------------------
379 -- Resolving configuration to settings
380 --
381
382 -- | Resolved configuration for the solver. The idea is that this is easier to
383 -- use than the raw configuration because in the raw configuration everything
384 -- is optional (monoidial). In the 'BuildTimeSettings' every field is filled
385 -- in, if only with the defaults.
386 --
387 -- Use 'resolveSolverSettings' to make one from the project config (by
388 -- applying defaults etc).
389 --
390 data SolverSettings
391 = SolverSettings {
392 solverSettingRemoteRepos :: [RemoteRepo], -- ^ Available Hackage servers.
393 solverSettingLocalNoIndexRepos :: [LocalRepo],
394 solverSettingConstraints :: [(UserConstraint, ConstraintSource)],
395 solverSettingPreferences :: [PackageVersionConstraint],
396 solverSettingFlagAssignment :: FlagAssignment, -- ^ For all local packages
397 solverSettingFlagAssignments :: Map PackageName FlagAssignment,
398 solverSettingCabalVersion :: Maybe Version, --TODO: [required eventually] unused
399 solverSettingSolver :: PreSolver,
400 solverSettingAllowOlder :: AllowOlder,
401 solverSettingAllowNewer :: AllowNewer,
402 solverSettingMaxBackjumps :: Maybe Int,
403 solverSettingReorderGoals :: ReorderGoals,
404 solverSettingCountConflicts :: CountConflicts,
405 solverSettingFineGrainedConflicts :: FineGrainedConflicts,
406 solverSettingMinimizeConflictSet :: MinimizeConflictSet,
407 solverSettingStrongFlags :: StrongFlags,
408 solverSettingAllowBootLibInstalls :: AllowBootLibInstalls,
409 solverSettingOnlyConstrained :: OnlyConstrained,
410 solverSettingIndexState :: Maybe TotalIndexState,
411 solverSettingActiveRepos :: Maybe ActiveRepos,
412 solverSettingIndependentGoals :: IndependentGoals
413 -- Things that only make sense for manual mode, not --local mode
414 -- too much control!
415 --solverSettingShadowPkgs :: Bool,
416 --solverSettingReinstall :: Bool,
417 --solverSettingAvoidReinstalls :: Bool,
418 --solverSettingOverrideReinstall :: Bool,
419 --solverSettingUpgradeDeps :: Bool
420 }
421 deriving (Eq, Show, Generic, Typeable)
422
423 instance Binary SolverSettings
424 instance Structured SolverSettings
425
426
427 -- | Resolved configuration for things that affect how we build and not the
428 -- value of the things we build. The idea is that this is easier to use than
429 -- the raw configuration because in the raw configuration everything is
430 -- optional (monoidial). In the 'BuildTimeSettings' every field is filled in,
431 -- if only with the defaults.
432 --
433 -- Use 'resolveBuildTimeSettings' to make one from the project config (by
434 -- applying defaults etc).
435 --
436 data BuildTimeSettings
437 = BuildTimeSettings {
438 buildSettingDryRun :: Bool,
439 buildSettingOnlyDeps :: Bool,
440 buildSettingOnlyDownload :: Bool,
441 buildSettingSummaryFile :: [PathTemplate],
442 buildSettingLogFile :: Maybe (Compiler -> Platform
443 -> PackageId -> UnitId
444 -> FilePath),
445 buildSettingLogVerbosity :: Verbosity,
446 buildSettingBuildReports :: ReportLevel,
447 buildSettingReportPlanningFailure :: Bool,
448 buildSettingSymlinkBinDir :: [FilePath],
449 buildSettingOneShot :: Bool,
450 buildSettingNumJobs :: Int,
451 buildSettingKeepGoing :: Bool,
452 buildSettingOfflineMode :: Bool,
453 buildSettingKeepTempFiles :: Bool,
454 buildSettingRemoteRepos :: [RemoteRepo],
455 buildSettingLocalNoIndexRepos :: [LocalRepo],
456 buildSettingCacheDir :: FilePath,
457 buildSettingHttpTransport :: Maybe String,
458 buildSettingIgnoreExpiry :: Bool,
459 buildSettingProgPathExtra :: [FilePath]
460 }