# LANGUAGE CPP , RecordWildCards , NamedFieldPuns , DeriveGeneric #

-- | Project configuration, implementation in terms of legacy types.
--
module Distribution.Client.ProjectConfig.Legacy (

    -- * Project config in terms of legacy types
    LegacyProjectConfig,
    parseLegacyProjectConfig,
    showLegacyProjectConfig,

    -- * Conversion to and from legacy config types
    commandLineFlagsToProjectConfig,
    convertLegacyProjectConfig,
    convertLegacyGlobalConfig,
    convertToLegacyProjectConfig,

    -- * Internals, just for tests
    parsePackageLocationTokenQ,
    renderPackageLocationToken,
  ) where

import Distribution.Client.ProjectConfig.Types
import Distribution.Client.Types
         ( RemoteRepo(..), emptyRemoteRepo )
import Distribution.Client.Dependency.Types
         ( ConstraintSource(..) )
import Distribution.Client.Config
         ( SavedConfig(..), remoteRepoFields )

import Distribution.Package
import Distribution.PackageDescription
         ( SourceRepo(..), RepoKind(..) )
import Distribution.PackageDescription.Parse
         ( sourceRepoFieldDescrs )
import Distribution.Simple.Compiler
         ( OptimisationLevel(..), DebugInfoLevel(..) )
import Distribution.Simple.Setup
         ( Flag(Flag), toFlag, fromFlagOrDefault
         , ConfigFlags(..), configureOptions
         , HaddockFlags(..), haddockOptions, defaultHaddockFlags
         , programConfigurationPaths', splitArgs
         , AllowNewer(..) )
import Distribution.Client.Setup
         ( GlobalFlags(..), globalCommand
         , ConfigExFlags(..), configureExOptions, defaultConfigExFlags
         , InstallFlags(..), installOptions, defaultInstallFlags )
import Distribution.Simple.Program
         ( programName, knownPrograms )
import Distribution.Simple.Program.Db
         ( ProgramDb, defaultProgramDb )
import Distribution.Client.Targets
         ( dispFlagAssignment, parseFlagAssignment )
import Distribution.Simple.Utils
         ( lowercase )
import Distribution.Utils.NubList
         ( toNubList, fromNubList, overNubList )
import Distribution.Simple.LocalBuildInfo
         ( toPathTemplate, fromPathTemplate )

import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP
         ( ReadP, (+++), (<++) )
import qualified Text.Read as Read
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint
         ( Doc, ($+$) )
import qualified Distribution.ParseUtils as ParseUtils (field)
import Distribution.ParseUtils
         ( ParseResult(..), PError(..), syntaxError, PWarning(..), warning
         , simpleField, commaNewLineListField
         , showToken )
import Distribution.Client.ParseUtils
import Distribution.Simple.Command
         ( CommandUI(commandOptions), ShowOrParseArgs(..)
         , OptionField, option, reqArg' )

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Monad
import qualified Data.Map as Map
import Data.Char (isSpace)
import Distribution.Compat.Semigroup
import GHC.Generics (Generic)

------------------------------------------------------------------
-- Representing the project config file in terms of legacy types
--

  | We already have parsers\/pretty - printers for almost all the fields in the
-- project config file, but they're in terms of the types used for the command
-- line flags for Setup.hs or cabal commands. We don't want to redefine them
-- all, at least not yet so for the moment we use the parsers at the old types
-- and use conversion functions.
--
-- Ultimately if\/when this project-based approach becomes the default then we
-- can redefine the parsers directly for the new types.
--
data LegacyProjectConfig = LegacyProjectConfig {
       legacyPackages          :: [String],
       legacyPackagesOptional  :: [String],
       legacyPackagesRepo      :: [SourceRepo],
       legacyPackagesNamed     :: [Dependency],

       legacySharedConfig      :: LegacySharedConfig,
       legacyLocalConfig       :: LegacyPackageConfig,
       legacySpecificConfig    :: MapMappend PackageName LegacyPackageConfig
     } deriving Generic

instance Monoid LegacyProjectConfig where
  mempty  = gmempty
  mappend = (<>)

instance Semigroup LegacyProjectConfig where
  (<>) = gmappend

data LegacyPackageConfig = LegacyPackageConfig {
       legacyConfigureFlags    :: ConfigFlags,
       legacyInstallPkgFlags   :: InstallFlags,
       legacyHaddockFlags      :: HaddockFlags
     } deriving Generic

instance Monoid LegacyPackageConfig where
  mempty  = gmempty
  mappend = (<>)

instance Semigroup LegacyPackageConfig where
  (<>) = gmappend

data LegacySharedConfig = LegacySharedConfig {
       legacyGlobalFlags       :: GlobalFlags,
       legacyConfigureShFlags  :: ConfigFlags,
       legacyConfigureExFlags  :: ConfigExFlags,
       legacyInstallFlags      :: InstallFlags
     } deriving Generic

instance Monoid LegacySharedConfig where
  mempty  = gmempty
  mappend = (<>)

instance Semigroup LegacySharedConfig where
  (<>) = gmappend


------------------------------------------------------------------
-- Converting from and to the legacy types
--

  | Convert configuration from the  configure@ or  build@ command
-- line into a 'ProjectConfig' value that can combined with configuration from
-- other sources.
--
-- At the moment this uses the legacy command line flag types. See
  '  ' for an explanation .
--
commandLineFlagsToProjectConfig :: GlobalFlags
                                -> ConfigFlags  -> ConfigExFlags
                                -> InstallFlags -> HaddockFlags
                                -> ProjectConfig
commandLineFlagsToProjectConfig globalFlags configFlags configExFlags
                                installFlags haddockFlags =
    mempty {
      projectConfigBuildOnly     = convertLegacyBuildOnlyFlags
                                     globalFlags configFlags
                                     installFlags haddockFlags,
      projectConfigShared        = convertLegacyAllPackageFlags
                                     globalFlags configFlags
                                     configExFlags installFlags,
      projectConfigLocalPackages = convertLegacyPerPackageFlags
                                     configFlags installFlags haddockFlags
    }


-- | Convert from the types currently used for the user-wide @~/.cabal/config@
-- file into the 'ProjectConfig' type.
--
-- Only a subset of the 'ProjectConfig' can be represented in the user-wide
-- config. In particular it does not include packages that are in the project,
-- and it also doesn't support package-specific configuration (only
-- configuration that applies to all packages).
--
convertLegacyGlobalConfig :: SavedConfig -> ProjectConfig
convertLegacyGlobalConfig
    SavedConfig {
      savedGlobalFlags       = globalFlags,
      savedInstallFlags      = installFlags,
      savedConfigureFlags    = configFlags,
      savedConfigureExFlags  = configExFlags,
      savedUserInstallDirs   = _,
      savedGlobalInstallDirs = _,
      savedUploadFlags       = _,
      savedReportFlags       = _,
      savedHaddockFlags      = haddockFlags
    } =
    mempty {
      projectConfigShared        = configAllPackages,
      projectConfigLocalPackages = configLocalPackages,
      projectConfigBuildOnly     = configBuildOnly
    }
  where
    --TODO: [code cleanup] eliminate use of default*Flags here and specify the
    -- defaults in the various resolve functions in terms of the new types.
    configExFlags' = defaultConfigExFlags <> configExFlags
    installFlags'  = defaultInstallFlags  <> installFlags
    haddockFlags'  = defaultHaddockFlags  <> haddockFlags

    configLocalPackages = convertLegacyPerPackageFlags
                            configFlags installFlags' haddockFlags'
    configAllPackages   = convertLegacyAllPackageFlags
                            globalFlags configFlags
                            configExFlags' installFlags'
    configBuildOnly     = convertLegacyBuildOnlyFlags
                            globalFlags configFlags
                            installFlags' haddockFlags'


-- | Convert the project config from the legacy types to the 'ProjectConfig'
  and associated types . See '  ' for an explanation of the
-- approach.
--
convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig
convertLegacyProjectConfig
  LegacyProjectConfig {
    legacyPackages,
    legacyPackagesOptional,
    legacyPackagesRepo,
    legacyPackagesNamed,
    legacySharedConfig = LegacySharedConfig globalFlags configShFlags
                                            configExFlags installSharedFlags,
    legacyLocalConfig  = LegacyPackageConfig configFlags installPerPkgFlags
                                             haddockFlags,
    legacySpecificConfig
  } =

    ProjectConfig {
      projectPackages              = legacyPackages,
      projectPackagesOptional      = legacyPackagesOptional,
      projectPackagesRepo          = legacyPackagesRepo,
      projectPackagesNamed         = legacyPackagesNamed,

      projectConfigBuildOnly       = configBuildOnly,
      projectConfigShared          = configAllPackages,
      projectConfigLocalPackages   = configLocalPackages,
      projectConfigSpecificPackage = fmap perPackage legacySpecificConfig
    }
  where
    configLocalPackages = convertLegacyPerPackageFlags
                            configFlags installPerPkgFlags haddockFlags
    configAllPackages   = convertLegacyAllPackageFlags
                            globalFlags (configFlags <> configShFlags)
                            configExFlags installSharedFlags
    configBuildOnly     = convertLegacyBuildOnlyFlags
                            globalFlags configShFlags
                            installSharedFlags haddockFlags

    perPackage (LegacyPackageConfig perPkgConfigFlags perPkgInstallFlags
                                    perPkgHaddockFlags) =
      convertLegacyPerPackageFlags
        perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags


-- | Helper used by other conversion functions that returns the
-- 'ProjectConfigShared' subset of the 'ProjectConfig'.
--
convertLegacyAllPackageFlags :: GlobalFlags -> ConfigFlags
                             -> ConfigExFlags -> InstallFlags
                             -> ProjectConfigShared
convertLegacyAllPackageFlags globalFlags configFlags
                             configExFlags installFlags =
    ProjectConfigShared{..}
  where
    GlobalFlags {
      globalConfigFile        = _, -- TODO: [required feature]
      globalSandboxConfigFile = _, -- ??
      globalRemoteRepos       = projectConfigRemoteRepos,
      globalLocalRepos        = projectConfigLocalRepos
    } = globalFlags

    ConfigFlags {
      configHcFlavor            = projectConfigHcFlavor,
      configHcPath              = projectConfigHcPath,
      configHcPkg               = projectConfigHcPkg,
configInstallDirs          = projectConfigInstallDirs ,
    --configUserInstall         = projectConfigUserInstall,
configPackageDBs           = projectConfigPackageDBs ,
      configAllowNewer          = projectConfigAllowNewer
    } = configFlags

    ConfigExFlags {
      configCabalVersion        = projectConfigCabalVersion,
      configExConstraints       = projectConfigConstraints,
      configPreferences         = projectConfigPreferences,
      configSolver              = projectConfigSolver
    } = configExFlags

    InstallFlags {
      installHaddockIndex       = projectConfigHaddockIndex,
    --installReinstall          = projectConfigReinstall,
    --installAvoidReinstalls    = projectConfigAvoidReinstalls,
    --installOverrideReinstall  = projectConfigOverrideReinstall,
      installMaxBackjumps       = projectConfigMaxBackjumps,
    --installUpgradeDeps        = projectConfigUpgradeDeps,
      installReorderGoals       = projectConfigReorderGoals,
    --installIndependentGoals   = projectConfigIndependentGoals,
installShadowPkgs          = projectConfigShadowPkgs ,
      installStrongFlags        = projectConfigStrongFlags
    } = installFlags



-- | Helper used by other conversion functions that returns the
-- 'PackageConfig' subset of the 'ProjectConfig'.
--
convertLegacyPerPackageFlags :: ConfigFlags -> InstallFlags -> HaddockFlags
                             -> PackageConfig
