cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

   1 {-# LANGUAGE ConstraintKinds #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE RecordWildCards #-}
   6
   7 -- | Project configuration, implementation in terms of legacy types.
   8 module Distribution.Client.ProjectConfig.Legacy
   9   ( -- Project config skeletons
  10     ProjectConfigSkeleton
  11   , parseProjectSkeleton
  12   , instantiateProjectConfigSkeletonFetchingCompiler
  13   , instantiateProjectConfigSkeletonWithCompiler
  14   , singletonProjectConfigSkeleton
  15   , projectSkeletonImports
  16
  17     -- * Project config in terms of legacy types
  18   , LegacyProjectConfig
  19   , parseLegacyProjectConfig
  20   , showLegacyProjectConfig
  21
  22     -- * Conversion to and from legacy config types
  23   , commandLineFlagsToProjectConfig
  24   , convertLegacyProjectConfig
  25   , convertLegacyGlobalConfig
  26   , convertToLegacyProjectConfig
  27
  28     -- * Internals, just for tests
  29   , parsePackageLocationTokenQ
  30   , renderPackageLocationToken
  31   ) where
  32
  33 import Distribution.Client.Compat.Prelude
  34
  35 import Distribution.Types.Flag (FlagName, parsecFlagAssignment)
  36
  37 import Distribution.Client.ProjectConfig.Types
  38 import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
  39 import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), emptyRemoteRepo)
  40 import Distribution.Client.Types.RepoName (RepoName (..), unRepoName)
  41 import Distribution.Client.Types.SourceRepo (SourceRepoList, sourceRepositoryPackageGrammar)
  42
  43 import Distribution.Client.Config
  44   ( SavedConfig (..)
  45   , postProcessRepo
  46   , remoteRepoFields
  47   )
  48
  49 import Distribution.Client.CmdInstall.ClientInstallFlags
  50   ( ClientInstallFlags (..)
  51   , clientInstallOptions
  52   , defaultClientInstallFlags
  53   )
  54
  55 import Distribution.Compat.Lens (toListOf, view)
  56
  57 import Distribution.Solver.Types.ConstraintSource
  58
  59 import Distribution.Client.NixStyleOptions (NixStyleFlags (..))
  60 import Distribution.Client.ProjectFlags (ProjectFlags (..), defaultProjectFlags, projectFlagsOptions)
  61 import Distribution.Client.Setup
  62   ( ConfigExFlags (..)
  63   , GlobalFlags (..)
  64   , InstallFlags (..)
  65   , configureExOptions
  66   , defaultConfigExFlags
  67   , defaultInstallFlags
  68   , globalCommand
  69   , installOptions
  70   )
  71 import Distribution.FieldGrammar
  72 import Distribution.Package
  73 import Distribution.PackageDescription
  74   ( Condition (..)
  75   , ConfVar (..)
  76   , FlagAssignment
  77   , dispFlagAssignment
  78   )
  79 import Distribution.PackageDescription.Configuration (simplifyWithSysParams)
  80 import Distribution.Simple.Compiler
  81   ( CompilerInfo (..)
  82   , DebugInfoLevel (..)
  83   , OptimisationLevel (..)
  84   )
  85 import Distribution.Simple.InstallDirs (CopyDest (NoCopyDest))
  86 import Distribution.Simple.LocalBuildInfo
  87   ( fromPathTemplate
  88   , toPathTemplate
  89   )
  90 import Distribution.Simple.Program
  91   ( knownPrograms
  92   , programName
  93   )
  94 import Distribution.Simple.Program.Db
  95   ( ProgramDb
  96   , defaultProgramDb
  97   )
  98 import Distribution.Simple.Setup
  99   ( BenchmarkFlags (..)
 100   , ConfigFlags (..)
 101   , DumpBuildInfo (DumpBuildInfo, NoDumpBuildInfo)
 102   , Flag (..)
 103   , HaddockFlags (..)
 104   , TestFlags (..)
 105   , benchmarkOptions'
 106   , configureOptions
 107   , defaultBenchmarkFlags
 108   , defaultHaddockFlags
 109   , defaultTestFlags
 110   , fromFlagOrDefault
 111   , haddockOptions
 112   , installDirsOptions
 113   , programDbPaths'
 114   , readPackageDb
 115   , showPackageDb
 116   , splitArgs
 117   , testOptions'
 118   , toFlag
 119   )
 120 import Distribution.Simple.Utils
 121   ( lowercase
 122   )
 123 import Distribution.Types.CondTree
 124   ( CondBranch (..)
 125   , CondTree (..)
 126   , ignoreConditions
 127   , mapTreeConds
 128   , traverseCondTreeC
 129   , traverseCondTreeV
 130   )
 131 import Distribution.Types.SourceRepo (RepoType)
 132 import Distribution.Utils.NubList
 133   ( fromNubList
 134   , overNubList
 135   , toNubList
 136   )
 137
 138 import Distribution.Client.ParseUtils
 139 import Distribution.Deprecated.ParseUtils
 140   ( PError (..)
 141   , PWarning (..)
 142   , ParseResult (..)
 143   , commaNewLineListFieldParsec
 144   , newLineListField
 145   , parseFail
 146   , parseHaskellString
 147   , parseTokenQ
 148   , showToken
 149   , simpleFieldParsec
 150   , syntaxError
 151   )
 152 import qualified Distribution.Deprecated.ParseUtils as ParseUtils
 153 import Distribution.Deprecated.ReadP
 154   ( ReadP
 155   , (+++)
 156   )
 157 import qualified Distribution.Deprecated.ReadP as Parse
 158 import Distribution.Parsec (ParsecParser, parsecToken)
 159 import Distribution.Simple.Command
 160   ( CommandUI (commandOptions)
 161   , OptionField (..)
 162   , ShowOrParseArgs (..)
 163   , option
 164   , reqArg'
 165   )
 166 import Distribution.System (Arch, OS)
 167 import Distribution.Types.PackageVersionConstraint
 168   ( PackageVersionConstraint
 169   )
 170 import Text.PrettyPrint
 171   ( Doc
 172   , ($+$)
 173   )
 174 import qualified Text.PrettyPrint as Disp
 175
 176 import qualified Data.ByteString.Char8 as BS
 177 import qualified Data.Map as Map
 178 import qualified Data.Set as Set
 179
 180 import Network.URI (URI (..), parseURI)
 181
 182 import Distribution.Fields.ConfVar (parseConditionConfVarFromClause)
 183
 184 import Distribution.Client.HttpUtils
 185 import Distribution.Client.ReplFlags (multiReplOption)
 186 import System.Directory (createDirectoryIfMissing)
 187 import System.FilePath (isAbsolute, isPathSeparator, makeValid, takeDirectory, (</>))
 188
 189 ------------------------------------------------------------------
 190 -- Handle extended project config files with conditionals and imports.
 191 --
 192
 193 -- | ProjectConfigSkeleton is a tree of conditional blocks and imports wrapping a config. It can be finalized by providing the conditional resolution info
 194 -- and then resolving and downloading the imports
 195 type ProjectConfigSkeleton = CondTree ConfVar [ProjectConfigImport] ProjectConfig
 196
 197 type ProjectConfigImport = String
 198
 199 singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton
 200 singletonProjectConfigSkeleton x = CondNode x mempty mempty
 201
 202 instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig
 203 instantiateProjectConfigSkeletonFetchingCompiler fetch flags skel
 204   | null (toListOf traverseCondTreeV skel) = pure $ fst (ignoreConditions skel)
 205   | otherwise = do
 206       (os, arch, impl) <- fetch
 207       pure $ instantiateProjectConfigSkeletonWithCompiler os arch impl flags skel
 208
 209 instantiateProjectConfigSkeletonWithCompiler :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig
 210 instantiateProjectConfigSkeletonWithCompiler os arch impl _flags skel = go $ mapTreeConds (fst . simplifyWithSysParams os arch impl) skel
 211   where
 212     go
 213       :: CondTree
 214           FlagName
 215           [ProjectConfigImport]
 216           ProjectConfig
 217       -> ProjectConfig
 218     go (CondNode l _imps ts) =
 219       let branches = concatMap processBranch ts
 220        in l <> mconcat branches
 221     processBranch (CondBranch cnd t mf) = case cnd of
 222       (Lit True) -> [go t]
 223       (Lit False) -> maybe ([]) ((: []) . go) mf
 224       _ -> error $ "unable to process condition: " ++ show cnd -- TODO it would be nice if there were a pretty printer
 225
 226 projectSkeletonImports :: ProjectConfigSkeleton -> [ProjectConfigImport]
 227 projectSkeletonImports = view traverseCondTreeC
 228
 229 parseProjectSkeleton :: FilePath -> HttpTransport -> Verbosity -> [ProjectConfigImport] -> FilePath -> BS.ByteString -> IO (ParseResult ProjectConfigSkeleton)
 230 parseProjectSkeleton cacheDir httpTransport verbosity seenImports source bs = (sanityWalkPCS False =<<) <$> liftPR (go []) (ParseUtils.readFields bs)
 231   where
 232     go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ParseResult ProjectConfigSkeleton)
 233     go acc (x : xs) = case x of
 234       (ParseUtils.F l "import" importLoc) ->
 235         if importLoc `elem` seenImports
 236           then pure . parseFail $ ParseUtils.FromString ("cyclical import of " ++ importLoc) (Just l)
 237           else do
 238             let fs = fmap (\z -> CondNode z [importLoc] mempty) $ fieldsToConfig (reverse acc)
 239             res <- parseProjectSkeleton cacheDir httpTransport verbosity (importLoc : seenImports) importLoc =<< fetchImportConfig importLoc
 240             rest <- go [] xs
 241             pure . fmap mconcat . sequence $ [fs, res, rest]
 242       (ParseUtils.Section l "if" p xs') -> do
 243         subpcs <- go [] xs'
 244         let fs = fmap singletonProjectConfigSkeleton $ fieldsToConfig (reverse acc)
 245         (elseClauses, rest) <- parseElseClauses xs
 246         let condNode =
 247               (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e])
 248                 <$>
 249                 -- we rewrap as as a section so the readFields lexer of the conditional parser doesn't get confused
 250                 adaptParseError l (parseConditionConfVarFromClause . BS.pack $ "if(" <> p <> ")")
 251                 <*> subpcs
 252                 <*> elseClauses
 253         pure . fmap mconcat . sequence $ [fs, condNode, rest]
 254       _ -> go (x : acc) xs
 255     go acc [] = pure . fmap singletonProjectConfigSkeleton . fieldsToConfig $ reverse acc
 256
 257     parseElseClauses :: [ParseUtils.Field] -> IO (ParseResult (Maybe ProjectConfigSkeleton), ParseResult ProjectConfigSkeleton)
 258     parseElseClauses x = case x of
 259       (ParseUtils.Section _l "else" _p xs' : xs) -> do
 260         subpcs <- go [] xs'
 261         rest <- go [] xs
 262         pure (Just <$> subpcs, rest)
 263       (ParseUtils.Section l "elif" p xs' : xs) -> do
 264         subpcs <- go [] xs'
 265         (elseClauses, rest) <- parseElseClauses xs
 266         let condNode =
 267               (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e])
 268                 <$> adaptParseError l (parseConditionConfVarFromClause . BS.pack $ "else(" <> p <> ")")
 269                 <*> subpcs
 270                 <*> elseClauses
 271         pure (Just <$> condNode, rest)
 272       _ -> (\r -> (pure Nothing, r)) <$> go [] x
 273
 274     fieldsToConfig xs = fmap (addProvenance . convertLegacyProjectConfig) $ parseLegacyProjectConfigFields source xs
 275     addProvenance x = x{projectConfigProvenance = Set.singleton (Explicit source)}
 276
 277     adaptParseError _ (Right x) = pure x
 278     adaptParseError l (Left e) = parseFail $ ParseUtils.FromString (show e) (Just l)
 279
 280     liftPR :: (a -> IO (ParseResult b)) -> ParseResult a -> IO (ParseResult b)
 281     liftPR f (ParseOk ws x) = addWarnings <$> f x
 282       where
 283         addWarnings (ParseOk ws' x') = ParseOk (ws' ++ ws) x'
 284         addWarnings x' = x'
 285     liftPR _ (ParseFailed e) = pure $ ParseFailed e
 286
 287     fetchImportConfig :: ProjectConfigImport -> IO BS.ByteString
 288     fetchImportConfig pci = case parseURI pci of
 289       Just uri -> do
 290         let fp = cacheDir </> map (\x -> if isPathSeparator x then '_' else x) (makeValid $ show uri)
 291         createDirectoryIfMissing True cacheDir
 292         _ <- downloadURI httpTransport verbosity uri fp
 293         BS.readFile fp
 294       Nothing ->
 295         BS.readFile $
 296           if isAbsolute pci then pci else takeDirectory source </> pci
 297
 298     modifiesCompiler :: ProjectConfig -> Bool
 299     modifiesCompiler pc = isSet projectConfigHcFlavor || isSet projectConfigHcPath || isSet projectConfigHcPkg
 300       where
 301         isSet f = f (projectConfigShared pc) /= NoFlag
 302
 303     sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton
 304     sanityWalkPCS underConditional t@(CondNode d _c comps)
 305       | underConditional && modifiesCompiler d = parseFail $ ParseUtils.FromString "Cannot set compiler in a conditional clause of a cabal project file" Nothing
 306       | otherwise = mapM_ sanityWalkBranch comps >> pure t
 307
 308     sanityWalkBranch :: CondBranch ConfVar [ProjectConfigImport] ProjectConfig -> ParseResult ()
 309     sanityWalkBranch (CondBranch _c t f) = traverse (sanityWalkPCS True) f >> sanityWalkPCS True t >> pure ()
 310
 311 ------------------------------------------------------------------
 312 -- Representing the project config file in terms of legacy types
 313 --
 314
 315 -- | We already have parsers\/pretty-printers for almost all the fields in the
 316 -- project config file, but they're in terms of the types used for the command
 317 -- line flags for Setup.hs or cabal commands. We don't want to redefine them
 318 -- all, at least not yet so for the moment we use the parsers at the old types
 319 -- and use conversion functions.
 320 --
 321 -- Ultimately if\/when this project-based approach becomes the default then we
 322 -- can redefine the parsers directly for the new types.
 323 data LegacyProjectConfig = LegacyProjectConfig
 324   { legacyPackages :: [String]
 325   , legacyPackagesOptional :: [String]
 326   , legacyPackagesRepo :: [SourceRepoList]
 327   , legacyPackagesNamed :: [PackageVersionConstraint]
 328   , legacySharedConfig :: LegacySharedConfig
 329   , legacyAllConfig :: LegacyPackageConfig
 330   , legacyLocalConfig :: LegacyPackageConfig
 331   , legacySpecificConfig :: MapMappend PackageName LegacyPackageConfig
 332   }
 333   deriving (Show, Generic)
 334
 335 instance Monoid LegacyProjectConfig where
 336   mempty = gmempty
 337   mappend = (<>)
 338
 339 instance Semigroup LegacyProjectConfig where
 340   (<>) = gmappend
 341
 342 data LegacyPackageConfig = LegacyPackageConfig
 343   { legacyConfigureFlags :: ConfigFlags
 344   , legacyInstallPkgFlags :: InstallFlags
 345   , legacyHaddockFlags :: HaddockFlags
 346   , legacyTestFlags :: TestFlags
 347   , legacyBenchmarkFlags :: BenchmarkFlags
 348   }
 349   deriving (Show, Generic)
 350
 351 instance Monoid LegacyPackageConfig where
 352   mempty = gmempty
 353   mappend = (<>)
 354
 355 instance Semigroup LegacyPackageConfig where
 356   (<>) = gmappend
 357
 358 data LegacySharedConfig = LegacySharedConfig
 359   { legacyGlobalFlags :: GlobalFlags
 360   , legacyConfigureShFlags :: ConfigFlags
 361   , legacyConfigureExFlags :: ConfigExFlags
 362   , legacyInstallFlags :: InstallFlags
 363   , legacyClientInstallFlags :: ClientInstallFlags
 364   , legacyProjectFlags :: ProjectFlags
 365   , legacyMultiRepl :: Flag Bool
 366   }
 367   deriving (Show, Generic)
 368
 369 instance Monoid LegacySharedConfig where
 370   mempty = gmempty
 371   mappend = (<>)
 372
 373 instance Semigroup LegacySharedConfig where
 374   (<>) = gmappend
 375
 376 ------------------------------------------------------------------
 377 -- Converting from and to the legacy types
 378 --
 379
 380 -- | Convert configuration from the @cabal configure@ or @cabal build@ command
 381 -- line into a 'ProjectConfig' value that can combined with configuration from
 382 -- other sources.
 383 --
 384 -- At the moment this uses the legacy command line flag types. See
 385 -- 'LegacyProjectConfig' for an explanation.
 386 commandLineFlagsToProjectConfig
 387   :: GlobalFlags
 388   -> NixStyleFlags a
 389   -> ClientInstallFlags
 390   -> ProjectConfig
 391 commandLineFlagsToProjectConfig globalFlags NixStyleFlags{..} clientInstallFlags =
 392   mempty
 393     { projectConfigBuildOnly =
 394         convertLegacyBuildOnlyFlags
 395           globalFlags
 396           configFlags
 397           installFlags
 398           clientInstallFlags
 399           haddockFlags
 400           testFlags
 401           benchmarkFlags
 402     , projectConfigShared =
 403         convertLegacyAllPackageFlags
 404           globalFlags
 405           configFlags
 406           configExFlags
 407           installFlags
 408           projectFlags
 409           NoFlag
 410     , projectConfigLocalPackages = localConfig
 411     , projectConfigAllPackages = allConfig
 412     }
 413   where
 414     (localConfig, allConfig) =
 415       splitConfig
 416         ( convertLegacyPerPackageFlags
 417             configFlags
 418             installFlags
 419             haddockFlags
 420             testFlags
 421             benchmarkFlags
 422         )
 423     -- split the package config (from command line arguments) into
 424     -- those applied to all packages and those to local only.
 425     --
 426     -- for now we will just copy over the ProgramPaths/Extra into
 427     -- the AllPackages.  The LocalPackages do not inherit them from
 428     -- AllPackages, and as such need to retain them.
 429     --
 430     -- The general decision rule for what to put into allConfig
 431     -- into localConfig is the following:
 432     --
 433     -- - anything that is host/toolchain/env specific should be applied
 434     --   to all packages, as packagesets have to be host/toolchain/env
 435     --   consistent.
 436     -- - anything else should be in the local config and could potentially
 437     --   be lifted into all-packages vial the `package *` cabal.project
 438     --   section.
 439     --
 440     splitConfig :: PackageConfig -> (PackageConfig, PackageConfig)
 441     splitConfig pc =
 442       ( pc
 443       , mempty
 444           { packageConfigProgramPaths = packageConfigProgramPaths pc
 445           , packageConfigProgramPathExtra = packageConfigProgramPathExtra pc
 446           , -- Some flags to haddock should be passed to dependencies
 447             packageConfigDocumentation = packageConfigDocumentation pc
 448           , packageConfigHaddockHoogle = packageConfigHaddockHoogle pc
 449           , packageConfigHaddockHtml = packageConfigHaddockHtml pc
 450           , packageConfigHaddockInternal = packageConfigHaddockInternal pc
 451           , packageConfigHaddockQuickJump = packageConfigHaddockQuickJump pc
 452           , packageConfigHaddockLinkedSource = packageConfigHaddockLinkedSource pc
 453           }
 454       )
 455
 456 -- | Convert from the types currently used for the user-wide Cabal config
 457 -- file into the 'ProjectConfig' type.
 458 --
 459 -- Only a subset of the 'ProjectConfig' can be represented in the user-wide
 460 -- config. In particular it does not include packages that are in the project,
 461 -- and it also doesn't support package-specific configuration (only
 462 -- configuration that applies to all packages).
 463 convertLegacyGlobalConfig :: SavedConfig -> ProjectConfig
 464 convertLegacyGlobalConfig
 465   SavedConfig
 466     { savedGlobalFlags = globalFlags
 467     , savedInstallFlags = installFlags
 468     , savedClientInstallFlags = clientInstallFlags
 469     , savedConfigureFlags = configFlags
 470     , savedConfigureExFlags = configExFlags
 471     , savedUserInstallDirs = _
 472     , savedGlobalInstallDirs = _
 473     , savedUploadFlags = _
 474     , savedReportFlags = _
 475     , savedHaddockFlags = haddockFlags
 476     , savedTestFlags = testFlags
 477     , savedBenchmarkFlags = benchmarkFlags
 478     , savedProjectFlags = projectFlags
 479     , savedReplMulti = replMulti
 480     } =
 481     mempty
 482       { projectConfigBuildOnly = configBuildOnly
 483       , projectConfigShared = configShared
 484       , projectConfigAllPackages = configAllPackages
 485       }
 486     where
 487       -- TODO: [code cleanup] eliminate use of default*Flags here and specify the
 488       -- defaults in the various resolve functions in terms of the new types.
 489       configExFlags' = defaultConfigExFlags <> configExFlags
 490       installFlags' = defaultInstallFlags <> installFlags
 491       clientInstallFlags' = defaultClientInstallFlags <> clientInstallFlags
 492       haddockFlags' = defaultHaddockFlags <> haddockFlags
 493       testFlags' = defaultTestFlags <> testFlags
 494       benchmarkFlags' = defaultBenchmarkFlags <> benchmarkFlags
 495       projectFlags' = defaultProjectFlags <> projectFlags
 496
 497       configAllPackages =
 498         convertLegacyPerPackageFlags
 499           configFlags
 500           installFlags'
 501           haddockFlags'
 502           testFlags'
 503           benchmarkFlags'
 504       configShared =
 505         convertLegacyAllPackageFlags
 506           globalFlags
 507           configFlags
 508           configExFlags'
 509           installFlags'
 510           projectFlags'
 511           replMulti
 512       configBuildOnly =
 513         convertLegacyBuildOnlyFlags
 514           globalFlags
 515           configFlags
 516           installFlags'
 517           clientInstallFlags'
 518           haddockFlags'
 519           testFlags'
 520           benchmarkFlags'
 521
 522 -- | Convert the project config from the legacy types to the 'ProjectConfig'
 523 -- and associated types. See 'LegacyProjectConfig' for an explanation of the
 524 -- approach.
 525 convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig
 526 convertLegacyProjectConfig
 527   LegacyProjectConfig
 528     { legacyPackages
 529     , legacyPackagesOptional
 530     , legacyPackagesRepo
 531     , legacyPackagesNamed
 532     , legacySharedConfig =
 533       LegacySharedConfig
 534         globalFlags
 535         configShFlags
 536         configExFlags
 537         installSharedFlags
 538         clientInstallFlags
 539         projectFlags
 540         multiRepl
 541     , legacyAllConfig
 542     , legacyLocalConfig =
 543       LegacyPackageConfig
 544         configFlags
 545         installPerPkgFlags
 546         haddockFlags
 547         testFlags
 548         benchmarkFlags
 549     , legacySpecificConfig
 550     } =
 551     ProjectConfig
 552       { projectPackages = legacyPackages
 553       , projectPackagesOptional = legacyPackagesOptional
 554       , projectPackagesRepo = legacyPackagesRepo
 555       , projectPackagesNamed = legacyPackagesNamed
 556       , projectConfigBuildOnly = configBuildOnly
 557       , projectConfigShared = configPackagesShared
 558       , projectConfigProvenance = mempty
 559       , projectConfigAllPackages = configAllPackages
 560       , projectConfigLocalPackages = configLocalPackages
 561       , projectConfigSpecificPackage = fmap perPackage legacySpecificConfig
 562       }
 563     where
 564       configAllPackages = convertLegacyPerPackageFlags g i h t b
 565         where
 566           LegacyPackageConfig g i h t b = legacyAllConfig
 567       configLocalPackages =
 568         convertLegacyPerPackageFlags
 569           configFlags
 570           installPerPkgFlags
 571           haddockFlags
 572           testFlags
 573           benchmarkFlags
 574       configPackagesShared =
 575         convertLegacyAllPackageFlags
 576           globalFlags
 577           (configFlags <> configShFlags)
 578           configExFlags
 579           installSharedFlags
 580           projectFlags
 581           multiRepl
 582       configBuildOnly =
 583         convertLegacyBuildOnlyFlags
 584           globalFlags
 585           configShFlags
 586           installSharedFlags
 587           clientInstallFlags
 588           haddockFlags
 589           testFlags
 590           benchmarkFlags
 591
 592       perPackage
 593         ( LegacyPackageConfig
 594             perPkgConfigFlags
 595             perPkgInstallFlags
 596             perPkgHaddockFlags
 597             perPkgTestFlags
 598             perPkgBenchmarkFlags
 599           ) =
 600           convertLegacyPerPackageFlags
 601             perPkgConfigFlags
 602             perPkgInstallFlags
 603             perPkgHaddockFlags
 604             perPkgTestFlags
 605             perPkgBenchmarkFlags
 606
 607 -- | Helper used by other conversion functions that returns the
 608 -- 'ProjectConfigShared' subset of the 'ProjectConfig'.
 609 convertLegacyAllPackageFlags
 610   :: GlobalFlags
 611   -> ConfigFlags
 612   -> ConfigExFlags
 613   -> InstallFlags
 614   -> ProjectFlags
 615   -> Flag Bool
 616   -> ProjectConfigShared
 617 convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags projectFlags projectConfigMultiRepl =
 618   ProjectConfigShared{..}
 619   where
 620     GlobalFlags
 621       { globalConfigFile = projectConfigConfigFile
 622       , globalRemoteRepos = projectConfigRemoteRepos
 623       , globalLocalNoIndexRepos = projectConfigLocalNoIndexRepos
 624       , globalActiveRepos = projectConfigActiveRepos
 625       , globalProgPathExtra = projectConfigProgPathExtra
 626       , globalStoreDir = projectConfigStoreDir
 627       } = globalFlags
 628
 629     ConfigFlags
 630       { configDistPref = projectConfigDistDir
 631       , configHcFlavor = projectConfigHcFlavor
 632       , configHcPath = projectConfigHcPath
 633       , configHcPkg = projectConfigHcPkg
 634       , -- configProgramPathExtra    = projectConfigProgPathExtra DELETE ME
 635       configInstallDirs = projectConfigInstallDirs
 636       , -- configUserInstall         = projectConfigUserInstall,
 637       configPackageDBs = projectConfigPackageDBs
 638       } = configFlags
 639
 640     ConfigExFlags
 641       { configCabalVersion = projectConfigCabalVersion
 642       , configExConstraints = projectConfigConstraints
 643       , configPreferences = projectConfigPreferences
 644       , configSolver = projectConfigSolver
 645       , configAllowOlder = projectConfigAllowOlder
 646       , configAllowNewer = projectConfigAllowNewer
 647       , configWriteGhcEnvironmentFilesPolicy =
 648         projectConfigWriteGhcEnvironmentFilesPolicy
 649       } = configExFlags
 650
 651     InstallFlags
 652       { installHaddockIndex = projectConfigHaddockIndex
 653       , -- installReinstall          = projectConfigReinstall,
 654       -- installAvoidReinstalls    = projectConfigAvoidReinstalls,
 655       -- installOverrideReinstall  = projectConfigOverrideReinstall,
 656       installIndexState = projectConfigIndexState
 657       , installMaxBackjumps = projectConfigMaxBackjumps
 658       , -- installUpgradeDeps        = projectConfigUpgradeDeps,
 659       installReorderGoals = projectConfigReorderGoals
 660       , installCountConflicts = projectConfigCountConflicts
 661       , installFineGrainedConflicts = projectConfigFineGrainedConflicts
 662       , installMinimizeConflictSet = projectConfigMinimizeConflictSet
 663       , installPerComponent = projectConfigPerComponent
 664       , installIndependentGoals = projectConfigIndependentGoals
 665       , installPreferOldest = projectConfigPreferOldest
 666       , -- installShadowPkgs         = projectConfigShadowPkgs,
 667       installStrongFlags = projectConfigStrongFlags
 668       , installAllowBootLibInstalls = projectConfigAllowBootLibInstalls
 669       , installOnlyConstrained = projectConfigOnlyConstrained
 670       } = installFlags
 671
 672     ProjectFlags
 673       { flagProjectDir = projectConfigProjectDir
 674       , flagProjectFile = projectConfigProjectFile
 675       , flagIgnoreProject = projectConfigIgnoreProject
 676       } = projectFlags
 677
 678 -- | Helper used by other conversion functions that returns the
 679 -- 'PackageConfig' subset of the 'ProjectConfig'.
 680 convertLegacyPerPackageFlags
 681   :: ConfigFlags
 682   -> InstallFlags
 683   -> HaddockFlags
 684   -> TestFlags
 685   -> BenchmarkFlags
 686   -> PackageConfig
 687 convertLegacyPerPackageFlags
 688   configFlags
 689   installFlags
 690   haddockFlags
 691   testFlags
 692   benchmarkFlags =
 693     PackageConfig{..}
 694     where
 695       ConfigFlags
 696         { configProgramPaths
 697         , configProgramArgs
 698         , configProgramPathExtra = packageConfigProgramPathExtra
 699         , configVanillaLib = packageConfigVanillaLib
 700         , configProfLib = packageConfigProfLib
 701         , configSharedLib = packageConfigSharedLib
 702         , configStaticLib = packageConfigStaticLib
 703         , configDynExe = packageConfigDynExe
 704         , configFullyStaticExe = packageConfigFullyStaticExe
 705         , configProfExe = packageConfigProfExe
 706         , configProf = packageConfigProf
 707         , configProfDetail = packageConfigProfDetail
 708         , configProfLibDetail = packageConfigProfLibDetail
 709         , configConfigureArgs = packageConfigConfigureArgs
 710         , configOptimization = packageConfigOptimization
 711         , configProgPrefix = packageConfigProgPrefix
 712         , configProgSuffix = packageConfigProgSuffix
 713         , configGHCiLib = packageConfigGHCiLib
 714         , configSplitSections = packageConfigSplitSections
 715         , configSplitObjs = packageConfigSplitObjs
 716         , configStripExes = packageConfigStripExes
 717         , configStripLibs = packageConfigStripLibs
 718         , configExtraLibDirs = packageConfigExtraLibDirs
 719         , configExtraLibDirsStatic = packageConfigExtraLibDirsStatic
 720         , configExtraFrameworkDirs = packageConfigExtraFrameworkDirs
 721         , configExtraIncludeDirs = packageConfigExtraIncludeDirs
 722         , configConfigurationsFlags = packageConfigFlagAssignment
 723         , configTests = packageConfigTests
 724         , configBenchmarks = packageConfigBenchmarks
 725         , configCoverage = coverage
 726         , configLibCoverage = libcoverage -- deprecated
 727         , configDebugInfo = packageConfigDebugInfo
 728         , configDumpBuildInfo = packageConfigDumpBuildInfo
 729         , configRelocatable = packageConfigRelocatable
 730         , configCoverageFor = _
 731         } = configFlags
 732       packageConfigProgramPaths = MapLast (Map.fromList configProgramPaths)
 733       packageConfigProgramArgs = MapMappend (Map.fromListWith (++) configProgramArgs)
 734
 735       packageConfigCoverage = coverage <> libcoverage
 736       -- TODO: defer this merging to the resolve phase
 737
 738       InstallFlags
 739         { installDocumentation = packageConfigDocumentation
 740         , installRunTests = packageConfigRunTests
 741         } = installFlags
 742
 743       HaddockFlags
 744         { haddockHoogle = packageConfigHaddockHoogle
 745         , haddockHtml = packageConfigHaddockHtml
 746         , haddockHtmlLocation = packageConfigHaddockHtmlLocation
 747         , haddockForeignLibs = packageConfigHaddockForeignLibs
 748         , haddockForHackage = packageConfigHaddockForHackage
 749         , haddockExecutables = packageConfigHaddockExecutables
 750         , haddockTestSuites = packageConfigHaddockTestSuites
 751         , haddockBenchmarks = packageConfigHaddockBenchmarks
 752         , haddockInternal = packageConfigHaddockInternal
 753         , haddockCss = packageConfigHaddockCss
 754         , haddockLinkedSource = packageConfigHaddockLinkedSource
 755         , haddockQuickJump = packageConfigHaddockQuickJump
 756         , haddockHscolourCss = packageConfigHaddockHscolourCss
 757         , haddockContents = packageConfigHaddockContents
 758         , haddockIndex = packageConfigHaddockIndex
 759         , haddockBaseUrl = packageConfigHaddockBaseUrl
 760         , haddockLib = packageConfigHaddockLib
 761         , haddockOutputDir = packageConfigHaddockOutputDir
 762         } = haddockFlags
 763
 764       TestFlags
 765         { testHumanLog = packageConfigTestHumanLog
 766         , testMachineLog = packageConfigTestMachineLog
 767         , testShowDetails = packageConfigTestShowDetails
 768         , testKeepTix = packageConfigTestKeepTix
 769         , testWrapper = packageConfigTestWrapper
 770         , testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites
 771         , testOptions = packageConfigTestTestOptions
 772         } = testFlags
 773
 774       BenchmarkFlags
 775         { benchmarkOptions = packageConfigBenchmarkOptions
 776         } = benchmarkFlags
 777
 778 -- | Helper used by other conversion functions that returns the
 779 -- 'ProjectConfigBuildOnly' subset of the 'ProjectConfig'.
 780 convertLegacyBuildOnlyFlags
 781   :: GlobalFlags
 782   -> ConfigFlags
 783   -> InstallFlags
 784   -> ClientInstallFlags
 785   -> HaddockFlags
 786   -> TestFlags
 787   -> BenchmarkFlags
 788   -> ProjectConfigBuildOnly
 789 convertLegacyBuildOnlyFlags
 790   globalFlags
 791   configFlags
 792   installFlags
 793   clientInstallFlags
 794   haddockFlags
 795   _
 796   _ =
 797     ProjectConfigBuildOnly{..}
 798     where
 799       projectConfigClientInstallFlags = clientInstallFlags
 800       GlobalFlags
 801         { globalCacheDir = projectConfigCacheDir
 802         , globalLogsDir = projectConfigLogsDir
 803         , globalHttpTransport = projectConfigHttpTransport
 804         , globalIgnoreExpiry = projectConfigIgnoreExpiry
 805         } = globalFlags
 806
 807       ConfigFlags
 808         { configVerbosity = projectConfigVerbosity
 809         } = configFlags
 810
 811       InstallFlags
 812         { installDryRun = projectConfigDryRun
 813         , installOnlyDownload = projectConfigOnlyDownload
 814         , installOnly = _
 815         , installOnlyDeps = projectConfigOnlyDeps
 816         , installRootCmd = _
 817         , installSummaryFile = projectConfigSummaryFile
 818         , installLogFile = projectConfigLogFile
 819         , installBuildReports = projectConfigBuildReports
 820         , installReportPlanningFailure = projectConfigReportPlanningFailure
 821         , installSymlinkBinDir = projectConfigSymlinkBinDir
 822         , installNumJobs = projectConfigNumJobs
 823         , installUseSemaphore = projectConfigUseSemaphore
 824         , installKeepGoing = projectConfigKeepGoing
 825         , installOfflineMode = projectConfigOfflineMode
 826         } = installFlags
 827
 828       HaddockFlags
 829         { haddockKeepTempFiles = projectConfigKeepTempFiles -- TODO: this ought to live elsewhere
 830         } = haddockFlags
 831
 832 convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
 833 convertToLegacyProjectConfig
 834   projectConfig@ProjectConfig
 835     { projectPackages
 836     , projectPackagesOptional
 837     , projectPackagesRepo
 838     , projectPackagesNamed
 839     , projectConfigAllPackages
 840     , projectConfigLocalPackages
 841     , projectConfigSpecificPackage
 842     } =
 843     LegacyProjectConfig
 844       { legacyPackages = projectPackages
 845       , legacyPackagesOptional = projectPackagesOptional
 846       , legacyPackagesRepo = projectPackagesRepo
 847       , legacyPackagesNamed = projectPackagesNamed
 848       , legacySharedConfig = convertToLegacySharedConfig projectConfig
 849       , legacyAllConfig =
 850           convertToLegacyPerPackageConfig
 851             projectConfigAllPackages
 852       , legacyLocalConfig =
 853           convertToLegacyAllPackageConfig projectConfig
 854             <> convertToLegacyPerPackageConfig
 855               projectConfigLocalPackages
 856       , legacySpecificConfig =
 857           fmap
 858             convertToLegacyPerPackageConfig
 859             projectConfigSpecificPackage
 860       }
 861
 862 convertToLegacySharedConfig :: ProjectConfig -> LegacySharedConfig
 863 convertToLegacySharedConfig
 864   ProjectConfig
 865     { projectConfigBuildOnly = ProjectConfigBuildOnly{..}
 866     , projectConfigShared = ProjectConfigShared{..}
 867     , projectConfigAllPackages =
 868       PackageConfig
 869         { packageConfigDocumentation
 870         }
 871     } =
 872     LegacySharedConfig
 873       { legacyGlobalFlags = globalFlags
 874       , legacyConfigureShFlags = configFlags
 875       , legacyConfigureExFlags = configExFlags
 876       , legacyInstallFlags = installFlags
 877       , legacyClientInstallFlags = projectConfigClientInstallFlags
 878       , legacyProjectFlags = projectFlags
 879       , legacyMultiRepl = projectConfigMultiRepl
 880       }
 881     where
 882       globalFlags =
 883         GlobalFlags
 884           { globalVersion = mempty
 885           , globalNumericVersion = mempty
 886           , globalConfigFile = projectConfigConfigFile
 887           , globalConstraintsFile = mempty
 888           , globalRemoteRepos = projectConfigRemoteRepos
 889           , globalCacheDir = projectConfigCacheDir
 890           , globalLocalNoIndexRepos = projectConfigLocalNoIndexRepos
 891           , globalActiveRepos = projectConfigActiveRepos
 892           , globalLogsDir = projectConfigLogsDir
 893           , globalIgnoreExpiry = projectConfigIgnoreExpiry
 894           , globalHttpTransport = projectConfigHttpTransport
 895           , globalNix = mempty
 896           , globalStoreDir = projectConfigStoreDir
 897           , globalProgPathExtra = projectConfigProgPathExtra
 898           }
 899
 900       configFlags =
 901         mempty
 902           { configVerbosity = projectConfigVerbosity
 903           , configDistPref = projectConfigDistDir
 904           , configPackageDBs = projectConfigPackageDBs
 905           , configInstallDirs = projectConfigInstallDirs
 906           }
 907
 908       configExFlags =
 909         ConfigExFlags
 910           { configCabalVersion = projectConfigCabalVersion
 911           , configAppend = mempty
 912           , configBackup = mempty
 913           , configExConstraints = projectConfigConstraints
 914           , configPreferences = projectConfigPreferences
 915           , configSolver = projectConfigSolver
 916           , configAllowOlder = projectConfigAllowOlder
 917           , configAllowNewer = projectConfigAllowNewer
 918           , configWriteGhcEnvironmentFilesPolicy =
 919               projectConfigWriteGhcEnvironmentFilesPolicy
 920           }
 921
 922       installFlags =
 923         InstallFlags
 924           { installDocumentation = packageConfigDocumentation
 925           , installHaddockIndex = projectConfigHaddockIndex
 926           , installDest = Flag NoCopyDest
 927           , installDryRun = projectConfigDryRun
 928           , installOnlyDownload = projectConfigOnlyDownload
 929           , installReinstall = mempty -- projectConfigReinstall,
 930           , installAvoidReinstalls = mempty -- projectConfigAvoidReinstalls,
 931           , installOverrideReinstall = mempty -- projectConfigOverrideReinstall,
 932           , installMaxBackjumps = projectConfigMaxBackjumps
 933           , installUpgradeDeps = mempty -- projectConfigUpgradeDeps,
 934           , installReorderGoals = projectConfigReorderGoals
 935           , installCountConflicts = projectConfigCountConflicts
 936           , installFineGrainedConflicts = projectConfigFineGrainedConflicts
 937           , installMinimizeConflictSet = projectConfigMinimizeConflictSet
 938           , installIndependentGoals = projectConfigIndependentGoals
 939           , installPreferOldest = projectConfigPreferOldest
 940           , installShadowPkgs = mempty -- projectConfigShadowPkgs,
 941           , installStrongFlags = projectConfigStrongFlags
 942           , installAllowBootLibInstalls = projectConfigAllowBootLibInstalls
 943           , installOnlyConstrained = projectConfigOnlyConstrained
 944           , installOnly = mempty
 945           , installOnlyDeps = projectConfigOnlyDeps
 946           , installIndexState = projectConfigIndexState
 947           , installRootCmd = mempty -- no longer supported
 948           , installSummaryFile = projectConfigSummaryFile
 949           , installLogFile = projectConfigLogFile
 950           , installBuildReports = projectConfigBuildReports
 951           , installReportPlanningFailure = projectConfigReportPlanningFailure
 952           , installSymlinkBinDir = projectConfigSymlinkBinDir
 953           , installPerComponent = projectConfigPerComponent
 954           , installNumJobs = projectConfigNumJobs
 955           , installUseSemaphore = projectConfigUseSemaphore
 956           , installKeepGoing = projectConfigKeepGoing
 957           , installRunTests = mempty
 958           , installOfflineMode = projectConfigOfflineMode
 959           }
 960
 961       projectFlags =
 962         ProjectFlags
 963           { flagProjectDir = projectConfigProjectDir
 964           , flagProjectFile = projectConfigProjectFile
 965           , flagIgnoreProject = projectConfigIgnoreProject
 966           }
 967
 968 convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig
 969 convertToLegacyAllPackageConfig
 970   ProjectConfig
 971     { projectConfigBuildOnly = ProjectConfigBuildOnly{..}
 972     , projectConfigShared = ProjectConfigShared{..}
 973     } =
 974     LegacyPackageConfig
 975       { legacyConfigureFlags = configFlags
 976       , legacyInstallPkgFlags = mempty
 977       , legacyHaddockFlags = haddockFlags
 978       , legacyTestFlags = mempty
 979       , legacyBenchmarkFlags = mempty
 980       }
 981     where
 982       configFlags =
 983         ConfigFlags
 984           { configArgs = mempty
 985           , configPrograms_ = mempty
 986           , configProgramPaths = mempty
 987           , configProgramArgs = mempty
 988           , configProgramPathExtra = mempty
 989           , configHcFlavor = projectConfigHcFlavor
 990           , configHcPath = projectConfigHcPath
 991           , configHcPkg = projectConfigHcPkg
 992           , configInstantiateWith = mempty
 993           , configVanillaLib = mempty
 994           , configProfLib = mempty
 995           , configSharedLib = mempty
 996           , configStaticLib = mempty
 997           , configDynExe = mempty
 998           , configFullyStaticExe = mempty
 999           , configProfExe = mempty
1000           , configProf = mempty
1001           , configProfDetail = mempty
1002           , configProfLibDetail = mempty
1003           , configConfigureArgs = mempty
1004           , configOptimization = mempty
1005           , configProgPrefix = mempty
1006           , configProgSuffix = mempty
1007           , configInstallDirs = projectConfigInstallDirs
1008           , configScratchDir = mempty
1009           , configDistPref = mempty
1010           , configCabalFilePath = mempty
1011           , configVerbosity = mempty
1012           , configUserInstall = mempty -- projectConfigUserInstall,
1013           , configPackageDBs = mempty
1014           , configGHCiLib = mempty
1015           , configSplitSections = mempty
1016           , configSplitObjs = mempty
1017           , configStripExes = mempty
1018           , configStripLibs = mempty
1019           , configExtraLibDirs = mempty
1020           , configExtraLibDirsStatic = mempty
1021           , configExtraFrameworkDirs = mempty
1022           , configConstraints = mempty
1023           , configDependencies = mempty
1024           , configPromisedDependencies = mempty
1025           , configExtraIncludeDirs = mempty
1026           , configDeterministic = mempty
1027           , configIPID = mempty
1028           , configCID = mempty
1029           , configConfigurationsFlags = mempty
1030           , configTests = mempty
1031           , configCoverage = mempty -- TODO: don't merge
1032           , configLibCoverage = mempty -- TODO: don't merge
1033           , configExactConfiguration = mempty
1034           , configBenchmarks = mempty
1035           , configFlagError = mempty -- TODO: ???
1036           , configRelocatable = mempty
1037           , configDebugInfo = mempty
1038           , configUseResponseFiles = mempty
1039           , configDumpBuildInfo = mempty
1040           , configAllowDependingOnPrivateLibs = mempty
1041           , configCoverageFor = mempty
1042           }
1043
1044       haddockFlags =
1045         mempty
1046           { haddockKeepTempFiles = projectConfigKeepTempFiles
1047           }
1048
1049 convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig
1050 convertToLegacyPerPackageConfig PackageConfig{..} =
1051   LegacyPackageConfig
1052     { legacyConfigureFlags = configFlags
1053     , legacyInstallPkgFlags = installFlags
1054     , legacyHaddockFlags = haddockFlags
1055     , legacyTestFlags = testFlags
1056     , legacyBenchmarkFlags = benchmarkFlags
1057     }
1058   where
1059     configFlags =
1060       ConfigFlags
1061         { configArgs = mempty
1062         , configPrograms_ = configPrograms_ mempty
1063         , configProgramPaths = Map.toList (getMapLast packageConfigProgramPaths)
1064         , configProgramArgs = Map.toList (getMapMappend packageConfigProgramArgs)
1065         , configProgramPathExtra = packageConfigProgramPathExtra
1066         , configHcFlavor = mempty
1067         , configHcPath = mempty
1068         , configHcPkg = mempty
1069         , configInstantiateWith = mempty
1070         , configVanillaLib = packageConfigVanillaLib
1071         , configProfLib = packageConfigProfLib
1072         , configSharedLib = packageConfigSharedLib
1073         , configStaticLib = packageConfigStaticLib
1074         , configDynExe = packageConfigDynExe
1075         , configFullyStaticExe = packageConfigFullyStaticExe
1076         , configProfExe = packageConfigProfExe
1077         , configProf = packageConfigProf
1078         , configProfDetail = packageConfigProfDetail
1079         , configProfLibDetail = packageConfigProfLibDetail
1080         , configConfigureArgs = packageConfigConfigureArgs
1081         , configOptimization = packageConfigOptimization
1082         , configProgPrefix = packageConfigProgPrefix
1083         , configProgSuffix = packageConfigProgSuffix
1084         , configInstallDirs = mempty
1085         , configScratchDir = mempty
1086         , configDistPref = mempty
1087         , configCabalFilePath = mempty
1088         , configVerbosity = mempty
1089         , configUserInstall = mempty
1090         , configPackageDBs = mempty
1091         , configGHCiLib = packageConfigGHCiLib
1092         , configSplitSections = packageConfigSplitSections
1093         , configSplitObjs = packageConfigSplitObjs
1094         , configStripExes = packageConfigStripExes
1095         , configStripLibs = packageConfigStripLibs
1096         , configExtraLibDirs = packageConfigExtraLibDirs
1097         , configExtraLibDirsStatic = packageConfigExtraLibDirsStatic
1098         , configExtraFrameworkDirs = packageConfigExtraFrameworkDirs
1099         , configConstraints = mempty
1100         , configDependencies = mempty
1101         , configPromisedDependencies = mempty
1102         , configExtraIncludeDirs = packageConfigExtraIncludeDirs
1103         , configIPID = mempty
1104         , configCID = mempty
1105         , configDeterministic = mempty
1106         , configConfigurationsFlags = packageConfigFlagAssignment
1107         , configTests = packageConfigTests
1108         , configCoverage = packageConfigCoverage -- TODO: don't merge
1109         , configLibCoverage = packageConfigCoverage -- TODO: don't merge
1110         , configExactConfiguration = mempty
1111         , configBenchmarks = packageConfigBenchmarks
1112         , configFlagError = mempty -- TODO: ???
1113         , configRelocatable = packageConfigRelocatable
1114         , configDebugInfo = packageConfigDebugInfo
1115         , configUseResponseFiles = mempty
1116         , configDumpBuildInfo = packageConfigDumpBuildInfo
1117         , configAllowDependingOnPrivateLibs = mempty
1118         , configCoverageFor = mempty
1119         }
1120
1121     installFlags =
1122       mempty
1123         { installDocumentation = packageConfigDocumentation
1124         , installRunTests = packageConfigRunTests
1125         }
1126
1127     haddockFlags =
1128       HaddockFlags
1129         { haddockProgramPaths = mempty
1130         , haddockProgramArgs = mempty
1131         , haddockHoogle = packageConfigHaddockHoogle
1132         , haddockHtml = packageConfigHaddockHtml
1133         , haddockHtmlLocation = packageConfigHaddockHtmlLocation
1134         , haddockForHackage = packageConfigHaddockForHackage
1135         , haddockForeignLibs = packageConfigHaddockForeignLibs
1136         , haddockExecutables = packageConfigHaddockExecutables
1137         , haddockTestSuites = packageConfigHaddockTestSuites
1138         , haddockBenchmarks = packageConfigHaddockBenchmarks
1139         , haddockInternal = packageConfigHaddockInternal
1140         , haddockCss = packageConfigHaddockCss
1141         , haddockLinkedSource = packageConfigHaddockLinkedSource
1142         , haddockQuickJump = packageConfigHaddockQuickJump
1143         , haddockHscolourCss = packageConfigHaddockHscolourCss
1144         , haddockContents = packageConfigHaddockContents
1145         , haddockDistPref = mempty
1146         , haddockKeepTempFiles = mempty
1147         , haddockVerbosity = mempty
1148         , haddockCabalFilePath = mempty
1149         , haddockIndex = packageConfigHaddockIndex
1150         , haddockBaseUrl = packageConfigHaddockBaseUrl
1151         , haddockLib = packageConfigHaddockLib
1152         , haddockOutputDir = packageConfigHaddockOutputDir
1153         , haddockArgs = mempty
1154         }
1155
1156     testFlags =
1157       TestFlags
1158         { testDistPref = mempty
1159         , testVerbosity = mempty
1160         , testHumanLog = packageConfigTestHumanLog
1161         , testMachineLog = packageConfigTestMachineLog
1162         , testShowDetails = packageConfigTestShowDetails
1163         , testKeepTix = packageConfigTestKeepTix
1164         , testWrapper = packageConfigTestWrapper
1165         , testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites
1166         , testOptions = packageConfigTestTestOptions
1167         }
1168
1169     benchmarkFlags =
1170       BenchmarkFlags
1171         { benchmarkDistPref = mempty
1172         , benchmarkVerbosity = mempty
1173         , benchmarkOptions = packageConfigBenchmarkOptions
1174         }
1175
1176 ------------------------------------------------
1177 -- Parsing and showing the project config file
1178 --
1179
1180 parseLegacyProjectConfigFields :: FilePath -> [ParseUtils.Field] -> ParseResult LegacyProjectConfig
1181 parseLegacyProjectConfigFields source =
1182   parseFieldsAndSections
1183     (legacyProjectConfigFieldDescrs constraintSrc)
1184     legacyPackageConfigSectionDescrs
1185     legacyPackageConfigFGSectionDescrs
1186     mempty
1187   where
1188     constraintSrc = ConstraintSourceProjectConfig source
1189
1190 parseLegacyProjectConfig :: FilePath -> BS.ByteString -> ParseResult LegacyProjectConfig
1191 parseLegacyProjectConfig source bs = parseLegacyProjectConfigFields source =<< ParseUtils.readFields bs
1192
1193 showLegacyProjectConfig :: LegacyProjectConfig -> String
1194 showLegacyProjectConfig config =
1195   Disp.render $
1196     showConfig
1197       (legacyProjectConfigFieldDescrs constraintSrc)
1198       legacyPackageConfigSectionDescrs
1199       legacyPackageConfigFGSectionDescrs
1200       config
1201       $+$ Disp.text ""
1202   where
1203     -- Note: ConstraintSource is unused when pretty-printing. We fake
1204     -- it here to avoid having to pass it on call-sites. It's not great
1205     -- but requires re-work of how we annotate provenance.
1206     constraintSrc = ConstraintSourceProjectConfig "unused"
1207
1208 legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectConfig]
1209 legacyProjectConfigFieldDescrs constraintSrc =
1210   [ newLineListField
1211       "packages"
1212       (Disp.text . renderPackageLocationToken)
1213       parsePackageLocationTokenQ
1214       legacyPackages
1215       (\v flags -> flags{legacyPackages = v})
1216   , newLineListField
1217       "optional-packages"
1218       (Disp.text . renderPackageLocationToken)
1219       parsePackageLocationTokenQ
1220       legacyPackagesOptional
1221       (\v flags -> flags{legacyPackagesOptional = v})
1222   , commaNewLineListFieldParsec
1223       "extra-packages"
1224       pretty
1225       parsec
1226       legacyPackagesNamed
1227       (\v flags -> flags{legacyPackagesNamed = v})
1228   ]
1229     ++ map
1230       ( liftField
1231           legacySharedConfig
1232           (\flags conf -> conf{legacySharedConfig = flags})
1233       )
1234       (legacySharedConfigFieldDescrs constraintSrc)
1235     ++ map
1236       ( liftField
1237           legacyLocalConfig
1238           (\flags conf -> conf{legacyLocalConfig = flags})
1239       )
1240       legacyPackageConfigFieldDescrs
1241
1242 -- | This is a bit tricky since it has to cover globs which have embedded @,@
1243 -- chars. But we don't just want to parse strictly as a glob since we want to
1244 -- allow http urls which don't parse as globs, and possibly some
1245 -- system-dependent file paths. So we parse fairly liberally as a token, but
1246 -- we allow @,@ inside matched @{}@ braces.
1247 parsePackageLocationTokenQ :: ReadP r String
1248 parsePackageLocationTokenQ =
1249   parseHaskellString
1250     Parse.<++ parsePackageLocationToken
1251   where
1252     parsePackageLocationToken :: ReadP r String
1253     parsePackageLocationToken = fmap fst (Parse.gather outerTerm)
1254       where
1255         outerTerm = alternateEither1 outerToken (braces innerTerm)
1256         innerTerm = alternateEither innerToken (braces innerTerm)
1257         outerToken = Parse.munch1 outerChar >> return ()
1258         innerToken = Parse.munch1 innerChar >> return ()
1259         outerChar c = not (isSpace c || c == '{' || c == '}' || c == ',')
1260         innerChar c = not (isSpace c || c == '{' || c == '}')
1261         braces = Parse.between (Parse.char '{') (Parse.char '}')
1262
1263     alternateEither
1264       , alternateEither1
1265       , alternatePQs
1266       , alternate1PQs
1267       , alternateQsP
1268       , alternate1QsP
1269         :: ReadP r () -> ReadP r () -> ReadP r ()
1270
1271     alternateEither1 p q = alternate1PQs p q +++ alternate1QsP q p
1272     alternateEither p q = alternateEither1 p q +++ return ()
1273     alternate1PQs p q = p >> alternateQsP q p
1274     alternatePQs p q = alternate1PQs p q +++ return ()
1275     alternate1QsP q p = Parse.many1 q >> alternatePQs p q
1276     alternateQsP q p = alternate1QsP q p +++ return ()
1277
1278 renderPackageLocationToken :: String -> String
1279 renderPackageLocationToken s
1280   | needsQuoting = show s
1281   | otherwise = s
1282   where
1283     needsQuoting =
1284       not (ok 0 s)
1285         || s == "." -- . on its own on a line has special meaning
1286         || take 2 s == "--" -- on its own line is comment syntax
1287         -- TODO: [code cleanup] these "." and "--" escaping issues
1288         -- ought to be dealt with systematically in ParseUtils.
1289     ok :: Int -> String -> Bool
1290     ok n [] = n == 0
1291     ok _ ('"' : _) = False
1292     ok n ('{' : cs) = ok (n + 1) cs
1293     ok n ('}' : cs) = ok (n - 1) cs
1294     ok n (',' : cs) = (n > 0) && ok n cs
1295     ok _ (c : _)
1296       | isSpace c = False
1297     ok n (_ : cs) = ok n cs
1298
1299 legacySharedConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacySharedConfig]
1300 legacySharedConfigFieldDescrs constraintSrc =
1301   concat
1302     [ liftFields
1303         legacyGlobalFlags
1304         (\flags conf -> conf{legacyGlobalFlags = flags})
1305         . addFields
1306           [ newLineListField
1307               "extra-prog-path-shared-only"
1308               showTokenQ
1309               parseTokenQ
1310               (fromNubList . globalProgPathExtra)
1311               (\v conf -> conf{globalProgPathExtra = toNubList v})
1312           ]
1313         . filterFields
1314           [ "remote-repo-cache"
1315           , "logs-dir"
1316           , "store-dir"
1317           , "ignore-expiry"
1318           , "http-transport"
1319           , "active-repositories"
1320           ]
1321         . commandOptionsToFields
1322         $ commandOptions (globalCommand []) ParseArgs
1323     , liftFields
1324         legacyConfigureShFlags
1325         (\flags conf -> conf{legacyConfigureShFlags = flags})
1326         . addFields
1327           [ commaNewLineListFieldParsec
1328               "package-dbs"
1329               (Disp.text . showPackageDb)
1330               (fmap readPackageDb parsecToken)
1331               configPackageDBs
1332               (\v conf -> conf{configPackageDBs = v})
1333           ]
1334         . filterFields (["verbose", "builddir"] ++ map optionName installDirsOptions)
1335         . commandOptionsToFields
1336         $ configureOptions ParseArgs
1337     , liftFields
1338         legacyConfigureExFlags
1339         (\flags conf -> conf{legacyConfigureExFlags = flags})
1340         . addFields
1341           [ commaNewLineListFieldParsec
1342               "constraints"
1343               (pretty . fst)
1344               (fmap (\constraint -> (constraint, constraintSrc)) parsec)
1345               configExConstraints
1346               (\v conf -> conf{configExConstraints = v})
1347           , commaNewLineListFieldParsec
1348               "preferences"
1349               pretty
1350               parsec
1351               configPreferences
1352               (\v conf -> conf{configPreferences = v})
1353           , monoidFieldParsec
1354               "allow-older"
1355               (maybe mempty pretty)
1356               (fmap Just parsec)
1357               (fmap unAllowOlder . configAllowOlder)
1358               (\v conf -> conf{configAllowOlder = fmap AllowOlder v})
1359           , monoidFieldParsec
1360               "allow-newer"
1361               (maybe mempty pretty)
1362               (fmap Just parsec)
1363               (fmap unAllowNewer . configAllowNewer)
1364               (\v conf -> conf{configAllowNewer = fmap AllowNewer v})
1365           ]
1366         . filterFields
1367           [ "cabal-lib-version"
1368           , "solver"
1369           , "write-ghc-environment-files"
1370           -- not "constraint" or "preference", we use our own plural ones above
1371           ]
1372         . commandOptionsToFields
1373         $ configureExOptions ParseArgs constraintSrc
1374     , liftFields
1375         legacyInstallFlags
1376         (\flags conf -> conf{legacyInstallFlags = flags})
1377         . addFields
1378           [ newLineListField
1379               "build-summary"
1380               (showTokenQ . fromPathTemplate)
1381               (fmap toPathTemplate parseTokenQ)
1382               (fromNubList . installSummaryFile)
1383               (\v conf -> conf{installSummaryFile = toNubList v})
1384           ]
1385         . filterFields
1386           [ "doc-index-file"
1387           , "root-cmd"
1388           , "symlink-bindir"
1389           , "build-log"
1390           , "remote-build-reporting"
1391           , "report-planning-failure"
1392           , "jobs"
1393           , "semaphore"
1394           , "keep-going"
1395           , "offline"
1396           , "per-component"
1397           , -- solver flags:
1398             "max-backjumps"
1399           , "reorder-goals"
1400           , "count-conflicts"
1401           , "fine-grained-conflicts"
1402           , "minimize-conflict-set"
1403           , "independent-goals"
1404           , "prefer-oldest"
1405           , "strong-flags"
1406           , "allow-boot-library-installs"
1407           , "reject-unconstrained-dependencies"
1408           , "index-state"
1409           ]
1410         . commandOptionsToFields
1411         $ installOptions ParseArgs
1412     , liftFields
1413         legacyClientInstallFlags
1414         (\flags conf -> conf{legacyClientInstallFlags = flags})
1415         . commandOptionsToFields
1416         $ clientInstallOptions ParseArgs
1417     , liftFields
1418         legacyProjectFlags
1419         (\flags conf -> conf{legacyProjectFlags = flags})
1420         . commandOptionsToFields
1421         $ projectFlagsOptions ParseArgs
1422     , [liftField legacyMultiRepl (\flags conf -> conf{legacyMultiRepl = flags}) (commandOptionToField multiReplOption)]
1423     ]
1424
1425 legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
1426 legacyPackageConfigFieldDescrs =
1427   ( liftFields
1428       legacyConfigureFlags
1429       (\flags conf -> conf{legacyConfigureFlags = flags})
1430       . addFields
1431         [ newLineListField
1432             "extra-include-dirs"
1433             showTokenQ
1434             parseTokenQ
1435             configExtraIncludeDirs
1436             (\v conf -> conf{configExtraIncludeDirs = v})
1437         , newLineListField
1438             "extra-lib-dirs"
1439             showTokenQ
1440             parseTokenQ
1441             configExtraLibDirs
1442             (\v conf -> conf{configExtraLibDirs = v})
1443         , newLineListField
1444             "extra-lib-dirs-static"
1445             showTokenQ
1446             parseTokenQ
1447             configExtraLibDirsStatic
1448             (\v conf -> conf{configExtraLibDirsStatic = v})
1449         , newLineListField
1450             "extra-framework-dirs"
1451             showTokenQ
1452             parseTokenQ
1453             configExtraFrameworkDirs
1454             (\v conf -> conf{configExtraFrameworkDirs = v})
1455         , newLineListField
1456             "extra-prog-path"
1457             showTokenQ
1458             parseTokenQ
1459             (fromNubList . configProgramPathExtra)
1460             (\v conf -> conf{configProgramPathExtra = toNubList v})
1461         , newLineListField
1462             "configure-options"
1463             showTokenQ
1464             parseTokenQ
1465             configConfigureArgs
1466             (\v conf -> conf{configConfigureArgs = v})
1467         , simpleFieldParsec
1468             "flags"
1469             dispFlagAssignment
1470             parsecFlagAssignment
1471             configConfigurationsFlags
1472             (\v conf -> conf{configConfigurationsFlags = v})
1473         , overrideDumpBuildInfo
1474         ]
1475       . filterFields
1476         [ "with-compiler"
1477         , "with-hc-pkg"
1478         , "program-prefix"
1479         , "program-suffix"
1480         , "library-vanilla"
1481         , "library-profiling"
1482         , "shared"
1483         , "static"
1484         , "executable-dynamic"
1485         , "executable-static"
1486         , "profiling"
1487         , "executable-profiling"
1488         , "profiling-detail"
1489         , "library-profiling-detail"
1490         , "library-for-ghci"
1491         , "split-objs"
1492         , "split-sections"
1493         , "executable-stripping"
1494         , "library-stripping"
1495         , "tests"
1496         , "benchmarks"
1497         , "coverage"
1498         , "library-coverage"
1499         , "relocatable"
1500         -- not "extra-include-dirs", "extra-lib-dirs", "extra-framework-dirs"
1501         -- or "extra-prog-path". We use corrected ones above that parse
1502         -- as list fields.
1503         ]
1504       . commandOptionsToFields
1505   )
1506     (configureOptions ParseArgs)
1507     ++ liftFields
1508       legacyConfigureFlags
1509       (\flags conf -> conf{legacyConfigureFlags = flags})
1510       [ overrideFieldCompiler
1511       , overrideFieldOptimization
1512       , overrideFieldDebugInfo
1513       ]
1514     ++ ( liftFields
1515           legacyInstallPkgFlags
1516           (\flags conf -> conf{legacyInstallPkgFlags = flags})
1517           . filterFields
1518             [ "documentation"
1519             , "run-tests"
1520             ]
1521           . commandOptionsToFields
1522        )
1523       (installOptions ParseArgs)
1524     ++ ( liftFields
1525           legacyHaddockFlags
1526           (\flags conf -> conf{legacyHaddockFlags = flags})
1527           . mapFieldNames
1528             ("haddock-" ++)
1529           . addFields
1530             [ simpleFieldParsec
1531                 "for-hackage"
1532                 -- TODO: turn this into a library function
1533                 (fromFlagOrDefault Disp.empty . fmap pretty)
1534                 (toFlag <$> parsec <|> pure mempty)
1535                 haddockForHackage
1536                 (\v conf -> conf{haddockForHackage = v})
1537             ]
1538           . filterFields
1539             [ "hoogle"
1540             , "html"
1541             , "html-location"
1542             , "foreign-libraries"
1543             , "executables"
1544             , "tests"
1545             , "benchmarks"
1546             , "all"
1547             , "internal"
1548             , "css"
1549             , "hyperlink-source"
1550             , "quickjump"
1551             , "hscolour-css"
1552             , "contents-location"
1553             , "index-location"
1554             , "keep-temp-files"
1555             , "base-url"
1556             , "lib"
1557             , "output-dir"
1558             ]
1559           . commandOptionsToFields
1560        )
1561       (haddockOptions ParseArgs)
1562     ++ ( liftFields
1563           legacyTestFlags
1564           (\flags conf -> conf{legacyTestFlags = flags})
1565           . mapFieldNames
1566             prefixTest
1567           . addFields
1568             [ newLineListField
1569                 "test-options"
1570                 (showTokenQ . fromPathTemplate)
1571                 (fmap toPathTemplate parseTokenQ)
1572                 testOptions
1573                 (\v conf -> conf{testOptions = v})
1574             ]
1575           . filterFields
1576             [ "log"
1577             , "machine-log"
1578             , "show-details"
1579             , "keep-tix-files"
1580             , "fail-when-no-test-suites"
1581             , "test-wrapper"
1582             ]
1583           . commandOptionsToFields
1584        )
1585       (testOptions' ParseArgs)
1586     ++ ( liftFields
1587           legacyBenchmarkFlags
1588           (\flags conf -> conf{legacyBenchmarkFlags = flags})
1589           . addFields
1590             [ newLineListField
1591                 "benchmark-options"
1592                 (showTokenQ . fromPathTemplate)
1593                 (fmap toPathTemplate parseTokenQ)
1594                 benchmarkOptions
1595                 (\v conf -> conf{benchmarkOptions = v})
1596             ]
1597           . filterFields
1598             []
1599           . commandOptionsToFields
1600        )
1601       (benchmarkOptions' ParseArgs)
1602   where
1603     overrideFieldCompiler =
1604       simpleFieldParsec
1605         "compiler"
1606         (fromFlagOrDefault Disp.empty . fmap pretty)
1607         (toFlag <$> parsec <|> pure mempty)
1608         configHcFlavor
1609         (\v flags -> flags{configHcFlavor = v})
1610
1611     overrideDumpBuildInfo =
1612       liftField
1613         configDumpBuildInfo
1614         (\v flags -> flags{configDumpBuildInfo = v})
1615         $ let name = "build-info"
1616            in FieldDescr
1617                 name
1618                 ( \f -> case f of
1619                     Flag NoDumpBuildInfo -> Disp.text "False"
1620                     Flag DumpBuildInfo -> Disp.text "True"
1621                     _ -> Disp.empty
1622                 )
1623                 ( \line str _ -> case () of
1624                     _
1625                       | str == "False" -> ParseOk [] (Flag NoDumpBuildInfo)
1626                       | str == "True" -> ParseOk [] (Flag DumpBuildInfo)
1627                       | lstr == "false" -> ParseOk [caseWarning name] (Flag NoDumpBuildInfo)
1628                       | lstr == "true" -> ParseOk [caseWarning name] (Flag DumpBuildInfo)
1629                       | otherwise -> ParseFailed (NoParse name line)
1630                       where
1631                         lstr = lowercase str
1632                 )
1633
1634     -- TODO: [code cleanup] The following is a hack. The "optimization" and
1635     -- "debug-info" fields are OptArg, and viewAsFieldDescr fails on that.
1636     -- Instead of a hand-written parser and printer, we should handle this case
1637     -- properly in the library.
1638
1639     overrideFieldOptimization =
1640       liftField
1641         configOptimization
1642         (\v flags -> flags{configOptimization = v})
1643         $ let name = "optimization"
1644            in FieldDescr
1645                 name
1646                 ( \f -> case f of
1647                     Flag NoOptimisation -> Disp.text "False"
1648                     Flag NormalOptimisation -> Disp.text "True"
1649                     Flag MaximumOptimisation -> Disp.text "2"
1650                     _ -> Disp.empty
1651                 )
1652                 ( \line str _ -> case () of
1653                     _
1654                       | str == "False" -> ParseOk [] (Flag NoOptimisation)
1655                       | str == "True" -> ParseOk [] (Flag NormalOptimisation)
1656                       | str == "0" -> ParseOk [] (Flag NoOptimisation)
1657                       | str == "1" -> ParseOk [] (Flag NormalOptimisation)
1658                       | str == "2" -> ParseOk [] (Flag MaximumOptimisation)
1659                       | lstr == "false" -> ParseOk [caseWarning name] (Flag NoOptimisation)
1660                       | lstr == "true" -> ParseOk [caseWarning name] (Flag NormalOptimisation)
1661                       | otherwise -> ParseFailed (NoParse name line)
1662                       where
1663                         lstr = lowercase str
1664                 )
1665
1666     overrideFieldDebugInfo =
1667       liftField configDebugInfo (\v flags -> flags{configDebugInfo = v}) $
1668         let name = "debug-info"
1669          in FieldDescr
1670               name
1671               ( \f -> case f of
1672                   Flag NoDebugInfo -> Disp.text "False"
1673                   Flag MinimalDebugInfo -> Disp.text "1"
1674                   Flag NormalDebugInfo -> Disp.text "True"
1675                   Flag MaximalDebugInfo -> Disp.text "3"
1676                   _ -> Disp.empty
1677               )
1678               ( \line str _ -> case () of
1679                   _
1680                     | str == "False" -> ParseOk [] (Flag NoDebugInfo)
1681                     | str == "True" -> ParseOk [] (Flag NormalDebugInfo)
1682                     | str == "0" -> ParseOk [] (Flag NoDebugInfo)
1683                     | str == "1" -> ParseOk [] (Flag MinimalDebugInfo)
1684                     | str == "2" -> ParseOk [] (Flag NormalDebugInfo)
1685                     | str == "3" -> ParseOk [] (Flag MaximalDebugInfo)
1686                     | lstr == "false" -> ParseOk [caseWarning name] (Flag NoDebugInfo)
1687                     | lstr == "true" -> ParseOk [caseWarning name] (Flag NormalDebugInfo)
1688                     | otherwise -> ParseFailed (NoParse name line)
1689                     where
1690                       lstr = lowercase str
1691               )
1692
1693     caseWarning name =
1694       PWarning $
1695         "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'."
1696
1697     prefixTest name
1698       | "test-" `isPrefixOf` name = name
1699       | otherwise = "test-" ++ name
1700
1701 legacyPackageConfigFGSectionDescrs
1702   :: ( FieldGrammar c g
1703      , Applicative (g SourceRepoList)
1704      , c (Identity RepoType)
1705      , c (List NoCommaFSep FilePathNT String)
1706      , c (NonEmpty' NoCommaFSep Token String)
1707      )
1708   => [FGSectionDescr g LegacyProjectConfig]
1709 legacyPackageConfigFGSectionDescrs =
1710   [ packageRepoSectionDescr
1711   ]
1712
1713 legacyPackageConfigSectionDescrs :: [SectionDescr LegacyProjectConfig]
1714 legacyPackageConfigSectionDescrs =
1715   [ packageSpecificOptionsSectionDescr
1716   , liftSection
1717       legacyLocalConfig
1718       (\flags conf -> conf{legacyLocalConfig = flags})
1719       programOptionsSectionDescr
1720   , liftSection
1721       legacyLocalConfig
1722       (\flags conf -> conf{legacyLocalConfig = flags})
1723       programLocationsSectionDescr
1724   , liftSection
1725       legacySharedConfig
1726       (\flags conf -> conf{legacySharedConfig = flags})
1727       $ liftSection
1728         legacyGlobalFlags
1729         (\flags conf -> conf{legacyGlobalFlags = flags})
1730         remoteRepoSectionDescr
1731   ]
1732
1733 packageRepoSectionDescr
1734   :: ( FieldGrammar c g
1735      , Applicative (g SourceRepoList)
1736      , c (Identity RepoType)
1737      , c (List NoCommaFSep FilePathNT String)
1738      , c (NonEmpty' NoCommaFSep Token String)
1739      )
1740   => FGSectionDescr g LegacyProjectConfig
1741 packageRepoSectionDescr =
1742   FGSectionDescr
1743     { fgSectionName = "source-repository-package"
1744     , fgSectionGrammar = sourceRepositoryPackageGrammar
1745     , fgSectionGet = map (\x -> ("", x)) . legacyPackagesRepo
1746     , fgSectionSet =
1747         \lineno unused pkgrepo projconf -> do
1748           unless (null unused) $
1749             syntaxError lineno "the section 'source-repository-package' takes no arguments"
1750           return
1751             projconf
1752               { legacyPackagesRepo = legacyPackagesRepo projconf ++ [pkgrepo]
1753               }
1754     }
1755
1756 -- | The definitions of all the fields that can appear in the @package pkgfoo@
1757 -- and @package *@ sections of the @cabal.project@-format files.
1758 packageSpecificOptionsFieldDescrs :: [FieldDescr LegacyPackageConfig]
1759 packageSpecificOptionsFieldDescrs =
1760   legacyPackageConfigFieldDescrs
1761     ++ programOptionsFieldDescrs
1762       (configProgramArgs . legacyConfigureFlags)
1763       ( \args pkgconf ->
1764           pkgconf
1765             { legacyConfigureFlags =
1766                 (legacyConfigureFlags pkgconf)
1767                   { configProgramArgs = args
1768                   }
1769             }
1770       )
1771     ++ liftFields
1772       legacyConfigureFlags
1773       ( \flags pkgconf ->
1774           pkgconf
1775             { legacyConfigureFlags = flags
1776             }
1777       )
1778       programLocationsFieldDescrs
1779
1780 -- | The definition of the @package pkgfoo@ sections of the @cabal.project@-format
1781 -- files. This section is per-package name. The special package @*@ applies to all
1782 -- packages used anywhere by the project, locally or as dependencies.
1783 packageSpecificOptionsSectionDescr :: SectionDescr LegacyProjectConfig
1784 packageSpecificOptionsSectionDescr =
1785   SectionDescr
1786     { sectionName = "package"
1787     , sectionFields = packageSpecificOptionsFieldDescrs
1788     , sectionSubsections = []
1789     , sectionGet = \projconf ->
1790         [ (prettyShow pkgname, pkgconf)
1791         | (pkgname, pkgconf) <-
1792             Map.toList
1793               . getMapMappend
1794               . legacySpecificConfig
1795               $ projconf
1796         ]
1797           ++ [("*", legacyAllConfig projconf)]
1798     , sectionSet =
1799         \lineno pkgnamestr pkgconf projconf -> case pkgnamestr of
1800           "*" ->
1801             return
1802               projconf
1803                 { legacyAllConfig = legacyAllConfig projconf <> pkgconf
1804                 }
1805           _ -> do
1806             pkgname <- case simpleParsec pkgnamestr of
1807               Just pkgname -> return pkgname
1808               Nothing ->
1809                 syntaxError lineno $
1810                   "a 'package' section requires a package name "
1811                     ++ "as an argument"
1812             return
1813               projconf
1814                 { legacySpecificConfig =
1815                     MapMappend $
1816                       Map.insertWith
1817                         mappend
1818                         pkgname
1819                         pkgconf
1820                         (getMapMappend $ legacySpecificConfig projconf)
1821                 }
1822     , sectionEmpty = mempty
1823     }
1824
1825 programOptionsFieldDescrs
1826   :: (a -> [(String, [String])])
1827   -> ([(String, [String])] -> a -> a)
1828   -> [FieldDescr a]
1829 programOptionsFieldDescrs get' set =
1830   commandOptionsToFields $
1831     programDbOptions
1832       defaultProgramDb
1833       ParseArgs
1834       get'
1835       set
1836
1837 programOptionsSectionDescr :: SectionDescr LegacyPackageConfig
1838 programOptionsSectionDescr =
1839   SectionDescr
1840     { sectionName = "program-options"
1841     , sectionFields =
1842         programOptionsFieldDescrs
1843           configProgramArgs
1844           (\args conf -> conf{configProgramArgs = args})
1845     , sectionSubsections = []
1846     , sectionGet =
1847         (\x -> [("", x)])
1848           . legacyConfigureFlags
1849     , sectionSet =
1850         \lineno unused confflags pkgconf -> do
1851           unless (null unused) $
1852             syntaxError lineno "the section 'program-options' takes no arguments"
1853           return
1854             pkgconf
1855               { legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
1856               }
1857     , sectionEmpty = mempty
1858     }
1859
1860 programLocationsFieldDescrs :: [FieldDescr ConfigFlags]
1861 programLocationsFieldDescrs =
1862   commandOptionsToFields $
1863     programDbPaths'
1864       (++ "-location")
1865       defaultProgramDb
1866       ParseArgs
1867       configProgramPaths
1868       (\paths conf -> conf{configProgramPaths = paths})
1869
1870 programLocationsSectionDescr :: SectionDescr LegacyPackageConfig
1871 programLocationsSectionDescr =
1872   SectionDescr
1873     { sectionName = "program-locations"
1874     , sectionFields = programLocationsFieldDescrs
1875     , sectionSubsections = []
1876     , sectionGet =
1877         (\x -> [("", x)])
1878           . legacyConfigureFlags
1879     , sectionSet =
1880         \lineno unused confflags pkgconf -> do
1881           unless (null unused) $
1882             syntaxError lineno "the section 'program-locations' takes no arguments"
1883           return
1884             pkgconf
1885               { legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
1886               }
1887     , sectionEmpty = mempty
1888     }
1889
1890 -- | For each known program @PROG@ in 'progDb', produce a @PROG-options@
1891 -- 'OptionField'.
1892 programDbOptions
1893   :: ProgramDb
1894   -> ShowOrParseArgs
1895   -> (flags -> [(String, [String])])
1896   -> ([(String, [String])] -> (flags -> flags))
1897   -> [OptionField flags]
1898 programDbOptions progDb showOrParseArgs get' set =
1899   case showOrParseArgs of
1900     -- we don't want a verbose help text list so we just show a generic one:
1901     ShowArgs -> [programOptions "PROG"]
1902     ParseArgs ->
1903       map
1904         (programOptions . programName . fst)
1905         (knownPrograms progDb)
1906   where
1907     programOptions prog =
1908       option
1909         ""
1910         [prog ++ "-options"]
1911         ("give extra options to " ++ prog)
1912         get'
1913         set
1914         ( reqArg'
1915             "OPTS"
1916             (\args -> [(prog, splitArgs args)])
1917             ( \progArgs ->
1918                 [ joinsArgs args
1919                 | (prog', args) <- progArgs
1920                 , prog == prog'
1921                 ]
1922             )
1923         )
1924
1925     joinsArgs = unwords . map escape
1926     escape arg
1927       | any isSpace arg = "\"" ++ arg ++ "\""
1928       | otherwise = arg
1929
1930 -- The implementation is slight hack: we parse all as remote repository
1931 -- but if the url schema is file+noindex, we switch to local.
1932 remoteRepoSectionDescr :: SectionDescr GlobalFlags
1933 remoteRepoSectionDescr =
1934   SectionDescr
1935     { sectionName = "repository"
1936     , sectionEmpty = emptyRemoteRepo (RepoName "")
1937     , sectionFields = remoteRepoFields
1938     , sectionSubsections = []
1939     , sectionGet = getS
1940     , sectionSet = setS
1941     }
1942   where
1943     getS :: GlobalFlags -> [(String, RemoteRepo)]
1944     getS gf =
1945       map (\x -> (unRepoName $ remoteRepoName x, x)) (fromNubList (globalRemoteRepos gf))
1946         ++ map (\x -> (unRepoName $ localRepoName x, localToRemote x)) (fromNubList (globalLocalNoIndexRepos gf))
1947
1948     setS :: Int -> String -> RemoteRepo -> GlobalFlags -> ParseResult GlobalFlags
1949     setS lineno reponame repo0 conf = do
1950       repo1 <- postProcessRepo lineno reponame repo0
1951       case repo1 of
1952         Left repo ->
1953           return
1954             conf
1955               { globalLocalNoIndexRepos = overNubList (++ [repo]) (globalLocalNoIndexRepos conf)
1956               }
1957         Right repo ->
1958           return
1959             conf
1960               { globalRemoteRepos = overNubList (++ [repo]) (globalRemoteRepos conf)
1961               }
1962
1963     localToRemote :: LocalRepo -> RemoteRepo
1964     localToRemote (LocalRepo name path sharedCache) =
1965       (emptyRemoteRepo name)
1966         { remoteRepoURI = URI "file+noindex:" Nothing path "" (if sharedCache then "#shared-cache" else "")
1967         }
1968
1969 -------------------------------
1970 -- Local field utils
1971 --
1972
1973 -- | Parser combinator for simple fields which uses the field type's
1974 -- 'Monoid' instance for combining multiple occurrences of the field.
1975 monoidFieldParsec
1976   :: Monoid a
1977   => String
1978   -> (a -> Doc)
1979   -> ParsecParser a
1980   -> (b -> a)
1981   -> (a -> b -> b)
1982   -> FieldDescr b
1983 monoidFieldParsec name showF readF get' set =
1984   liftField get' set' $ ParseUtils.fieldParsec name showF readF
1985   where
1986     set' xs b = set (get' b `mappend` xs) b
1987
1988 -- TODO: [code cleanup] local redefinition that should replace the version in
1989 -- D.ParseUtils called showFilePath. This version escapes "." and "--" which
1990 -- otherwise are special syntax.
1991 showTokenQ :: String -> Doc
1992 showTokenQ "" = Disp.empty
1993 showTokenQ x@('-' : '-' : _) = Disp.text (show x)
1994 showTokenQ x@('.' : []) = Disp.text (show x)
1995 showTokenQ x = showToken x
1996
1997 -- Handy util
1998 addFields
1999   :: [FieldDescr a]
2000   -> ([FieldDescr a] -> [FieldDescr a])
2001 addFields = (++)