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