convertLegacyPerPackageFlags configFlags installFlags haddockFlags =
    PackageConfig{..}
  where
    ConfigFlags {
      configProgramPaths,
      configProgramArgs,
      configProgramPathExtra    = packageConfigProgramPathExtra,
      configVanillaLib          = packageConfigVanillaLib,
      configProfLib             = packageConfigProfLib,
      configSharedLib           = packageConfigSharedLib,
      configDynExe              = packageConfigDynExe,
      configProfExe             = packageConfigProfExe,
      configProf                = packageConfigProf,
      configProfDetail          = packageConfigProfDetail,
      configProfLibDetail       = packageConfigProfLibDetail,
      configConfigureArgs       = packageConfigConfigureArgs,
      configOptimization        = packageConfigOptimization,
      configProgPrefix          = packageConfigProgPrefix,
      configProgSuffix          = packageConfigProgSuffix,
      configGHCiLib             = packageConfigGHCiLib,
      configSplitObjs           = packageConfigSplitObjs,
      configStripExes           = packageConfigStripExes,
      configStripLibs           = packageConfigStripLibs,
      configExtraLibDirs        = packageConfigExtraLibDirs,
      configExtraFrameworkDirs  = packageConfigExtraFrameworkDirs,
      configExtraIncludeDirs    = packageConfigExtraIncludeDirs,
      configConfigurationsFlags = packageConfigFlagAssignment,
      configTests               = packageConfigTests,
      configBenchmarks          = packageConfigBenchmarks,
      configCoverage            = coverage,
      configLibCoverage         = libcoverage, --deprecated
      configDebugInfo           = packageConfigDebugInfo,
      configRelocatable         = packageConfigRelocatable
    } = configFlags
    packageConfigProgramPaths   = MapLast    (Map.fromList configProgramPaths)
    packageConfigProgramArgs    = MapMappend (Map.fromList configProgramArgs)

    packageConfigCoverage       = coverage <> libcoverage
    --TODO: defer this merging to the resolve phase

    InstallFlags {
      installDocumentation      = packageConfigDocumentation,
      installRunTests           = packageConfigRunTests
    } = installFlags

    HaddockFlags {
      haddockHoogle             = packageConfigHaddockHoogle,
      haddockHtml               = packageConfigHaddockHtml,
      haddockHtmlLocation       = packageConfigHaddockHtmlLocation,
      haddockExecutables        = packageConfigHaddockExecutables,
      haddockTestSuites         = packageConfigHaddockTestSuites,
      haddockBenchmarks         = packageConfigHaddockBenchmarks,
      haddockInternal           = packageConfigHaddockInternal,
      haddockCss                = packageConfigHaddockCss,
      haddockHscolour           = packageConfigHaddockHscolour,
      haddockHscolourCss        = packageConfigHaddockHscolourCss,
      haddockContents           = packageConfigHaddockContents
    } = haddockFlags



-- | Helper used by other conversion functions that returns the
-- 'ProjectConfigBuildOnly' subset of the 'ProjectConfig'.
--
convertLegacyBuildOnlyFlags :: GlobalFlags -> ConfigFlags
                            -> InstallFlags -> HaddockFlags
                            -> ProjectConfigBuildOnly
convertLegacyBuildOnlyFlags globalFlags configFlags
                              installFlags haddockFlags =
    ProjectConfigBuildOnly{..}
  where
    GlobalFlags {
      globalCacheDir          = projectConfigCacheDir,
      globalLogsDir           = projectConfigLogsDir,
      globalWorldFile         = projectConfigWorldFile,
      globalHttpTransport     = projectConfigHttpTransport,
      globalIgnoreExpiry      = projectConfigIgnoreExpiry
    } = globalFlags

    ConfigFlags {
      configVerbosity           = projectConfigVerbosity
    } = configFlags

    InstallFlags {
      installDryRun             = projectConfigDryRun,
      installOnly               = _,
      installOnlyDeps           = projectConfigOnlyDeps,
      installRootCmd            = projectConfigRootCmd,
      installSummaryFile        = projectConfigSummaryFile,
      installLogFile            = projectConfigLogFile,
      installBuildReports       = projectConfigBuildReports,
      installReportPlanningFailure = projectConfigReportPlanningFailure,
      installSymlinkBinDir      = projectConfigSymlinkBinDir,
      installOneShot            = projectConfigOneShot,
      installNumJobs            = projectConfigNumJobs,
      installOfflineMode        = projectConfigOfflineMode
    } = installFlags

    HaddockFlags {
      haddockKeepTempFiles      = projectConfigKeepTempFiles --TODO: this ought to live elsewhere
    } = haddockFlags


convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
convertToLegacyProjectConfig
    projectConfig@ProjectConfig {
      projectPackages,
      projectPackagesOptional,
      projectPackagesRepo,
      projectPackagesNamed,
      projectConfigLocalPackages,
      projectConfigSpecificPackage
    } =
    LegacyProjectConfig {
      legacyPackages         = projectPackages,
      legacyPackagesOptional = projectPackagesOptional,
      legacyPackagesRepo     = projectPackagesRepo,
      legacyPackagesNamed    = projectPackagesNamed,
      legacySharedConfig     = convertToLegacySharedConfig projectConfig,
      legacyLocalConfig      = convertToLegacyAllPackageConfig projectConfig
                            <> convertToLegacyPerPackageConfig
                                 projectConfigLocalPackages,
      legacySpecificConfig   = fmap convertToLegacyPerPackageConfig
                                    projectConfigSpecificPackage
    }

convertToLegacySharedConfig :: ProjectConfig -> LegacySharedConfig
convertToLegacySharedConfig
    ProjectConfig {
      projectConfigBuildOnly     = ProjectConfigBuildOnly {..},
      projectConfigShared        = ProjectConfigShared {..}
    } =

    LegacySharedConfig {
      legacyGlobalFlags      = globalFlags,
      legacyConfigureShFlags = configFlags,
      legacyConfigureExFlags = configExFlags,
      legacyInstallFlags     = installFlags
    }
  where
    globalFlags = GlobalFlags {
      globalVersion           = mempty,
      globalNumericVersion    = mempty,
      globalConfigFile        = mempty,
      globalSandboxConfigFile = mempty,
      globalConstraintsFile   = mempty,
      globalRemoteRepos       = projectConfigRemoteRepos,
      globalCacheDir          = projectConfigCacheDir,
      globalLocalRepos        = projectConfigLocalRepos,
      globalLogsDir           = projectConfigLogsDir,
      globalWorldFile         = projectConfigWorldFile,
      globalRequireSandbox    = mempty,
      globalIgnoreSandbox     = mempty,
      globalIgnoreExpiry      = projectConfigIgnoreExpiry,
      globalHttpTransport     = projectConfigHttpTransport
    }

    configFlags = mempty {
      configVerbosity     = projectConfigVerbosity,
      configAllowNewer    = projectConfigAllowNewer
    }

    configExFlags = ConfigExFlags {
      configCabalVersion  = projectConfigCabalVersion,
      configExConstraints = projectConfigConstraints,
      configPreferences   = projectConfigPreferences,
      configSolver        = projectConfigSolver
    }

    installFlags = InstallFlags {
      installDocumentation     = mempty,
      installHaddockIndex      = projectConfigHaddockIndex,
      installDryRun            = projectConfigDryRun,
      installReinstall         = mempty, --projectConfigReinstall,
      installAvoidReinstalls   = mempty, --projectConfigAvoidReinstalls,
      installOverrideReinstall = mempty, --projectConfigOverrideReinstall,
      installMaxBackjumps      = projectConfigMaxBackjumps,
      installUpgradeDeps       = mempty, --projectConfigUpgradeDeps,
      installReorderGoals      = projectConfigReorderGoals,
      installIndependentGoals  = mempty, --projectConfigIndependentGoals,
projectConfigShadowPkgs ,
      installStrongFlags       = projectConfigStrongFlags,
      installOnly              = mempty,
      installOnlyDeps          = projectConfigOnlyDeps,
      installRootCmd           = projectConfigRootCmd,
      installSummaryFile       = projectConfigSummaryFile,
      installLogFile           = projectConfigLogFile,
      installBuildReports      = projectConfigBuildReports,
      installReportPlanningFailure = projectConfigReportPlanningFailure,
      installSymlinkBinDir     = projectConfigSymlinkBinDir,
      installOneShot           = projectConfigOneShot,
      installNumJobs           = projectConfigNumJobs,
      installRunTests          = mempty,
      installOfflineMode       = projectConfigOfflineMode
    }


convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig
convertToLegacyAllPackageConfig
    ProjectConfig {
      projectConfigBuildOnly = ProjectConfigBuildOnly {..},
      projectConfigShared    = ProjectConfigShared {..}
    } =

    LegacyPackageConfig {
      legacyConfigureFlags = configFlags,
      legacyInstallPkgFlags= mempty,
      legacyHaddockFlags   = haddockFlags
    }
  where
    configFlags = ConfigFlags {
      configPrograms_           = mempty,
      configProgramPaths        = mempty,
      configProgramArgs         = mempty,
      configProgramPathExtra    = mempty,
      configHcFlavor            = projectConfigHcFlavor,
      configHcPath              = projectConfigHcPath,
      configHcPkg               = projectConfigHcPkg,
      configVanillaLib          = mempty,
      configProfLib             = mempty,
      configSharedLib           = mempty,
      configDynExe              = mempty,
      configProfExe             = mempty,
      configProf                = mempty,
      configProfDetail          = mempty,
      configProfLibDetail       = mempty,
      configConfigureArgs       = mempty,
      configOptimization        = mempty,
      configProgPrefix          = mempty,
      configProgSuffix          = mempty,
      configInstallDirs         = mempty,
      configScratchDir          = mempty,
      configDistPref            = mempty,
      configVerbosity           = mempty,
      configUserInstall         = mempty, --projectConfigUserInstall,
projectConfigPackageDBs ,
      configGHCiLib             = mempty,
      configSplitObjs           = mempty,
      configStripExes           = mempty,
      configStripLibs           = mempty,
      configExtraLibDirs        = mempty,
      configExtraFrameworkDirs  = mempty,
      configConstraints         = mempty,
      configDependencies        = mempty,
      configExtraIncludeDirs    = mempty,
      configIPID                = mempty,
      configConfigurationsFlags = mempty,
      configTests               = mempty,
      configCoverage            = mempty, --TODO: don't merge
      configLibCoverage         = mempty, --TODO: don't merge
      configExactConfiguration  = mempty,
      configBenchmarks          = mempty,
      configFlagError           = mempty,                --TODO: ???
      configRelocatable         = mempty,
      configDebugInfo           = mempty,
      configAllowNewer          = mempty
    }

    haddockFlags = mempty {
      haddockKeepTempFiles = projectConfigKeepTempFiles
    }


convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig
convertToLegacyPerPackageConfig PackageConfig {..} =
    LegacyPackageConfig {
      legacyConfigureFlags  = configFlags,
      legacyInstallPkgFlags = installFlags,
      legacyHaddockFlags    = haddockFlags
    }
  where
    configFlags = ConfigFlags {
      configPrograms_           = configPrograms_ mempty,
      configProgramPaths        = Map.toList (getMapLast packageConfigProgramPaths),
      configProgramArgs         = Map.toList (getMapMappend packageConfigProgramArgs),
      configProgramPathExtra    = packageConfigProgramPathExtra,
      configHcFlavor            = mempty,
      configHcPath              = mempty,
      configHcPkg               = mempty,
      configVanillaLib          = packageConfigVanillaLib,
      configProfLib             = packageConfigProfLib,
      configSharedLib           = packageConfigSharedLib,
      configDynExe              = packageConfigDynExe,
      configProfExe             = packageConfigProfExe,
      configProf                = packageConfigProf,
      configProfDetail          = packageConfigProfDetail,
      configProfLibDetail       = packageConfigProfLibDetail,
      configConfigureArgs       = packageConfigConfigureArgs,
      configOptimization        = packageConfigOptimization,
      configProgPrefix          = packageConfigProgPrefix,
      configProgSuffix          = packageConfigProgSuffix,
      configInstallDirs         = mempty,
      configScratchDir          = mempty,
      configDistPref            = mempty,
      configVerbosity           = mempty,
      configUserInstall         = mempty,
      configPackageDBs          = mempty,
      configGHCiLib             = packageConfigGHCiLib,
      configSplitObjs           = packageConfigSplitObjs,
      configStripExes           = packageConfigStripExes,
      configStripLibs           = packageConfigStripLibs,
      configExtraLibDirs        = packageConfigExtraLibDirs,
      configExtraFrameworkDirs  = packageConfigExtraFrameworkDirs,
      configConstraints         = mempty,
      configDependencies        = mempty,
      configExtraIncludeDirs    = packageConfigExtraIncludeDirs,
      configIPID                = mempty,
      configConfigurationsFlags = packageConfigFlagAssignment,
      configTests               = packageConfigTests,
      configCoverage            = packageConfigCoverage, --TODO: don't merge
      configLibCoverage         = packageConfigCoverage, --TODO: don't merge
      configExactConfiguration  = mempty,
      configBenchmarks          = packageConfigBenchmarks,
      configFlagError           = mempty,                --TODO: ???
      configRelocatable         = packageConfigRelocatable,
      configDebugInfo           = packageConfigDebugInfo,
      configAllowNewer          = mempty
    }

    installFlags = mempty {
      installDocumentation      = packageConfigDocumentation,
      installRunTests           = packageConfigRunTests
    }

    haddockFlags = HaddockFlags {
      haddockProgramPaths  = mempty,
      haddockProgramArgs   = mempty,
      haddockHoogle        = packageConfigHaddockHoogle,
      haddockHtml          = packageConfigHaddockHtml,
      haddockHtmlLocation  = packageConfigHaddockHtmlLocation,
      haddockForHackage    = mempty, --TODO: added recently
      haddockExecutables   = packageConfigHaddockExecutables,
      haddockTestSuites    = packageConfigHaddockTestSuites,
      haddockBenchmarks    = packageConfigHaddockBenchmarks,
      haddockInternal      = packageConfigHaddockInternal,
      haddockCss           = packageConfigHaddockCss,
      haddockHscolour      = packageConfigHaddockHscolour,
      haddockHscolourCss   = packageConfigHaddockHscolourCss,
      haddockContents      = packageConfigHaddockContents,
      haddockDistPref      = mempty,
      haddockKeepTempFiles = mempty,
      haddockVerbosity     = mempty
    }


