never executed always true always false
1 {-# LANGUAGE RecordWildCards, NamedFieldPuns, DeriveGeneric, ConstraintKinds #-}
2
3 -- | Project configuration, implementation in terms of legacy types.
4 --
5 module Distribution.Client.ProjectConfig.Legacy (
6
7 -- * Project config in terms of legacy types
8 LegacyProjectConfig,
9 parseLegacyProjectConfig,
10 showLegacyProjectConfig,
11
12 -- * Conversion to and from legacy config types
13 commandLineFlagsToProjectConfig,
14 convertLegacyProjectConfig,
15 convertLegacyGlobalConfig,
16 convertToLegacyProjectConfig,
17
18 -- * Internals, just for tests
19 parsePackageLocationTokenQ,
20 renderPackageLocationToken,
21 ) where
22
23 import Prelude ()
24 import Distribution.Client.Compat.Prelude
25
26 import Distribution.Types.Flag (parsecFlagAssignment)
27
28 import Distribution.Client.ProjectConfig.Types
29 import Distribution.Client.Types.RepoName (RepoName (..), unRepoName)
30 import Distribution.Client.Types.Repo (RemoteRepo(..), LocalRepo (..), emptyRemoteRepo)
31 import Distribution.Client.Types.AllowNewer (AllowNewer(..), AllowOlder(..))
32 import Distribution.Client.Types.SourceRepo (sourceRepositoryPackageGrammar, SourceRepoList)
33
34 import Distribution.Client.Config
35 ( SavedConfig(..), remoteRepoFields, postProcessRepo )
36
37 import Distribution.Client.CmdInstall.ClientInstallFlags
38 ( ClientInstallFlags(..), defaultClientInstallFlags
39 , clientInstallOptions )
40
41 import Distribution.Solver.Types.ConstraintSource
42
43 import Distribution.FieldGrammar
44 import Distribution.Package
45 import Distribution.Types.SourceRepo (RepoType)
46 import Distribution.PackageDescription
47 ( dispFlagAssignment )
48 import Distribution.Simple.Compiler
49 ( OptimisationLevel(..), DebugInfoLevel(..) )
50 import Distribution.Simple.InstallDirs ( CopyDest (NoCopyDest) )
51 import Distribution.Simple.Setup
52 ( Flag(Flag), toFlag, fromFlagOrDefault
53 , ConfigFlags(..), configureOptions
54 , HaddockFlags(..), haddockOptions, defaultHaddockFlags
55 , TestFlags(..), testOptions', defaultTestFlags
56 , BenchmarkFlags(..), benchmarkOptions', defaultBenchmarkFlags
57 , programDbPaths', splitArgs
58 )
59 import Distribution.Client.NixStyleOptions (NixStyleFlags (..))
60 import Distribution.Client.ProjectFlags (ProjectFlags (..), projectFlagsOptions, defaultProjectFlags)
61 import Distribution.Client.Setup
62 ( GlobalFlags(..), globalCommand
63 , ConfigExFlags(..), configureExOptions, defaultConfigExFlags
64 , InstallFlags(..), installOptions, defaultInstallFlags )
65 import Distribution.Simple.Program
66 ( programName, knownPrograms )
67 import Distribution.Simple.Program.Db
68 ( ProgramDb, defaultProgramDb )
69 import Distribution.Simple.Utils
70 ( lowercase )
71 import Distribution.Utils.NubList
72 ( toNubList, fromNubList, overNubList )
73 import Distribution.Simple.LocalBuildInfo
74 ( toPathTemplate, fromPathTemplate )
75
76 import qualified Distribution.Deprecated.ReadP as Parse
77 import Distribution.Deprecated.ReadP
78 ( ReadP, (+++) )
79 import qualified Text.PrettyPrint as Disp
80 import Text.PrettyPrint
81 ( Doc, ($+$) )
82 import qualified Distribution.Deprecated.ParseUtils as ParseUtils
83 import Distribution.Deprecated.ParseUtils
84 ( ParseResult(..), PError(..), syntaxError, PWarning(..)
85 , commaNewLineListFieldParsec, newLineListField, parseTokenQ
86 , parseHaskellString, showToken
87 , simpleFieldParsec
88 )
89 import Distribution.Client.ParseUtils
90 import Distribution.Simple.Command
91 ( CommandUI(commandOptions), ShowOrParseArgs(..)
92 , OptionField, option, reqArg' )
93 import Distribution.Types.PackageVersionConstraint
94 ( PackageVersionConstraint )
95 import Distribution.Parsec (ParsecParser)
96
97 import qualified Data.Map as Map
98 import qualified Data.ByteString as BS
99
100 import Network.URI (URI (..))
101
102 ------------------------------------------------------------------
103 -- Representing the project config file in terms of legacy types
104 --
105
106 -- | We already have parsers\/pretty-printers for almost all the fields in the
107 -- project config file, but they're in terms of the types used for the command
108 -- line flags for Setup.hs or cabal commands. We don't want to redefine them
109 -- all, at least not yet so for the moment we use the parsers at the old types
110 -- and use conversion functions.
111 --
112 -- Ultimately if\/when this project-based approach becomes the default then we
113 -- can redefine the parsers directly for the new types.
114 --
115 data LegacyProjectConfig = LegacyProjectConfig {
116 legacyPackages :: [String],
117 legacyPackagesOptional :: [String],
118 legacyPackagesRepo :: [SourceRepoList],
119 legacyPackagesNamed :: [PackageVersionConstraint],
120
121 legacySharedConfig :: LegacySharedConfig,
122 legacyAllConfig :: LegacyPackageConfig,
123 legacyLocalConfig :: LegacyPackageConfig,
124 legacySpecificConfig :: MapMappend PackageName LegacyPackageConfig
125 } deriving (Show, Generic)
126
127 instance Monoid LegacyProjectConfig where
128 mempty = gmempty
129 mappend = (<>)
130
131 instance Semigroup LegacyProjectConfig where
132 (<>) = gmappend
133
134 data LegacyPackageConfig = LegacyPackageConfig {
135 legacyConfigureFlags :: ConfigFlags,
136 legacyInstallPkgFlags :: InstallFlags,
137 legacyHaddockFlags :: HaddockFlags,
138 legacyTestFlags :: TestFlags,
139 legacyBenchmarkFlags :: BenchmarkFlags
140 } deriving (Show, Generic)
141
142 instance Monoid LegacyPackageConfig where
143 mempty = gmempty
144 mappend = (<>)
145
146 instance Semigroup LegacyPackageConfig where
147 (<>) = gmappend
148
149 data LegacySharedConfig = LegacySharedConfig {
150 legacyGlobalFlags :: GlobalFlags,
151 legacyConfigureShFlags :: ConfigFlags,
152 legacyConfigureExFlags :: ConfigExFlags,
153 legacyInstallFlags :: InstallFlags,
154 legacyClientInstallFlags:: ClientInstallFlags,
155 legacyProjectFlags :: ProjectFlags
156 } deriving (Show, Generic)
157
158 instance Monoid LegacySharedConfig where
159 mempty = gmempty
160 mappend = (<>)
161
162 instance Semigroup LegacySharedConfig where
163 (<>) = gmappend
164
165
166 ------------------------------------------------------------------
167 -- Converting from and to the legacy types
168 --
169
170 -- | Convert configuration from the @cabal configure@ or @cabal build@ command
171 -- line into a 'ProjectConfig' value that can combined with configuration from
172 -- other sources.
173 --
174 -- At the moment this uses the legacy command line flag types. See
175 -- 'LegacyProjectConfig' for an explanation.
176 --
177 commandLineFlagsToProjectConfig :: GlobalFlags
178 -> NixStyleFlags a
179 -> ClientInstallFlags
180 -> ProjectConfig
181 commandLineFlagsToProjectConfig globalFlags NixStyleFlags {..} clientInstallFlags =
182 mempty {
183 projectConfigBuildOnly = convertLegacyBuildOnlyFlags
184 globalFlags configFlags
185 installFlags clientInstallFlags
186 haddockFlags testFlags benchmarkFlags,
187 projectConfigShared = convertLegacyAllPackageFlags
188 globalFlags configFlags
189 configExFlags installFlags projectFlags,
190 projectConfigLocalPackages = localConfig,
191 projectConfigAllPackages = allConfig
192 }
193 where (localConfig, allConfig) = splitConfig
194 (convertLegacyPerPackageFlags
195 configFlags installFlags
196 haddockFlags testFlags benchmarkFlags)
197 -- split the package config (from command line arguments) into
198 -- those applied to all packages and those to local only.
199 --
200 -- for now we will just copy over the ProgramPaths/Args/Extra into
201 -- the AllPackages. The LocalPackages do not inherit them from
202 -- AllPackages, and as such need to retain them.
203 --
204 -- The general decision rule for what to put into allConfig
205 -- into localConfig is the following:
206 --
207 -- - anything that is host/toolchain/env specific should be applied
208 -- to all packages, as packagesets have to be host/toolchain/env
209 -- consistent.
210 -- - anything else should be in the local config and could potentially
211 -- be lifted into all-packages vial the `package *` cabal.project
212 -- section.
213 --
214 splitConfig :: PackageConfig -> (PackageConfig, PackageConfig)
215 splitConfig pc = (pc
216 , mempty { packageConfigProgramPaths = packageConfigProgramPaths pc
217 , packageConfigProgramArgs = packageConfigProgramArgs pc
218 , packageConfigProgramPathExtra = packageConfigProgramPathExtra pc
219 , packageConfigDocumentation = packageConfigDocumentation pc })
220
221 -- | Convert from the types currently used for the user-wide @~/.cabal/config@
222 -- file into the 'ProjectConfig' type.
223 --
224 -- Only a subset of the 'ProjectConfig' can be represented in the user-wide
225 -- config. In particular it does not include packages that are in the project,
226 -- and it also doesn't support package-specific configuration (only
227 -- configuration that applies to all packages).
228 --
229 convertLegacyGlobalConfig :: SavedConfig -> ProjectConfig
230 convertLegacyGlobalConfig
231 SavedConfig {
232 savedGlobalFlags = globalFlags,
233 savedInstallFlags = installFlags,
234 savedClientInstallFlags= clientInstallFlags,
235 savedConfigureFlags = configFlags,
236 savedConfigureExFlags = configExFlags,
237 savedUserInstallDirs = _,
238 savedGlobalInstallDirs = _,
239 savedUploadFlags = _,
240 savedReportFlags = _,
241 savedHaddockFlags = haddockFlags,
242 savedTestFlags = testFlags,
243 savedBenchmarkFlags = benchmarkFlags,
244 savedProjectFlags = projectFlags
245 } =
246 mempty {
247 projectConfigBuildOnly = configBuildOnly,
248 projectConfigShared = configShared,
249 projectConfigAllPackages = configAllPackages
250 }
251 where
252 --TODO: [code cleanup] eliminate use of default*Flags here and specify the
253 -- defaults in the various resolve functions in terms of the new types.
254 configExFlags' = defaultConfigExFlags <> configExFlags
255 installFlags' = defaultInstallFlags <> installFlags
256 clientInstallFlags' = defaultClientInstallFlags <> clientInstallFlags
257 haddockFlags' = defaultHaddockFlags <> haddockFlags
258 testFlags' = defaultTestFlags <> testFlags
259 benchmarkFlags' = defaultBenchmarkFlags <> benchmarkFlags
260 projectFlags' = defaultProjectFlags <> projectFlags
261
262 configAllPackages = convertLegacyPerPackageFlags
263 configFlags installFlags'
264 haddockFlags' testFlags' benchmarkFlags'
265 configShared = convertLegacyAllPackageFlags
266 globalFlags configFlags
267 configExFlags' installFlags' projectFlags'
268 configBuildOnly = convertLegacyBuildOnlyFlags
269 globalFlags configFlags
270 installFlags' clientInstallFlags'
271 haddockFlags' testFlags' benchmarkFlags'
272
273
274 -- | Convert the project config from the legacy types to the 'ProjectConfig'
275 -- and associated types. See 'LegacyProjectConfig' for an explanation of the
276 -- approach.
277 --
278 convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig
279 convertLegacyProjectConfig
280 LegacyProjectConfig {
281 legacyPackages,
282 legacyPackagesOptional,
283 legacyPackagesRepo,
284 legacyPackagesNamed,
285 legacySharedConfig = LegacySharedConfig globalFlags configShFlags
286 configExFlags installSharedFlags
287 clientInstallFlags projectFlags,
288 legacyAllConfig,
289 legacyLocalConfig = LegacyPackageConfig configFlags installPerPkgFlags
290 haddockFlags testFlags benchmarkFlags,
291 legacySpecificConfig
292 } =
293
294 ProjectConfig {
295 projectPackages = legacyPackages,
296 projectPackagesOptional = legacyPackagesOptional,
297 projectPackagesRepo = legacyPackagesRepo,
298 projectPackagesNamed = legacyPackagesNamed,
299
300 projectConfigBuildOnly = configBuildOnly,
301 projectConfigShared = configPackagesShared,
302 projectConfigProvenance = mempty,
303 projectConfigAllPackages = configAllPackages,
304 projectConfigLocalPackages = configLocalPackages,
305 projectConfigSpecificPackage = fmap perPackage legacySpecificConfig
306 }
307 where
308 configAllPackages = convertLegacyPerPackageFlags g i h t b
309 where LegacyPackageConfig g i h t b = legacyAllConfig
310 configLocalPackages = convertLegacyPerPackageFlags
311 configFlags installPerPkgFlags haddockFlags
312 testFlags benchmarkFlags
313 configPackagesShared= convertLegacyAllPackageFlags
314 globalFlags (configFlags <> configShFlags)
315 configExFlags installSharedFlags projectFlags
316 configBuildOnly = convertLegacyBuildOnlyFlags
317 globalFlags configShFlags
318 installSharedFlags clientInstallFlags
319 haddockFlags testFlags benchmarkFlags
320
321 perPackage (LegacyPackageConfig perPkgConfigFlags perPkgInstallFlags
322 perPkgHaddockFlags perPkgTestFlags
323 perPkgBenchmarkFlags) =
324 convertLegacyPerPackageFlags
325 perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags
326 perPkgTestFlags perPkgBenchmarkFlags
327
328
329 -- | Helper used by other conversion functions that returns the
330 -- 'ProjectConfigShared' subset of the 'ProjectConfig'.
331 --
332 convertLegacyAllPackageFlags
333 :: GlobalFlags
334 -> ConfigFlags
335 -> ConfigExFlags
336 -> InstallFlags
337 -> ProjectFlags
338 -> ProjectConfigShared
339 convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags projectFlags =
340 ProjectConfigShared{..}
341 where
342 GlobalFlags {
343 globalConfigFile = projectConfigConfigFile,
344 globalRemoteRepos = projectConfigRemoteRepos,
345 globalLocalNoIndexRepos = projectConfigLocalNoIndexRepos,
346 globalActiveRepos = projectConfigActiveRepos,
347 globalProgPathExtra = projectConfigProgPathExtra,
348 globalStoreDir = projectConfigStoreDir
349 } = globalFlags
350
351 ConfigFlags {
352 configDistPref = projectConfigDistDir,
353 configHcFlavor = projectConfigHcFlavor,
354 configHcPath = projectConfigHcPath,
355 configHcPkg = projectConfigHcPkg
356 --configProgramPathExtra = projectConfigProgPathExtra DELETE ME
357 --configInstallDirs = projectConfigInstallDirs,
358 --configUserInstall = projectConfigUserInstall,
359 --configPackageDBs = projectConfigPackageDBs,
360 } = configFlags
361
362 ConfigExFlags {
363 configCabalVersion = projectConfigCabalVersion,
364 configExConstraints = projectConfigConstraints,
365 configPreferences = projectConfigPreferences,
366 configSolver = projectConfigSolver,
367 configAllowOlder = projectConfigAllowOlder,
368 configAllowNewer = projectConfigAllowNewer,
369 configWriteGhcEnvironmentFilesPolicy
370 = projectConfigWriteGhcEnvironmentFilesPolicy
371 } = configExFlags
372
373 InstallFlags {
374 installHaddockIndex = projectConfigHaddockIndex,
375 --installReinstall = projectConfigReinstall,
376 --installAvoidReinstalls = projectConfigAvoidReinstalls,
377 --installOverrideReinstall = projectConfigOverrideReinstall,
378 installIndexState = projectConfigIndexState,
379 installMaxBackjumps = projectConfigMaxBackjumps,
380 --installUpgradeDeps = projectConfigUpgradeDeps,
381 installReorderGoals = projectConfigReorderGoals,
382 installCountConflicts = projectConfigCountConflicts,
383 installFineGrainedConflicts = projectConfigFineGrainedConflicts,
384 installMinimizeConflictSet = projectConfigMinimizeConflictSet,
385 installPerComponent = projectConfigPerComponent,
386 installIndependentGoals = projectConfigIndependentGoals,
387 --installShadowPkgs = projectConfigShadowPkgs,
388 installStrongFlags = projectConfigStrongFlags,
389 installAllowBootLibInstalls = projectConfigAllowBootLibInstalls,
390 installOnlyConstrained = projectConfigOnlyConstrained
391 } = installFlags
392
393 ProjectFlags
394 { flagProjectFileName = projectConfigProjectFile
395 , flagIgnoreProject = projectConfigIgnoreProject
396 } = projectFlags
397
398 -- | Helper used by other conversion functions that returns the
399 -- 'PackageConfig' subset of the 'ProjectConfig'.
400 --
401 convertLegacyPerPackageFlags :: ConfigFlags -> InstallFlags -> HaddockFlags
402 -> TestFlags -> BenchmarkFlags -> PackageConfig
403 convertLegacyPerPackageFlags configFlags installFlags
404 haddockFlags testFlags benchmarkFlags =
405 PackageConfig{..}
406 where
407 ConfigFlags {
408 configProgramPaths,
409 configProgramArgs,
410 configProgramPathExtra = packageConfigProgramPathExtra,
411 configVanillaLib = packageConfigVanillaLib,
412 configProfLib = packageConfigProfLib,
413 configSharedLib = packageConfigSharedLib,
414 configStaticLib = packageConfigStaticLib,
415 configDynExe = packageConfigDynExe,
416 configFullyStaticExe = packageConfigFullyStaticExe,
417 configProfExe = packageConfigProfExe,
418 configProf = packageConfigProf,
419 configProfDetail = packageConfigProfDetail,
420 configProfLibDetail = packageConfigProfLibDetail,
421 configConfigureArgs = packageConfigConfigureArgs,
422 configOptimization = packageConfigOptimization,
423 configProgPrefix = packageConfigProgPrefix,
424 configProgSuffix = packageConfigProgSuffix,
425 configGHCiLib = packageConfigGHCiLib,
426 configSplitSections = packageConfigSplitSections,
427 configSplitObjs = packageConfigSplitObjs,
428 configStripExes = packageConfigStripExes,
429 configStripLibs = packageConfigStripLibs,
430 configExtraLibDirs = packageConfigExtraLibDirs,
431 configExtraFrameworkDirs = packageConfigExtraFrameworkDirs,
432 configExtraIncludeDirs = packageConfigExtraIncludeDirs,
433 configConfigurationsFlags = packageConfigFlagAssignment,
434 configTests = packageConfigTests,
435 configBenchmarks = packageConfigBenchmarks,
436 configCoverage = coverage,
437 configLibCoverage = libcoverage, --deprecated
438 configDebugInfo = packageConfigDebugInfo,
439 configRelocatable = packageConfigRelocatable
440 } = configFlags
441 packageConfigProgramPaths = MapLast (Map.fromList configProgramPaths)
442 packageConfigProgramArgs = MapMappend (Map.fromListWith (++) configProgramArgs)
443
444 packageConfigCoverage = coverage <> libcoverage
445 --TODO: defer this merging to the resolve phase
446
447 InstallFlags {
448 installDocumentation = packageConfigDocumentation,
449 installRunTests = packageConfigRunTests
450 } = installFlags
451
452 HaddockFlags {
453 haddockHoogle = packageConfigHaddockHoogle,
454 haddockHtml = packageConfigHaddockHtml,
455 haddockHtmlLocation = packageConfigHaddockHtmlLocation,
456 haddockForeignLibs = packageConfigHaddockForeignLibs,
457 haddockForHackage = packageConfigHaddockForHackage,
458 haddockExecutables = packageConfigHaddockExecutables,
459 haddockTestSuites = packageConfigHaddockTestSuites,
460 haddockBenchmarks = packageConfigHaddockBenchmarks,
461 haddockInternal = packageConfigHaddockInternal,
462 haddockCss = packageConfigHaddockCss,
463 haddockLinkedSource = packageConfigHaddockLinkedSource,
464 haddockQuickJump = packageConfigHaddockQuickJump,
465 haddockHscolourCss = packageConfigHaddockHscolourCss,
466 haddockContents = packageConfigHaddockContents
467 } = haddockFlags
468
469 TestFlags {
470 testHumanLog = packageConfigTestHumanLog,
471 testMachineLog = packageConfigTestMachineLog,
472 testShowDetails = packageConfigTestShowDetails,
473 testKeepTix = packageConfigTestKeepTix,
474 testWrapper = packageConfigTestWrapper,
475 testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites,
476 testOptions = packageConfigTestTestOptions
477 } = testFlags
478
479 BenchmarkFlags {
480 benchmarkOptions = packageConfigBenchmarkOptions
481 } = benchmarkFlags
482
483
484 -- | Helper used by other conversion functions that returns the
485 -- 'ProjectConfigBuildOnly' subset of the 'ProjectConfig'.
486 --
487 convertLegacyBuildOnlyFlags :: GlobalFlags -> ConfigFlags
488 -> InstallFlags -> ClientInstallFlags
489 -> HaddockFlags -> TestFlags
490 -> BenchmarkFlags
491 -> ProjectConfigBuildOnly
492 convertLegacyBuildOnlyFlags globalFlags configFlags
493 installFlags clientInstallFlags
494 haddockFlags _ _ =
495 ProjectConfigBuildOnly{..}
496 where
497 projectConfigClientInstallFlags = clientInstallFlags
498 GlobalFlags {
499 globalCacheDir = projectConfigCacheDir,
500 globalLogsDir = projectConfigLogsDir,
501 globalWorldFile = _,
502 globalHttpTransport = projectConfigHttpTransport,
503 globalIgnoreExpiry = projectConfigIgnoreExpiry
504 } = globalFlags
505
506 ConfigFlags {
507 configVerbosity = projectConfigVerbosity
508 } = configFlags
509
510 InstallFlags {
511 installDryRun = projectConfigDryRun,
512 installOnlyDownload = projectConfigOnlyDownload,
513 installOnly = _,
514 installOnlyDeps = projectConfigOnlyDeps,
515 installRootCmd = _,
516 installSummaryFile = projectConfigSummaryFile,
517 installLogFile = projectConfigLogFile,
518 installBuildReports = projectConfigBuildReports,
519 installReportPlanningFailure = projectConfigReportPlanningFailure,
520 installSymlinkBinDir = projectConfigSymlinkBinDir,
521 installOneShot = projectConfigOneShot,
522 installNumJobs = projectConfigNumJobs,
523 installKeepGoing = projectConfigKeepGoing,
524 installOfflineMode = projectConfigOfflineMode
525 } = installFlags
526
527 HaddockFlags {
528 haddockKeepTempFiles = projectConfigKeepTempFiles --TODO: this ought to live elsewhere
529 } = haddockFlags
530
531
532 convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
533 convertToLegacyProjectConfig
534 projectConfig@ProjectConfig {
535 projectPackages,
536 projectPackagesOptional,
537 projectPackagesRepo,
538 projectPackagesNamed,
539 projectConfigAllPackages,
540 projectConfigLocalPackages,
541 projectConfigSpecificPackage
542 } =
543 LegacyProjectConfig {
544 legacyPackages = projectPackages,
545 legacyPackagesOptional = projectPackagesOptional,
546 legacyPackagesRepo = projectPackagesRepo,
547 legacyPackagesNamed = projectPackagesNamed,
548 legacySharedConfig = convertToLegacySharedConfig projectConfig,
549 legacyAllConfig = convertToLegacyPerPackageConfig
550 projectConfigAllPackages,
551 legacyLocalConfig = convertToLegacyAllPackageConfig projectConfig
552 <> convertToLegacyPerPackageConfig
553 projectConfigLocalPackages,
554 legacySpecificConfig = fmap convertToLegacyPerPackageConfig
555 projectConfigSpecificPackage
556 }
557
558 convertToLegacySharedConfig :: ProjectConfig -> LegacySharedConfig
559 convertToLegacySharedConfig
560 ProjectConfig {
561 projectConfigBuildOnly = ProjectConfigBuildOnly {..},
562 projectConfigShared = ProjectConfigShared {..},
563 projectConfigAllPackages = PackageConfig {
564 packageConfigDocumentation
565 }
566 } =
567
568 LegacySharedConfig
569 { legacyGlobalFlags = globalFlags
570 , legacyConfigureShFlags = configFlags
571 , legacyConfigureExFlags = configExFlags
572 , legacyInstallFlags = installFlags
573 , legacyClientInstallFlags = projectConfigClientInstallFlags
574 , legacyProjectFlags = projectFlags
575 }
576 where
577 globalFlags = GlobalFlags {
578 globalVersion = mempty,
579 globalNumericVersion = mempty,
580 globalConfigFile = projectConfigConfigFile,
581 globalConstraintsFile = mempty,
582 globalRemoteRepos = projectConfigRemoteRepos,
583 globalCacheDir = projectConfigCacheDir,
584 globalLocalNoIndexRepos = projectConfigLocalNoIndexRepos,
585 globalActiveRepos = projectConfigActiveRepos,
586 globalLogsDir = projectConfigLogsDir,
587 globalWorldFile = mempty,
588 globalIgnoreExpiry = projectConfigIgnoreExpiry,
589 globalHttpTransport = projectConfigHttpTransport,
590 globalNix = mempty,
591 globalStoreDir = projectConfigStoreDir,
592 globalProgPathExtra = projectConfigProgPathExtra
593 }
594
595 configFlags = mempty {
596 configVerbosity = projectConfigVerbosity,
597 configDistPref = projectConfigDistDir
598 }
599
600 configExFlags = ConfigExFlags {
601 configCabalVersion = projectConfigCabalVersion,
602 configExConstraints = projectConfigConstraints,
603 configPreferences = projectConfigPreferences,
604 configSolver = projectConfigSolver,
605 configAllowOlder = projectConfigAllowOlder,
606 configAllowNewer = projectConfigAllowNewer,
607 configWriteGhcEnvironmentFilesPolicy
608 = projectConfigWriteGhcEnvironmentFilesPolicy
609 }
610
611 installFlags = InstallFlags {
612 installDocumentation = packageConfigDocumentation,
613 installHaddockIndex = projectConfigHaddockIndex,
614 installDest = Flag NoCopyDest,
615 installDryRun = projectConfigDryRun,
616 installOnlyDownload = projectConfigOnlyDownload,
617 installReinstall = mempty, --projectConfigReinstall,
618 installAvoidReinstalls = mempty, --projectConfigAvoidReinstalls,
619 installOverrideReinstall = mempty, --projectConfigOverrideReinstall,
620 installMaxBackjumps = projectConfigMaxBackjumps,
621 installUpgradeDeps = mempty, --projectConfigUpgradeDeps,
622 installReorderGoals = projectConfigReorderGoals,
623 installCountConflicts = projectConfigCountConflicts,
624 installFineGrainedConflicts = projectConfigFineGrainedConflicts,
625 installMinimizeConflictSet = projectConfigMinimizeConflictSet,
626 installIndependentGoals = projectConfigIndependentGoals,
627 installShadowPkgs = mempty, --projectConfigShadowPkgs,
628 installStrongFlags = projectConfigStrongFlags,
629 installAllowBootLibInstalls = projectConfigAllowBootLibInstalls,
630 installOnlyConstrained = projectConfigOnlyConstrained,
631 installOnly = mempty,
632 installOnlyDeps = projectConfigOnlyDeps,
633 installIndexState = projectConfigIndexState,
634 installRootCmd = mempty, --no longer supported
635 installSummaryFile = projectConfigSummaryFile,
636 installLogFile = projectConfigLogFile,
637 installBuildReports = projectConfigBuildReports,
638 installReportPlanningFailure = projectConfigReportPlanningFailure,
639 installSymlinkBinDir = projectConfigSymlinkBinDir,
640 installPerComponent = projectConfigPerComponent,
641 installOneShot = projectConfigOneShot,
642 installNumJobs = projectConfigNumJobs,
643 installKeepGoing = projectConfigKeepGoing,
644 installRunTests = mempty,
645 installOfflineMode = projectConfigOfflineMode
646 }
647
648 projectFlags = ProjectFlags
649 { flagProjectFileName = projectConfigProjectFile
650 , flagIgnoreProject = projectConfigIgnoreProject
651 }
652
653
654 convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig
655 convertToLegacyAllPackageConfig
656 ProjectConfig {
657 projectConfigBuildOnly = ProjectConfigBuildOnly {..},
658 projectConfigShared = ProjectConfigShared {..}
659 } =
660
661 LegacyPackageConfig {
662 legacyConfigureFlags = configFlags,
663 legacyInstallPkgFlags= mempty,
664 legacyHaddockFlags = haddockFlags,
665 legacyTestFlags = mempty,
666 legacyBenchmarkFlags = mempty
667 }
668 where
669 configFlags = ConfigFlags {
670 configArgs = mempty,
671 configPrograms_ = mempty,
672 configProgramPaths = mempty,
673 configProgramArgs = mempty,
674 configProgramPathExtra = mempty,
675 configHcFlavor = projectConfigHcFlavor,
676 configHcPath = projectConfigHcPath,
677 configHcPkg = projectConfigHcPkg,
678 configInstantiateWith = mempty,
679 configVanillaLib = mempty,
680 configProfLib = mempty,
681 configSharedLib = mempty,
682 configStaticLib = mempty,
683 configDynExe = mempty,
684 configFullyStaticExe = mempty,
685 configProfExe = mempty,
686 configProf = mempty,
687 configProfDetail = mempty,
688 configProfLibDetail = mempty,
689 configConfigureArgs = mempty,
690 configOptimization = mempty,
691 configProgPrefix = mempty,
692 configProgSuffix = mempty,
693 configInstallDirs = mempty,
694 configScratchDir = mempty,
695 configDistPref = mempty,
696 configCabalFilePath = mempty,
697 configVerbosity = mempty,
698 configUserInstall = mempty, --projectConfigUserInstall,
699 configPackageDBs = mempty, --projectConfigPackageDBs,
700 configGHCiLib = mempty,
701 configSplitSections = mempty,
702 configSplitObjs = mempty,
703 configStripExes = mempty,
704 configStripLibs = mempty,
705 configExtraLibDirs = mempty,
706 configExtraFrameworkDirs = mempty,
707 configConstraints = mempty,
708 configDependencies = mempty,
709 configExtraIncludeDirs = mempty,
710 configDeterministic = mempty,
711 configIPID = mempty,
712 configCID = mempty,
713 configConfigurationsFlags = mempty,
714 configTests = mempty,
715 configCoverage = mempty, --TODO: don't merge
716 configLibCoverage = mempty, --TODO: don't merge
717 configExactConfiguration = mempty,
718 configBenchmarks = mempty,
719 configFlagError = mempty, --TODO: ???
720 configRelocatable = mempty,
721 configDebugInfo = mempty,
722 configUseResponseFiles = mempty,
723 configAllowDependingOnPrivateLibs = mempty
724 }
725
726 haddockFlags = mempty {
727 haddockKeepTempFiles = projectConfigKeepTempFiles
728 }
729
730
731 convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig
732 convertToLegacyPerPackageConfig PackageConfig {..} =
733 LegacyPackageConfig {
734 legacyConfigureFlags = configFlags,
735 legacyInstallPkgFlags = installFlags,
736 legacyHaddockFlags = haddockFlags,
737 legacyTestFlags = testFlags,
738 legacyBenchmarkFlags = benchmarkFlags
739 }
740 where
741 configFlags = ConfigFlags {
742 configArgs = mempty,
743 configPrograms_ = configPrograms_ mempty,
744 configProgramPaths = Map.toList (getMapLast packageConfigProgramPaths),
745 configProgramArgs = Map.toList (getMapMappend packageConfigProgramArgs),
746 configProgramPathExtra = packageConfigProgramPathExtra,
747 configHcFlavor = mempty,
748 configHcPath = mempty,
749 configHcPkg = mempty,
750 configInstantiateWith = mempty,
751 configVanillaLib = packageConfigVanillaLib,
752 configProfLib = packageConfigProfLib,
753 configSharedLib = packageConfigSharedLib,
754 configStaticLib = packageConfigStaticLib,
755 configDynExe = packageConfigDynExe,
756 configFullyStaticExe = packageConfigFullyStaticExe,
757 configProfExe = packageConfigProfExe,
758 configProf = packageConfigProf,
759 configProfDetail = packageConfigProfDetail,
760 configProfLibDetail = packageConfigProfLibDetail,
761 configConfigureArgs = packageConfigConfigureArgs,
762 configOptimization = packageConfigOptimization,
763 configProgPrefix = packageConfigProgPrefix,
764 configProgSuffix = packageConfigProgSuffix,
765 configInstallDirs = mempty,
766 configScratchDir = mempty,
767 configDistPref = mempty,
768 configCabalFilePath = mempty,
769 configVerbosity = mempty,
770 configUserInstall = mempty,
771 configPackageDBs = mempty,
772 configGHCiLib = packageConfigGHCiLib,
773 configSplitSections = packageConfigSplitSections,
774 configSplitObjs = packageConfigSplitObjs,
775 configStripExes = packageConfigStripExes,
776 configStripLibs = packageConfigStripLibs,
777 configExtraLibDirs = packageConfigExtraLibDirs,
778 configExtraFrameworkDirs = packageConfigExtraFrameworkDirs,
779 configConstraints = mempty,
780 configDependencies = mempty,
781 configExtraIncludeDirs = packageConfigExtraIncludeDirs,
782 configIPID = mempty,
783 configCID = mempty,
784 configDeterministic = mempty,
785 configConfigurationsFlags = packageConfigFlagAssignment,
786 configTests = packageConfigTests,
787 configCoverage = packageConfigCoverage, --TODO: don't merge
788 configLibCoverage = packageConfigCoverage, --TODO: don't merge
789 configExactConfiguration = mempty,
790 configBenchmarks = packageConfigBenchmarks,
791 configFlagError = mempty, --TODO: ???
792 configRelocatable = packageConfigRelocatable,
793 configDebugInfo = packageConfigDebugInfo,
794 configUseResponseFiles = mempty,
795 configAllowDependingOnPrivateLibs = mempty
796 }
797
798 installFlags = mempty {
799 installDocumentation = packageConfigDocumentation,
800 installRunTests = packageConfigRunTests
801 }
802
803 haddockFlags = HaddockFlags {
804 haddockProgramPaths = mempty,
805 haddockProgramArgs = mempty,
806 haddockHoogle = packageConfigHaddockHoogle,
807 haddockHtml = packageConfigHaddockHtml,
808 haddockHtmlLocation = packageConfigHaddockHtmlLocation,
809 haddockForHackage = packageConfigHaddockForHackage,
810 haddockForeignLibs = packageConfigHaddockForeignLibs,
811 haddockExecutables = packageConfigHaddockExecutables,
812 haddockTestSuites = packageConfigHaddockTestSuites,
813 haddockBenchmarks = packageConfigHaddockBenchmarks,
814 haddockInternal = packageConfigHaddockInternal,
815 haddockCss = packageConfigHaddockCss,
816 haddockLinkedSource = packageConfigHaddockLinkedSource,
817 haddockQuickJump = packageConfigHaddockQuickJump,
818 haddockHscolourCss = packageConfigHaddockHscolourCss,
819 haddockContents = packageConfigHaddockContents,
820 haddockDistPref = mempty,
821 haddockKeepTempFiles = mempty,
822 haddockVerbosity = mempty,
823 haddockCabalFilePath = mempty,
824 haddockArgs = mempty
825 }
826
827 testFlags = TestFlags {
828 testDistPref = mempty,
829 testVerbosity = mempty,
830 testHumanLog = packageConfigTestHumanLog,
831 testMachineLog = packageConfigTestMachineLog,
832 testShowDetails = packageConfigTestShowDetails,
833 testKeepTix = packageConfigTestKeepTix,
834 testWrapper = packageConfigTestWrapper,
835 testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites,
836 testOptions = packageConfigTestTestOptions
837 }
838
839 benchmarkFlags = BenchmarkFlags {
840 benchmarkDistPref = mempty,
841 benchmarkVerbosity = mempty,
842 benchmarkOptions = packageConfigBenchmarkOptions
843 }
844
845 ------------------------------------------------
846 -- Parsing and showing the project config file
847 --
848
849 parseLegacyProjectConfig :: FilePath -> BS.ByteString -> ParseResult LegacyProjectConfig
850 parseLegacyProjectConfig source =
851 parseConfig (legacyProjectConfigFieldDescrs constraintSrc)
852 legacyPackageConfigSectionDescrs
853 legacyPackageConfigFGSectionDescrs
854 mempty
855 where
856 constraintSrc = ConstraintSourceProjectConfig source
857
858 showLegacyProjectConfig :: LegacyProjectConfig -> String
859 showLegacyProjectConfig config =
860 Disp.render $
861 showConfig (legacyProjectConfigFieldDescrs constraintSrc)
862 legacyPackageConfigSectionDescrs
863 legacyPackageConfigFGSectionDescrs
864 config
865 $+$
866 Disp.text ""
867 where
868 -- Note: ConstraintSource is unused when pretty-printing. We fake
869 -- it here to avoid having to pass it on call-sites. It's not great
870 -- but requires re-work of how we annotate provenance.
871 constraintSrc = ConstraintSourceProjectConfig "unused"
872
873
874 legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectConfig]
875 legacyProjectConfigFieldDescrs constraintSrc =
876
877 [ newLineListField "packages"
878 (Disp.text . renderPackageLocationToken) parsePackageLocationTokenQ
879 legacyPackages
880 (\v flags -> flags { legacyPackages = v })
881 , newLineListField "optional-packages"
882 (Disp.text . renderPackageLocationToken) parsePackageLocationTokenQ
883 legacyPackagesOptional
884 (\v flags -> flags { legacyPackagesOptional = v })
885 , commaNewLineListFieldParsec "extra-packages"
886 pretty parsec
887 legacyPackagesNamed
888 (\v flags -> flags { legacyPackagesNamed = v })
889 ]
890
891 ++ map (liftField
892 legacySharedConfig
893 (\flags conf -> conf { legacySharedConfig = flags }))
894 (legacySharedConfigFieldDescrs constraintSrc)
895
896 ++ map (liftField
897 legacyLocalConfig
898 (\flags conf -> conf { legacyLocalConfig = flags }))
899 legacyPackageConfigFieldDescrs
900
901 -- | This is a bit tricky since it has to cover globs which have embedded @,@
902 -- chars. But we don't just want to parse strictly as a glob since we want to
903 -- allow http urls which don't parse as globs, and possibly some
904 -- system-dependent file paths. So we parse fairly liberally as a token, but
905 -- we allow @,@ inside matched @{}@ braces.
906 --
907 parsePackageLocationTokenQ :: ReadP r String
908 parsePackageLocationTokenQ = parseHaskellString
909 Parse.<++ parsePackageLocationToken
910 where
911 parsePackageLocationToken :: ReadP r String
912 parsePackageLocationToken = fmap fst (Parse.gather outerTerm)
913 where
914 outerTerm = alternateEither1 outerToken (braces innerTerm)
915 innerTerm = alternateEither innerToken (braces innerTerm)
916 outerToken = Parse.munch1 outerChar >> return ()
917 innerToken = Parse.munch1 innerChar >> return ()
918 outerChar c = not (isSpace c || c == '{' || c == '}' || c == ',')
919 innerChar c = not (isSpace c || c == '{' || c == '}')
920 braces = Parse.between (Parse.char '{') (Parse.char '}')
921
922 alternateEither, alternateEither1,
923 alternatePQs, alternate1PQs, alternateQsP, alternate1QsP
924 :: ReadP r () -> ReadP r () -> ReadP r ()
925
926 alternateEither1 p q = alternate1PQs p q +++ alternate1QsP q p
927 alternateEither p q = alternateEither1 p q +++ return ()
928 alternate1PQs p q = p >> alternateQsP q p
929 alternatePQs p q = alternate1PQs p q +++ return ()
930 alternate1QsP q p = Parse.many1 q >> alternatePQs p q
931 alternateQsP q p = alternate1QsP q p +++ return ()
932
933 renderPackageLocationToken :: String -> String
934 renderPackageLocationToken s | needsQuoting = show s
935 | otherwise = s
936 where
937 needsQuoting = not (ok 0 s)
938 || s == "." -- . on its own on a line has special meaning
939 || take 2 s == "--" -- on its own line is comment syntax
940 --TODO: [code cleanup] these "." and "--" escaping issues
941 -- ought to be dealt with systematically in ParseUtils.
942 ok :: Int -> String -> Bool
943 ok n [] = n == 0
944 ok _ ('"':_) = False
945 ok n ('{':cs) = ok (n+1) cs
946 ok n ('}':cs) = ok (n-1) cs
947 ok n (',':cs) = (n > 0) && ok n cs
948 ok _ (c:_)
949 | isSpace c = False
950 ok n (_ :cs) = ok n cs
951
952
953 legacySharedConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacySharedConfig]
954 legacySharedConfigFieldDescrs constraintSrc = concat
955 [ liftFields
956 legacyGlobalFlags
957 (\flags conf -> conf { legacyGlobalFlags = flags })
958 . addFields
959 [ newLineListField "extra-prog-path-shared-only"
960 showTokenQ parseTokenQ
961 (fromNubList . globalProgPathExtra)
962 (\v conf -> conf { globalProgPathExtra = toNubList v })
963 ]
964 . filterFields
965 [ "remote-repo-cache"
966 , "logs-dir", "store-dir", "ignore-expiry", "http-transport"
967 , "active-repositories"
968 ]
969 . commandOptionsToFields
970 $ commandOptions (globalCommand []) ParseArgs
971
972 , liftFields
973 legacyConfigureShFlags
974 (\flags conf -> conf { legacyConfigureShFlags = flags })
975 . filterFields ["verbose", "builddir" ]
976 . commandOptionsToFields
977 $ configureOptions ParseArgs
978
979 , liftFields
980 legacyConfigureExFlags
981 (\flags conf -> conf { legacyConfigureExFlags = flags })
982 . addFields
983 [ commaNewLineListFieldParsec "constraints"
984 (pretty . fst) (fmap (\constraint -> (constraint, constraintSrc)) parsec)
985 configExConstraints (\v conf -> conf { configExConstraints = v })
986
987 , commaNewLineListFieldParsec "preferences"
988 pretty parsec
989 configPreferences (\v conf -> conf { configPreferences = v })
990
991 , monoidFieldParsec "allow-older"
992 (maybe mempty pretty) (fmap Just parsec)
993 (fmap unAllowOlder . configAllowOlder)
994 (\v conf -> conf { configAllowOlder = fmap AllowOlder v })
995
996 , monoidFieldParsec "allow-newer"
997 (maybe mempty pretty) (fmap Just parsec)
998 (fmap unAllowNewer . configAllowNewer)
999 (\v conf -> conf { configAllowNewer = fmap AllowNewer v })
1000 ]
1001 . filterFields
1002 [ "cabal-lib-version", "solver", "write-ghc-environment-files"
1003 -- not "constraint" or "preference", we use our own plural ones above
1004 ]
1005 . commandOptionsToFields
1006 $ configureExOptions ParseArgs constraintSrc
1007
1008 , liftFields
1009 legacyInstallFlags
1010 (\flags conf -> conf { legacyInstallFlags = flags })
1011 . addFields
1012 [ newLineListField "build-summary"
1013 (showTokenQ . fromPathTemplate) (fmap toPathTemplate parseTokenQ)
1014 (fromNubList . installSummaryFile)
1015 (\v conf -> conf { installSummaryFile = toNubList v })
1016 ]
1017 . filterFields
1018 [ "doc-index-file"
1019 , "root-cmd", "symlink-bindir"
1020 , "build-log"
1021 , "remote-build-reporting", "report-planning-failure"
1022 , "one-shot", "jobs", "keep-going", "offline", "per-component"
1023 -- solver flags:
1024 , "max-backjumps", "reorder-goals", "count-conflicts"
1025 , "fine-grained-conflicts" , "minimize-conflict-set", "independent-goals"
1026 , "strong-flags" , "allow-boot-library-installs"
1027 , "reject-unconstrained-dependencies", "index-state"
1028 ]
1029 . commandOptionsToFields
1030 $ installOptions ParseArgs
1031
1032 , liftFields
1033 legacyClientInstallFlags
1034 (\flags conf -> conf { legacyClientInstallFlags = flags })
1035 . commandOptionsToFields
1036 $ clientInstallOptions ParseArgs
1037
1038 , liftFields
1039 legacyProjectFlags
1040 (\flags conf -> conf { legacyProjectFlags = flags })
1041 . commandOptionsToFields
1042 $ projectFlagsOptions ParseArgs
1043
1044 ]
1045
1046
1047 legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
1048 legacyPackageConfigFieldDescrs =
1049 ( liftFields
1050 legacyConfigureFlags
1051 (\flags conf -> conf { legacyConfigureFlags = flags })
1052 . addFields
1053 [ newLineListField "extra-include-dirs"
1054 showTokenQ parseTokenQ
1055 configExtraIncludeDirs
1056 (\v conf -> conf { configExtraIncludeDirs = v })
1057 , newLineListField "extra-lib-dirs"
1058 showTokenQ parseTokenQ
1059 configExtraLibDirs
1060 (\v conf -> conf { configExtraLibDirs = v })
1061 , newLineListField "extra-framework-dirs"
1062 showTokenQ parseTokenQ
1063 configExtraFrameworkDirs
1064 (\v conf -> conf { configExtraFrameworkDirs = v })
1065 , newLineListField "extra-prog-path"
1066 showTokenQ parseTokenQ
1067 (fromNubList . configProgramPathExtra)
1068 (\v conf -> conf { configProgramPathExtra = toNubList v })
1069 , newLineListField "configure-options"
1070 showTokenQ parseTokenQ
1071 configConfigureArgs
1072 (\v conf -> conf { configConfigureArgs = v })
1073 , simpleFieldParsec "flags"
1074 dispFlagAssignment parsecFlagAssignment
1075 configConfigurationsFlags
1076 (\v conf -> conf { configConfigurationsFlags = v })
1077 ]
1078 . filterFields
1079 [ "with-compiler", "with-hc-pkg"
1080 , "program-prefix", "program-suffix"
1081 , "library-vanilla", "library-profiling"
1082 , "shared", "static", "executable-dynamic", "executable-static"
1083 , "profiling", "executable-profiling"
1084 , "profiling-detail", "library-profiling-detail"
1085 , "library-for-ghci", "split-objs", "split-sections"
1086 , "executable-stripping", "library-stripping"
1087 , "tests", "benchmarks"
1088 , "coverage", "library-coverage"
1089 , "relocatable"
1090 -- not "extra-include-dirs", "extra-lib-dirs", "extra-framework-dirs"
1091 -- or "extra-prog-path". We use corrected ones above that parse
1092 -- as list fields.
1093 ]
1094 . commandOptionsToFields
1095 ) (configureOptions ParseArgs)
1096 ++
1097 liftFields
1098 legacyConfigureFlags
1099 (\flags conf -> conf { legacyConfigureFlags = flags })
1100 [ overrideFieldCompiler
1101 , overrideFieldOptimization
1102 , overrideFieldDebugInfo
1103 ]
1104 ++
1105 ( liftFields
1106 legacyInstallPkgFlags
1107 (\flags conf -> conf { legacyInstallPkgFlags = flags })
1108 . filterFields
1109 [ "documentation", "run-tests"
1110 ]
1111 . commandOptionsToFields
1112 ) (installOptions ParseArgs)
1113 ++
1114 ( liftFields
1115 legacyHaddockFlags
1116 (\flags conf -> conf { legacyHaddockFlags = flags })
1117 . mapFieldNames
1118 ("haddock-"++)
1119 . addFields
1120 [ simpleFieldParsec "for-hackage"
1121 -- TODO: turn this into a library function
1122 (fromFlagOrDefault Disp.empty . fmap pretty) (toFlag <$> parsec <|> pure mempty)
1123 haddockForHackage (\v conf -> conf { haddockForHackage = v })
1124 ]
1125 . filterFields
1126 [ "hoogle", "html", "html-location"
1127 , "foreign-libraries"
1128 , "executables", "tests", "benchmarks", "all", "internal", "css"
1129 , "hyperlink-source", "quickjump", "hscolour-css"
1130 , "contents-location", "keep-temp-files"
1131 ]
1132 . commandOptionsToFields
1133 ) (haddockOptions ParseArgs)
1134 ++
1135 ( liftFields
1136 legacyTestFlags
1137 (\flags conf -> conf { legacyTestFlags = flags })
1138 . mapFieldNames
1139 prefixTest
1140 . addFields
1141 [ newLineListField "test-options"
1142 (showTokenQ . fromPathTemplate) (fmap toPathTemplate parseTokenQ)
1143 testOptions
1144 (\v conf -> conf { testOptions = v })
1145 ]
1146 . filterFields
1147 [ "log", "machine-log", "show-details", "keep-tix-files"
1148 , "fail-when-no-test-suites", "test-wrapper" ]
1149 . commandOptionsToFields
1150 ) (testOptions' ParseArgs)
1151 ++
1152 ( liftFields
1153 legacyBenchmarkFlags
1154 (\flags conf -> conf { legacyBenchmarkFlags = flags })
1155 . addFields
1156 [ newLineListField "benchmark-options"
1157 (showTokenQ . fromPathTemplate) (fmap toPathTemplate parseTokenQ)
1158 benchmarkOptions
1159 (\v conf -> conf { benchmarkOptions = v })
1160 ]
1161 . filterFields
1162 []
1163 . commandOptionsToFields
1164 ) (benchmarkOptions' ParseArgs)
1165
1166
1167 where
1168 overrideFieldCompiler =
1169 simpleFieldParsec "compiler"
1170 (fromFlagOrDefault Disp.empty . fmap pretty)
1171 (toFlag <$> parsec <|> pure mempty)
1172 configHcFlavor (\v flags -> flags { configHcFlavor = v })
1173
1174
1175 -- TODO: [code cleanup] The following is a hack. The "optimization" and
1176 -- "debug-info" fields are OptArg, and viewAsFieldDescr fails on that.
1177 -- Instead of a hand-written parser and printer, we should handle this case
1178 -- properly in the library.
1179
1180 overrideFieldOptimization =
1181 liftField configOptimization
1182 (\v flags -> flags { configOptimization = v }) $
1183 let name = "optimization" in
1184 FieldDescr name
1185 (\f -> case f of
1186 Flag NoOptimisation -> Disp.text "False"
1187 Flag NormalOptimisation -> Disp.text "True"
1188 Flag MaximumOptimisation -> Disp.text "2"
1189 _ -> Disp.empty)
1190 (\line str _ -> case () of
1191 _ | str == "False" -> ParseOk [] (Flag NoOptimisation)
1192 | str == "True" -> ParseOk [] (Flag NormalOptimisation)
1193 | str == "0" -> ParseOk [] (Flag NoOptimisation)
1194 | str == "1" -> ParseOk [] (Flag NormalOptimisation)
1195 | str == "2" -> ParseOk [] (Flag MaximumOptimisation)
1196 | lstr == "false" -> ParseOk [caseWarning] (Flag NoOptimisation)
1197 | lstr == "true" -> ParseOk [caseWarning] (Flag NormalOptimisation)
1198 | otherwise -> ParseFailed (NoParse name line)
1199 where
1200 lstr = lowercase str
1201 caseWarning = PWarning $
1202 "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")
1203
1204 overrideFieldDebugInfo =
1205 liftField configDebugInfo (\v flags -> flags { configDebugInfo = v }) $
1206 let name = "debug-info" in
1207 FieldDescr name
1208 (\f -> case f of
1209 Flag NoDebugInfo -> Disp.text "False"
1210 Flag MinimalDebugInfo -> Disp.text "1"
1211 Flag NormalDebugInfo -> Disp.text "True"
1212 Flag MaximalDebugInfo -> Disp.text "3"
1213 _ -> Disp.empty)
1214 (\line str _ -> case () of
1215 _ | str == "False" -> ParseOk [] (Flag NoDebugInfo)
1216 | str == "True" -> ParseOk [] (Flag NormalDebugInfo)
1217 | str == "0" -> ParseOk [] (Flag NoDebugInfo)
1218 | str == "1" -> ParseOk [] (Flag MinimalDebugInfo)
1219 | str == "2" -> ParseOk [] (Flag NormalDebugInfo)
1220 | str == "3" -> ParseOk [] (Flag MaximalDebugInfo)
1221 | lstr == "false" -> ParseOk [caseWarning] (Flag NoDebugInfo)
1222 | lstr == "true" -> ParseOk [caseWarning] (Flag NormalDebugInfo)
1223 | otherwise -> ParseFailed (NoParse name line)
1224 where
1225 lstr = lowercase str
1226 caseWarning = PWarning $
1227 "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")
1228
1229 prefixTest name | "test-" `isPrefixOf` name = name
1230 | otherwise = "test-" ++ name
1231
1232
1233 legacyPackageConfigFGSectionDescrs
1234 :: ( FieldGrammar c g, Applicative (g SourceRepoList)
1235 , c (Identity RepoType)
1236 , c (List NoCommaFSep FilePathNT String)
1237 , c (NonEmpty' NoCommaFSep Token String)
1238 )
1239 => [FGSectionDescr g LegacyProjectConfig]
1240 legacyPackageConfigFGSectionDescrs =
1241 [ packageRepoSectionDescr
1242 ]
1243
1244 legacyPackageConfigSectionDescrs :: [SectionDescr LegacyProjectConfig]
1245 legacyPackageConfigSectionDescrs =
1246 [ packageSpecificOptionsSectionDescr
1247 , liftSection
1248 legacyLocalConfig
1249 (\flags conf -> conf { legacyLocalConfig = flags })
1250 programOptionsSectionDescr
1251 , liftSection
1252 legacyLocalConfig
1253 (\flags conf -> conf { legacyLocalConfig = flags })
1254 programLocationsSectionDescr
1255 , liftSection
1256 legacySharedConfig
1257 (\flags conf -> conf { legacySharedConfig = flags }) $
1258 liftSection
1259 legacyGlobalFlags
1260 (\flags conf -> conf { legacyGlobalFlags = flags })
1261 remoteRepoSectionDescr
1262 ]
1263
1264 packageRepoSectionDescr
1265 :: ( FieldGrammar c g, Applicative (g SourceRepoList)
1266 , c (Identity RepoType)
1267 , c (List NoCommaFSep FilePathNT String)
1268 , c (NonEmpty' NoCommaFSep Token String)
1269 )
1270 => FGSectionDescr g LegacyProjectConfig
1271 packageRepoSectionDescr = FGSectionDescr
1272 { fgSectionName = "source-repository-package"
1273 , fgSectionGrammar = sourceRepositoryPackageGrammar
1274 , fgSectionGet = map (\x->("", x)) . legacyPackagesRepo
1275 , fgSectionSet =
1276 \lineno unused pkgrepo projconf -> do
1277 unless (null unused) $
1278 syntaxError lineno "the section 'source-repository-package' takes no arguments"
1279 return projconf {
1280 legacyPackagesRepo = legacyPackagesRepo projconf ++ [pkgrepo]
1281 }
1282 }
1283
1284 -- | The definitions of all the fields that can appear in the @package pkgfoo@
1285 -- and @package *@ sections of the @cabal.project@-format files.
1286 --
1287 packageSpecificOptionsFieldDescrs :: [FieldDescr LegacyPackageConfig]
1288 packageSpecificOptionsFieldDescrs =
1289 legacyPackageConfigFieldDescrs
1290 ++ programOptionsFieldDescrs
1291 (configProgramArgs . legacyConfigureFlags)
1292 (\args pkgconf -> pkgconf {
1293 legacyConfigureFlags = (legacyConfigureFlags pkgconf) {
1294 configProgramArgs = args
1295 }
1296 }
1297 )
1298 ++ liftFields
1299 legacyConfigureFlags
1300 (\flags pkgconf -> pkgconf {
1301 legacyConfigureFlags = flags
1302 }
1303 )
1304 programLocationsFieldDescrs
1305
1306 -- | The definition of the @package pkgfoo@ sections of the @cabal.project@-format
1307 -- files. This section is per-package name. The special package @*@ applies to all
1308 -- packages used anywhere by the project, locally or as dependencies.
1309 --
1310 packageSpecificOptionsSectionDescr :: SectionDescr LegacyProjectConfig
1311 packageSpecificOptionsSectionDescr =
1312 SectionDescr {
1313 sectionName = "package",
1314 sectionFields = packageSpecificOptionsFieldDescrs,
1315 sectionSubsections = [],
1316 sectionGet = \projconf ->
1317 [ (prettyShow pkgname, pkgconf)
1318 | (pkgname, pkgconf) <-
1319 Map.toList . getMapMappend
1320 . legacySpecificConfig $ projconf ]
1321 ++ [ ("*", legacyAllConfig projconf) ],
1322 sectionSet =
1323 \lineno pkgnamestr pkgconf projconf -> case pkgnamestr of
1324 "*" -> return projconf {
1325 legacyAllConfig = legacyAllConfig projconf <> pkgconf
1326 }
1327 _ -> do
1328 pkgname <- case simpleParsec pkgnamestr of
1329 Just pkgname -> return pkgname
1330 Nothing -> syntaxError lineno $
1331 "a 'package' section requires a package name "
1332 ++ "as an argument"
1333 return projconf {
1334 legacySpecificConfig =
1335 MapMappend $
1336 Map.insertWith mappend pkgname pkgconf
1337 (getMapMappend $ legacySpecificConfig projconf)
1338 },
1339 sectionEmpty = mempty
1340 }
1341
1342 programOptionsFieldDescrs :: (a -> [(String, [String])])
1343 -> ([(String, [String])] -> a -> a)
1344 -> [FieldDescr a]
1345 programOptionsFieldDescrs get' set =
1346 commandOptionsToFields
1347 $ programDbOptions
1348 defaultProgramDb
1349 ParseArgs get' set
1350
1351 programOptionsSectionDescr :: SectionDescr LegacyPackageConfig
1352 programOptionsSectionDescr =
1353 SectionDescr {
1354 sectionName = "program-options",
1355 sectionFields = programOptionsFieldDescrs
1356 configProgramArgs
1357 (\args conf -> conf { configProgramArgs = args }),
1358 sectionSubsections = [],
1359 sectionGet = (\x->[("", x)])
1360 . legacyConfigureFlags,
1361 sectionSet =
1362 \lineno unused confflags pkgconf -> do
1363 unless (null unused) $
1364 syntaxError lineno "the section 'program-options' takes no arguments"
1365 return pkgconf {
1366 legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
1367 },
1368 sectionEmpty = mempty
1369 }
1370
1371 programLocationsFieldDescrs :: [FieldDescr ConfigFlags]
1372 programLocationsFieldDescrs =
1373 commandOptionsToFields
1374 $ programDbPaths'
1375 (++ "-location")
1376 defaultProgramDb
1377 ParseArgs
1378 configProgramPaths
1379 (\paths conf -> conf { configProgramPaths = paths })
1380
1381 programLocationsSectionDescr :: SectionDescr LegacyPackageConfig
1382 programLocationsSectionDescr =
1383 SectionDescr {
1384 sectionName = "program-locations",
1385 sectionFields = programLocationsFieldDescrs,
1386 sectionSubsections = [],
1387 sectionGet = (\x->[("", x)])
1388 . legacyConfigureFlags,
1389 sectionSet =
1390 \lineno unused confflags pkgconf -> do
1391 unless (null unused) $
1392 syntaxError lineno "the section 'program-locations' takes no arguments"
1393 return pkgconf {
1394 legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
1395 },
1396 sectionEmpty = mempty
1397 }
1398
1399
1400 -- | For each known program @PROG@ in 'progDb', produce a @PROG-options@
1401 -- 'OptionField'.
1402 programDbOptions
1403 :: ProgramDb
1404 -> ShowOrParseArgs
1405 -> (flags -> [(String, [String])])
1406 -> ([(String, [String])] -> (flags -> flags))
1407 -> [OptionField flags]
1408 programDbOptions progDb showOrParseArgs get' set =
1409 case showOrParseArgs of
1410 -- we don't want a verbose help text list so we just show a generic one:
1411 ShowArgs -> [programOptions "PROG"]
1412 ParseArgs -> map (programOptions . programName . fst)
1413 (knownPrograms progDb)
1414 where
1415 programOptions prog =
1416 option "" [prog ++ "-options"]
1417 ("give extra options to " ++ prog)
1418 get' set
1419 (reqArg' "OPTS" (\args -> [(prog, splitArgs args)])
1420 (\progArgs -> [ joinsArgs args
1421 | (prog', args) <- progArgs, prog==prog' ]))
1422
1423
1424 joinsArgs = unwords . map escape
1425 escape arg | any isSpace arg = "\"" ++ arg ++ "\""
1426 | otherwise = arg
1427
1428
1429 -- The implementation is slight hack: we parse all as remote repository
1430 -- but if the url schema is file+noindex, we switch to local.
1431 remoteRepoSectionDescr :: SectionDescr GlobalFlags
1432 remoteRepoSectionDescr = SectionDescr
1433 { sectionName = "repository"
1434 , sectionEmpty = emptyRemoteRepo (RepoName "")
1435 , sectionFields = remoteRepoFields
1436 , sectionSubsections = []
1437 , sectionGet = getS
1438 , sectionSet = setS
1439 }
1440 where
1441 getS :: GlobalFlags -> [(String, RemoteRepo)]
1442 getS gf =
1443 map (\x->(unRepoName $ remoteRepoName x, x)) (fromNubList (globalRemoteRepos gf))
1444 ++
1445 map (\x->(unRepoName $ localRepoName x, localToRemote x)) (fromNubList (globalLocalNoIndexRepos gf))
1446
1447 setS :: Int -> String -> RemoteRepo -> GlobalFlags -> ParseResult GlobalFlags
1448 setS lineno reponame repo0 conf = do
1449 repo1 <- postProcessRepo lineno reponame repo0
1450 case repo1 of
1451 Left repo -> return conf
1452 { globalLocalNoIndexRepos = overNubList (++[repo]) (globalLocalNoIndexRepos conf)
1453 }
1454 Right repo -> return conf
1455 { globalRemoteRepos = overNubList (++[repo]) (globalRemoteRepos conf)
1456 }
1457
1458 localToRemote :: LocalRepo -> RemoteRepo
1459 localToRemote (LocalRepo name path sharedCache) = (emptyRemoteRepo name)
1460 { remoteRepoURI = URI "file+noindex:" Nothing path "" (if sharedCache then "#shared-cache" else "")
1461 }
1462
1463 -------------------------------
1464 -- Local field utils
1465 --
1466
1467 -- | Parser combinator for simple fields which uses the field type's
1468 -- 'Monoid' instance for combining multiple occurrences of the field.
1469 monoidFieldParsec
1470 :: Monoid a => String -> (a -> Doc) -> ParsecParser a
1471 -> (b -> a) -> (a -> b -> b) -> FieldDescr b
1472 monoidFieldParsec name showF readF get' set =
1473 liftField get' set' $ ParseUtils.fieldParsec name showF readF
1474 where
1475 set' xs b = set (get' b `mappend` xs) b
1476
1477
1478 --TODO: [code cleanup] local redefinition that should replace the version in
1479 -- D.ParseUtils called showFilePath. This version escapes "." and "--" which
1480 -- otherwise are special syntax.
1481 showTokenQ :: String -> Doc
1482 showTokenQ "" = Disp.empty
1483 showTokenQ x@('-':'-':_) = Disp.text (show x)
1484 showTokenQ x@('.':[]) = Disp.text (show x)
1485 showTokenQ x = showToken x
1486
1487
1488 -- Handy util
1489 addFields :: [FieldDescr a]
1490 -> ([FieldDescr a] -> [FieldDescr a])
1491 addFields = (++)