------------------------------------------------
-- Parsing and showing the project config file
--

parseLegacyProjectConfig :: String -> ParseResult LegacyProjectConfig
parseLegacyProjectConfig =
    parseConfig legacyProjectConfigFieldDescrs
                legacyPackageConfigSectionDescrs
                mempty

showLegacyProjectConfig :: LegacyProjectConfig -> String
showLegacyProjectConfig config =
    Disp.render $
    showConfig  legacyProjectConfigFieldDescrs
                legacyPackageConfigSectionDescrs
                config
  $+$
    Disp.text ""


legacyProjectConfigFieldDescrs :: [FieldDescr LegacyProjectConfig]
legacyProjectConfigFieldDescrs =

    [ newLineListField "packages"
        (Disp.text . renderPackageLocationToken) parsePackageLocationTokenQ
        legacyPackages
        (\v flags -> flags { legacyPackages = v })
    , newLineListField "optional-packages"
        (Disp.text . renderPackageLocationToken) parsePackageLocationTokenQ
        legacyPackagesOptional
        (\v flags -> flags { legacyPackagesOptional = v })
    , commaNewLineListField "extra-packages"
        disp parse
        legacyPackagesNamed
        (\v flags -> flags { legacyPackagesNamed = v })
    ]

 ++ map (liftField
           legacySharedConfig
           (\flags conf -> conf { legacySharedConfig = flags }))
        legacySharedConfigFieldDescrs

 ++ map (liftField
           legacyLocalConfig
           (\flags conf -> conf { legacyLocalConfig = flags }))
        legacyPackageConfigFieldDescrs

-- | This is a bit tricky since it has to cover globs which have embedded @,@
-- chars. But we don't just want to parse strictly as a glob since we want to
-- allow http urls which don't parse as globs, and possibly some
-- system-dependent file paths. So we parse fairly liberally as a token, but
-- we allow @,@ inside matched @{}@ braces.
--
parsePackageLocationTokenQ :: ReadP r String
parsePackageLocationTokenQ = parseHaskellString
                   Parse.<++ parsePackageLocationToken
  where
    parsePackageLocationToken :: ReadP r String
    parsePackageLocationToken = fmap fst (Parse.gather outerTerm)
      where
        outerTerm   = alternateEither1 outerToken (braces innerTerm)
        innerTerm   = alternateEither  innerToken (braces innerTerm)
        outerToken  = Parse.munch1 outerChar >> return ()
        innerToken  = Parse.munch1 innerChar >> return ()
        outerChar c = not (isSpace c || c == '{' || c == '}' || c == ',')
        innerChar c = not (isSpace c || c == '{' || c == '}')
        braces      = Parse.between (Parse.char '{') (Parse.char '}')

    alternateEither, alternateEither1,
      alternatePQs, alternate1PQs, alternateQsP, alternate1QsP
      :: ReadP r () -> ReadP r () -> ReadP r ()

    alternateEither1 p q = alternate1PQs p q +++ alternate1QsP q p
    alternateEither  p q = alternateEither1 p q +++ return ()
    alternate1PQs    p q = p >> alternateQsP q p
    alternatePQs     p q = alternate1PQs p q +++ return ()
    alternate1QsP    q p = Parse.many1 q >> alternatePQs p q
    alternateQsP     q p = alternate1QsP q p +++ return ()

renderPackageLocationToken :: String -> String
renderPackageLocationToken s | needsQuoting = show s
                             | otherwise    = s
  where
    needsQuoting  = not (ok 0 s)
                 || s == "." -- . on its own on a line has special meaning
                 || take 2 s == "--" -- on its own line is comment syntax
                 --TODO: [code cleanup] these "." and "--" escaping issues
  ought to be dealt with systematically in ParseUtils .
    ok :: Int -> String -> Bool
    ok n []       = n == 0
    ok _ ('"':_)  = False
    ok n ('{':cs) = ok (n+1) cs
    ok n ('}':cs) = ok (n-1) cs
    ok n (',':cs) = (n > 0) && ok n cs
    ok _ (c:_)
      | isSpace c = False
    ok n (_  :cs) = ok n cs


legacySharedConfigFieldDescrs :: [FieldDescr LegacySharedConfig]
legacySharedConfigFieldDescrs =

  ( liftFields
      legacyGlobalFlags
      (\flags conf -> conf { legacyGlobalFlags = flags })
  . addFields
      [ newLineListField "local-repo"
          showTokenQ parseTokenQ
          (fromNubList . globalLocalRepos)
          (\v conf -> conf { globalLocalRepos = toNubList v })
      ]
  . filterFields
      [ "remote-repo-cache"
      , "logs-dir", "world-file", "ignore-expiry", "http-transport"
      ]
  . commandOptionsToFields
  ) (commandOptions (globalCommand []) ParseArgs)
 ++
  ( liftFields
      legacyConfigureShFlags
      (\flags conf -> conf { legacyConfigureShFlags = flags })
  . addFields
      [ simpleField "allow-newer"
        (maybe mempty dispAllowNewer) (fmap Just parseAllowNewer)
        configAllowNewer (\v conf -> conf { configAllowNewer = v })
      ]
  . filterFields ["verbose"]
  . commandOptionsToFields
  ) (configureOptions ParseArgs)
 ++
  ( liftFields
      legacyConfigureExFlags
      (\flags conf -> conf { legacyConfigureExFlags = flags })
  . addFields
      [ commaNewLineListField "constraints"
        (disp . fst) (fmap (\constraint -> (constraint, constraintSrc)) parse)
        configExConstraints (\v conf -> conf { configExConstraints = v })

      , commaNewLineListField "preferences"
        disp parse
        configPreferences (\v conf -> conf { configPreferences = v })
      ]
  . filterFields
      [ "cabal-lib-version", "solver"
        -- not "constraint" or "preference", we use our own plural ones above
      ]
  . commandOptionsToFields
  ) (configureExOptions ParseArgs constraintSrc)
 ++
  ( liftFields
      legacyInstallFlags
      (\flags conf -> conf { legacyInstallFlags = flags })
  . addFields
      [ newLineListField "build-summary"
          (showTokenQ . fromPathTemplate) (fmap toPathTemplate parseTokenQ)
          (fromNubList . installSummaryFile)
          (\v conf -> conf { installSummaryFile = toNubList v })
      ]
  . filterFields
      [ "doc-index-file"
      , "root-cmd", "symlink-bindir"
      , "build-log"
      , "remote-build-reporting", "report-planning-failure"
      , "one-shot", "jobs", "offline"
        -- solver flags:
      , "max-backjumps", "reorder-goals", "strong-flags"
      ]
  . commandOptionsToFields
  ) (installOptions ParseArgs)
  where
    constraintSrc = ConstraintSourceProjectConfig "TODO"

parseAllowNewer :: ReadP r AllowNewer
parseAllowNewer =
     ((const AllowNewerNone <$> (Parse.string "none" +++ Parse.string "None"))
  +++ (const AllowNewerAll  <$> (Parse.string "all"  +++ Parse.string "All")))
  <++ (      AllowNewerSome <$> parseOptCommaList parse)

dispAllowNewer :: AllowNewer -> Doc
dispAllowNewer  AllowNewerNone       = Disp.text "None"
dispAllowNewer (AllowNewerSome pkgs) = Disp.fsep . Disp.punctuate Disp.comma
                                                 . map disp $ pkgs
dispAllowNewer  AllowNewerAll        = Disp.text "All"


legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
legacyPackageConfigFieldDescrs =
  ( liftFields
      legacyConfigureFlags
      (\flags conf -> conf { legacyConfigureFlags = flags })
  . addFields
      [ newLineListField "extra-include-dirs"
          showTokenQ parseTokenQ
          configExtraIncludeDirs
          (\v conf -> conf { configExtraIncludeDirs = v })
      , newLineListField "extra-lib-dirs"
          showTokenQ parseTokenQ
          configExtraLibDirs
          (\v conf -> conf { configExtraLibDirs = v })
      , newLineListField "extra-framework-dirs"
          showTokenQ parseTokenQ
          configExtraFrameworkDirs
          (\v conf -> conf { configExtraFrameworkDirs = v })
      , newLineListField "extra-prog-path"
          showTokenQ parseTokenQ
          (fromNubList . configProgramPathExtra)
          (\v conf -> conf { configProgramPathExtra = toNubList v })
      , newLineListField "configure-options"
          showTokenQ parseTokenQ
          configConfigureArgs
          (\v conf -> conf { configConfigureArgs = v })
      , simpleField "flags"
          dispFlagAssignment parseFlagAssignment
          configConfigurationsFlags
          (\v conf -> conf { configConfigurationsFlags = v })
      ]
  . filterFields
      [ "compiler", "with-compiler", "with-hc-pkg"
      , "program-prefix", "program-suffix"
      , "library-vanilla", "library-profiling"
      , "shared", "executable-dynamic"
      , "profiling", "executable-profiling"
      , "profiling-detail", "library-profiling-detail"
      , "optimization", "debug-info", "library-for-ghci", "split-objs"
      , "executable-stripping", "library-stripping"
      , "tests", "benchmarks"
      , "coverage", "library-coverage"
      , "relocatable"
        -- not "extra-include-dirs", "extra-lib-dirs", "extra-framework-dirs"
        -- or "extra-prog-path". We use corrected ones above that parse
        -- as list fields.
      ]
  . commandOptionsToFields
  ) (configureOptions ParseArgs)
 ++
    liftFields
      legacyConfigureFlags
      (\flags conf -> conf { legacyConfigureFlags = flags })
    [ overrideFieldCompiler
    , overrideFieldOptimization
    , overrideFieldDebugInfo
    ]
 ++
  ( liftFields
      legacyInstallPkgFlags
      (\flags conf -> conf { legacyInstallPkgFlags = flags })
  . filterFields
      [ "documentation", "run-tests"
      ]
  . commandOptionsToFields
  ) (installOptions ParseArgs)
 ++
  ( liftFields
      legacyHaddockFlags
      (\flags conf -> conf { legacyHaddockFlags = flags })
  . mapFieldNames
      ("haddock-"++)
  . filterFields
      [ "hoogle", "html", "html-location"
      , "executables", "tests", "benchmarks", "all", "internal", "css"
      , "hyperlink-source", "hscolour-css"
      , "contents-location", "keep-temp-files"
      ]
  . commandOptionsToFields
  ) (haddockOptions ParseArgs)

  where
    overrideFieldCompiler =
      simpleField "compiler"
        (fromFlagOrDefault Disp.empty . fmap disp)
        (Parse.option mempty (fmap toFlag parse))
        configHcFlavor (\v flags -> flags { configHcFlavor = v })


    -- TODO: [code cleanup] The following is a hack. The "optimization" and
  " debug - info " fields are OptArg , and viewAsFieldDescr fails on that .
    -- Instead of a hand-written parser and printer, we should handle this case
    -- properly in the library.

    overrideFieldOptimization =
      liftField configOptimization
                (\v flags -> flags { configOptimization = v }) $
      let name = "optimization" in
      FieldDescr name
        (\f -> case f of
                 Flag NoOptimisation      -> Disp.text "False"
                 Flag NormalOptimisation  -> Disp.text "True"
                 Flag MaximumOptimisation -> Disp.text "2"
                 _                        -> Disp.empty)
        (\line str _ -> case () of
         _ |  str == "False" -> ParseOk [] (Flag NoOptimisation)
           |  str == "True"  -> ParseOk [] (Flag NormalOptimisation)
           |  str == "0"     -> ParseOk [] (Flag NoOptimisation)
           |  str == "1"     -> ParseOk [] (Flag NormalOptimisation)
           |  str == "2"     -> ParseOk [] (Flag MaximumOptimisation)
           | lstr == "false" -> ParseOk [caseWarning] (Flag NoOptimisation)
           | lstr == "true"  -> ParseOk [caseWarning] (Flag NormalOptimisation)
           | otherwise       -> ParseFailed (NoParse name line)
           where
             lstr = lowercase str
             caseWarning = PWarning $
               "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")

    overrideFieldDebugInfo =
      liftField configDebugInfo (\v flags -> flags { configDebugInfo = v }) $
      let name = "debug-info" in
      FieldDescr name
        (\f -> case f of
                 Flag NoDebugInfo      -> Disp.text "False"
                 Flag MinimalDebugInfo -> Disp.text "1"
                 Flag NormalDebugInfo  -> Disp.text "True"
                 Flag MaximalDebugInfo -> Disp.text "3"
                 _                     -> Disp.empty)
        (\line str _ -> case () of
         _ |  str == "False" -> ParseOk [] (Flag NoDebugInfo)
           |  str == "True"  -> ParseOk [] (Flag NormalDebugInfo)
           |  str == "0"     -> ParseOk [] (Flag NoDebugInfo)
           |  str == "1"     -> ParseOk [] (Flag MinimalDebugInfo)
           |  str == "2"     -> ParseOk [] (Flag NormalDebugInfo)
           |  str == "3"     -> ParseOk [] (Flag MaximalDebugInfo)
           | lstr == "false" -> ParseOk [caseWarning] (Flag NoDebugInfo)
           | lstr == "true"  -> ParseOk [caseWarning] (Flag NormalDebugInfo)
           | otherwise       -> ParseFailed (NoParse name line)
           where
             lstr = lowercase str
             caseWarning = PWarning $
               "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")


legacyPackageConfigSectionDescrs :: [SectionDescr LegacyProjectConfig]
legacyPackageConfigSectionDescrs =
    [ packageRepoSectionDescr
    , packageSpecificOptionsSectionDescr
    , liftSection
        legacyLocalConfig
        (\flags conf -> conf { legacyLocalConfig = flags })
        programOptionsSectionDescr
    , liftSection
        legacyLocalConfig
        (\flags conf -> conf { legacyLocalConfig = flags })
        programLocationsSectionDescr
    , liftSection
        legacySharedConfig
        (\flags conf -> conf { legacySharedConfig = flags }) $
      liftSection
        legacyGlobalFlags
        (\flags conf -> conf { legacyGlobalFlags = flags })
        remoteRepoSectionDescr
    ]

packageRepoSectionDescr :: SectionDescr LegacyProjectConfig
packageRepoSectionDescr =
    SectionDescr {
      sectionName        = "source-repository-package",
      sectionFields      = sourceRepoFieldDescrs,
      sectionSubsections = [],
      sectionGet         = map (\x->("", x))
                         . legacyPackagesRepo,
      sectionSet         =
        \lineno unused pkgrepo projconf -> do
          unless (null unused) $
            syntaxError lineno "the section 'source-repository-package' takes no arguments"
          return projconf {
            legacyPackagesRepo = legacyPackagesRepo projconf ++ [pkgrepo]
          },
      sectionEmpty       = SourceRepo {
                             repoKind     = RepoThis, -- hopefully unused
                             repoType     = Nothing,
                             repoLocation = Nothing,
                             repoModule   = Nothing,
                             repoBranch   = Nothing,
                             repoTag      = Nothing,
                             repoSubdir   = Nothing
                           }
    }

packageSpecificOptionsSectionDescr :: SectionDescr LegacyProjectConfig
packageSpecificOptionsSectionDescr =
    SectionDescr {
      sectionName        = "package",
      sectionFields      = legacyPackageConfigFieldDescrs
                        ++ programOptionsFieldDescrs
                             (configProgramArgs . legacyConfigureFlags)
                             (\args pkgconf -> pkgconf {
                                 legacyConfigureFlags = (legacyConfigureFlags pkgconf) {
                                   configProgramArgs  = args
                                 }
                               }
                             )
                        ++ liftFields
                             legacyConfigureFlags
                             (\flags pkgconf -> pkgconf {
                                 legacyConfigureFlags = flags
                               }
                             )
                             programLocationsFieldDescrs,
      sectionSubsections = [],
      sectionGet         = \projconf ->
                             [ (display pkgname, pkgconf)
                             | (pkgname, pkgconf) <-
                                 Map.toList . getMapMappend
                               . legacySpecificConfig $ projconf ],
      sectionSet         =
        \lineno pkgnamestr pkgconf projconf -> do
          pkgname <- case simpleParse pkgnamestr of
            Just pkgname -> return pkgname
            Nothing      -> syntaxError lineno $
                                "a 'package' section requires a package name "
                             ++ "as an argument"
          return projconf {
            legacySpecificConfig =
              MapMappend $
              Map.insertWith mappend pkgname pkgconf
                             (getMapMappend $ legacySpecificConfig projconf)
          },
      sectionEmpty       = mempty
    }

programOptionsFieldDescrs :: (a -> [(String, [String])])
                          -> ([(String, [String])] -> a -> a)
                          -> [FieldDescr a]
programOptionsFieldDescrs get set =
    commandOptionsToFields
  $ programConfigurationOptions
      defaultProgramDb
      ParseArgs get set

programOptionsSectionDescr :: SectionDescr LegacyPackageConfig
programOptionsSectionDescr =
    SectionDescr {
      sectionName        = "program-options",
      sectionFields      = programOptionsFieldDescrs
                             configProgramArgs
                             (\args conf -> conf { configProgramArgs = args }),
      sectionSubsections = [],
      sectionGet         = (\x->[("", x)])
                         . legacyConfigureFlags,
      sectionSet         =
        \lineno unused confflags pkgconf -> do
          unless (null unused) $
            syntaxError lineno "the section 'program-options' takes no arguments"
          return pkgconf {
            legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
          },
      sectionEmpty       = mempty
    }

programLocationsFieldDescrs :: [FieldDescr ConfigFlags]
programLocationsFieldDescrs =
     commandOptionsToFields
   $ programConfigurationPaths'
       (++ "-location")
       defaultProgramDb
       ParseArgs
       configProgramPaths
       (\paths conf -> conf { configProgramPaths = paths })

programLocationsSectionDescr :: SectionDescr LegacyPackageConfig
programLocationsSectionDescr =
    SectionDescr {
      sectionName        = "program-locations",
      sectionFields      = programLocationsFieldDescrs,
      sectionSubsections = [],
      sectionGet         = (\x->[("", x)])
                         . legacyConfigureFlags,
      sectionSet         =
        \lineno unused confflags pkgconf -> do
          unless (null unused) $
            syntaxError lineno "the section 'program-locations' takes no arguments"
          return pkgconf {
            legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
          },
      sectionEmpty       = mempty
    }


  | For each known program @PROG@ in ' progConf ' , produce a @PROG - options@
-- 'OptionField'.
programConfigurationOptions
  :: ProgramDb
  -> ShowOrParseArgs
  -> (flags -> [(String, [String])])
  -> ([(String, [String])] -> (flags -> flags))
  -> [OptionField flags]
programConfigurationOptions progConf showOrParseArgs get set =
  case showOrParseArgs of
    -- we don't want a verbose help text list so we just show a generic one:
    ShowArgs  -> [programOptions  "PROG"]
    ParseArgs -> map (programOptions . programName . fst)
                 (knownPrograms progConf)
  where
    programOptions prog =
      option "" [prog ++ "-options"]
        ("give extra options to " ++ prog)
        get set
        (reqArg' "OPTS" (\args -> [(prog, splitArgs args)])
           (\progArgs -> [ joinsArgs args
                         | (prog', args) <- progArgs, prog==prog' ]))


    joinsArgs = unwords . map escape
    escape arg | any isSpace arg = "\"" ++ arg ++ "\""
               | otherwise       = arg


remoteRepoSectionDescr :: SectionDescr GlobalFlags
remoteRepoSectionDescr =
    SectionDescr {
      sectionName        = "repository",
      sectionFields      = remoteRepoFields,
      sectionSubsections = [],
      sectionGet         = map (\x->(remoteRepoName x, x)) . fromNubList
                         . globalRemoteRepos,
      sectionSet         =
        \lineno reponame repo0 conf -> do
          when (null reponame) $
            syntaxError lineno $ "a 'repository' section requires the "
                              ++ "repository name as an argument"
          let repo = repo0 { remoteRepoName = reponame }
          when (remoteRepoKeyThreshold repo
                 > length (remoteRepoRootKeys repo)) $
            warning $ "'key-threshold' for repository "
                   ++ show (remoteRepoName repo)
                   ++ " higher than number of keys"
          when (not (null (remoteRepoRootKeys repo))
                && remoteRepoSecure repo /= Just True) $
            warning $ "'root-keys' for repository "
                   ++ show (remoteRepoName repo)
                   ++ " non-empty, but 'secure' not set to True."
          return conf {
            globalRemoteRepos = overNubList (++[repo]) (globalRemoteRepos conf)
          },
      sectionEmpty       = emptyRemoteRepo ""
    }


-------------------------------
-- Local field utils
--

--TODO: [code cleanup] all these utils should move to Distribution.ParseUtils
-- either augmenting or replacing the ones there

TODO : [ code cleanup ] this is a different definition from listField , like
-- commaNewLineListField it pretty prints on multiple lines
newLineListField :: String -> (a -> Doc) -> ReadP [a] a
                 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
newLineListField = listFieldWithSep Disp.sep

--TODO: [code cleanup] local copy purely so we can use the fixed version
-- of parseOptCommaList below
listFieldWithSep :: ([Doc] -> Doc) -> String -> (a -> Doc) -> ReadP [a] a
                 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listFieldWithSep separator name showF readF get set =
  liftField get set' $
    ParseUtils.field name showF' (parseOptCommaList readF)
  where
    set' xs b = set (get b ++ xs) b
    showF'    = separator . map showF

--TODO: [code cleanup] local redefinition that should replace the version in
-- D.ParseUtils. This version avoid parse ambiguity for list element parsers
-- that have multiple valid parses of prefixes.
parseOptCommaList :: ReadP r a -> ReadP r [a]
parseOptCommaList p = Parse.sepBy p sep
  where
    -- The separator must not be empty or it introduces ambiguity
    sep = (Parse.skipSpaces >> Parse.char ',' >> Parse.skipSpaces)
      +++ (Parse.satisfy isSpace >> Parse.skipSpaces)

--TODO: [code cleanup] local redefinition that should replace the version in
  D.ParseUtils called showFilePath . This version escapes " . " and " -- " which
-- otherwise are special syntax.
showTokenQ :: String -> Doc
showTokenQ ""            = Disp.empty
showTokenQ x@('-':'-':_) = Disp.text (show x)
showTokenQ x@('.':[])    = Disp.text (show x)
showTokenQ x             = showToken x

  This is just a copy of parseTokenQ , using the fixed parseHaskellString
parseTokenQ :: ReadP r String
parseTokenQ = parseHaskellString
          <++ Parse.munch1 (\x -> not (isSpace x) && x /= ',')

--TODO: [code cleanup] use this to replace the parseHaskellString in
  Distribution . ParseUtils . It turns out Read instance for  accepts
-- the ['a', 'b'] syntax, which we do not want. In particular it messes
-- up any token starting with [].
parseHaskellString :: ReadP r String
parseHaskellString =
  Parse.readS_to_P $
    Read.readPrec_to_S (do Read.String s <- Read.lexP; return s) 0

  Handy util
addFields :: [FieldDescr a]
          -> ([FieldDescr a] -> [FieldDescr a])
addFields = (++)

 | Project configuration, implementation in terms of legacy types.

 * Project config in terms of legacy types
 * Conversion to and from legacy config types
 * Internals, just for tests
----------------------------------------------------------------
 Representing the project config file in terms of legacy types

 project config file, but they're in terms of the types used for the command
 line flags for Setup.hs or cabal commands. We don't want to redefine them
 all, at least not yet so for the moment we use the parsers at the old types
 and use conversion functions.

 Ultimately if\/when this project-based approach becomes the default then we
 can redefine the parsers directly for the new types.

----------------------------------------------------------------
 Converting from and to the legacy types

 line into a 'ProjectConfig' value that can combined with configuration from
 other sources.

 At the moment this uses the legacy command line flag types. See

 | Convert from the types currently used for the user-wide @~/.cabal/config@
 file into the 'ProjectConfig' type.

 Only a subset of the 'ProjectConfig' can be represented in the user-wide
 config. In particular it does not include packages that are in the project,
 and it also doesn't support package-specific configuration (only
 configuration that applies to all packages).

TODO: [code cleanup] eliminate use of default*Flags here and specify the
 defaults in the various resolve functions in terms of the new types.
 | Convert the project config from the legacy types to the 'ProjectConfig'
 approach.

 | Helper used by other conversion functions that returns the
 'ProjectConfigShared' subset of the 'ProjectConfig'.

 TODO: [required feature]
 ??
configUserInstall         = projectConfigUserInstall,
installReinstall          = projectConfigReinstall,
installAvoidReinstalls    = projectConfigAvoidReinstalls,
installOverrideReinstall  = projectConfigOverrideReinstall,
installUpgradeDeps        = projectConfigUpgradeDeps,
installIndependentGoals   = projectConfigIndependentGoals,
 | Helper used by other conversion functions that returns the
 'PackageConfig' subset of the 'ProjectConfig'.

deprecated
TODO: defer this merging to the resolve phase
 | Helper used by other conversion functions that returns the
 'ProjectConfigBuildOnly' subset of the 'ProjectConfig'.

TODO: this ought to live elsewhere
projectConfigReinstall,
projectConfigAvoidReinstalls,
projectConfigOverrideReinstall,
projectConfigUpgradeDeps,
projectConfigIndependentGoals,
projectConfigUserInstall,
TODO: don't merge
TODO: don't merge
TODO: ???
TODO: don't merge
TODO: don't merge
TODO: ???
TODO: added recently
----------------------------------------------
 Parsing and showing the project config file

 | This is a bit tricky since it has to cover globs which have embedded @,@
 chars. But we don't just want to parse strictly as a glob since we want to
 allow http urls which don't parse as globs, and possibly some
 system-dependent file paths. So we parse fairly liberally as a token, but
 we allow @,@ inside matched @{}@ braces.

 . on its own on a line has special meaning
 on its own line is comment syntax
TODO: [code cleanup] these "." and "--" escaping issues
 not "constraint" or "preference", we use our own plural ones above
 solver flags:
 not "extra-include-dirs", "extra-lib-dirs", "extra-framework-dirs"
 or "extra-prog-path". We use corrected ones above that parse
 as list fields.
 TODO: [code cleanup] The following is a hack. The "optimization" and
 Instead of a hand-written parser and printer, we should handle this case
 properly in the library.
 hopefully unused
 'OptionField'.
 we don't want a verbose help text list so we just show a generic one:
-----------------------------
 Local field utils

TODO: [code cleanup] all these utils should move to Distribution.ParseUtils
 either augmenting or replacing the ones there
 commaNewLineListField it pretty prints on multiple lines
TODO: [code cleanup] local copy purely so we can use the fixed version
 of parseOptCommaList below
TODO: [code cleanup] local redefinition that should replace the version in
 D.ParseUtils. This version avoid parse ambiguity for list element parsers
 that have multiple valid parses of prefixes.
 The separator must not be empty or it introduces ambiguity
TODO: [code cleanup] local redefinition that should replace the version in
 otherwise are special syntax.
TODO: [code cleanup] use this to replace the parseHaskellString in
 the ['a', 'b'] syntax, which we do not want. In particular it messes
 up any token starting with [].
# LANGUAGE CPP , RecordWildCards , NamedFieldPuns , DeriveGeneric #

module Distribution.Client.ProjectConfig.Legacy (

    LegacyProjectConfig,
    parseLegacyProjectConfig,
    showLegacyProjectConfig,

    commandLineFlagsToProjectConfig,
    convertLegacyProjectConfig,
    convertLegacyGlobalConfig,
    convertToLegacyProjectConfig,

    parsePackageLocationTokenQ,
    renderPackageLocationToken,
  ) where

import Distribution.Client.ProjectConfig.Types
import Distribution.Client.Types
         ( RemoteRepo(..), emptyRemoteRepo )
import Distribution.Client.Dependency.Types
         ( ConstraintSource(..) )
import Distribution.Client.Config
         ( SavedConfig(..), remoteRepoFields )

import Distribution.Package
import Distribution.PackageDescription
         ( SourceRepo(..), RepoKind(..) )
import Distribution.PackageDescription.Parse
         ( sourceRepoFieldDescrs )
import Distribution.Simple.Compiler
         ( OptimisationLevel(..), DebugInfoLevel(..) )
import Distribution.Simple.Setup
         ( Flag(Flag), toFlag, fromFlagOrDefault
         , ConfigFlags(..), configureOptions
         , HaddockFlags(..), haddockOptions, defaultHaddockFlags
         , programConfigurationPaths', splitArgs
         , AllowNewer(..) )
import Distribution.Client.Setup
         ( GlobalFlags(..), globalCommand
         , ConfigExFlags(..), configureExOptions, defaultConfigExFlags
         , InstallFlags(..), installOptions, defaultInstallFlags )
import Distribution.Simple.Program
         ( programName, knownPrograms )
import Distribution.Simple.Program.Db
         ( ProgramDb, defaultProgramDb )
import Distribution.Client.Targets
         ( dispFlagAssignment, parseFlagAssignment )
import Distribution.Simple.Utils
         ( lowercase )
import Distribution.Utils.NubList
         ( toNubList, fromNubList, overNubList )
import Distribution.Simple.LocalBuildInfo
         ( toPathTemplate, fromPathTemplate )

import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP
         ( ReadP, (+++), (<++) )
import qualified Text.Read as Read
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint
         ( Doc, ($+$) )
import qualified Distribution.ParseUtils as ParseUtils (field)
import Distribution.ParseUtils
         ( ParseResult(..), PError(..), syntaxError, PWarning(..), warning
         , simpleField, commaNewLineListField
         , showToken )
import Distribution.Client.ParseUtils
import Distribution.Simple.Command
         ( CommandUI(commandOptions), ShowOrParseArgs(..)
         , OptionField, option, reqArg' )

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Monad
import qualified Data.Map as Map
import Data.Char (isSpace)
import Distribution.Compat.Semigroup
import GHC.Generics (Generic)


  | We already have parsers\/pretty - printers for almost all the fields in the
data LegacyProjectConfig = LegacyProjectConfig {
       legacyPackages          :: [String],
       legacyPackagesOptional  :: [String],
       legacyPackagesRepo      :: [SourceRepo],
       legacyPackagesNamed     :: [Dependency],

       legacySharedConfig      :: LegacySharedConfig,
       legacyLocalConfig       :: LegacyPackageConfig,
       legacySpecificConfig    :: MapMappend PackageName LegacyPackageConfig
     } deriving Generic

instance Monoid LegacyProjectConfig where
  mempty  = gmempty
  mappend = (<>)

instance Semigroup LegacyProjectConfig where
  (<>) = gmappend

data LegacyPackageConfig = LegacyPackageConfig {
       legacyConfigureFlags    :: ConfigFlags,
       legacyInstallPkgFlags   :: InstallFlags,
       legacyHaddockFlags      :: HaddockFlags
     } deriving Generic

instance Monoid LegacyPackageConfig where
  mempty  = gmempty
  mappend = (<>)

instance Semigroup LegacyPackageConfig where
  (<>) = gmappend

data LegacySharedConfig = LegacySharedConfig {
       legacyGlobalFlags       :: GlobalFlags,
       legacyConfigureShFlags  :: ConfigFlags,
       legacyConfigureExFlags  :: ConfigExFlags,
       legacyInstallFlags      :: InstallFlags
     } deriving Generic

instance Monoid LegacySharedConfig where
  mempty  = gmempty
  mappend = (<>)

instance Semigroup LegacySharedConfig where
  (<>) = gmappend



  | Convert configuration from the  configure@ or  build@ command
  '  ' for an explanation .
commandLineFlagsToProjectConfig :: GlobalFlags
                                -> ConfigFlags  -> ConfigExFlags
                                -> InstallFlags -> HaddockFlags
                                -> ProjectConfig
commandLineFlagsToProjectConfig globalFlags configFlags configExFlags
                                installFlags haddockFlags =
    mempty {
      projectConfigBuildOnly     = convertLegacyBuildOnlyFlags
                                     globalFlags configFlags
                                     installFlags haddockFlags,
      projectConfigShared        = convertLegacyAllPackageFlags
                                     globalFlags configFlags
                                     configExFlags installFlags,
      projectConfigLocalPackages = convertLegacyPerPackageFlags
                                     configFlags installFlags haddockFlags
    }


convertLegacyGlobalConfig :: SavedConfig -> ProjectConfig
convertLegacyGlobalConfig
    SavedConfig {
      savedGlobalFlags       = globalFlags,
      savedInstallFlags      = installFlags,
      savedConfigureFlags    = configFlags,
      savedConfigureExFlags  = configExFlags,
      savedUserInstallDirs   = _,
      savedGlobalInstallDirs = _,
      savedUploadFlags       = _,
      savedReportFlags       = _,
      savedHaddockFlags      = haddockFlags
    } =
    mempty {
      projectConfigShared        = configAllPackages,
      projectConfigLocalPackages = configLocalPackages,
      projectConfigBuildOnly     = configBuildOnly
    }
  where
    configExFlags' = defaultConfigExFlags <> configExFlags
    installFlags'  = defaultInstallFlags  <> installFlags
    haddockFlags'  = defaultHaddockFlags  <> haddockFlags

    configLocalPackages = convertLegacyPerPackageFlags
                            configFlags installFlags' haddockFlags'
    configAllPackages   = convertLegacyAllPackageFlags
                            globalFlags configFlags
                            configExFlags' installFlags'
    configBuildOnly     = convertLegacyBuildOnlyFlags
                            globalFlags configFlags
                            installFlags' haddockFlags'


  and associated types . See '  ' for an explanation of the
convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig
convertLegacyProjectConfig
  LegacyProjectConfig {
    legacyPackages,
    legacyPackagesOptional,
    legacyPackagesRepo,
    legacyPackagesNamed,
    legacySharedConfig = LegacySharedConfig globalFlags configShFlags
                                            configExFlags installSharedFlags,
    legacyLocalConfig  = LegacyPackageConfig configFlags installPerPkgFlags
                                             haddockFlags,
    legacySpecificConfig
  } =

    ProjectConfig {
      projectPackages              = legacyPackages,
      projectPackagesOptional      = legacyPackagesOptional,
      projectPackagesRepo          = legacyPackagesRepo,
      projectPackagesNamed         = legacyPackagesNamed,

      projectConfigBuildOnly       = configBuildOnly,
      projectConfigShared          = configAllPackages,
      projectConfigLocalPackages   = configLocalPackages,
      projectConfigSpecificPackage = fmap perPackage legacySpecificConfig
    }
  where
    configLocalPackages = convertLegacyPerPackageFlags
                            configFlags installPerPkgFlags haddockFlags
    configAllPackages   = convertLegacyAllPackageFlags
                            globalFlags (configFlags <> configShFlags)
                            configExFlags installSharedFlags
    configBuildOnly     = convertLegacyBuildOnlyFlags
                            globalFlags configShFlags
                            installSharedFlags haddockFlags

    perPackage (LegacyPackageConfig perPkgConfigFlags perPkgInstallFlags
                                    perPkgHaddockFlags) =
      convertLegacyPerPackageFlags
        perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags


convertLegacyAllPackageFlags :: GlobalFlags -> ConfigFlags
                             -> ConfigExFlags -> InstallFlags
                             -> ProjectConfigShared
convertLegacyAllPackageFlags globalFlags configFlags
                             configExFlags installFlags =
    ProjectConfigShared{..}
  where
    GlobalFlags {
      globalRemoteRepos       = projectConfigRemoteRepos,
      globalLocalRepos        = projectConfigLocalRepos
    } = globalFlags

    ConfigFlags {
      configHcFlavor            = projectConfigHcFlavor,
      configHcPath              = projectConfigHcPath,
      configHcPkg               = projectConfigHcPkg,
configInstallDirs          = projectConfigInstallDirs ,
configPackageDBs           = projectConfigPackageDBs ,
      configAllowNewer          = projectConfigAllowNewer
    } = configFlags

    ConfigExFlags {
      configCabalVersion        = projectConfigCabalVersion,
      configExConstraints       = projectConfigConstraints,
      configPreferences         = projectConfigPreferences,
      configSolver              = projectConfigSolver
    } = configExFlags

    InstallFlags {
      installHaddockIndex       = projectConfigHaddockIndex,
      installMaxBackjumps       = projectConfigMaxBackjumps,
      installReorderGoals       = projectConfigReorderGoals,
installShadowPkgs          = projectConfigShadowPkgs ,
      installStrongFlags        = projectConfigStrongFlags
    } = installFlags



convertLegacyPerPackageFlags :: ConfigFlags -> InstallFlags -> HaddockFlags
                             -> PackageConfig
convertLegacyPerPackageFlags configFlags installFlags haddockFlags =
    PackageConfig{..}
  where
    ConfigFlags {
      configProgramPaths,
      configProgramArgs,
      configProgramPathExtra    = packageConfigProgramPathExtra,
      configVanillaLib          = packageConfigVanillaLib,
      configProfLib             = packageConfigProfLib,
      configSharedLib           = packageConfigSharedLib,
      configDynExe              = packageConfigDynExe,
      configProfExe             = packageConfigProfExe,
      configProf                = packageConfigProf,
      configProfDetail          = packageConfigProfDetail,
      configProfLibDetail       = packageConfigProfLibDetail,
      configConfigureArgs       = packageConfigConfigureArgs,
      configOptimization        = packageConfigOptimization,
      configProgPrefix          = packageConfigProgPrefix,
      configProgSuffix          = packageConfigProgSuffix,
      configGHCiLib             = packageConfigGHCiLib,
      configSplitObjs           = packageConfigSplitObjs,
      configStripExes           = packageConfigStripExes,
      configStripLibs           = packageConfigStripLibs,
      configExtraLibDirs        = packageConfigExtraLibDirs,
      configExtraFrameworkDirs  = packageConfigExtraFrameworkDirs,
      configExtraIncludeDirs    = packageConfigExtraIncludeDirs,
      configConfigurationsFlags = packageConfigFlagAssignment,
      configTests               = packageConfigTests,
      configBenchmarks          = packageConfigBenchmarks,
      configCoverage            = coverage,
      configDebugInfo           = packageConfigDebugInfo,
      configRelocatable         = packageConfigRelocatable
    } = configFlags
    packageConfigProgramPaths   = MapLast    (Map.fromList configProgramPaths)
    packageConfigProgramArgs    = MapMappend (Map.fromList configProgramArgs)

    packageConfigCoverage       = coverage <> libcoverage

    InstallFlags {
      installDocumentation      = packageConfigDocumentation,
      installRunTests           = packageConfigRunTests
    } = installFlags

    HaddockFlags {
      haddockHoogle             = packageConfigHaddockHoogle,
      haddockHtml               = packageConfigHaddockHtml,
      haddockHtmlLocation       = packageConfigHaddockHtmlLocation,
      haddockExecutables        = packageConfigHaddockExecutables,
      haddockTestSuites         = packageConfigHaddockTestSuites,
      haddockBenchmarks         = packageConfigHaddockBenchmarks,
      haddockInternal           = packageConfigHaddockInternal,
      haddockCss                = packageConfigHaddockCss,
      haddockHscolour           = packageConfigHaddockHscolour,
      haddockHscolourCss        = packageConfigHaddockHscolourCss,
      haddockContents           = packageConfigHaddockContents
    } = haddockFlags



convertLegacyBuildOnlyFlags :: GlobalFlags -> ConfigFlags
                            -> InstallFlags -> HaddockFlags
                            -> ProjectConfigBuildOnly
convertLegacyBuildOnlyFlags globalFlags configFlags
                              installFlags haddockFlags =
    ProjectConfigBuildOnly{..}
  where
    GlobalFlags {
      globalCacheDir          = projectConfigCacheDir,
      globalLogsDir           = projectConfigLogsDir,
      globalWorldFile         = projectConfigWorldFile,
      globalHttpTransport     = projectConfigHttpTransport,
      globalIgnoreExpiry      = projectConfigIgnoreExpiry
    } = globalFlags

    ConfigFlags {
      configVerbosity           = projectConfigVerbosity
    } = configFlags

    InstallFlags {
      installDryRun             = projectConfigDryRun,
      installOnly               = _,
      installOnlyDeps           = projectConfigOnlyDeps,
      installRootCmd            = projectConfigRootCmd,
      installSummaryFile        = projectConfigSummaryFile,
      installLogFile            = projectConfigLogFile,
      installBuildReports       = projectConfigBuildReports,
      installReportPlanningFailure = projectConfigReportPlanningFailure,
      installSymlinkBinDir      = projectConfigSymlinkBinDir,
      installOneShot            = projectConfigOneShot,
      installNumJobs            = projectConfigNumJobs,
      installOfflineMode        = projectConfigOfflineMode
    } = installFlags

    HaddockFlags {
    } = haddockFlags


convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
convertToLegacyProjectConfig
    projectConfig@ProjectConfig {
      projectPackages,
      projectPackagesOptional,
      projectPackagesRepo,
      projectPackagesNamed,
      projectConfigLocalPackages,
      projectConfigSpecificPackage
    } =
    LegacyProjectConfig {
      legacyPackages         = projectPackages,
      legacyPackagesOptional = projectPackagesOptional,
      legacyPackagesRepo     = projectPackagesRepo,
      legacyPackagesNamed    = projectPackagesNamed,
      legacySharedConfig     = convertToLegacySharedConfig projectConfig,
      legacyLocalConfig      = convertToLegacyAllPackageConfig projectConfig
                            <> convertToLegacyPerPackageConfig
                                 projectConfigLocalPackages,
      legacySpecificConfig   = fmap convertToLegacyPerPackageConfig
                                    projectConfigSpecificPackage
    }

convertToLegacySharedConfig :: ProjectConfig -> LegacySharedConfig
convertToLegacySharedConfig
    ProjectConfig {
      projectConfigBuildOnly     = ProjectConfigBuildOnly {..},
      projectConfigShared        = ProjectConfigShared {..}
    } =

    LegacySharedConfig {
      legacyGlobalFlags      = globalFlags,
      legacyConfigureShFlags = configFlags,
      legacyConfigureExFlags = configExFlags,
      legacyInstallFlags     = installFlags
    }
  where
    globalFlags = GlobalFlags {
      globalVersion           = mempty,
      globalNumericVersion    = mempty,
      globalConfigFile        = mempty,
      globalSandboxConfigFile = mempty,
      globalConstraintsFile   = mempty,
      globalRemoteRepos       = projectConfigRemoteRepos,
      globalCacheDir          = projectConfigCacheDir,
      globalLocalRepos        = projectConfigLocalRepos,
      globalLogsDir           = projectConfigLogsDir,
      globalWorldFile         = projectConfigWorldFile,
      globalRequireSandbox    = mempty,
      globalIgnoreSandbox     = mempty,
      globalIgnoreExpiry      = projectConfigIgnoreExpiry,
      globalHttpTransport     = projectConfigHttpTransport
    }

    configFlags = mempty {
      configVerbosity     = projectConfigVerbosity,
      configAllowNewer    = projectConfigAllowNewer
    }

    configExFlags = ConfigExFlags {
      configCabalVersion  = projectConfigCabalVersion,
      configExConstraints = projectConfigConstraints,
      configPreferences   = projectConfigPreferences,
      configSolver        = projectConfigSolver
    }

    installFlags = InstallFlags {
      installDocumentation     = mempty,
      installHaddockIndex      = projectConfigHaddockIndex,
      installDryRun            = projectConfigDryRun,
      installMaxBackjumps      = projectConfigMaxBackjumps,
      installReorderGoals      = projectConfigReorderGoals,
projectConfigShadowPkgs ,
      installStrongFlags       = projectConfigStrongFlags,
      installOnly              = mempty,
      installOnlyDeps          = projectConfigOnlyDeps,
      installRootCmd           = projectConfigRootCmd,
      installSummaryFile       = projectConfigSummaryFile,
      installLogFile           = projectConfigLogFile,
      installBuildReports      = projectConfigBuildReports,
      installReportPlanningFailure = projectConfigReportPlanningFailure,
      installSymlinkBinDir     = projectConfigSymlinkBinDir,
      installOneShot           = projectConfigOneShot,
      installNumJobs           = projectConfigNumJobs,
      installRunTests          = mempty,
      installOfflineMode       = projectConfigOfflineMode
    }


convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig
convertToLegacyAllPackageConfig
    ProjectConfig {
      projectConfigBuildOnly = ProjectConfigBuildOnly {..},
      projectConfigShared    = ProjectConfigShared {..}
    } =

    LegacyPackageConfig {
      legacyConfigureFlags = configFlags,
      legacyInstallPkgFlags= mempty,
      legacyHaddockFlags   = haddockFlags
    }
  where
    configFlags = ConfigFlags {
      configPrograms_           = mempty,
      configProgramPaths        = mempty,
      configProgramArgs         = mempty,
      configProgramPathExtra    = mempty,
      configHcFlavor            = projectConfigHcFlavor,
      configHcPath              = projectConfigHcPath,
      configHcPkg               = projectConfigHcPkg,
      configVanillaLib          = mempty,
      configProfLib             = mempty,
      configSharedLib           = mempty,
      configDynExe              = mempty,
      configProfExe             = mempty,
      configProf                = mempty,
      configProfDetail          = mempty,
      configProfLibDetail       = mempty,
      configConfigureArgs       = mempty,
      configOptimization        = mempty,
      configProgPrefix          = mempty,
      configProgSuffix          = mempty,
      configInstallDirs         = mempty,
      configScratchDir          = mempty,
      configDistPref            = mempty,
      configVerbosity           = mempty,
projectConfigPackageDBs ,
      configGHCiLib             = mempty,
      configSplitObjs           = mempty,
      configStripExes           = mempty,
      configStripLibs           = mempty,
      configExtraLibDirs        = mempty,
      configExtraFrameworkDirs  = mempty,
      configConstraints         = mempty,
      configDependencies        = mempty,
      configExtraIncludeDirs    = mempty,
      configIPID                = mempty,
      configConfigurationsFlags = mempty,
      configTests               = mempty,
      configExactConfiguration  = mempty,
      configBenchmarks          = mempty,
      configRelocatable         = mempty,
      configDebugInfo           = mempty,
      configAllowNewer          = mempty
    }

    haddockFlags = mempty {
      haddockKeepTempFiles = projectConfigKeepTempFiles
    }


convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig
convertToLegacyPerPackageConfig PackageConfig {..} =
    LegacyPackageConfig {
      legacyConfigureFlags  = configFlags,
      legacyInstallPkgFlags = installFlags,
      legacyHaddockFlags    = haddockFlags
    }
  where
    configFlags = ConfigFlags {
      configPrograms_           = configPrograms_ mempty,
      configProgramPaths        = Map.toList (getMapLast packageConfigProgramPaths),
      configProgramArgs         = Map.toList (getMapMappend packageConfigProgramArgs),
      configProgramPathExtra    = packageConfigProgramPathExtra,
      configHcFlavor            = mempty,
      configHcPath              = mempty,
      configHcPkg               = mempty,
      configVanillaLib          = packageConfigVanillaLib,
      configProfLib             = packageConfigProfLib,
      configSharedLib           = packageConfigSharedLib,
      configDynExe              = packageConfigDynExe,
      configProfExe             = packageConfigProfExe,
      configProf                = packageConfigProf,
      configProfDetail          = packageConfigProfDetail,
      configProfLibDetail       = packageConfigProfLibDetail,
      configConfigureArgs       = packageConfigConfigureArgs,
      configOptimization        = packageConfigOptimization,
      configProgPrefix          = packageConfigProgPrefix,
      configProgSuffix          = packageConfigProgSuffix,
      configInstallDirs         = mempty,
      configScratchDir          = mempty,
      configDistPref            = mempty,
      configVerbosity           = mempty,
      configUserInstall         = mempty,
      configPackageDBs          = mempty,
      configGHCiLib             = packageConfigGHCiLib,
      configSplitObjs           = packageConfigSplitObjs,
      configStripExes           = packageConfigStripExes,
      configStripLibs           = packageConfigStripLibs,
      configExtraLibDirs        = packageConfigExtraLibDirs,
      configExtraFrameworkDirs  = packageConfigExtraFrameworkDirs,
      configConstraints         = mempty,
      configDependencies        = mempty,
      configExtraIncludeDirs    = packageConfigExtraIncludeDirs,
      configIPID                = mempty,
      configConfigurationsFlags = packageConfigFlagAssignment,
      configTests               = packageConfigTests,
      configExactConfiguration  = mempty,
      configBenchmarks          = packageConfigBenchmarks,
      configRelocatable         = packageConfigRelocatable,
      configDebugInfo           = packageConfigDebugInfo,
      configAllowNewer          = mempty
    }

    installFlags = mempty {
      installDocumentation      = packageConfigDocumentation,
      installRunTests           = packageConfigRunTests
    }

    haddockFlags = HaddockFlags {
      haddockProgramPaths  = mempty,
      haddockProgramArgs   = mempty,
      haddockHoogle        = packageConfigHaddockHoogle,
      haddockHtml          = packageConfigHaddockHtml,
      haddockHtmlLocation  = packageConfigHaddockHtmlLocation,
      haddockExecutables   = packageConfigHaddockExecutables,
      haddockTestSuites    = packageConfigHaddockTestSuites,
      haddockBenchmarks    = packageConfigHaddockBenchmarks,
      haddockInternal      = packageConfigHaddockInternal,
      haddockCss           = packageConfigHaddockCss,
      haddockHscolour      = packageConfigHaddockHscolour,
      haddockHscolourCss   = packageConfigHaddockHscolourCss,
      haddockContents      = packageConfigHaddockContents,
      haddockDistPref      = mempty,
      haddockKeepTempFiles = mempty,
      haddockVerbosity     = mempty
    }



parseLegacyProjectConfig :: String -> ParseResult LegacyProjectConfig
parseLegacyProjectConfig =
    parseConfig legacyProjectConfigFieldDescrs
                legacyPackageConfigSectionDescrs
                mempty

showLegacyProjectConfig :: LegacyProjectConfig -> String
showLegacyProjectConfig config =
    Disp.render $
    showConfig  legacyProjectConfigFieldDescrs
                legacyPackageConfigSectionDescrs
                config
  $+$
    Disp.text ""


legacyProjectConfigFieldDescrs :: [FieldDescr LegacyProjectConfig]
legacyProjectConfigFieldDescrs =

    [ newLineListField "packages"
        (Disp.text . renderPackageLocationToken) parsePackageLocationTokenQ
        legacyPackages
        (\v flags -> flags { legacyPackages = v })
    , newLineListField "optional-packages"
        (Disp.text . renderPackageLocationToken) parsePackageLocationTokenQ
        legacyPackagesOptional
        (\v flags -> flags { legacyPackagesOptional = v })
    , commaNewLineListField "extra-packages"
        disp parse
        legacyPackagesNamed
        (\v flags -> flags { legacyPackagesNamed = v })
    ]

 ++ map (liftField
           legacySharedConfig
           (\flags conf -> conf { legacySharedConfig = flags }))
        legacySharedConfigFieldDescrs

 ++ map (liftField
           legacyLocalConfig
           (\flags conf -> conf { legacyLocalConfig = flags }))
        legacyPackageConfigFieldDescrs

parsePackageLocationTokenQ :: ReadP r String
parsePackageLocationTokenQ = parseHaskellString
                   Parse.<++ parsePackageLocationToken
  where
    parsePackageLocationToken :: ReadP r String
    parsePackageLocationToken = fmap fst (Parse.gather outerTerm)
      where
        outerTerm   = alternateEither1 outerToken (braces innerTerm)
        innerTerm   = alternateEither  innerToken (braces innerTerm)
        outerToken  = Parse.munch1 outerChar >> return ()
        innerToken  = Parse.munch1 innerChar >> return ()
        outerChar c = not (isSpace c || c == '{' || c == '}' || c == ',')
        innerChar c = not (isSpace c || c == '{' || c == '}')
        braces      = Parse.between (Parse.char '{') (Parse.char '}')

    alternateEither, alternateEither1,
      alternatePQs, alternate1PQs, alternateQsP, alternate1QsP
      :: ReadP r () -> ReadP r () -> ReadP r ()

    alternateEither1 p q = alternate1PQs p q +++ alternate1QsP q p
    alternateEither  p q = alternateEither1 p q +++ return ()
    alternate1PQs    p q = p >> alternateQsP q p
    alternatePQs     p q = alternate1PQs p q +++ return ()
    alternate1QsP    q p = Parse.many1 q >> alternatePQs p q
    alternateQsP     q p = alternate1QsP q p +++ return ()

renderPackageLocationToken :: String -> String
renderPackageLocationToken s | needsQuoting = show s
                             | otherwise    = s
  where
    needsQuoting  = not (ok 0 s)
  ought to be dealt with systematically in ParseUtils .
    ok :: Int -> String -> Bool
    ok n []       = n == 0
    ok _ ('"':_)  = False
    ok n ('{':cs) = ok (n+1) cs
    ok n ('}':cs) = ok (n-1) cs
    ok n (',':cs) = (n > 0) && ok n cs
    ok _ (c:_)
      | isSpace c = False
    ok n (_  :cs) = ok n cs


legacySharedConfigFieldDescrs :: [FieldDescr LegacySharedConfig]
legacySharedConfigFieldDescrs =

  ( liftFields
      legacyGlobalFlags
      (\flags conf -> conf { legacyGlobalFlags = flags })
  . addFields
      [ newLineListField "local-repo"
          showTokenQ parseTokenQ
          (fromNubList . globalLocalRepos)
          (\v conf -> conf { globalLocalRepos = toNubList v })
      ]
  . filterFields
      [ "remote-repo-cache"
      , "logs-dir", "world-file", "ignore-expiry", "http-transport"
      ]
  . commandOptionsToFields
  ) (commandOptions (globalCommand []) ParseArgs)
 ++
  ( liftFields
      legacyConfigureShFlags
      (\flags conf -> conf { legacyConfigureShFlags = flags })
  . addFields
      [ simpleField "allow-newer"
        (maybe mempty dispAllowNewer) (fmap Just parseAllowNewer)
        configAllowNewer (\v conf -> conf { configAllowNewer = v })
      ]
  . filterFields ["verbose"]
  . commandOptionsToFields
  ) (configureOptions ParseArgs)
 ++
  ( liftFields
      legacyConfigureExFlags
      (\flags conf -> conf { legacyConfigureExFlags = flags })
  . addFields
      [ commaNewLineListField "constraints"
        (disp . fst) (fmap (\constraint -> (constraint, constraintSrc)) parse)
        configExConstraints (\v conf -> conf { configExConstraints = v })

      , commaNewLineListField "preferences"
        disp parse
        configPreferences (\v conf -> conf { configPreferences = v })
      ]
  . filterFields
      [ "cabal-lib-version", "solver"
      ]
  . commandOptionsToFields
  ) (configureExOptions ParseArgs constraintSrc)
 ++
  ( liftFields
      legacyInstallFlags
      (\flags conf -> conf { legacyInstallFlags = flags })
  . addFields
      [ newLineListField "build-summary"
          (showTokenQ . fromPathTemplate) (fmap toPathTemplate parseTokenQ)
          (fromNubList . installSummaryFile)
          (\v conf -> conf { installSummaryFile = toNubList v })
      ]
  . filterFields
      [ "doc-index-file"
      , "root-cmd", "symlink-bindir"
      , "build-log"
      , "remote-build-reporting", "report-planning-failure"
      , "one-shot", "jobs", "offline"
      , "max-backjumps", "reorder-goals", "strong-flags"
      ]
  . commandOptionsToFields
  ) (installOptions ParseArgs)
  where
    constraintSrc = ConstraintSourceProjectConfig "TODO"

parseAllowNewer :: ReadP r AllowNewer
parseAllowNewer =
     ((const AllowNewerNone <$> (Parse.string "none" +++ Parse.string "None"))
  +++ (const AllowNewerAll  <$> (Parse.string "all"  +++ Parse.string "All")))
  <++ (      AllowNewerSome <$> parseOptCommaList parse)

dispAllowNewer :: AllowNewer -> Doc
dispAllowNewer  AllowNewerNone       = Disp.text "None"
dispAllowNewer (AllowNewerSome pkgs) = Disp.fsep . Disp.punctuate Disp.comma
                                                 . map disp $ pkgs
dispAllowNewer  AllowNewerAll        = Disp.text "All"


legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
legacyPackageConfigFieldDescrs =
  ( liftFields
      legacyConfigureFlags
      (\flags conf -> conf { legacyConfigureFlags = flags })
  . addFields
      [ newLineListField "extra-include-dirs"
          showTokenQ parseTokenQ
          configExtraIncludeDirs
          (\v conf -> conf { configExtraIncludeDirs = v })
      , newLineListField "extra-lib-dirs"
          showTokenQ parseTokenQ
          configExtraLibDirs
          (\v conf -> conf { configExtraLibDirs = v })
      , newLineListField "extra-framework-dirs"
          showTokenQ parseTokenQ
          configExtraFrameworkDirs
          (\v conf -> conf { configExtraFrameworkDirs = v })
      , newLineListField "extra-prog-path"
          showTokenQ parseTokenQ
          (fromNubList . configProgramPathExtra)
          (\v conf -> conf { configProgramPathExtra = toNubList v })
      , newLineListField "configure-options"
          showTokenQ parseTokenQ
          configConfigureArgs
          (\v conf -> conf { configConfigureArgs = v })
      , simpleField "flags"
          dispFlagAssignment parseFlagAssignment
          configConfigurationsFlags
          (\v conf -> conf { configConfigurationsFlags = v })
      ]
  . filterFields
      [ "compiler", "with-compiler", "with-hc-pkg"
      , "program-prefix", "program-suffix"
      , "library-vanilla", "library-profiling"
      , "shared", "executable-dynamic"
      , "profiling", "executable-profiling"
      , "profiling-detail", "library-profiling-detail"
      , "optimization", "debug-info", "library-for-ghci", "split-objs"
      , "executable-stripping", "library-stripping"
      , "tests", "benchmarks"
      , "coverage", "library-coverage"
      , "relocatable"
      ]
  . commandOptionsToFields
  ) (configureOptions ParseArgs)
 ++
    liftFields
      legacyConfigureFlags
      (\flags conf -> conf { legacyConfigureFlags = flags })
    [ overrideFieldCompiler
    , overrideFieldOptimization
    , overrideFieldDebugInfo
    ]
 ++
  ( liftFields
      legacyInstallPkgFlags
      (\flags conf -> conf { legacyInstallPkgFlags = flags })
  . filterFields
      [ "documentation", "run-tests"
      ]
  . commandOptionsToFields
  ) (installOptions ParseArgs)
 ++
  ( liftFields
      legacyHaddockFlags
      (\flags conf -> conf { legacyHaddockFlags = flags })
  . mapFieldNames
      ("haddock-"++)
  . filterFields
      [ "hoogle", "html", "html-location"
      , "executables", "tests", "benchmarks", "all", "internal", "css"
      , "hyperlink-source", "hscolour-css"
      , "contents-location", "keep-temp-files"
      ]
  . commandOptionsToFields
  ) (haddockOptions ParseArgs)

  where
    overrideFieldCompiler =
      simpleField "compiler"
        (fromFlagOrDefault Disp.empty . fmap disp)
        (Parse.option mempty (fmap toFlag parse))
        configHcFlavor (\v flags -> flags { configHcFlavor = v })


  " debug - info " fields are OptArg , and viewAsFieldDescr fails on that .

    overrideFieldOptimization =
      liftField configOptimization
                (\v flags -> flags { configOptimization = v }) $
      let name = "optimization" in
      FieldDescr name
        (\f -> case f of
                 Flag NoOptimisation      -> Disp.text "False"
                 Flag NormalOptimisation  -> Disp.text "True"
                 Flag MaximumOptimisation -> Disp.text "2"
                 _                        -> Disp.empty)
        (\line str _ -> case () of
         _ |  str == "False" -> ParseOk [] (Flag NoOptimisation)
           |  str == "True"  -> ParseOk [] (Flag NormalOptimisation)
           |  str == "0"     -> ParseOk [] (Flag NoOptimisation)
           |  str == "1"     -> ParseOk [] (Flag NormalOptimisation)
           |  str == "2"     -> ParseOk [] (Flag MaximumOptimisation)
           | lstr == "false" -> ParseOk [caseWarning] (Flag NoOptimisation)
           | lstr == "true"  -> ParseOk [caseWarning] (Flag NormalOptimisation)
           | otherwise       -> ParseFailed (NoParse name line)
           where
             lstr = lowercase str
             caseWarning = PWarning $
               "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")

    overrideFieldDebugInfo =
      liftField configDebugInfo (\v flags -> flags { configDebugInfo = v }) $
      let name = "debug-info" in
      FieldDescr name
        (\f -> case f of
                 Flag NoDebugInfo      -> Disp.text "False"
                 Flag MinimalDebugInfo -> Disp.text "1"
                 Flag NormalDebugInfo  -> Disp.text "True"
                 Flag MaximalDebugInfo -> Disp.text "3"
                 _                     -> Disp.empty)
        (\line str _ -> case () of
         _ |  str == "False" -> ParseOk [] (Flag NoDebugInfo)
           |  str == "True"  -> ParseOk [] (Flag NormalDebugInfo)
           |  str == "0"     -> ParseOk [] (Flag NoDebugInfo)
           |  str == "1"     -> ParseOk [] (Flag MinimalDebugInfo)
           |  str == "2"     -> ParseOk [] (Flag NormalDebugInfo)
           |  str == "3"     -> ParseOk [] (Flag MaximalDebugInfo)
           | lstr == "false" -> ParseOk [caseWarning] (Flag NoDebugInfo)
           | lstr == "true"  -> ParseOk [caseWarning] (Flag NormalDebugInfo)
           | otherwise       -> ParseFailed (NoParse name line)
           where
             lstr = lowercase str
             caseWarning = PWarning $
               "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")


legacyPackageConfigSectionDescrs :: [SectionDescr LegacyProjectConfig]
legacyPackageConfigSectionDescrs =
    [ packageRepoSectionDescr
    , packageSpecificOptionsSectionDescr
    , liftSection
        legacyLocalConfig
        (\flags conf -> conf { legacyLocalConfig = flags })
        programOptionsSectionDescr
    , liftSection
        legacyLocalConfig
        (\flags conf -> conf { legacyLocalConfig = flags })
        programLocationsSectionDescr
    , liftSection
        legacySharedConfig
        (\flags conf -> conf { legacySharedConfig = flags }) $
      liftSection
        legacyGlobalFlags
        (\flags conf -> conf { legacyGlobalFlags = flags })
        remoteRepoSectionDescr
    ]

packageRepoSectionDescr :: SectionDescr LegacyProjectConfig
packageRepoSectionDescr =
    SectionDescr {
      sectionName        = "source-repository-package",
      sectionFields      = sourceRepoFieldDescrs,
      sectionSubsections = [],
      sectionGet         = map (\x->("", x))
                         . legacyPackagesRepo,
      sectionSet         =
        \lineno unused pkgrepo projconf -> do
          unless (null unused) $
            syntaxError lineno "the section 'source-repository-package' takes no arguments"
          return projconf {
            legacyPackagesRepo = legacyPackagesRepo projconf ++ [pkgrepo]
          },
      sectionEmpty       = SourceRepo {
                             repoType     = Nothing,
                             repoLocation = Nothing,
                             repoModule   = Nothing,
                             repoBranch   = Nothing,
                             repoTag      = Nothing,
                             repoSubdir   = Nothing
                           }
    }

packageSpecificOptionsSectionDescr :: SectionDescr LegacyProjectConfig
packageSpecificOptionsSectionDescr =
    SectionDescr {
      sectionName        = "package",
      sectionFields      = legacyPackageConfigFieldDescrs
                        ++ programOptionsFieldDescrs
                             (configProgramArgs . legacyConfigureFlags)
                             (\args pkgconf -> pkgconf {
                                 legacyConfigureFlags = (legacyConfigureFlags pkgconf) {
                                   configProgramArgs  = args
                                 }
                               }
                             )
                        ++ liftFields
                             legacyConfigureFlags
                             (\flags pkgconf -> pkgconf {
                                 legacyConfigureFlags = flags
                               }
                             )
                             programLocationsFieldDescrs,
      sectionSubsections = [],
      sectionGet         = \projconf ->
                             [ (display pkgname, pkgconf)
                             | (pkgname, pkgconf) <-
                                 Map.toList . getMapMappend
                               . legacySpecificConfig $ projconf ],
      sectionSet         =
        \lineno pkgnamestr pkgconf projconf -> do
          pkgname <- case simpleParse pkgnamestr of
            Just pkgname -> return pkgname
            Nothing      -> syntaxError lineno $
                                "a 'package' section requires a package name "
                             ++ "as an argument"
          return projconf {
            legacySpecificConfig =
              MapMappend $
              Map.insertWith mappend pkgname pkgconf
                             (getMapMappend $ legacySpecificConfig projconf)
          },
      sectionEmpty       = mempty
    }

programOptionsFieldDescrs :: (a -> [(String, [String])])
                          -> ([(String, [String])] -> a -> a)
                          -> [FieldDescr a]
programOptionsFieldDescrs get set =
    commandOptionsToFields
  $ programConfigurationOptions
      defaultProgramDb
      ParseArgs get set

programOptionsSectionDescr :: SectionDescr LegacyPackageConfig
programOptionsSectionDescr =
    SectionDescr {
      sectionName        = "program-options",
      sectionFields      = programOptionsFieldDescrs
                             configProgramArgs
                             (\args conf -> conf { configProgramArgs = args }),
      sectionSubsections = [],
      sectionGet         = (\x->[("", x)])
                         . legacyConfigureFlags,
      sectionSet         =
        \lineno unused confflags pkgconf -> do
          unless (null unused) $
            syntaxError lineno "the section 'program-options' takes no arguments"
          return pkgconf {
            legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
          },
      sectionEmpty       = mempty
    }

programLocationsFieldDescrs :: [FieldDescr ConfigFlags]
programLocationsFieldDescrs =
     commandOptionsToFields
   $ programConfigurationPaths'
       (++ "-location")
       defaultProgramDb
       ParseArgs
       configProgramPaths
       (\paths conf -> conf { configProgramPaths = paths })

programLocationsSectionDescr :: SectionDescr LegacyPackageConfig
programLocationsSectionDescr =
    SectionDescr {
      sectionName        = "program-locations",
      sectionFields      = programLocationsFieldDescrs,
      sectionSubsections = [],
      sectionGet         = (\x->[("", x)])
                         . legacyConfigureFlags,
      sectionSet         =
        \lineno unused confflags pkgconf -> do
          unless (null unused) $
            syntaxError lineno "the section 'program-locations' takes no arguments"
          return pkgconf {
            legacyConfigureFlags = legacyConfigureFlags pkgconf <> confflags
          },
      sectionEmpty       = mempty
    }


  | For each known program @PROG@ in ' progConf ' , produce a @PROG - options@
programConfigurationOptions
  :: ProgramDb
  -> ShowOrParseArgs
  -> (flags -> [(String, [String])])
  -> ([(String, [String])] -> (flags -> flags))
  -> [OptionField flags]
programConfigurationOptions progConf showOrParseArgs get set =
  case showOrParseArgs of
    ShowArgs  -> [programOptions  "PROG"]
    ParseArgs -> map (programOptions . programName . fst)
                 (knownPrograms progConf)
  where
    programOptions prog =
      option "" [prog ++ "-options"]
        ("give extra options to " ++ prog)
        get set
        (reqArg' "OPTS" (\args -> [(prog, splitArgs args)])
           (\progArgs -> [ joinsArgs args
                         | (prog', args) <- progArgs, prog==prog' ]))


    joinsArgs = unwords . map escape
    escape arg | any isSpace arg = "\"" ++ arg ++ "\""
               | otherwise       = arg


remoteRepoSectionDescr :: SectionDescr GlobalFlags
remoteRepoSectionDescr =
    SectionDescr {
      sectionName        = "repository",
      sectionFields      = remoteRepoFields,
      sectionSubsections = [],
      sectionGet         = map (\x->(remoteRepoName x, x)) . fromNubList
                         . globalRemoteRepos,
      sectionSet         =
        \lineno reponame repo0 conf -> do
          when (null reponame) $
            syntaxError lineno $ "a 'repository' section requires the "
                              ++ "repository name as an argument"
          let repo = repo0 { remoteRepoName = reponame }
          when (remoteRepoKeyThreshold repo
                 > length (remoteRepoRootKeys repo)) $
            warning $ "'key-threshold' for repository "
                   ++ show (remoteRepoName repo)
                   ++ " higher than number of keys"
          when (not (null (remoteRepoRootKeys repo))
                && remoteRepoSecure repo /= Just True) $
            warning $ "'root-keys' for repository "
                   ++ show (remoteRepoName repo)
                   ++ " non-empty, but 'secure' not set to True."
          return conf {
            globalRemoteRepos = overNubList (++[repo]) (globalRemoteRepos conf)
          },
      sectionEmpty       = emptyRemoteRepo ""
    }




TODO : [ code cleanup ] this is a different definition from listField , like
newLineListField :: String -> (a -> Doc) -> ReadP [a] a
                 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
newLineListField = listFieldWithSep Disp.sep

listFieldWithSep :: ([Doc] -> Doc) -> String -> (a -> Doc) -> ReadP [a] a
                 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listFieldWithSep separator name showF readF get set =
  liftField get set' $
    ParseUtils.field name showF' (parseOptCommaList readF)
  where
    set' xs b = set (get b ++ xs) b
    showF'    = separator . map showF

parseOptCommaList :: ReadP r a -> ReadP r [a]
parseOptCommaList p = Parse.sepBy p sep
  where
    sep = (Parse.skipSpaces >> Parse.char ',' >> Parse.skipSpaces)
      +++ (Parse.satisfy isSpace >> Parse.skipSpaces)

  D.ParseUtils called showFilePath . This version escapes " . " and " -- " which
showTokenQ :: String -> Doc
showTokenQ ""            = Disp.empty
showTokenQ x@('-':'-':_) = Disp.text (show x)
showTokenQ x@('.':[])    = Disp.text (show x)
showTokenQ x             = showToken x

  This is just a copy of parseTokenQ , using the fixed parseHaskellString
parseTokenQ :: ReadP r String
parseTokenQ = parseHaskellString
          <++ Parse.munch1 (\x -> not (isSpace x) && x /= ',')

  Distribution . ParseUtils . It turns out Read instance for  accepts
parseHaskellString :: ReadP r String
parseHaskellString =
  Parse.readS_to_P $
    Read.readPrec_to_S (do Read.String s <- Read.lexP; return s) 0

  Handy util
addFields :: [FieldDescr a]
          -> ([FieldDescr a] -> [FieldDescr a])
addFields = (++)
