{-# LANGUAGE DeriveGeneric #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Config
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Utilities for handling saved state such as known packages, known servers and
-- downloaded packages.
-----------------------------------------------------------------------------
module Distribution.Client.Config (
    SavedConfig(..),
    loadConfig,
    getConfigFilePath,

    showConfig,
    showConfigWithComments,
    parseConfig,

    getCabalDir,
    defaultConfigFile,
    defaultCacheDir,
    defaultCompiler,
    defaultInstallPath,
    defaultLogsDir,
    defaultUserInstall,

    baseSavedConfig,
    commentSavedConfig,
    initialSavedConfig,
    configFieldDescriptions,
    haddockFlagsFields,
    installDirsFields,
    withProgramsFields,
    withProgramOptionsFields,
    userConfigDiff,
    userConfigUpdate,
    createDefaultConfigFile,

    remoteRepoFields,
    postProcessRepo,
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Language.Haskell.Extension ( Language(Haskell2010) )

import Distribution.Deprecated.ViewAsFieldDescr
         ( viewAsFieldDescr )

import Distribution.Client.Types
         ( RemoteRepo(..), LocalRepo (..), emptyRemoteRepo
         , AllowOlder(..), AllowNewer(..), RelaxDeps(..), isRelaxDeps
         , RepoName (..), unRepoName
         )
import Distribution.Client.Types.Credentials (Username (..), Password (..))
import Distribution.Client.BuildReports.Types
         ( ReportLevel(..) )
import qualified Distribution.Client.Init.Types as IT
         ( InitFlags(..) )
import qualified Distribution.Client.Init.Defaults as IT
import Distribution.Client.Setup
         ( GlobalFlags(..), globalCommand, defaultGlobalFlags
         , ConfigExFlags(..), configureExOptions, defaultConfigExFlags
         , initOptions
         , InstallFlags(..), installOptions, defaultInstallFlags
         , UploadFlags(..), uploadCommand
         , ReportFlags(..), reportCommand )
import Distribution.Client.CmdInstall.ClientInstallFlags
         ( ClientInstallFlags(..), defaultClientInstallFlags
         , clientInstallOptions )
import Distribution.Utils.NubList
         ( NubList, fromNubList, toNubList, overNubList )

import Distribution.Simple.Compiler
         ( DebugInfoLevel(..), OptimisationLevel(..) )
import Distribution.Simple.Setup
         ( ConfigFlags(..), configureOptions, defaultConfigFlags
         , HaddockFlags(..), haddockOptions, defaultHaddockFlags
         , TestFlags(..), defaultTestFlags
         , BenchmarkFlags(..), defaultBenchmarkFlags
         , installDirsOptions, optionDistPref
         , programDbPaths', programDbOptions
         , Flag(..), toFlag, flagToMaybe, fromFlagOrDefault )
import Distribution.Simple.InstallDirs
         ( InstallDirs(..), defaultInstallDirs
         , PathTemplate, toPathTemplate )
import Distribution.Deprecated.ParseUtils
         ( FieldDescr(..), liftField, runP
         , ParseResult(..), PError(..), PWarning(..)
         , locatedErrorMsg, showPWarning
         , readFields, warning, lineNo
         , simpleField, listField, spaceListField
         , parseOptCommaList, parseTokenQ, syntaxError
         , simpleFieldParsec, listFieldParsec
         )
import Distribution.Client.ParseUtils
         ( parseFields, ppFields, ppSection )
import Distribution.Client.HttpUtils
         ( isOldHackageURI )
import qualified Distribution.Deprecated.ParseUtils as ParseUtils
         ( Field(..) )
import Distribution.Simple.Command
         ( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..) )
import Distribution.Simple.Program
         ( defaultProgramDb )
import Distribution.Simple.Utils
         ( die', notice, warn, lowercase, cabalVersion, toUTF8BS )
import Distribution.Client.Version
         ( cabalInstallVersion )
import Distribution.Compiler
         ( CompilerFlavor(..), defaultCompilerFlavor )
import Distribution.Verbosity
         ( normal )
import qualified Distribution.Compat.CharParsing as P
import Distribution.Client.ProjectFlags (ProjectFlags (..))
import Distribution.Solver.Types.ConstraintSource

import qualified Text.PrettyPrint as Disp
         ( render, text, empty )
import Distribution.Parsec (parsecOptCommaList, ParsecParser, parsecToken, parsecFilePath)
import Text.PrettyPrint
         ( ($+$) )
import Text.PrettyPrint.HughesPJ
         ( text, Doc )
import System.Directory
         ( createDirectoryIfMissing, getAppUserDataDirectory, renameFile )
import Network.URI
         ( URI(..), URIAuth(..), parseURI )
import System.FilePath
         ( (<.>), (</>), takeDirectory )
import System.IO.Error
         ( isDoesNotExistError )
import Distribution.Compat.Environment
         ( getEnvironment, lookupEnv )
import qualified Data.Map as M
import qualified Data.ByteString as BS

--
-- * Configuration saved in the config file
--

data SavedConfig = SavedConfig
    { SavedConfig -> GlobalFlags
savedGlobalFlags        :: GlobalFlags
    , SavedConfig -> InitFlags
savedInitFlags          :: IT.InitFlags
    , SavedConfig -> InstallFlags
savedInstallFlags       :: InstallFlags
    , SavedConfig -> ClientInstallFlags
savedClientInstallFlags :: ClientInstallFlags
    , SavedConfig -> ConfigFlags
savedConfigureFlags     :: ConfigFlags
    , SavedConfig -> ConfigExFlags
savedConfigureExFlags   :: ConfigExFlags
    , SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs    :: InstallDirs (Flag PathTemplate)
    , SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs  :: InstallDirs (Flag PathTemplate)
    , SavedConfig -> UploadFlags
savedUploadFlags        :: UploadFlags
    , SavedConfig -> ReportFlags
savedReportFlags        :: ReportFlags
    , SavedConfig -> HaddockFlags
savedHaddockFlags       :: HaddockFlags
    , SavedConfig -> TestFlags
savedTestFlags          :: TestFlags
    , SavedConfig -> BenchmarkFlags
savedBenchmarkFlags     :: BenchmarkFlags
    , SavedConfig -> ProjectFlags
savedProjectFlags       :: ProjectFlags
    } deriving (forall x. SavedConfig -> Rep SavedConfig x)
-> (forall x. Rep SavedConfig x -> SavedConfig)
-> Generic SavedConfig
forall x. Rep SavedConfig x -> SavedConfig
forall x. SavedConfig -> Rep SavedConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SavedConfig x -> SavedConfig
$cfrom :: forall x. SavedConfig -> Rep SavedConfig x
Generic

instance Monoid SavedConfig where
  mempty :: SavedConfig
mempty = SavedConfig
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: SavedConfig -> SavedConfig -> SavedConfig
mappend = SavedConfig -> SavedConfig -> SavedConfig
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup SavedConfig where
  SavedConfig
a <> :: SavedConfig -> SavedConfig -> SavedConfig
<> SavedConfig
b = SavedConfig :: GlobalFlags
-> InitFlags
-> InstallFlags
-> ClientInstallFlags
-> ConfigFlags
-> ConfigExFlags
-> InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
-> UploadFlags
-> ReportFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> ProjectFlags
-> SavedConfig
SavedConfig {
    savedGlobalFlags :: GlobalFlags
savedGlobalFlags       = GlobalFlags
combinedSavedGlobalFlags,
    savedInitFlags :: InitFlags
savedInitFlags         = InitFlags
combinedSavedInitFlags,
    savedInstallFlags :: InstallFlags
savedInstallFlags      = InstallFlags
combinedSavedInstallFlags,
    savedClientInstallFlags :: ClientInstallFlags
savedClientInstallFlags = ClientInstallFlags
combinedSavedClientInstallFlags,
    savedConfigureFlags :: ConfigFlags
savedConfigureFlags    = ConfigFlags
combinedSavedConfigureFlags,
    savedConfigureExFlags :: ConfigExFlags
savedConfigureExFlags  = ConfigExFlags
combinedSavedConfigureExFlags,
    savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs   = InstallDirs (Flag PathTemplate)
combinedSavedUserInstallDirs,
    savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs = InstallDirs (Flag PathTemplate)
combinedSavedGlobalInstallDirs,
    savedUploadFlags :: UploadFlags
savedUploadFlags       = UploadFlags
combinedSavedUploadFlags,
    savedReportFlags :: ReportFlags
savedReportFlags       = ReportFlags
combinedSavedReportFlags,
    savedHaddockFlags :: HaddockFlags
savedHaddockFlags      = HaddockFlags
combinedSavedHaddockFlags,
    savedTestFlags :: TestFlags
savedTestFlags         = TestFlags
combinedSavedTestFlags,
    savedBenchmarkFlags :: BenchmarkFlags
savedBenchmarkFlags    = BenchmarkFlags
combinedSavedBenchmarkFlags,
    savedProjectFlags :: ProjectFlags
savedProjectFlags      = ProjectFlags
combinedSavedProjectFlags
  }
    where
      -- This is ugly, but necessary. If we're mappending two config files, we
      -- want the values of the *non-empty* list fields from the second one to
      -- *override* the corresponding values from the first one. Default
      -- behaviour (concatenation) is confusing and makes some use cases (see
      -- #1884) impossible.
      --
      -- However, we also want to allow specifying multiple values for a list
      -- field in a *single* config file. For example, we want the following to
      -- continue to work:
      --
      -- remote-repo: hackage.haskell.org:http://hackage.haskell.org/
      -- remote-repo: private-collection:http://hackage.local/
      --
      -- So we can't just wrap the list fields inside Flags; we have to do some
      -- special-casing just for SavedConfig.

      -- NB: the signature prevents us from using 'combine' on lists.
      combine' :: (SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
      combine' :: (SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> flags
field flags -> Flag a
subfield =
        (flags -> Flag a
subfield (flags -> Flag a)
-> (SavedConfig -> flags) -> SavedConfig -> Flag a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> Flag a) -> SavedConfig -> Flag a
forall a b. (a -> b) -> a -> b
$ SavedConfig
a) Flag a -> Flag a -> Flag a
forall a. Monoid a => a -> a -> a
`mappend` (flags -> Flag a
subfield (flags -> Flag a)
-> (SavedConfig -> flags) -> SavedConfig -> Flag a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> Flag a) -> SavedConfig -> Flag a
forall a b. (a -> b) -> a -> b
$ SavedConfig
b)

      combineMonoid :: Monoid mon => (SavedConfig -> flags) -> (flags -> mon)
                    -> mon
      combineMonoid :: (SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> flags
field flags -> mon
subfield =
        (flags -> mon
subfield (flags -> mon) -> (SavedConfig -> flags) -> SavedConfig -> mon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> mon) -> SavedConfig -> mon
forall a b. (a -> b) -> a -> b
$ SavedConfig
a) mon -> mon -> mon
forall a. Monoid a => a -> a -> a
`mappend` (flags -> mon
subfield (flags -> mon) -> (SavedConfig -> flags) -> SavedConfig -> mon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> mon) -> SavedConfig -> mon
forall a b. (a -> b) -> a -> b
$ SavedConfig
b)

      lastNonEmpty' :: (SavedConfig -> flags) -> (flags -> [a]) -> [a]
      lastNonEmpty' :: (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty'   SavedConfig -> flags
field flags -> [a]
subfield =
        let a' :: [a]
a' = flags -> [a]
subfield (flags -> [a]) -> (SavedConfig -> flags) -> SavedConfig -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> [a]) -> SavedConfig -> [a]
forall a b. (a -> b) -> a -> b
$ SavedConfig
a
            b' :: [a]
b' = flags -> [a]
subfield (flags -> [a]) -> (SavedConfig -> flags) -> SavedConfig -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> [a]) -> SavedConfig -> [a]
forall a b. (a -> b) -> a -> b
$ SavedConfig
b
        in case [a]
b' of [] -> [a]
a'
                      [a]
_  -> [a]
b'

      lastNonMempty'
        :: (Eq a, Monoid a) => (SavedConfig -> flags) -> (flags -> a) -> a
      lastNonMempty' :: (SavedConfig -> flags) -> (flags -> a) -> a
lastNonMempty'   SavedConfig -> flags
field flags -> a
subfield =
        let a' :: a
a' = flags -> a
subfield (flags -> a) -> (SavedConfig -> flags) -> SavedConfig -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> a) -> SavedConfig -> a
forall a b. (a -> b) -> a -> b
$ SavedConfig
a
            b' :: a
b' = flags -> a
subfield (flags -> a) -> (SavedConfig -> flags) -> SavedConfig -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> a) -> SavedConfig -> a
forall a b. (a -> b) -> a -> b
$ SavedConfig
b
        in if a
b' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty then a
a' else a
b'

      lastNonEmptyNL' :: (SavedConfig -> flags) -> (flags -> NubList a)
                      -> NubList a
      lastNonEmptyNL' :: (SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> flags
field flags -> NubList a
subfield =
        let a' :: NubList a
a' = flags -> NubList a
subfield (flags -> NubList a)
-> (SavedConfig -> flags) -> SavedConfig -> NubList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> NubList a) -> SavedConfig -> NubList a
forall a b. (a -> b) -> a -> b
$ SavedConfig
a
            b' :: NubList a
b' = flags -> NubList a
subfield (flags -> NubList a)
-> (SavedConfig -> flags) -> SavedConfig -> NubList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field (SavedConfig -> NubList a) -> SavedConfig -> NubList a
forall a b. (a -> b) -> a -> b
$ SavedConfig
b
        in case NubList a -> [a]
forall a. NubList a -> [a]
fromNubList NubList a
b' of [] -> NubList a
a'
                                  [a]
_  -> NubList a
b'

      combinedSavedGlobalFlags :: GlobalFlags
combinedSavedGlobalFlags = GlobalFlags :: Flag Bool
-> Flag Bool
-> Flag FilePath
-> Flag FilePath
-> NubList RemoteRepo
-> Flag FilePath
-> NubList LocalRepo
-> Flag ActiveRepos
-> Flag FilePath
-> Flag Bool
-> Flag FilePath
-> Flag Bool
-> Flag FilePath
-> NubList FilePath
-> GlobalFlags
GlobalFlags {
        globalVersion :: Flag Bool
globalVersion           = (GlobalFlags -> Flag Bool) -> Flag Bool
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalVersion,
        globalNumericVersion :: Flag Bool
globalNumericVersion    = (GlobalFlags -> Flag Bool) -> Flag Bool
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalNumericVersion,
        globalConfigFile :: Flag FilePath
globalConfigFile        = (GlobalFlags -> Flag FilePath) -> Flag FilePath
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag FilePath
globalConfigFile,
        globalConstraintsFile :: Flag FilePath
globalConstraintsFile   = (GlobalFlags -> Flag FilePath) -> Flag FilePath
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag FilePath
globalConstraintsFile,
        globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos       = (GlobalFlags -> NubList RemoteRepo) -> NubList RemoteRepo
forall a. (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL GlobalFlags -> NubList RemoteRepo
globalRemoteRepos,
        globalCacheDir :: Flag FilePath
globalCacheDir          = (GlobalFlags -> Flag FilePath) -> Flag FilePath
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag FilePath
globalCacheDir,
        globalLocalNoIndexRepos :: NubList LocalRepo
globalLocalNoIndexRepos = (GlobalFlags -> NubList LocalRepo) -> NubList LocalRepo
forall a. (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL GlobalFlags -> NubList LocalRepo
globalLocalNoIndexRepos,
        globalActiveRepos :: Flag ActiveRepos
globalActiveRepos       = (GlobalFlags -> Flag ActiveRepos) -> Flag ActiveRepos
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag ActiveRepos
globalActiveRepos,
        globalLogsDir :: Flag FilePath
globalLogsDir           = (GlobalFlags -> Flag FilePath) -> Flag FilePath
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag FilePath
globalLogsDir,
        globalIgnoreExpiry :: Flag Bool
globalIgnoreExpiry      = (GlobalFlags -> Flag Bool) -> Flag Bool
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalIgnoreExpiry,
        globalHttpTransport :: Flag FilePath
globalHttpTransport     = (GlobalFlags -> Flag FilePath) -> Flag FilePath
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag FilePath
globalHttpTransport,
        globalNix :: Flag Bool
globalNix               = (GlobalFlags -> Flag Bool) -> Flag Bool
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalNix,
        globalStoreDir :: Flag FilePath
globalStoreDir          = (GlobalFlags -> Flag FilePath) -> Flag FilePath
forall a. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag FilePath
globalStoreDir,
        globalProgPathExtra :: NubList FilePath
globalProgPathExtra     = (GlobalFlags -> NubList FilePath) -> NubList FilePath
forall a. (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL GlobalFlags -> NubList FilePath
globalProgPathExtra
        }
        where
          combine :: (GlobalFlags -> Flag a) -> Flag a
combine        = (SavedConfig -> GlobalFlags) -> (GlobalFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> GlobalFlags
savedGlobalFlags
          lastNonEmptyNL :: (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL = (SavedConfig -> GlobalFlags)
-> (GlobalFlags -> NubList a) -> NubList a
forall flags a.
(SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> GlobalFlags
savedGlobalFlags

      combinedSavedInitFlags :: InitFlags
combinedSavedInitFlags = InitFlags :: Flag Bool
-> Flag Bool
-> Flag FilePath
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag PackageName
-> Flag Version
-> Flag CabalSpecVersion
-> Flag SpecLicense
-> Flag FilePath
-> Flag FilePath
-> Flag FilePath
-> Flag FilePath
-> Flag FilePath
-> Flag [FilePath]
-> Flag [FilePath]
-> Flag PackageType
-> Flag FilePath
-> Flag Language
-> Flag [ModuleName]
-> Flag [ModuleName]
-> Flag [Extension]
-> Flag [Dependency]
-> Flag [FilePath]
-> Flag [FilePath]
-> Flag [FilePath]
-> Flag Bool
-> Flag [FilePath]
-> Flag FilePath
-> Flag Verbosity
-> Flag Bool
-> InitFlags
IT.InitFlags {
        applicationDirs :: Flag [FilePath]
IT.applicationDirs = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [FilePath]) -> Flag [FilePath]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [FilePath]
IT.applicationDirs,
        author :: Flag FilePath
IT.author              = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.author,
        buildTools :: Flag [FilePath]
IT.buildTools          = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [FilePath]) -> Flag [FilePath]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [FilePath]
IT.buildTools,
        cabalVersion :: Flag CabalSpecVersion
IT.cabalVersion        = (InitFlags -> Flag CabalSpecVersion) -> Flag CabalSpecVersion
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag CabalSpecVersion
IT.cabalVersion,
        category :: Flag FilePath
IT.category            = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.category,
        dependencies :: Flag [Dependency]
IT.dependencies        = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [Dependency]) -> Flag [Dependency]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [Dependency]
IT.dependencies,
        email :: Flag FilePath
IT.email               = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.email,
        exposedModules :: Flag [ModuleName]
IT.exposedModules      = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [ModuleName]) -> Flag [ModuleName]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [ModuleName]
IT.exposedModules,
        extraSrc :: Flag [FilePath]
IT.extraSrc            = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [FilePath]) -> Flag [FilePath]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [FilePath]
IT.extraSrc,
        extraDoc :: Flag [FilePath]
IT.extraDoc            = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [FilePath]) -> Flag [FilePath]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [FilePath]
IT.extraDoc,
        homepage :: Flag FilePath
IT.homepage            = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.homepage,
        initHcPath :: Flag FilePath
IT.initHcPath          = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.initHcPath,
        initVerbosity :: Flag Verbosity
IT.initVerbosity       = (InitFlags -> Flag Verbosity) -> Flag Verbosity
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Verbosity
IT.initVerbosity,
        initializeTestSuite :: Flag Bool
IT.initializeTestSuite = (InitFlags -> Flag Bool) -> Flag Bool
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.initializeTestSuite,
        interactive :: Flag Bool
IT.interactive         = (InitFlags -> Flag Bool) -> Flag Bool
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.interactive,
        language :: Flag Language
IT.language            = (InitFlags -> Flag Language) -> Flag Language
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Language
IT.language,
        license :: Flag SpecLicense
IT.license             = (InitFlags -> Flag SpecLicense) -> Flag SpecLicense
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag SpecLicense
IT.license,
        mainIs :: Flag FilePath
IT.mainIs              = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.mainIs,
        minimal :: Flag Bool
IT.minimal             = (InitFlags -> Flag Bool) -> Flag Bool
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.minimal,
        noComments :: Flag Bool
IT.noComments          = (InitFlags -> Flag Bool) -> Flag Bool
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.noComments,
        otherExts :: Flag [Extension]
IT.otherExts           = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [Extension]) -> Flag [Extension]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [Extension]
IT.otherExts,
        otherModules :: Flag [ModuleName]
IT.otherModules        = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [ModuleName]) -> Flag [ModuleName]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [ModuleName]
IT.otherModules,
        overwrite :: Flag Bool
IT.overwrite           = (InitFlags -> Flag Bool) -> Flag Bool
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.overwrite,
        packageDir :: Flag FilePath
IT.packageDir          = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.packageDir,
        packageName :: Flag PackageName
IT.packageName         = (InitFlags -> Flag PackageName) -> Flag PackageName
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag PackageName
IT.packageName,
        packageType :: Flag PackageType
IT.packageType         = (InitFlags -> Flag PackageType) -> Flag PackageType
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag PackageType
IT.packageType,
        quiet :: Flag Bool
IT.quiet               = (InitFlags -> Flag Bool) -> Flag Bool
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.quiet,
        simpleProject :: Flag Bool
IT.simpleProject       = (InitFlags -> Flag Bool) -> Flag Bool
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.simpleProject,
        sourceDirs :: Flag [FilePath]
IT.sourceDirs          = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [FilePath]) -> Flag [FilePath]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [FilePath]
IT.sourceDirs,
        synopsis :: Flag FilePath
IT.synopsis            = (InitFlags -> Flag FilePath) -> Flag FilePath
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag FilePath
IT.synopsis,
        testDirs :: Flag [FilePath]
IT.testDirs            = (SavedConfig -> InitFlags)
-> (InitFlags -> Flag [FilePath]) -> Flag [FilePath]
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [FilePath]
IT.testDirs,
        version :: Flag Version
IT.version             = (InitFlags -> Flag Version) -> Flag Version
forall a. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Version
IT.version
        }
        where
          combine :: (InitFlags -> Flag a) -> Flag a
combine = (SavedConfig -> InitFlags) -> (InitFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> InitFlags
savedInitFlags

      combinedSavedInstallFlags :: InstallFlags
combinedSavedInstallFlags = InstallFlags :: Flag Bool
-> Flag PathTemplate
-> Flag CopyDest
-> Flag Bool
-> Flag Bool
-> Flag Int
-> Flag ReorderGoals
-> Flag CountConflicts
-> Flag FineGrainedConflicts
-> Flag MinimizeConflictSet
-> Flag IndependentGoals
-> Flag ShadowPkgs
-> Flag StrongFlags
-> Flag AllowBootLibInstalls
-> Flag OnlyConstrained
-> Flag Bool
-> Flag AvoidReinstalls
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag TotalIndexState
-> Flag FilePath
-> NubList PathTemplate
-> Flag PathTemplate
-> Flag ReportLevel
-> Flag Bool
-> Flag FilePath
-> Flag Bool
-> Flag (Maybe Int)
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> InstallFlags
InstallFlags {
        installDocumentation :: Flag Bool
installDocumentation         = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installDocumentation,
        installHaddockIndex :: Flag PathTemplate
installHaddockIndex          = (InstallFlags -> Flag PathTemplate) -> Flag PathTemplate
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag PathTemplate
installHaddockIndex,
        installDryRun :: Flag Bool
installDryRun                = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installDryRun,
        installOnlyDownload :: Flag Bool
installOnlyDownload          = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOnlyDownload,
        installDest :: Flag CopyDest
installDest                  = (InstallFlags -> Flag CopyDest) -> Flag CopyDest
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag CopyDest
installDest,
        installMaxBackjumps :: Flag Int
installMaxBackjumps          = (InstallFlags -> Flag Int) -> Flag Int
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Int
installMaxBackjumps,
        installReorderGoals :: Flag ReorderGoals
installReorderGoals          = (InstallFlags -> Flag ReorderGoals) -> Flag ReorderGoals
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag ReorderGoals
installReorderGoals,
        installCountConflicts :: Flag CountConflicts
installCountConflicts        = (InstallFlags -> Flag CountConflicts) -> Flag CountConflicts
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag CountConflicts
installCountConflicts,
        installFineGrainedConflicts :: Flag FineGrainedConflicts
installFineGrainedConflicts  = (InstallFlags -> Flag FineGrainedConflicts)
-> Flag FineGrainedConflicts
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag FineGrainedConflicts
installFineGrainedConflicts,
        installMinimizeConflictSet :: Flag MinimizeConflictSet
installMinimizeConflictSet   = (InstallFlags -> Flag MinimizeConflictSet)
-> Flag MinimizeConflictSet
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag MinimizeConflictSet
installMinimizeConflictSet,
        installIndependentGoals :: Flag IndependentGoals
installIndependentGoals      = (InstallFlags -> Flag IndependentGoals) -> Flag IndependentGoals
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag IndependentGoals
installIndependentGoals,
        installShadowPkgs :: Flag ShadowPkgs
installShadowPkgs            = (InstallFlags -> Flag ShadowPkgs) -> Flag ShadowPkgs
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag ShadowPkgs
installShadowPkgs,
        installStrongFlags :: Flag StrongFlags
installStrongFlags           = (InstallFlags -> Flag StrongFlags) -> Flag StrongFlags
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag StrongFlags
installStrongFlags,
        installAllowBootLibInstalls :: Flag AllowBootLibInstalls
installAllowBootLibInstalls  = (InstallFlags -> Flag AllowBootLibInstalls)
-> Flag AllowBootLibInstalls
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag AllowBootLibInstalls
installAllowBootLibInstalls,
        installOnlyConstrained :: Flag OnlyConstrained
installOnlyConstrained       = (InstallFlags -> Flag OnlyConstrained) -> Flag OnlyConstrained
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag OnlyConstrained
installOnlyConstrained,
        installReinstall :: Flag Bool
installReinstall             = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installReinstall,
        installAvoidReinstalls :: Flag AvoidReinstalls
installAvoidReinstalls       = (InstallFlags -> Flag AvoidReinstalls) -> Flag AvoidReinstalls
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag AvoidReinstalls
installAvoidReinstalls,
        installOverrideReinstall :: Flag Bool
installOverrideReinstall     = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOverrideReinstall,
        installUpgradeDeps :: Flag Bool
installUpgradeDeps           = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installUpgradeDeps,
        installOnly :: Flag Bool
installOnly                  = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOnly,
        installOnlyDeps :: Flag Bool
installOnlyDeps              = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOnlyDeps,
        installIndexState :: Flag TotalIndexState
installIndexState            = (InstallFlags -> Flag TotalIndexState) -> Flag TotalIndexState
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag TotalIndexState
installIndexState,
        installRootCmd :: Flag FilePath
installRootCmd               = (InstallFlags -> Flag FilePath) -> Flag FilePath
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag FilePath
installRootCmd,
        installSummaryFile :: NubList PathTemplate
installSummaryFile           = (InstallFlags -> NubList PathTemplate) -> NubList PathTemplate
forall a. (InstallFlags -> NubList a) -> NubList a
lastNonEmptyNL InstallFlags -> NubList PathTemplate
installSummaryFile,
        installLogFile :: Flag PathTemplate
installLogFile               = (InstallFlags -> Flag PathTemplate) -> Flag PathTemplate
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag PathTemplate
installLogFile,
        installBuildReports :: Flag ReportLevel
installBuildReports          = (InstallFlags -> Flag ReportLevel) -> Flag ReportLevel
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag ReportLevel
installBuildReports,
        installReportPlanningFailure :: Flag Bool
installReportPlanningFailure = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installReportPlanningFailure,
        installSymlinkBinDir :: Flag FilePath
installSymlinkBinDir         = (InstallFlags -> Flag FilePath) -> Flag FilePath
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag FilePath
installSymlinkBinDir,
        installPerComponent :: Flag Bool
installPerComponent          = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installPerComponent,
        installNumJobs :: Flag (Maybe Int)
installNumJobs               = (InstallFlags -> Flag (Maybe Int)) -> Flag (Maybe Int)
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag (Maybe Int)
installNumJobs,
        installKeepGoing :: Flag Bool
installKeepGoing             = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installKeepGoing,
        installRunTests :: Flag Bool
installRunTests              = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installRunTests,
        installOfflineMode :: Flag Bool
installOfflineMode           = (InstallFlags -> Flag Bool) -> Flag Bool
forall a. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOfflineMode
        }
        where
          combine :: (InstallFlags -> Flag a) -> Flag a
combine        = (SavedConfig -> InstallFlags) -> (InstallFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> InstallFlags
savedInstallFlags
          lastNonEmptyNL :: (InstallFlags -> NubList a) -> NubList a
lastNonEmptyNL = (SavedConfig -> InstallFlags)
-> (InstallFlags -> NubList a) -> NubList a
forall flags a.
(SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> InstallFlags
savedInstallFlags

      combinedSavedClientInstallFlags :: ClientInstallFlags
combinedSavedClientInstallFlags = ClientInstallFlags :: Flag Bool
-> Flag FilePath
-> Flag OverwritePolicy
-> Flag InstallMethod
-> Flag FilePath
-> ClientInstallFlags
ClientInstallFlags
        { cinstInstallLibs :: Flag Bool
cinstInstallLibs     = (ClientInstallFlags -> Flag Bool) -> Flag Bool
forall a. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag Bool
cinstInstallLibs
        , cinstEnvironmentPath :: Flag FilePath
cinstEnvironmentPath = (ClientInstallFlags -> Flag FilePath) -> Flag FilePath
forall a. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag FilePath
cinstEnvironmentPath
        , cinstOverwritePolicy :: Flag OverwritePolicy
cinstOverwritePolicy = (ClientInstallFlags -> Flag OverwritePolicy)
-> Flag OverwritePolicy
forall a. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag OverwritePolicy
cinstOverwritePolicy
        , cinstInstallMethod :: Flag InstallMethod
cinstInstallMethod   = (ClientInstallFlags -> Flag InstallMethod) -> Flag InstallMethod
forall a. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag InstallMethod
cinstInstallMethod
        , cinstInstalldir :: Flag FilePath
cinstInstalldir      = (ClientInstallFlags -> Flag FilePath) -> Flag FilePath
forall a. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag FilePath
cinstInstalldir
        }
        where
          combine :: (ClientInstallFlags -> Flag a) -> Flag a
combine        = (SavedConfig -> ClientInstallFlags)
-> (ClientInstallFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> ClientInstallFlags
savedClientInstallFlags

      combinedSavedConfigureFlags :: ConfigFlags
combinedSavedConfigureFlags = ConfigFlags :: [FilePath]
-> Option' (Last' ProgramDb)
-> [(FilePath, FilePath)]
-> [(FilePath, [FilePath])]
-> NubList FilePath
-> Flag CompilerFlavor
-> Flag FilePath
-> Flag FilePath
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag ProfDetailLevel
-> Flag ProfDetailLevel
-> [FilePath]
-> Flag OptimisationLevel
-> Flag PathTemplate
-> Flag PathTemplate
-> InstallDirs (Flag PathTemplate)
-> Flag FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> Flag FilePath
-> Flag ComponentId
-> Flag Bool
-> Flag FilePath
-> Flag FilePath
-> Flag Verbosity
-> Flag Bool
-> [Maybe PackageDB]
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> [PackageVersionConstraint]
-> [GivenComponent]
-> [(ModuleName, Module)]
-> FlagAssignment
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag FilePath
-> Flag Bool
-> Flag DebugInfoLevel
-> Flag DumpBuildInfo
-> Flag Bool
-> Flag Bool
-> ConfigFlags
ConfigFlags {
        configArgs :: [FilePath]
configArgs                = (ConfigFlags -> [FilePath]) -> [FilePath]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [FilePath]
configArgs,
        configPrograms_ :: Option' (Last' ProgramDb)
configPrograms_           = ConfigFlags -> Option' (Last' ProgramDb)
configPrograms_ (ConfigFlags -> Option' (Last' ProgramDb))
-> (SavedConfig -> ConfigFlags)
-> SavedConfig
-> Option' (Last' ProgramDb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags (SavedConfig -> Option' (Last' ProgramDb))
-> SavedConfig -> Option' (Last' ProgramDb)
forall a b. (a -> b) -> a -> b
$ SavedConfig
b,
        -- TODO: NubListify
        configProgramPaths :: [(FilePath, FilePath)]
configProgramPaths        = (ConfigFlags -> [(FilePath, FilePath)]) -> [(FilePath, FilePath)]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [(FilePath, FilePath)]
configProgramPaths,
        -- TODO: NubListify
        configProgramArgs :: [(FilePath, [FilePath])]
configProgramArgs         = (ConfigFlags -> [(FilePath, [FilePath])])
-> [(FilePath, [FilePath])]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [(FilePath, [FilePath])]
configProgramArgs,
        configProgramPathExtra :: NubList FilePath
configProgramPathExtra    = (ConfigFlags -> NubList FilePath) -> NubList FilePath
forall a. (ConfigFlags -> NubList a) -> NubList a
lastNonEmptyNL ConfigFlags -> NubList FilePath
configProgramPathExtra,
        configInstantiateWith :: [(ModuleName, Module)]
configInstantiateWith     = (ConfigFlags -> [(ModuleName, Module)]) -> [(ModuleName, Module)]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [(ModuleName, Module)]
configInstantiateWith,
        configHcFlavor :: Flag CompilerFlavor
configHcFlavor            = (ConfigFlags -> Flag CompilerFlavor) -> Flag CompilerFlavor
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag CompilerFlavor
configHcFlavor,
        configHcPath :: Flag FilePath
configHcPath              = (ConfigFlags -> Flag FilePath) -> Flag FilePath
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag FilePath
configHcPath,
        configHcPkg :: Flag FilePath
configHcPkg               = (ConfigFlags -> Flag FilePath) -> Flag FilePath
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag FilePath
configHcPkg,
        configVanillaLib :: Flag Bool
configVanillaLib          = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configVanillaLib,
        configProfLib :: Flag Bool
configProfLib             = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configProfLib,
        configProf :: Flag Bool
configProf                = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configProf,
        configSharedLib :: Flag Bool
configSharedLib           = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configSharedLib,
        configStaticLib :: Flag Bool
configStaticLib           = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configStaticLib,
        configDynExe :: Flag Bool
configDynExe              = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configDynExe,
        configFullyStaticExe :: Flag Bool
configFullyStaticExe      = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configFullyStaticExe,
        configProfExe :: Flag Bool
configProfExe             = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configProfExe,
        configProfDetail :: Flag ProfDetailLevel
configProfDetail          = (ConfigFlags -> Flag ProfDetailLevel) -> Flag ProfDetailLevel
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag ProfDetailLevel
configProfDetail,
        configProfLibDetail :: Flag ProfDetailLevel
configProfLibDetail       = (ConfigFlags -> Flag ProfDetailLevel) -> Flag ProfDetailLevel
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag ProfDetailLevel
configProfLibDetail,
        -- TODO: NubListify
        configConfigureArgs :: [FilePath]
configConfigureArgs       = (ConfigFlags -> [FilePath]) -> [FilePath]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [FilePath]
configConfigureArgs,
        configOptimization :: Flag OptimisationLevel
configOptimization        = (ConfigFlags -> Flag OptimisationLevel) -> Flag OptimisationLevel
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag OptimisationLevel
configOptimization,
        configDebugInfo :: Flag DebugInfoLevel
configDebugInfo           = (ConfigFlags -> Flag DebugInfoLevel) -> Flag DebugInfoLevel
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag DebugInfoLevel
configDebugInfo,
        configProgPrefix :: Flag PathTemplate
configProgPrefix          = (ConfigFlags -> Flag PathTemplate) -> Flag PathTemplate
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag PathTemplate
configProgPrefix,
        configProgSuffix :: Flag PathTemplate
configProgSuffix          = (ConfigFlags -> Flag PathTemplate) -> Flag PathTemplate
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag PathTemplate
configProgSuffix,
        -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
        configInstallDirs :: InstallDirs (Flag PathTemplate)
configInstallDirs         =
          (ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs (ConfigFlags -> InstallDirs (Flag PathTemplate))
-> (SavedConfig -> ConfigFlags)
-> SavedConfig
-> InstallDirs (Flag PathTemplate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags (SavedConfig -> InstallDirs (Flag PathTemplate))
-> SavedConfig -> InstallDirs (Flag PathTemplate)
forall a b. (a -> b) -> a -> b
$ SavedConfig
a)
          InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
forall a. Monoid a => a -> a -> a
`mappend` (ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs (ConfigFlags -> InstallDirs (Flag PathTemplate))
-> (SavedConfig -> ConfigFlags)
-> SavedConfig
-> InstallDirs (Flag PathTemplate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags (SavedConfig -> InstallDirs (Flag PathTemplate))
-> SavedConfig -> InstallDirs (Flag PathTemplate)
forall a b. (a -> b) -> a -> b
$ SavedConfig
b),
        configScratchDir :: Flag FilePath
configScratchDir          = (ConfigFlags -> Flag FilePath) -> Flag FilePath
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag FilePath
configScratchDir,
        -- TODO: NubListify
        configExtraLibDirs :: [FilePath]
configExtraLibDirs        = (ConfigFlags -> [FilePath]) -> [FilePath]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [FilePath]
configExtraLibDirs,
        configExtraLibDirsStatic :: [FilePath]
configExtraLibDirsStatic  = (ConfigFlags -> [FilePath]) -> [FilePath]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [FilePath]
configExtraLibDirsStatic,
        -- TODO: NubListify
        configExtraFrameworkDirs :: [FilePath]
configExtraFrameworkDirs  = (ConfigFlags -> [FilePath]) -> [FilePath]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [FilePath]
configExtraFrameworkDirs,
        -- TODO: NubListify
        configExtraIncludeDirs :: [FilePath]
configExtraIncludeDirs    = (ConfigFlags -> [FilePath]) -> [FilePath]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [FilePath]
configExtraIncludeDirs,
        configDeterministic :: Flag Bool
configDeterministic       = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configDeterministic,
        configIPID :: Flag FilePath
configIPID                = (ConfigFlags -> Flag FilePath) -> Flag FilePath
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag FilePath
configIPID,
        configCID :: Flag ComponentId
configCID                 = (ConfigFlags -> Flag ComponentId) -> Flag ComponentId
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag ComponentId
configCID,
        configDistPref :: Flag FilePath
configDistPref            = (ConfigFlags -> Flag FilePath) -> Flag FilePath
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag FilePath
configDistPref,
        configCabalFilePath :: Flag FilePath
configCabalFilePath       = (ConfigFlags -> Flag FilePath) -> Flag FilePath
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag FilePath
configCabalFilePath,
        configVerbosity :: Flag Verbosity
configVerbosity           = (ConfigFlags -> Flag Verbosity) -> Flag Verbosity
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Verbosity
configVerbosity,
        configUserInstall :: Flag Bool
configUserInstall         = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configUserInstall,
        -- TODO: NubListify
        configPackageDBs :: [Maybe PackageDB]
configPackageDBs          = (ConfigFlags -> [Maybe PackageDB]) -> [Maybe PackageDB]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [Maybe PackageDB]
configPackageDBs,
        configGHCiLib :: Flag Bool
configGHCiLib             = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configGHCiLib,
        configSplitSections :: Flag Bool
configSplitSections       = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configSplitSections,
        configSplitObjs :: Flag Bool
configSplitObjs           = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configSplitObjs,
        configStripExes :: Flag Bool
configStripExes           = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configStripExes,
        configStripLibs :: Flag Bool
configStripLibs           = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configStripLibs,
        -- TODO: NubListify
        configConstraints :: [PackageVersionConstraint]
configConstraints         = (ConfigFlags -> [PackageVersionConstraint])
-> [PackageVersionConstraint]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [PackageVersionConstraint]
configConstraints,
        -- TODO: NubListify
        configDependencies :: [GivenComponent]
configDependencies        = (ConfigFlags -> [GivenComponent]) -> [GivenComponent]
forall a. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [GivenComponent]
configDependencies,
        -- TODO: NubListify
        configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = (ConfigFlags -> FlagAssignment) -> FlagAssignment
lastNonMempty ConfigFlags -> FlagAssignment
configConfigurationsFlags,
        configTests :: Flag Bool
configTests               = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configTests,
        configBenchmarks :: Flag Bool
configBenchmarks          = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configBenchmarks,
        configCoverage :: Flag Bool
configCoverage            = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configCoverage,
        configLibCoverage :: Flag Bool
configLibCoverage         = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configLibCoverage,
        configExactConfiguration :: Flag Bool
configExactConfiguration  = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configExactConfiguration,
        configFlagError :: Flag FilePath
configFlagError           = (ConfigFlags -> Flag FilePath) -> Flag FilePath
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag FilePath
configFlagError,
        configRelocatable :: Flag Bool
configRelocatable         = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configRelocatable,
        configUseResponseFiles :: Flag Bool
configUseResponseFiles    = (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configUseResponseFiles,
        configDumpBuildInfo :: Flag DumpBuildInfo
configDumpBuildInfo       = (ConfigFlags -> Flag DumpBuildInfo) -> Flag DumpBuildInfo
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag DumpBuildInfo
configDumpBuildInfo,
        configAllowDependingOnPrivateLibs :: Flag Bool
configAllowDependingOnPrivateLibs =
            (ConfigFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configAllowDependingOnPrivateLibs
        }
        where
          combine :: (ConfigFlags -> Flag a) -> Flag a
combine        = (SavedConfig -> ConfigFlags) -> (ConfigFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> ConfigFlags
savedConfigureFlags
          lastNonEmpty :: (ConfigFlags -> [a]) -> [a]
lastNonEmpty   = (SavedConfig -> ConfigFlags) -> (ConfigFlags -> [a]) -> [a]
forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty'   SavedConfig -> ConfigFlags
savedConfigureFlags
          lastNonEmptyNL :: (ConfigFlags -> NubList a) -> NubList a
lastNonEmptyNL = (SavedConfig -> ConfigFlags)
-> (ConfigFlags -> NubList a) -> NubList a
forall flags a.
(SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> ConfigFlags
savedConfigureFlags
          lastNonMempty :: (ConfigFlags -> FlagAssignment) -> FlagAssignment
lastNonMempty  = (SavedConfig -> ConfigFlags)
-> (ConfigFlags -> FlagAssignment) -> FlagAssignment
forall a flags.
(Eq a, Monoid a) =>
(SavedConfig -> flags) -> (flags -> a) -> a
lastNonMempty'  SavedConfig -> ConfigFlags
savedConfigureFlags

      combinedSavedConfigureExFlags :: ConfigExFlags
combinedSavedConfigureExFlags = ConfigExFlags :: Flag Version
-> Flag Bool
-> Flag Bool
-> [(UserConstraint, ConstraintSource)]
-> [PackageVersionConstraint]
-> Flag PreSolver
-> Maybe AllowNewer
-> Maybe AllowOlder
-> Flag WriteGhcEnvironmentFilesPolicy
-> ConfigExFlags
ConfigExFlags {
        configCabalVersion :: Flag Version
configCabalVersion  = (ConfigExFlags -> Flag Version) -> Flag Version
forall a. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag Version
configCabalVersion,
        configAppend :: Flag Bool
configAppend        = (ConfigExFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag Bool
configAppend,
        configBackup :: Flag Bool
configBackup        = (ConfigExFlags -> Flag Bool) -> Flag Bool
forall a. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag Bool
configBackup,
        -- TODO: NubListify
        configExConstraints :: [(UserConstraint, ConstraintSource)]
configExConstraints = (ConfigExFlags -> [(UserConstraint, ConstraintSource)])
-> [(UserConstraint, ConstraintSource)]
forall a. (ConfigExFlags -> [a]) -> [a]
lastNonEmpty ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints,
        -- TODO: NubListify
        configPreferences :: [PackageVersionConstraint]
configPreferences   = (ConfigExFlags -> [PackageVersionConstraint])
-> [PackageVersionConstraint]
forall a. (ConfigExFlags -> [a]) -> [a]
lastNonEmpty ConfigExFlags -> [PackageVersionConstraint]
configPreferences,
        configSolver :: Flag PreSolver
configSolver        = (ConfigExFlags -> Flag PreSolver) -> Flag PreSolver
forall a. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag PreSolver
configSolver,
        configAllowNewer :: Maybe AllowNewer
configAllowNewer    =
            (SavedConfig -> ConfigExFlags)
-> (ConfigExFlags -> Maybe AllowNewer) -> Maybe AllowNewer
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> ConfigExFlags
savedConfigureExFlags ConfigExFlags -> Maybe AllowNewer
configAllowNewer,
        configAllowOlder :: Maybe AllowOlder
configAllowOlder    =
            (SavedConfig -> ConfigExFlags)
-> (ConfigExFlags -> Maybe AllowOlder) -> Maybe AllowOlder
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> ConfigExFlags
savedConfigureExFlags ConfigExFlags -> Maybe AllowOlder
configAllowOlder,
        configWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
configWriteGhcEnvironmentFilesPolicy
                            = (ConfigExFlags -> Flag WriteGhcEnvironmentFilesPolicy)
-> Flag WriteGhcEnvironmentFilesPolicy
forall a. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag WriteGhcEnvironmentFilesPolicy
configWriteGhcEnvironmentFilesPolicy
        }
        where
          combine :: (ConfigExFlags -> Flag a) -> Flag a
combine      = (SavedConfig -> ConfigExFlags)
-> (ConfigExFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> ConfigExFlags
savedConfigureExFlags
          lastNonEmpty :: (ConfigExFlags -> [a]) -> [a]
lastNonEmpty = (SavedConfig -> ConfigExFlags) -> (ConfigExFlags -> [a]) -> [a]
forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' SavedConfig -> ConfigExFlags
savedConfigureExFlags

      -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
      combinedSavedUserInstallDirs :: InstallDirs (Flag PathTemplate)
combinedSavedUserInstallDirs = SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs SavedConfig
a
                                     InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs SavedConfig
b

      -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
      combinedSavedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
combinedSavedGlobalInstallDirs = SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs SavedConfig
a
                                       InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
-> InstallDirs (Flag PathTemplate)
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs SavedConfig
b

      combinedSavedUploadFlags :: UploadFlags
combinedSavedUploadFlags = UploadFlags :: Flag IsCandidate
-> Flag Bool
-> Flag Username
-> Flag Password
-> Flag [FilePath]
-> Flag Verbosity
-> UploadFlags
UploadFlags {
        uploadCandidate :: Flag IsCandidate
uploadCandidate   = (UploadFlags -> Flag IsCandidate) -> Flag IsCandidate
forall a. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag IsCandidate
uploadCandidate,
        uploadDoc :: Flag Bool
uploadDoc         = (UploadFlags -> Flag Bool) -> Flag Bool
forall a. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Bool
uploadDoc,
        uploadUsername :: Flag Username
uploadUsername    = (UploadFlags -> Flag Username) -> Flag Username
forall a. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Username
uploadUsername,
        uploadPassword :: Flag Password
uploadPassword    = (UploadFlags -> Flag Password) -> Flag Password
forall a. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Password
uploadPassword,
        uploadPasswordCmd :: Flag [FilePath]
uploadPasswordCmd = (UploadFlags -> Flag [FilePath]) -> Flag [FilePath]
forall a. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag [FilePath]
uploadPasswordCmd,
        uploadVerbosity :: Flag Verbosity
uploadVerbosity   = (UploadFlags -> Flag Verbosity) -> Flag Verbosity
forall a. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Verbosity
uploadVerbosity
        }
        where
          combine :: (UploadFlags -> Flag a) -> Flag a
combine = (SavedConfig -> UploadFlags) -> (UploadFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> UploadFlags
savedUploadFlags

      combinedSavedReportFlags :: ReportFlags
combinedSavedReportFlags = ReportFlags :: Flag Username -> Flag Password -> Flag Verbosity -> ReportFlags
ReportFlags {
        reportUsername :: Flag Username
reportUsername  = (ReportFlags -> Flag Username) -> Flag Username
forall a. (ReportFlags -> Flag a) -> Flag a
combine ReportFlags -> Flag Username
reportUsername,
        reportPassword :: Flag Password
reportPassword  = (ReportFlags -> Flag Password) -> Flag Password
forall a. (ReportFlags -> Flag a) -> Flag a
combine ReportFlags -> Flag Password
reportPassword,
        reportVerbosity :: Flag Verbosity
reportVerbosity = (ReportFlags -> Flag Verbosity) -> Flag Verbosity
forall a. (ReportFlags -> Flag a) -> Flag a
combine ReportFlags -> Flag Verbosity
reportVerbosity
        }
        where
          combine :: (ReportFlags -> Flag a) -> Flag a
combine = (SavedConfig -> ReportFlags) -> (ReportFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> ReportFlags
savedReportFlags

      combinedSavedHaddockFlags :: HaddockFlags
combinedSavedHaddockFlags = HaddockFlags :: [(FilePath, FilePath)]
-> [(FilePath, [FilePath])]
-> Flag Bool
-> Flag Bool
-> Flag FilePath
-> Flag HaddockTarget
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag FilePath
-> Flag Bool
-> Flag Bool
-> Flag FilePath
-> Flag PathTemplate
-> Flag FilePath
-> Flag Bool
-> Flag Verbosity
-> Flag FilePath
-> [FilePath]
-> HaddockFlags
HaddockFlags {
        -- TODO: NubListify
        haddockProgramPaths :: [(FilePath, FilePath)]
haddockProgramPaths  = (HaddockFlags -> [(FilePath, FilePath)]) -> [(FilePath, FilePath)]
forall a. (HaddockFlags -> [a]) -> [a]
lastNonEmpty HaddockFlags -> [(FilePath, FilePath)]
haddockProgramPaths,
        -- TODO: NubListify
        haddockProgramArgs :: [(FilePath, [FilePath])]
haddockProgramArgs   = (HaddockFlags -> [(FilePath, [FilePath])])
-> [(FilePath, [FilePath])]
forall a. (HaddockFlags -> [a]) -> [a]
lastNonEmpty HaddockFlags -> [(FilePath, [FilePath])]
haddockProgramArgs,
        haddockHoogle :: Flag Bool
haddockHoogle        = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockHoogle,
        haddockHtml :: Flag Bool
haddockHtml          = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockHtml,
        haddockHtmlLocation :: Flag FilePath
haddockHtmlLocation  = (HaddockFlags -> Flag FilePath) -> Flag FilePath
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag FilePath
haddockHtmlLocation,
        haddockForHackage :: Flag HaddockTarget
haddockForHackage    = (HaddockFlags -> Flag HaddockTarget) -> Flag HaddockTarget
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag HaddockTarget
haddockForHackage,
        haddockExecutables :: Flag Bool
haddockExecutables   = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockExecutables,
        haddockTestSuites :: Flag Bool
haddockTestSuites    = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockTestSuites,
        haddockBenchmarks :: Flag Bool
haddockBenchmarks    = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockBenchmarks,
        haddockForeignLibs :: Flag Bool
haddockForeignLibs   = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockForeignLibs,
        haddockInternal :: Flag Bool
haddockInternal      = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockInternal,
        haddockCss :: Flag FilePath
haddockCss           = (HaddockFlags -> Flag FilePath) -> Flag FilePath
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag FilePath
haddockCss,
        haddockLinkedSource :: Flag Bool
haddockLinkedSource  = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockLinkedSource,
        haddockQuickJump :: Flag Bool
haddockQuickJump     = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockQuickJump,
        haddockHscolourCss :: Flag FilePath
haddockHscolourCss   = (HaddockFlags -> Flag FilePath) -> Flag FilePath
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag FilePath
haddockHscolourCss,
        haddockContents :: Flag PathTemplate
haddockContents      = (HaddockFlags -> Flag PathTemplate) -> Flag PathTemplate
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag PathTemplate
haddockContents,
        haddockDistPref :: Flag FilePath
haddockDistPref      = (HaddockFlags -> Flag FilePath) -> Flag FilePath
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag FilePath
haddockDistPref,
        haddockKeepTempFiles :: Flag Bool
haddockKeepTempFiles = (HaddockFlags -> Flag Bool) -> Flag Bool
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockKeepTempFiles,
        haddockVerbosity :: Flag Verbosity
haddockVerbosity     = (HaddockFlags -> Flag Verbosity) -> Flag Verbosity
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Verbosity
haddockVerbosity,
        haddockCabalFilePath :: Flag FilePath
haddockCabalFilePath = (HaddockFlags -> Flag FilePath) -> Flag FilePath
forall a. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag FilePath
haddockCabalFilePath,
        haddockArgs :: [FilePath]
haddockArgs          = (HaddockFlags -> [FilePath]) -> [FilePath]
forall a. (HaddockFlags -> [a]) -> [a]
lastNonEmpty HaddockFlags -> [FilePath]
haddockArgs
        }
        where
          combine :: (HaddockFlags -> Flag a) -> Flag a
combine      = (SavedConfig -> HaddockFlags) -> (HaddockFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> HaddockFlags
savedHaddockFlags
          lastNonEmpty :: (HaddockFlags -> [a]) -> [a]
lastNonEmpty = (SavedConfig -> HaddockFlags) -> (HaddockFlags -> [a]) -> [a]
forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty'   SavedConfig -> HaddockFlags
savedHaddockFlags

      combinedSavedTestFlags :: TestFlags
combinedSavedTestFlags = TestFlags :: Flag FilePath
-> Flag Verbosity
-> Flag PathTemplate
-> Flag PathTemplate
-> Flag TestShowDetails
-> Flag Bool
-> Flag FilePath
-> Flag Bool
-> [PathTemplate]
-> TestFlags
TestFlags {
        testDistPref :: Flag FilePath
testDistPref    = (TestFlags -> Flag FilePath) -> Flag FilePath
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag FilePath
testDistPref,
        testVerbosity :: Flag Verbosity
testVerbosity   = (TestFlags -> Flag Verbosity) -> Flag Verbosity
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag Verbosity
testVerbosity,
        testHumanLog :: Flag PathTemplate
testHumanLog    = (TestFlags -> Flag PathTemplate) -> Flag PathTemplate
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag PathTemplate
testHumanLog,
        testMachineLog :: Flag PathTemplate
testMachineLog  = (TestFlags -> Flag PathTemplate) -> Flag PathTemplate
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag PathTemplate
testMachineLog,
        testShowDetails :: Flag TestShowDetails
testShowDetails = (TestFlags -> Flag TestShowDetails) -> Flag TestShowDetails
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag TestShowDetails
testShowDetails,
        testKeepTix :: Flag Bool
testKeepTix     = (TestFlags -> Flag Bool) -> Flag Bool
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag Bool
testKeepTix,
        testWrapper :: Flag FilePath
testWrapper     = (TestFlags -> Flag FilePath) -> Flag FilePath
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag FilePath
testWrapper,
        testFailWhenNoTestSuites :: Flag Bool
testFailWhenNoTestSuites = (TestFlags -> Flag Bool) -> Flag Bool
forall a. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag Bool
testFailWhenNoTestSuites,
        testOptions :: [PathTemplate]
testOptions     = (TestFlags -> [PathTemplate]) -> [PathTemplate]
forall a. (TestFlags -> [a]) -> [a]
lastNonEmpty TestFlags -> [PathTemplate]
testOptions
        }
        where
          combine :: (TestFlags -> Flag a) -> Flag a
combine      = (SavedConfig -> TestFlags) -> (TestFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> TestFlags
savedTestFlags
          lastNonEmpty :: (TestFlags -> [a]) -> [a]
lastNonEmpty = (SavedConfig -> TestFlags) -> (TestFlags -> [a]) -> [a]
forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty'   SavedConfig -> TestFlags
savedTestFlags

      combinedSavedBenchmarkFlags :: BenchmarkFlags
combinedSavedBenchmarkFlags = BenchmarkFlags :: Flag FilePath -> Flag Verbosity -> [PathTemplate] -> BenchmarkFlags
BenchmarkFlags {
        benchmarkDistPref :: Flag FilePath
benchmarkDistPref  = (BenchmarkFlags -> Flag FilePath) -> Flag FilePath
forall a. (BenchmarkFlags -> Flag a) -> Flag a
combine BenchmarkFlags -> Flag FilePath
benchmarkDistPref,
        benchmarkVerbosity :: Flag Verbosity
benchmarkVerbosity = (BenchmarkFlags -> Flag Verbosity) -> Flag Verbosity
forall a. (BenchmarkFlags -> Flag a) -> Flag a
combine BenchmarkFlags -> Flag Verbosity
benchmarkVerbosity,
        benchmarkOptions :: [PathTemplate]
benchmarkOptions   = (BenchmarkFlags -> [PathTemplate]) -> [PathTemplate]
forall a. (BenchmarkFlags -> [a]) -> [a]
lastNonEmpty BenchmarkFlags -> [PathTemplate]
benchmarkOptions
        }
        where
          combine :: (BenchmarkFlags -> Flag a) -> Flag a
combine      = (SavedConfig -> BenchmarkFlags)
-> (BenchmarkFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> BenchmarkFlags
savedBenchmarkFlags
          lastNonEmpty :: (BenchmarkFlags -> [a]) -> [a]
lastNonEmpty = (SavedConfig -> BenchmarkFlags) -> (BenchmarkFlags -> [a]) -> [a]
forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty'   SavedConfig -> BenchmarkFlags
savedBenchmarkFlags

      combinedSavedProjectFlags :: ProjectFlags
combinedSavedProjectFlags = ProjectFlags :: Flag FilePath -> Flag Bool -> ProjectFlags
ProjectFlags
        { flagProjectFileName :: Flag FilePath
flagProjectFileName = (ProjectFlags -> Flag FilePath) -> Flag FilePath
forall a. (ProjectFlags -> Flag a) -> Flag a
combine ProjectFlags -> Flag FilePath
flagProjectFileName
        , flagIgnoreProject :: Flag Bool
flagIgnoreProject   = (ProjectFlags -> Flag Bool) -> Flag Bool
forall a. (ProjectFlags -> Flag a) -> Flag a
combine ProjectFlags -> Flag Bool
flagIgnoreProject
        }
        where
          combine :: (ProjectFlags -> Flag a) -> Flag a
combine      = (SavedConfig -> ProjectFlags) -> (ProjectFlags -> Flag a) -> Flag a
forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine'        SavedConfig -> ProjectFlags
savedProjectFlags

--
-- * Default config
--

-- | These are the absolute basic defaults. The fields that must be
-- initialised. When we load the config from the file we layer the loaded
-- values over these ones, so any missing fields in the file take their values
-- from here.
--
baseSavedConfig :: IO SavedConfig
baseSavedConfig :: IO SavedConfig
baseSavedConfig = do
  FilePath
userPrefix <- IO FilePath
getCabalDir
  FilePath
cacheDir   <- IO FilePath
defaultCacheDir
  FilePath
logsDir    <- IO FilePath
defaultLogsDir
  SavedConfig -> IO SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
forall a. Monoid a => a
mempty {
    savedConfigureFlags :: ConfigFlags
savedConfigureFlags  = ConfigFlags
forall a. Monoid a => a
mempty {
      configHcFlavor :: Flag CompilerFlavor
configHcFlavor     = CompilerFlavor -> Flag CompilerFlavor
forall a. a -> Flag a
toFlag CompilerFlavor
defaultCompiler,
      configUserInstall :: Flag Bool
configUserInstall  = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
defaultUserInstall,
      configVerbosity :: Flag Verbosity
configVerbosity    = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag Verbosity
normal
    },
    savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs = InstallDirs (Flag PathTemplate)
forall a. Monoid a => a
mempty {
      prefix :: Flag PathTemplate
prefix             = PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag (FilePath -> PathTemplate
toPathTemplate FilePath
userPrefix)
    },
    savedGlobalFlags :: GlobalFlags
savedGlobalFlags = GlobalFlags
forall a. Monoid a => a
mempty {
      globalCacheDir :: Flag FilePath
globalCacheDir     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
cacheDir,
      globalLogsDir :: Flag FilePath
globalLogsDir      = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
logsDir
    }
  }

-- | This is the initial configuration that we write out to the config file
-- if the file does not exist (or the config we use if the file cannot be read
-- for some other reason). When the config gets loaded it gets layered on top
-- of 'baseSavedConfig' so we do not need to include it into the initial
-- values we save into the config file.
--
initialSavedConfig :: IO SavedConfig
initialSavedConfig :: IO SavedConfig
initialSavedConfig = do
  FilePath
cacheDir    <- IO FilePath
defaultCacheDir
  FilePath
logsDir     <- IO FilePath
defaultLogsDir
  [FilePath]
extraPath   <- IO [FilePath]
defaultExtraPath
  FilePath
installPath <- IO FilePath
defaultInstallPath
  SavedConfig -> IO SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
forall a. Monoid a => a
mempty {
    savedGlobalFlags :: GlobalFlags
savedGlobalFlags     = GlobalFlags
forall a. Monoid a => a
mempty {
      globalCacheDir :: Flag FilePath
globalCacheDir     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
cacheDir,
      globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos  = [RemoteRepo] -> NubList RemoteRepo
forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo
defaultRemoteRepo]
    },
    savedConfigureFlags :: ConfigFlags
savedConfigureFlags  = ConfigFlags
forall a. Monoid a => a
mempty {
      configProgramPathExtra :: NubList FilePath
configProgramPathExtra = [FilePath] -> NubList FilePath
forall a. Ord a => [a] -> NubList a
toNubList [FilePath]
extraPath
    },
    savedInstallFlags :: InstallFlags
savedInstallFlags    = InstallFlags
forall a. Monoid a => a
mempty {
      installSummaryFile :: NubList PathTemplate
installSummaryFile = [PathTemplate] -> NubList PathTemplate
forall a. Ord a => [a] -> NubList a
toNubList [FilePath -> PathTemplate
toPathTemplate (FilePath
logsDir FilePath -> FilePath -> FilePath
</> FilePath
"build.log")],
      installBuildReports :: Flag ReportLevel
installBuildReports= ReportLevel -> Flag ReportLevel
forall a. a -> Flag a
toFlag ReportLevel
NoReports,
      installNumJobs :: Flag (Maybe Int)
installNumJobs     = Maybe Int -> Flag (Maybe Int)
forall a. a -> Flag a
toFlag Maybe Int
forall a. Maybe a
Nothing
    },
    savedClientInstallFlags :: ClientInstallFlags
savedClientInstallFlags = ClientInstallFlags
forall a. Monoid a => a
mempty {
      cinstInstalldir :: Flag FilePath
cinstInstalldir = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
installPath
    }
  }

defaultCabalDir :: IO FilePath
defaultCabalDir :: IO FilePath
defaultCabalDir = FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"cabal"

getCabalDir :: IO FilePath
getCabalDir :: IO FilePath
getCabalDir = do
  Maybe FilePath
mDir <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"CABAL_DIR"
  case Maybe FilePath
mDir of
    Maybe FilePath
Nothing -> IO FilePath
defaultCabalDir
    Just FilePath
dir -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir

defaultConfigFile :: IO FilePath
defaultConfigFile :: IO FilePath
defaultConfigFile = do
  FilePath
dir <- IO FilePath
getCabalDir
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"config"

defaultCacheDir :: IO FilePath
defaultCacheDir :: IO FilePath
defaultCacheDir = do
  FilePath
dir <- IO FilePath
getCabalDir
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"packages"

defaultLogsDir :: IO FilePath
defaultLogsDir :: IO FilePath
defaultLogsDir = do
  FilePath
dir <- IO FilePath
getCabalDir
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"logs"

defaultExtraPath :: IO [FilePath]
defaultExtraPath :: IO [FilePath]
defaultExtraPath = do
  FilePath
dir <- IO FilePath
getCabalDir
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"bin"]

defaultInstallPath :: IO FilePath
defaultInstallPath :: IO FilePath
defaultInstallPath = do
  FilePath
dir <- IO FilePath
getCabalDir
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"bin")

defaultCompiler :: CompilerFlavor
defaultCompiler :: CompilerFlavor
defaultCompiler = CompilerFlavor -> Maybe CompilerFlavor -> CompilerFlavor
forall a. a -> Maybe a -> a
fromMaybe CompilerFlavor
GHC Maybe CompilerFlavor
defaultCompilerFlavor

defaultUserInstall :: Bool
defaultUserInstall :: Bool
defaultUserInstall = Bool
True
-- We do per-user installs by default on all platforms. We used to default to
-- global installs on Windows but that no longer works on Windows Vista or 7.

defaultRemoteRepo :: RemoteRepo
defaultRemoteRepo :: RemoteRepo
defaultRemoteRepo = RepoName
-> URI -> Maybe Bool -> [FilePath] -> Int -> Bool -> RemoteRepo
RemoteRepo RepoName
name URI
uri Maybe Bool
forall a. Maybe a
Nothing [] Int
0 Bool
False
  where
    str :: FilePath
str  = FilePath
"hackage.haskell.org"
    name :: RepoName
name = FilePath -> RepoName
RepoName FilePath
str
    uri :: URI
uri  = FilePath
-> Maybe URIAuth -> FilePath -> FilePath -> FilePath -> URI
URI FilePath
"http:" (URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just (FilePath -> FilePath -> FilePath -> URIAuth
URIAuth FilePath
"" FilePath
str FilePath
"")) FilePath
"/" FilePath
"" FilePath
""
    -- Note that lots of old ~/.cabal/config files will have the old url
    -- http://hackage.haskell.org/packages/archive
    -- but new config files can use the new url (without the /packages/archive)
    -- and avoid having to do a http redirect

-- For the default repo we know extra information, fill this in.
--
-- We need this because the 'defaultRemoteRepo' above is only used for the
-- first time when a config file is made. So for users with older config files
-- we might have only have older info. This lets us fill that in even for old
-- config files.
--
addInfoForKnownRepos :: RemoteRepo -> RemoteRepo
addInfoForKnownRepos :: RemoteRepo -> RemoteRepo
addInfoForKnownRepos RemoteRepo
repo
  | RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repo RepoName -> RepoName -> Bool
forall a. Eq a => a -> a -> Bool
== RemoteRepo -> RepoName
remoteRepoName RemoteRepo
defaultRemoteRepo
  = RemoteRepo -> RemoteRepo
useSecure (RemoteRepo -> RemoteRepo)
-> (RemoteRepo -> RemoteRepo) -> RemoteRepo -> RemoteRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> RemoteRepo
tryHttps (RemoteRepo -> RemoteRepo)
-> (RemoteRepo -> RemoteRepo) -> RemoteRepo -> RemoteRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> RemoteRepo
fixOldURI (RemoteRepo -> RemoteRepo) -> RemoteRepo -> RemoteRepo
forall a b. (a -> b) -> a -> b
$ RemoteRepo
repo
  where
    fixOldURI :: RemoteRepo -> RemoteRepo
fixOldURI RemoteRepo
r
      | URI -> Bool
isOldHackageURI (RemoteRepo -> URI
remoteRepoURI RemoteRepo
r)
                  = RemoteRepo
r { remoteRepoURI :: URI
remoteRepoURI = RemoteRepo -> URI
remoteRepoURI RemoteRepo
defaultRemoteRepo }
      | Bool
otherwise = RemoteRepo
r

    tryHttps :: RemoteRepo -> RemoteRepo
tryHttps RemoteRepo
r = RemoteRepo
r { remoteRepoShouldTryHttps :: Bool
remoteRepoShouldTryHttps = Bool
True }

    useSecure :: RemoteRepo -> RemoteRepo
useSecure r :: RemoteRepo
r@RemoteRepo{
                  remoteRepoSecure :: RemoteRepo -> Maybe Bool
remoteRepoSecure       = Maybe Bool
secure,
                  remoteRepoRootKeys :: RemoteRepo -> [FilePath]
remoteRepoRootKeys     = [],
                  remoteRepoKeyThreshold :: RemoteRepo -> Int
remoteRepoKeyThreshold = Int
0
                } | Maybe Bool
secure Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
            = RemoteRepo
r {
                -- Use hackage-security by default unless you opt-out with
                -- secure: False
                remoteRepoSecure :: Maybe Bool
remoteRepoSecure       = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
                remoteRepoRootKeys :: [FilePath]
remoteRepoRootKeys     = [FilePath]
defaultHackageRemoteRepoKeys,
                remoteRepoKeyThreshold :: Int
remoteRepoKeyThreshold = Int
defaultHackageRemoteRepoKeyThreshold
              }
    useSecure RemoteRepo
r = RemoteRepo
r
addInfoForKnownRepos RemoteRepo
other = RemoteRepo
other

-- | The current hackage.haskell.org repo root keys that we ship with cabal.
---
-- This lets us bootstrap trust in this repo without user intervention.
-- These keys need to be periodically updated when new root keys are added.
-- See the root key procedures for details.
--
defaultHackageRemoteRepoKeys :: [String]
defaultHackageRemoteRepoKeys :: [FilePath]
defaultHackageRemoteRepoKeys =
    [ FilePath
"fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0",
      FilePath
"1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42",
      FilePath
"2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3",
      FilePath
"0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d",
      FilePath
"51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
    ]

-- | The required threshold of root key signatures for hackage.haskell.org
--
defaultHackageRemoteRepoKeyThreshold :: Int
defaultHackageRemoteRepoKeyThreshold :: Int
defaultHackageRemoteRepoKeyThreshold = Int
3

--
-- * Config file reading
--

-- | Loads the main configuration, and applies additional defaults to give the
-- effective configuration. To loads just what is actually in the config file,
-- use 'loadRawConfig'.
--
loadConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
loadConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
loadConfig Verbosity
verbosity Flag FilePath
configFileFlag = do
  SavedConfig
config <- Verbosity -> Flag FilePath -> IO SavedConfig
loadRawConfig Verbosity
verbosity Flag FilePath
configFileFlag
  SavedConfig -> IO SavedConfig
extendToEffectiveConfig SavedConfig
config

extendToEffectiveConfig :: SavedConfig -> IO SavedConfig
extendToEffectiveConfig :: SavedConfig -> IO SavedConfig
extendToEffectiveConfig SavedConfig
config = do
  SavedConfig
base <- IO SavedConfig
baseSavedConfig
  let effective0 :: SavedConfig
effective0   = SavedConfig
base SavedConfig -> SavedConfig -> SavedConfig
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
config
      globalFlags0 :: GlobalFlags
globalFlags0 = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
effective0
      effective :: SavedConfig
effective  = SavedConfig
effective0 {
                     savedGlobalFlags :: GlobalFlags
savedGlobalFlags = GlobalFlags
globalFlags0 {
                       globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos =
                         ([RemoteRepo] -> [RemoteRepo])
-> NubList RemoteRepo -> NubList RemoteRepo
forall a. Ord a => ([a] -> [a]) -> NubList a -> NubList a
overNubList ((RemoteRepo -> RemoteRepo) -> [RemoteRepo] -> [RemoteRepo]
forall a b. (a -> b) -> [a] -> [b]
map RemoteRepo -> RemoteRepo
addInfoForKnownRepos)
                                     (GlobalFlags -> NubList RemoteRepo
globalRemoteRepos GlobalFlags
globalFlags0)
                     }
                   }
  SavedConfig -> IO SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
effective

-- | Like 'loadConfig' but does not apply any additional defaults, it just
-- loads what is actually in the config file. This is thus suitable for
-- comparing or editing a config file, but not suitable for using as the
-- effective configuration.
--
loadRawConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
loadRawConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
loadRawConfig Verbosity
verbosity Flag FilePath
configFileFlag = do
  (ConfigFileSource
source, FilePath
configFile) <- Flag FilePath -> IO (ConfigFileSource, FilePath)
getConfigFilePathAndSource Flag FilePath
configFileFlag
  Maybe (ParseResult SavedConfig)
minp <- SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig))
readConfigFile SavedConfig
forall a. Monoid a => a
mempty FilePath
configFile
  case Maybe (ParseResult SavedConfig)
minp of
    Maybe (ParseResult SavedConfig)
Nothing -> do
      Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"Config file path source is " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfigFileSource -> FilePath
sourceMsg ConfigFileSource
source FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
      -- 2021-10-07, issue #7705
      -- Only create default config file if name was not given explicitly
      -- via option --config-file or environment variable.
      case ConfigFileSource
source of
        ConfigFileSource
Default -> do
          Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity FilePath
msgNotFound
          Verbosity -> [FilePath] -> FilePath -> IO SavedConfig
createDefaultConfigFile Verbosity
verbosity [] FilePath
configFile
        ConfigFileSource
CommandlineOption   -> IO SavedConfig
forall a. IO a
failNoConfigFile
        ConfigFileSource
EnvironmentVariable -> IO SavedConfig
forall a. IO a
failNoConfigFile
      where
        msgNotFound :: FilePath
msgNotFound = [FilePath] -> FilePath
unwords [ FilePath
"Config file not found:", FilePath
configFile ]
        failNoConfigFile :: IO a
failNoConfigFile = Verbosity -> FilePath -> IO a
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
          [ FilePath
msgNotFound
          , FilePath
"(Config files can be created via the cabal-command 'user-config init'.)"
          ]
    Just (ParseOk [PWarning]
ws SavedConfig
conf) -> do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PWarning] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PWarning]
ws) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> FilePath
unlines ((PWarning -> FilePath) -> [PWarning] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PWarning -> FilePath
showPWarning FilePath
configFile) [PWarning]
ws)
      SavedConfig -> IO SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
conf
    Just (ParseFailed PError
err) -> do
      let (Maybe Int
line, FilePath
msg) = PError -> (Maybe Int, FilePath)
locatedErrorMsg PError
err
      Verbosity -> FilePath -> IO SavedConfig
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO SavedConfig) -> FilePath -> IO SavedConfig
forall a b. (a -> b) -> a -> b
$
          FilePath
"Error parsing config file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
configFile
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (Int -> FilePath) -> Maybe Int -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\Int
n -> Char
':' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n) Maybe Int
line FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg

  where
    sourceMsg :: ConfigFileSource -> FilePath
sourceMsg ConfigFileSource
CommandlineOption =   FilePath
"commandline option"
    sourceMsg ConfigFileSource
EnvironmentVariable = FilePath
"environment variable CABAL_CONFIG"
    sourceMsg ConfigFileSource
Default =             FilePath
"default config file"

-- | Provenance of the config file.

data ConfigFileSource = CommandlineOption
                      | EnvironmentVariable
                      | Default

-- | Returns the config file path, without checking that the file exists.
-- The order of precedence is: input flag, CABAL_CONFIG, default location.
getConfigFilePath :: Flag FilePath -> IO FilePath
getConfigFilePath :: Flag FilePath -> IO FilePath
getConfigFilePath = ((ConfigFileSource, FilePath) -> FilePath)
-> IO (ConfigFileSource, FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConfigFileSource, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (IO (ConfigFileSource, FilePath) -> IO FilePath)
-> (Flag FilePath -> IO (ConfigFileSource, FilePath))
-> Flag FilePath
-> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag FilePath -> IO (ConfigFileSource, FilePath)
getConfigFilePathAndSource

getConfigFilePathAndSource :: Flag FilePath -> IO (ConfigFileSource, FilePath)
getConfigFilePathAndSource :: Flag FilePath -> IO (ConfigFileSource, FilePath)
getConfigFilePathAndSource Flag FilePath
configFileFlag =
    [(ConfigFileSource, IO (Maybe FilePath))]
-> IO (ConfigFileSource, FilePath)
forall (m :: * -> *) a b. Monad m => [(a, m (Maybe b))] -> m (a, b)
getSource [(ConfigFileSource, IO (Maybe FilePath))]
sources
  where
    sources :: [(ConfigFileSource, IO (Maybe FilePath))]
sources =
      [ (ConfigFileSource
CommandlineOption,   Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> (Flag FilePath -> Maybe FilePath)
-> Flag FilePath
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe (Flag FilePath -> IO (Maybe FilePath))
-> Flag FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Flag FilePath
configFileFlag)
      , (ConfigFileSource
EnvironmentVariable, FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"CABAL_CONFIG" ([(FilePath, FilePath)] -> Maybe FilePath)
-> IO [(FilePath, FilePath)] -> IO (Maybe FilePath)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO [(FilePath, FilePath)]
getEnvironment)
      , (ConfigFileSource
Default,             FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO FilePath
defaultConfigFile) ]

    getSource :: [(a, m (Maybe b))] -> m (a, b)
getSource [] = FilePath -> m (a, b)
forall a. HasCallStack => FilePath -> a
error FilePath
"no config file path candidate found."
    getSource ((a
source,m (Maybe b)
action): [(a, m (Maybe b))]
xs) =
                      m (Maybe b)
action m (Maybe b) -> (Maybe b -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (a, b) -> (b -> m (a, b)) -> Maybe b -> m (a, b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(a, m (Maybe b))] -> m (a, b)
getSource [(a, m (Maybe b))]
xs) ((a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b) -> m (a, b)) -> (b -> (a, b)) -> b -> m (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
source)

readConfigFile
  :: SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig))
readConfigFile :: SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig))
readConfigFile SavedConfig
initial FilePath
file = IO (Maybe (ParseResult SavedConfig))
-> IO (Maybe (ParseResult SavedConfig))
forall a. IO (Maybe a) -> IO (Maybe a)
handleNotExists (IO (Maybe (ParseResult SavedConfig))
 -> IO (Maybe (ParseResult SavedConfig)))
-> IO (Maybe (ParseResult SavedConfig))
-> IO (Maybe (ParseResult SavedConfig))
forall a b. (a -> b) -> a -> b
$
  (ByteString -> Maybe (ParseResult SavedConfig))
-> IO ByteString -> IO (Maybe (ParseResult SavedConfig))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseResult SavedConfig -> Maybe (ParseResult SavedConfig)
forall a. a -> Maybe a
Just (ParseResult SavedConfig -> Maybe (ParseResult SavedConfig))
-> (ByteString -> ParseResult SavedConfig)
-> ByteString
-> Maybe (ParseResult SavedConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintSource
-> SavedConfig -> ByteString -> ParseResult SavedConfig
parseConfig (FilePath -> ConstraintSource
ConstraintSourceMainConfig FilePath
file) SavedConfig
initial)
       (FilePath -> IO ByteString
BS.readFile FilePath
file)

  where
    handleNotExists :: IO (Maybe a) -> IO (Maybe a)
handleNotExists IO (Maybe a)
action = IO (Maybe a) -> (IOException -> IO (Maybe a)) -> IO (Maybe a)
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO (Maybe a)
action ((IOException -> IO (Maybe a)) -> IO (Maybe a))
-> (IOException -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \IOException
ioe ->
      if IOException -> Bool
isDoesNotExistError IOException
ioe
        then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        else IOException -> IO (Maybe a)
forall a. IOException -> IO a
ioError IOException
ioe

createDefaultConfigFile :: Verbosity -> [String] -> FilePath -> IO SavedConfig
createDefaultConfigFile :: Verbosity -> [FilePath] -> FilePath -> IO SavedConfig
createDefaultConfigFile Verbosity
verbosity [FilePath]
extraLines FilePath
filePath  = do
  SavedConfig
commentConf <- IO SavedConfig
commentSavedConfig
  SavedConfig
initialConf <- IO SavedConfig
initialSavedConfig
  SavedConfig
extraConf   <- Verbosity -> [FilePath] -> IO SavedConfig
parseExtraLines Verbosity
verbosity [FilePath]
extraLines
  Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing default configuration to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
filePath
  FilePath -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile FilePath
filePath SavedConfig
commentConf (SavedConfig
initialConf SavedConfig -> SavedConfig -> SavedConfig
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
extraConf)
  SavedConfig -> IO SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
initialConf

writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile FilePath
file SavedConfig
comments SavedConfig
vals = do
  let tmpFile :: FilePath
tmpFile = FilePath
file FilePath -> FilePath -> FilePath
<.> FilePath
"tmp"
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
file)
  FilePath -> FilePath -> IO ()
writeFile FilePath
tmpFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath
explanation FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SavedConfig -> SavedConfig -> FilePath
showConfigWithComments SavedConfig
comments SavedConfig
vals FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
  FilePath -> FilePath -> IO ()
renameFile FilePath
tmpFile FilePath
file
  where
    explanation :: FilePath
explanation = [FilePath] -> FilePath
unlines
      [FilePath
"-- This is the configuration file for the 'cabal' command line tool."
      ,FilePath
"--"
      ,FilePath
"-- The available configuration options are listed below."
      ,FilePath
"-- Some of them have default values listed."
      ,FilePath
"--"
      ,FilePath
"-- Lines (like this one) beginning with '--' are comments."
      ,FilePath
"-- Be careful with spaces and indentation because they are"
      ,FilePath
"-- used to indicate layout for nested sections."
      ,FilePath
"--"
      ,FilePath
"-- This config file was generated using the following versions"
      ,FilePath
"-- of Cabal and cabal-install:"
      ,FilePath
"-- Cabal library version: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
cabalVersion
      ,FilePath
"-- cabal-install version: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
cabalInstallVersion
      ,FilePath
"",FilePath
""
      ]

-- | These are the default values that get used in Cabal if a no value is
-- given. We use these here to include in comments when we write out the
-- initial config file so that the user can see what default value they are
-- overriding.
--
commentSavedConfig :: IO SavedConfig
commentSavedConfig :: IO SavedConfig
commentSavedConfig = do
  InstallDirTemplates
userInstallDirs   <- CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs CompilerFlavor
defaultCompiler Bool
True Bool
True
  InstallDirTemplates
globalInstallDirs <- CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs CompilerFlavor
defaultCompiler Bool
False Bool
True
  let conf0 :: SavedConfig
conf0 = SavedConfig
forall a. Monoid a => a
mempty {
        savedGlobalFlags :: GlobalFlags
savedGlobalFlags       = GlobalFlags
defaultGlobalFlags {
            globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = [RemoteRepo] -> NubList RemoteRepo
forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo
defaultRemoteRepo]
            },
        savedInitFlags :: InitFlags
savedInitFlags       = InitFlags
forall a. Monoid a => a
mempty {
            interactive :: Flag Bool
IT.interactive     = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
False,
            cabalVersion :: Flag CabalSpecVersion
IT.cabalVersion    = CabalSpecVersion -> Flag CabalSpecVersion
forall a. a -> Flag a
toFlag CabalSpecVersion
IT.defaultCabalVersion,
            language :: Flag Language
IT.language        = Language -> Flag Language
forall a. a -> Flag a
toFlag Language
Haskell2010,
            license :: Flag SpecLicense
IT.license         = Flag SpecLicense
forall a. Flag a
NoFlag,
            sourceDirs :: Flag [FilePath]
IT.sourceDirs      = [FilePath] -> Flag [FilePath]
forall a. a -> Flag a
Flag [FilePath
IT.defaultSourceDir],
            applicationDirs :: Flag [FilePath]
IT.applicationDirs = [FilePath] -> Flag [FilePath]
forall a. a -> Flag a
Flag [FilePath
IT.defaultApplicationDir]
            },
        savedInstallFlags :: InstallFlags
savedInstallFlags      = InstallFlags
defaultInstallFlags,
        savedClientInstallFlags :: ClientInstallFlags
savedClientInstallFlags= ClientInstallFlags
defaultClientInstallFlags,
        savedConfigureExFlags :: ConfigExFlags
savedConfigureExFlags  = ConfigExFlags
defaultConfigExFlags {
            configAllowNewer :: Maybe AllowNewer
configAllowNewer     = AllowNewer -> Maybe AllowNewer
forall a. a -> Maybe a
Just (RelaxDeps -> AllowNewer
AllowNewer RelaxDeps
forall a. Monoid a => a
mempty),
            configAllowOlder :: Maybe AllowOlder
configAllowOlder     = AllowOlder -> Maybe AllowOlder
forall a. a -> Maybe a
Just (RelaxDeps -> AllowOlder
AllowOlder RelaxDeps
forall a. Monoid a => a
mempty)
            },
        savedConfigureFlags :: ConfigFlags
savedConfigureFlags    = (ProgramDb -> ConfigFlags
defaultConfigFlags ProgramDb
defaultProgramDb) {
            configUserInstall :: Flag Bool
configUserInstall    = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
defaultUserInstall
            },
        savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs   = (PathTemplate -> Flag PathTemplate)
-> InstallDirTemplates -> InstallDirs (Flag PathTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag InstallDirTemplates
userInstallDirs,
        savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs = (PathTemplate -> Flag PathTemplate)
-> InstallDirTemplates -> InstallDirs (Flag PathTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> Flag PathTemplate
forall a. a -> Flag a
toFlag InstallDirTemplates
globalInstallDirs,
        savedUploadFlags :: UploadFlags
savedUploadFlags       = CommandUI UploadFlags -> UploadFlags
forall flags. CommandUI flags -> flags
commandDefaultFlags CommandUI UploadFlags
uploadCommand,
        savedReportFlags :: ReportFlags
savedReportFlags       = CommandUI ReportFlags -> ReportFlags
forall flags. CommandUI flags -> flags
commandDefaultFlags CommandUI ReportFlags
reportCommand,
        savedHaddockFlags :: HaddockFlags
savedHaddockFlags      = HaddockFlags
defaultHaddockFlags,
        savedTestFlags :: TestFlags
savedTestFlags         = TestFlags
defaultTestFlags,
        savedBenchmarkFlags :: BenchmarkFlags
savedBenchmarkFlags    = BenchmarkFlags
defaultBenchmarkFlags
        }
  SavedConfig
conf1 <- SavedConfig -> IO SavedConfig
extendToEffectiveConfig SavedConfig
conf0
  let globalFlagsConf1 :: GlobalFlags
globalFlagsConf1 = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
conf1
      conf2 :: SavedConfig
conf2 = SavedConfig
conf1 {
        savedGlobalFlags :: GlobalFlags
savedGlobalFlags = GlobalFlags
globalFlagsConf1 {
            globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = ([RemoteRepo] -> [RemoteRepo])
-> NubList RemoteRepo -> NubList RemoteRepo
forall a. Ord a => ([a] -> [a]) -> NubList a -> NubList a
overNubList ((RemoteRepo -> RemoteRepo) -> [RemoteRepo] -> [RemoteRepo]
forall a b. (a -> b) -> [a] -> [b]
map RemoteRepo -> RemoteRepo
removeRootKeys)
                                (GlobalFlags -> NubList RemoteRepo
globalRemoteRepos GlobalFlags
globalFlagsConf1)
            }
        }
  SavedConfig -> IO SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
conf2
    where
      -- Most people don't want to see default root keys, so don't print them.
      removeRootKeys :: RemoteRepo -> RemoteRepo
      removeRootKeys :: RemoteRepo -> RemoteRepo
removeRootKeys RemoteRepo
r = RemoteRepo
r { remoteRepoRootKeys :: [FilePath]
remoteRepoRootKeys = [] }

-- | All config file fields.
--
configFieldDescriptions :: ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions :: ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions ConstraintSource
src =

     (FieldDescr GlobalFlags -> FieldDescr SavedConfig)
-> [OptionField GlobalFlags]
-> [FilePath]
-> [FieldDescr GlobalFlags]
-> [FieldDescr SavedConfig]
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag
       (CommandUI GlobalFlags
-> ShowOrParseArgs -> [OptionField GlobalFlags]
forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions ([Command Any] -> CommandUI GlobalFlags
forall action. [Command action] -> CommandUI GlobalFlags
globalCommand []) ShowOrParseArgs
ParseArgs)
       [FilePath
"version", FilePath
"numeric-version", FilePath
"config-file"] []

  [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr ConfigFlags -> FieldDescr SavedConfig)
-> [OptionField ConfigFlags]
-> [FilePath]
-> [FieldDescr ConfigFlags]
-> [FieldDescr SavedConfig]
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr ConfigFlags -> FieldDescr SavedConfig
liftConfigFlag
       (ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions ShowOrParseArgs
ParseArgs)
       ([FilePath
"builddir", FilePath
"constraint", FilePath
"dependency", FilePath
"ipid"]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FieldDescr (InstallDirs (Flag PathTemplate)) -> FilePath)
-> [FieldDescr (InstallDirs (Flag PathTemplate))] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FieldDescr (InstallDirs (Flag PathTemplate)) -> FilePath
forall a. FieldDescr a -> FilePath
fieldName [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields)

        -- This is only here because viewAsFieldDescr gives us a parser
        -- that only recognises 'ghc' etc, the case-sensitive flag names, not
        -- what the normal case-insensitive parser gives us.
       [FilePath
-> (Flag CompilerFlavor -> Doc)
-> ParsecParser (Flag CompilerFlavor)
-> (ConfigFlags -> Flag CompilerFlavor)
-> (Flag CompilerFlavor -> ConfigFlags -> ConfigFlags)
-> FieldDescr ConfigFlags
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"compiler"
          (Doc -> Flag Doc -> Doc
forall a. a -> Flag a -> a
fromFlagOrDefault Doc
Disp.empty (Flag Doc -> Doc)
-> (Flag CompilerFlavor -> Flag Doc) -> Flag CompilerFlavor -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerFlavor -> Doc) -> Flag CompilerFlavor -> Flag Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
pretty) (CompilerFlavor -> Flag CompilerFlavor
forall a. a -> Flag a
Flag (CompilerFlavor -> Flag CompilerFlavor)
-> ParsecParser CompilerFlavor
-> ParsecParser (Flag CompilerFlavor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser CompilerFlavor
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec ParsecParser (Flag CompilerFlavor)
-> ParsecParser (Flag CompilerFlavor)
-> ParsecParser (Flag CompilerFlavor)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flag CompilerFlavor -> ParsecParser (Flag CompilerFlavor)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag CompilerFlavor
forall a. Flag a
NoFlag)
          ConfigFlags -> Flag CompilerFlavor
configHcFlavor (\Flag CompilerFlavor
v ConfigFlags
flags -> ConfigFlags
flags { configHcFlavor :: Flag CompilerFlavor
configHcFlavor = Flag CompilerFlavor
v })

        -- TODO: The following is a temporary fix. The "optimization"
        -- and "debug-info" fields are OptArg, and viewAsFieldDescr
        -- fails on that. Instead of a hand-written hackaged parser
        -- and printer, we should handle this case properly in the
        -- library.
       ,(ConfigFlags -> Flag OptimisationLevel)
-> (Flag OptimisationLevel -> ConfigFlags -> ConfigFlags)
-> FieldDescr (Flag OptimisationLevel)
-> FieldDescr ConfigFlags
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField ConfigFlags -> Flag OptimisationLevel
configOptimization (\Flag OptimisationLevel
v ConfigFlags
flags ->
                                       ConfigFlags
flags { configOptimization :: Flag OptimisationLevel
configOptimization = Flag OptimisationLevel
v }) (FieldDescr (Flag OptimisationLevel) -> FieldDescr ConfigFlags)
-> FieldDescr (Flag OptimisationLevel) -> FieldDescr ConfigFlags
forall a b. (a -> b) -> a -> b
$
        let name :: FilePath
name = FilePath
"optimization" in
        FilePath
-> (Flag OptimisationLevel -> Doc)
-> (Int
    -> FilePath
    -> Flag OptimisationLevel
    -> ParseResult (Flag OptimisationLevel))
-> FieldDescr (Flag OptimisationLevel)
forall a.
FilePath
-> (a -> Doc)
-> (Int -> FilePath -> a -> ParseResult a)
-> FieldDescr a
FieldDescr FilePath
name
          (\Flag OptimisationLevel
f -> case Flag OptimisationLevel
f of
                   Flag OptimisationLevel
NoOptimisation      -> FilePath -> Doc
Disp.text FilePath
"False"
                   Flag OptimisationLevel
NormalOptimisation  -> FilePath -> Doc
Disp.text FilePath
"True"
                   Flag OptimisationLevel
MaximumOptimisation -> FilePath -> Doc
Disp.text FilePath
"2"
                   Flag OptimisationLevel
_                        -> Doc
Disp.empty)
          (\Int
line FilePath
str Flag OptimisationLevel
_ -> case () of
           ()
_ |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"False" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"True"  -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"0"     -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"1"     -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"2"     -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
MaximumOptimisation)
             | FilePath
lstr FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"false" -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning] (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
             | FilePath
lstr FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"true"  -> [PWarning]
-> Flag OptimisationLevel -> ParseResult (Flag OptimisationLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning]
                                  (OptimisationLevel -> Flag OptimisationLevel
forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
             | Bool
otherwise       -> PError -> ParseResult (Flag OptimisationLevel)
forall a. PError -> ParseResult a
ParseFailed (FilePath -> Int -> PError
NoParse FilePath
name Int
line)
             where
               lstr :: FilePath
lstr = FilePath -> FilePath
lowercase FilePath
str
               caseWarning :: PWarning
caseWarning = FilePath -> PWarning
PWarning (FilePath -> PWarning) -> FilePath -> PWarning
forall a b. (a -> b) -> a -> b
$
                 FilePath
"The '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name
                 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' field is case sensitive, use 'True' or 'False'.")
       ,(ConfigFlags -> Flag DebugInfoLevel)
-> (Flag DebugInfoLevel -> ConfigFlags -> ConfigFlags)
-> FieldDescr (Flag DebugInfoLevel)
-> FieldDescr ConfigFlags
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField ConfigFlags -> Flag DebugInfoLevel
configDebugInfo (\Flag DebugInfoLevel
v ConfigFlags
flags -> ConfigFlags
flags { configDebugInfo :: Flag DebugInfoLevel
configDebugInfo = Flag DebugInfoLevel
v }) (FieldDescr (Flag DebugInfoLevel) -> FieldDescr ConfigFlags)
-> FieldDescr (Flag DebugInfoLevel) -> FieldDescr ConfigFlags
forall a b. (a -> b) -> a -> b
$
        let name :: FilePath
name = FilePath
"debug-info" in
        FilePath
-> (Flag DebugInfoLevel -> Doc)
-> (Int
    -> FilePath
    -> Flag DebugInfoLevel
    -> ParseResult (Flag DebugInfoLevel))
-> FieldDescr (Flag DebugInfoLevel)
forall a.
FilePath
-> (a -> Doc)
-> (Int -> FilePath -> a -> ParseResult a)
-> FieldDescr a
FieldDescr FilePath
name
          (\Flag DebugInfoLevel
f -> case Flag DebugInfoLevel
f of
                   Flag DebugInfoLevel
NoDebugInfo      -> FilePath -> Doc
Disp.text FilePath
"False"
                   Flag DebugInfoLevel
MinimalDebugInfo -> FilePath -> Doc
Disp.text FilePath
"1"
                   Flag DebugInfoLevel
NormalDebugInfo  -> FilePath -> Doc
Disp.text FilePath
"True"
                   Flag DebugInfoLevel
MaximalDebugInfo -> FilePath -> Doc
Disp.text FilePath
"3"
                   Flag DebugInfoLevel
_                     -> Doc
Disp.empty)
          (\Int
line FilePath
str Flag DebugInfoLevel
_ -> case () of
           ()
_ |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"False" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"True"  -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"0"     -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"1"     -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
MinimalDebugInfo)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"2"     -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
             |  FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"3"     -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
MaximalDebugInfo)
             | FilePath
lstr FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"false" -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
             | FilePath
lstr FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"true"  -> [PWarning]
-> Flag DebugInfoLevel -> ParseResult (Flag DebugInfoLevel)
forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning] (DebugInfoLevel -> Flag DebugInfoLevel
forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
             | Bool
otherwise       -> PError -> ParseResult (Flag DebugInfoLevel)
forall a. PError -> ParseResult a
ParseFailed (FilePath -> Int -> PError
NoParse FilePath
name Int
line)
             where
               lstr :: FilePath
lstr = FilePath -> FilePath
lowercase FilePath
str
               caseWarning :: PWarning
caseWarning = FilePath -> PWarning
PWarning (FilePath -> PWarning) -> FilePath -> PWarning
forall a b. (a -> b) -> a -> b
$
                 FilePath
"The '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name
                 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' field is case sensitive, use 'True' or 'False'.")
       ]

  [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr ConfigExFlags -> FieldDescr SavedConfig)
-> [OptionField ConfigExFlags]
-> [FilePath]
-> [FieldDescr ConfigExFlags]
-> [FieldDescr SavedConfig]
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr ConfigExFlags -> FieldDescr SavedConfig
liftConfigExFlag
       (ShowOrParseArgs -> ConstraintSource -> [OptionField ConfigExFlags]
configureExOptions ShowOrParseArgs
ParseArgs ConstraintSource
src)
       []
       [let pkgs :: ParsecParser (Maybe AllowOlder)
pkgs            = (AllowOlder -> Maybe AllowOlder
forall a. a -> Maybe a
Just (AllowOlder -> Maybe AllowOlder)
-> ([RelaxedDep] -> AllowOlder) -> [RelaxedDep] -> Maybe AllowOlder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowOlder
AllowOlder (RelaxDeps -> AllowOlder)
-> ([RelaxedDep] -> RelaxDeps) -> [RelaxedDep] -> AllowOlder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelaxedDep] -> RelaxDeps
RelaxDepsSome)
                              ([RelaxedDep] -> Maybe AllowOlder)
-> ParsecParser [RelaxedDep] -> ParsecParser (Maybe AllowOlder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecParser RelaxedDep -> ParsecParser [RelaxedDep]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList ParsecParser RelaxedDep
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
            parseAllowOlder :: ParsecParser (Maybe AllowOlder)
parseAllowOlder = ((AllowOlder -> Maybe AllowOlder
forall a. a -> Maybe a
Just (AllowOlder -> Maybe AllowOlder)
-> (Bool -> AllowOlder) -> Bool -> Maybe AllowOlder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowOlder
AllowOlder (RelaxDeps -> AllowOlder)
-> (Bool -> RelaxDeps) -> Bool -> AllowOlder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RelaxDeps
toRelaxDeps)
                               (Bool -> Maybe AllowOlder)
-> ParsecParser Bool -> ParsecParser (Maybe AllowOlder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecParser Bool
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec) ParsecParser (Maybe AllowOlder)
-> ParsecParser (Maybe AllowOlder)
-> ParsecParser (Maybe AllowOlder)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecParser (Maybe AllowOlder)
pkgs
         in FilePath
-> (Maybe AllowOlder -> Doc)
-> ParsecParser (Maybe AllowOlder)
-> (ConfigExFlags -> Maybe AllowOlder)
-> (Maybe AllowOlder -> ConfigExFlags -> ConfigExFlags)
-> FieldDescr ConfigExFlags
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"allow-older"
            (Maybe RelaxDeps -> Doc
showRelaxDeps (Maybe RelaxDeps -> Doc)
-> (Maybe AllowOlder -> Maybe RelaxDeps) -> Maybe AllowOlder -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AllowOlder -> RelaxDeps) -> Maybe AllowOlder -> Maybe RelaxDeps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AllowOlder -> RelaxDeps
unAllowOlder) ParsecParser (Maybe AllowOlder)
parseAllowOlder
            ConfigExFlags -> Maybe AllowOlder
configAllowOlder (\Maybe AllowOlder
v ConfigExFlags
flags -> ConfigExFlags
flags { configAllowOlder :: Maybe AllowOlder
configAllowOlder = Maybe AllowOlder
v })
       ,let pkgs :: ParsecParser (Maybe AllowNewer)
pkgs            = (AllowNewer -> Maybe AllowNewer
forall a. a -> Maybe a
Just (AllowNewer -> Maybe AllowNewer)
-> ([RelaxedDep] -> AllowNewer) -> [RelaxedDep] -> Maybe AllowNewer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowNewer
AllowNewer (RelaxDeps -> AllowNewer)
-> ([RelaxedDep] -> RelaxDeps) -> [RelaxedDep] -> AllowNewer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelaxedDep] -> RelaxDeps
RelaxDepsSome)
                              ([RelaxedDep] -> Maybe AllowNewer)
-> ParsecParser [RelaxedDep] -> ParsecParser (Maybe AllowNewer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecParser RelaxedDep -> ParsecParser [RelaxedDep]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList ParsecParser RelaxedDep
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
            parseAllowNewer :: ParsecParser (Maybe AllowNewer)
parseAllowNewer = ((AllowNewer -> Maybe AllowNewer
forall a. a -> Maybe a
Just (AllowNewer -> Maybe AllowNewer)
-> (Bool -> AllowNewer) -> Bool -> Maybe AllowNewer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowNewer
AllowNewer (RelaxDeps -> AllowNewer)
-> (Bool -> RelaxDeps) -> Bool -> AllowNewer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RelaxDeps
toRelaxDeps)
                               (Bool -> Maybe AllowNewer)
-> ParsecParser Bool -> ParsecParser (Maybe AllowNewer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecParser Bool
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec) ParsecParser (Maybe AllowNewer)
-> ParsecParser (Maybe AllowNewer)
-> ParsecParser (Maybe AllowNewer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecParser (Maybe AllowNewer)
pkgs
         in FilePath
-> (Maybe AllowNewer -> Doc)
-> ParsecParser (Maybe AllowNewer)
-> (ConfigExFlags -> Maybe AllowNewer)
-> (Maybe AllowNewer -> ConfigExFlags -> ConfigExFlags)
-> FieldDescr ConfigExFlags
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"allow-newer"
            (Maybe RelaxDeps -> Doc
showRelaxDeps (Maybe RelaxDeps -> Doc)
-> (Maybe AllowNewer -> Maybe RelaxDeps) -> Maybe AllowNewer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AllowNewer -> RelaxDeps) -> Maybe AllowNewer -> Maybe RelaxDeps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AllowNewer -> RelaxDeps
unAllowNewer) ParsecParser (Maybe AllowNewer)
parseAllowNewer
            ConfigExFlags -> Maybe AllowNewer
configAllowNewer (\Maybe AllowNewer
v ConfigExFlags
flags -> ConfigExFlags
flags { configAllowNewer :: Maybe AllowNewer
configAllowNewer = Maybe AllowNewer
v })
       ]

  [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr InstallFlags -> FieldDescr SavedConfig)
-> [OptionField InstallFlags]
-> [FilePath]
-> [FieldDescr InstallFlags]
-> [FieldDescr SavedConfig]
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr InstallFlags -> FieldDescr SavedConfig
liftInstallFlag
       (ShowOrParseArgs -> [OptionField InstallFlags]
installOptions ShowOrParseArgs
ParseArgs)
       [FilePath
"dry-run", FilePath
"only", FilePath
"only-dependencies", FilePath
"dependencies-only"] []

  [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr ClientInstallFlags -> FieldDescr SavedConfig)
-> [OptionField ClientInstallFlags]
-> [FilePath]
-> [FieldDescr ClientInstallFlags]
-> [FieldDescr SavedConfig]
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr ClientInstallFlags -> FieldDescr SavedConfig
liftClientInstallFlag
       (ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions ShowOrParseArgs
ParseArgs)
       [] []

  [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr UploadFlags -> FieldDescr SavedConfig)
-> [OptionField UploadFlags]
-> [FilePath]
-> [FieldDescr UploadFlags]
-> [FieldDescr SavedConfig]
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag
       (CommandUI UploadFlags
-> ShowOrParseArgs -> [OptionField UploadFlags]
forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions CommandUI UploadFlags
uploadCommand ShowOrParseArgs
ParseArgs)
       [FilePath
"verbose", FilePath
"check", FilePath
"documentation", FilePath
"publish"] []

  [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr ReportFlags -> FieldDescr SavedConfig)
-> [OptionField ReportFlags]
-> [FilePath]
-> [FieldDescr ReportFlags]
-> [FieldDescr SavedConfig]
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr ReportFlags -> FieldDescr SavedConfig
liftReportFlag
       (CommandUI ReportFlags
-> ShowOrParseArgs -> [OptionField ReportFlags]
forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions CommandUI ReportFlags
reportCommand ShowOrParseArgs
ParseArgs)
       [FilePath
"verbose", FilePath
"username", FilePath
"password"] []
       --FIXME: this is a hack, hiding the user name and password.
       -- But otherwise it masks the upload ones. Either need to
       -- share the options or make then distinct. In any case
       -- they should probably be per-server.

  [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ [ OptionField SavedConfig -> FieldDescr SavedConfig
forall a. OptionField a -> FieldDescr a
viewAsFieldDescr
       (OptionField SavedConfig -> FieldDescr SavedConfig)
-> OptionField SavedConfig -> FieldDescr SavedConfig
forall a b. (a -> b) -> a -> b
$ (SavedConfig -> Flag FilePath)
-> (Flag FilePath -> SavedConfig -> SavedConfig)
-> ShowOrParseArgs
-> OptionField SavedConfig
forall flags.
(flags -> Flag FilePath)
-> (Flag FilePath -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref
       (ConfigFlags -> Flag FilePath
configDistPref (ConfigFlags -> Flag FilePath)
-> (SavedConfig -> ConfigFlags) -> SavedConfig -> Flag FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags)
       (\Flag FilePath
distPref SavedConfig
config ->
          SavedConfig
config
          { savedConfigureFlags :: ConfigFlags
savedConfigureFlags = (SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config) {
               configDistPref :: Flag FilePath
configDistPref = Flag FilePath
distPref }
          , savedHaddockFlags :: HaddockFlags
savedHaddockFlags = (SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
config) {
               haddockDistPref :: Flag FilePath
haddockDistPref = Flag FilePath
distPref }
          }
       )
       ShowOrParseArgs
ParseArgs
     ]

  where
    toSavedConfig :: (FieldDescr a -> a)
-> [OptionField a] -> t FilePath -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr a -> a
lift [OptionField a]
options t FilePath
exclusions t (FieldDescr a)
replacements =
      [ FieldDescr a -> a
lift (FieldDescr a -> Maybe (FieldDescr a) -> FieldDescr a
forall a. a -> Maybe a -> a
fromMaybe FieldDescr a
field Maybe (FieldDescr a)
replacement)
      | OptionField a
opt <- [OptionField a]
options
      , let field :: FieldDescr a
field       = OptionField a -> FieldDescr a
forall a. OptionField a -> FieldDescr a
viewAsFieldDescr OptionField a
opt
            name :: FilePath
name        = FieldDescr a -> FilePath
forall a. FieldDescr a -> FilePath
fieldName FieldDescr a
field
            replacement :: Maybe (FieldDescr a)
replacement = (FieldDescr a -> Bool) -> t (FieldDescr a) -> Maybe (FieldDescr a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
name) (FilePath -> Bool)
-> (FieldDescr a -> FilePath) -> FieldDescr a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescr a -> FilePath
forall a. FieldDescr a -> FilePath
fieldName) t (FieldDescr a)
replacements
      , FilePath
name FilePath -> t FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t FilePath
exclusions ]

    showRelaxDeps :: Maybe RelaxDeps -> Doc
showRelaxDeps Maybe RelaxDeps
Nothing                     = Doc
forall a. Monoid a => a
mempty
    showRelaxDeps (Just RelaxDeps
rd) | RelaxDeps -> Bool
isRelaxDeps RelaxDeps
rd  = FilePath -> Doc
Disp.text FilePath
"True"
                            | Bool
otherwise       = FilePath -> Doc
Disp.text FilePath
"False"

    toRelaxDeps :: Bool -> RelaxDeps
toRelaxDeps Bool
True  = RelaxDeps
RelaxDepsAll
    toRelaxDeps Bool
False = RelaxDeps
forall a. Monoid a => a
mempty


-- TODO: next step, make the deprecated fields elicit a warning.
--
deprecatedFieldDescriptions :: [FieldDescr SavedConfig]
deprecatedFieldDescriptions :: [FieldDescr SavedConfig]
deprecatedFieldDescriptions =
  [ FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag (FieldDescr GlobalFlags -> FieldDescr SavedConfig)
-> FieldDescr GlobalFlags -> FieldDescr SavedConfig
forall a b. (a -> b) -> a -> b
$
    FilePath
-> (RemoteRepo -> Doc)
-> ParsecParser RemoteRepo
-> (GlobalFlags -> [RemoteRepo])
-> ([RemoteRepo] -> GlobalFlags -> GlobalFlags)
-> FieldDescr GlobalFlags
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldParsec FilePath
"repos"
      RemoteRepo -> Doc
forall a. Pretty a => a -> Doc
pretty ParsecParser RemoteRepo
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
      (NubList RemoteRepo -> [RemoteRepo]
forall a. NubList a -> [a]
fromNubList (NubList RemoteRepo -> [RemoteRepo])
-> (GlobalFlags -> NubList RemoteRepo)
-> GlobalFlags
-> [RemoteRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> NubList RemoteRepo
globalRemoteRepos)
      (\[RemoteRepo]
rs GlobalFlags
cfg -> GlobalFlags
cfg { globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = [RemoteRepo] -> NubList RemoteRepo
forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo]
rs })
  , FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag (FieldDescr GlobalFlags -> FieldDescr SavedConfig)
-> FieldDescr GlobalFlags -> FieldDescr SavedConfig
forall a b. (a -> b) -> a -> b
$
    FilePath
-> (Flag FilePath -> Doc)
-> ParsecParser (Flag FilePath)
-> (GlobalFlags -> Flag FilePath)
-> (Flag FilePath -> GlobalFlags -> GlobalFlags)
-> FieldDescr GlobalFlags
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"cachedir"
      (FilePath -> Doc
Disp.text (FilePath -> Doc)
-> (Flag FilePath -> FilePath) -> Flag FilePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"") (ParsecParser FilePath -> ParsecParser (Flag FilePath)
forall a. ParsecParser a -> ParsecParser (Flag a)
optionalFlag ParsecParser FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
parsecFilePath)
      GlobalFlags -> Flag FilePath
globalCacheDir    (\Flag FilePath
d GlobalFlags
cfg -> GlobalFlags
cfg { globalCacheDir :: Flag FilePath
globalCacheDir = Flag FilePath
d })
  , FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag (FieldDescr UploadFlags -> FieldDescr SavedConfig)
-> FieldDescr UploadFlags -> FieldDescr SavedConfig
forall a b. (a -> b) -> a -> b
$
    FilePath
-> (Flag Username -> Doc)
-> ParsecParser (Flag Username)
-> (UploadFlags -> Flag Username)
-> (Flag Username -> UploadFlags -> UploadFlags)
-> FieldDescr UploadFlags
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"hackage-username"
      (FilePath -> Doc
Disp.text (FilePath -> Doc)
-> (Flag Username -> FilePath) -> Flag Username -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" (Flag FilePath -> FilePath)
-> (Flag Username -> Flag FilePath) -> Flag Username -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Username -> FilePath) -> Flag Username -> Flag FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Username -> FilePath
unUsername)
      (ParsecParser Username -> ParsecParser (Flag Username)
forall a. ParsecParser a -> ParsecParser (Flag a)
optionalFlag ((FilePath -> Username)
-> ParsecParser FilePath -> ParsecParser Username
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Username
Username ParsecParser FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
parsecToken))
      UploadFlags -> Flag Username
uploadUsername    (\Flag Username
d UploadFlags
cfg -> UploadFlags
cfg { uploadUsername :: Flag Username
uploadUsername = Flag Username
d })
  , FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag (FieldDescr UploadFlags -> FieldDescr SavedConfig)
-> FieldDescr UploadFlags -> FieldDescr SavedConfig
forall a b. (a -> b) -> a -> b
$
    FilePath
-> (Flag Password -> Doc)
-> ParsecParser (Flag Password)
-> (UploadFlags -> Flag Password)
-> (Flag Password -> UploadFlags -> UploadFlags)
-> FieldDescr UploadFlags
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"hackage-password"
      (FilePath -> Doc
Disp.text (FilePath -> Doc)
-> (Flag Password -> FilePath) -> Flag Password -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" (Flag FilePath -> FilePath)
-> (Flag Password -> Flag FilePath) -> Flag Password -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Password -> FilePath) -> Flag Password -> Flag FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Password -> FilePath
unPassword)
      (ParsecParser Password -> ParsecParser (Flag Password)
forall a. ParsecParser a -> ParsecParser (Flag a)
optionalFlag ((FilePath -> Password)
-> ParsecParser FilePath -> ParsecParser Password
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Password
Password ParsecParser FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
parsecToken))
      UploadFlags -> Flag Password
uploadPassword    (\Flag Password
d UploadFlags
cfg -> UploadFlags
cfg { uploadPassword :: Flag Password
uploadPassword = Flag Password
d })
  , FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag (FieldDescr UploadFlags -> FieldDescr SavedConfig)
-> FieldDescr UploadFlags -> FieldDescr SavedConfig
forall a b. (a -> b) -> a -> b
$
    FilePath
-> (FilePath -> Doc)
-> ReadP [FilePath] FilePath
-> (UploadFlags -> [FilePath])
-> ([FilePath] -> UploadFlags -> UploadFlags)
-> FieldDescr UploadFlags
forall a b.
FilePath
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
spaceListField FilePath
"hackage-password-command"
      FilePath -> Doc
Disp.text ReadP [FilePath] FilePath
forall r. ReadP r FilePath
parseTokenQ
      ([FilePath] -> Flag [FilePath] -> [FilePath]
forall a. a -> Flag a -> a
fromFlagOrDefault [] (Flag [FilePath] -> [FilePath])
-> (UploadFlags -> Flag [FilePath]) -> UploadFlags -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UploadFlags -> Flag [FilePath]
uploadPasswordCmd)
                        (\[FilePath]
d UploadFlags
cfg -> UploadFlags
cfg { uploadPasswordCmd :: Flag [FilePath]
uploadPasswordCmd = [FilePath] -> Flag [FilePath]
forall a. a -> Flag a
Flag [FilePath]
d })
  ]
 [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr (InstallDirs (Flag PathTemplate))
 -> FieldDescr SavedConfig)
-> [FieldDescr (InstallDirs (Flag PathTemplate))]
-> [FieldDescr SavedConfig]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath)
-> FieldDescr SavedConfig -> FieldDescr SavedConfig
forall a. (FilePath -> FilePath) -> FieldDescr a -> FieldDescr a
modifyFieldName (FilePath
"user-"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)   (FieldDescr SavedConfig -> FieldDescr SavedConfig)
-> (FieldDescr (InstallDirs (Flag PathTemplate))
    -> FieldDescr SavedConfig)
-> FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
liftUserInstallDirs)
    [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields
 [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ (FieldDescr (InstallDirs (Flag PathTemplate))
 -> FieldDescr SavedConfig)
-> [FieldDescr (InstallDirs (Flag PathTemplate))]
-> [FieldDescr SavedConfig]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath)
-> FieldDescr SavedConfig -> FieldDescr SavedConfig
forall a. (FilePath -> FilePath) -> FieldDescr a -> FieldDescr a
modifyFieldName (FilePath
"global-"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FieldDescr SavedConfig -> FieldDescr SavedConfig)
-> (FieldDescr (InstallDirs (Flag PathTemplate))
    -> FieldDescr SavedConfig)
-> FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
liftGlobalInstallDirs)
    [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields
  where
    optionalFlag :: ParsecParser a -> ParsecParser (Flag a)
    optionalFlag :: ParsecParser a -> ParsecParser (Flag a)
optionalFlag ParsecParser a
p = a -> Flag a
forall a. a -> Flag a
toFlag (a -> Flag a) -> ParsecParser a -> ParsecParser (Flag a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser a
p ParsecParser (Flag a)
-> ParsecParser (Flag a) -> ParsecParser (Flag a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flag a -> ParsecParser (Flag a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag a
forall a. Monoid a => a
mempty

    modifyFieldName :: (String -> String) -> FieldDescr a -> FieldDescr a
    modifyFieldName :: (FilePath -> FilePath) -> FieldDescr a -> FieldDescr a
modifyFieldName FilePath -> FilePath
f FieldDescr a
d = FieldDescr a
d { fieldName :: FilePath
fieldName = FilePath -> FilePath
f (FieldDescr a -> FilePath
forall a. FieldDescr a -> FilePath
fieldName FieldDescr a
d) }

liftUserInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))
                    -> FieldDescr SavedConfig
liftUserInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
liftUserInstallDirs = (SavedConfig -> InstallDirs (Flag PathTemplate))
-> (InstallDirs (Flag PathTemplate) -> SavedConfig -> SavedConfig)
-> FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
  SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs (\InstallDirs (Flag PathTemplate)
flags SavedConfig
conf -> SavedConfig
conf { savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs = InstallDirs (Flag PathTemplate)
flags })

liftGlobalInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))
                      -> FieldDescr SavedConfig
liftGlobalInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
liftGlobalInstallDirs =
  (SavedConfig -> InstallDirs (Flag PathTemplate))
-> (InstallDirs (Flag PathTemplate) -> SavedConfig -> SavedConfig)
-> FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs
  (\InstallDirs (Flag PathTemplate)
flags SavedConfig
conf -> SavedConfig
conf { savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs = InstallDirs (Flag PathTemplate)
flags })

liftGlobalFlag :: FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag :: FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag = (SavedConfig -> GlobalFlags)
-> (GlobalFlags -> SavedConfig -> SavedConfig)
-> FieldDescr GlobalFlags
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
  SavedConfig -> GlobalFlags
savedGlobalFlags (\GlobalFlags
flags SavedConfig
conf -> SavedConfig
conf { savedGlobalFlags :: GlobalFlags
savedGlobalFlags = GlobalFlags
flags })

liftConfigFlag :: FieldDescr ConfigFlags -> FieldDescr SavedConfig
liftConfigFlag :: FieldDescr ConfigFlags -> FieldDescr SavedConfig
liftConfigFlag = (SavedConfig -> ConfigFlags)
-> (ConfigFlags -> SavedConfig -> SavedConfig)
-> FieldDescr ConfigFlags
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
  SavedConfig -> ConfigFlags
savedConfigureFlags (\ConfigFlags
flags SavedConfig
conf -> SavedConfig
conf { savedConfigureFlags :: ConfigFlags
savedConfigureFlags = ConfigFlags
flags })

liftConfigExFlag :: FieldDescr ConfigExFlags -> FieldDescr SavedConfig
liftConfigExFlag :: FieldDescr ConfigExFlags -> FieldDescr SavedConfig
liftConfigExFlag = (SavedConfig -> ConfigExFlags)
-> (ConfigExFlags -> SavedConfig -> SavedConfig)
-> FieldDescr ConfigExFlags
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
  SavedConfig -> ConfigExFlags
savedConfigureExFlags (\ConfigExFlags
flags SavedConfig
conf -> SavedConfig
conf { savedConfigureExFlags :: ConfigExFlags
savedConfigureExFlags = ConfigExFlags
flags })

liftInstallFlag :: FieldDescr InstallFlags -> FieldDescr SavedConfig
liftInstallFlag :: FieldDescr InstallFlags -> FieldDescr SavedConfig
liftInstallFlag = (SavedConfig -> InstallFlags)
-> (InstallFlags -> SavedConfig -> SavedConfig)
-> FieldDescr InstallFlags
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
  SavedConfig -> InstallFlags
savedInstallFlags (\InstallFlags
flags SavedConfig
conf -> SavedConfig
conf { savedInstallFlags :: InstallFlags
savedInstallFlags = InstallFlags
flags })

liftClientInstallFlag :: FieldDescr ClientInstallFlags -> FieldDescr SavedConfig
liftClientInstallFlag :: FieldDescr ClientInstallFlags -> FieldDescr SavedConfig
liftClientInstallFlag =
  (SavedConfig -> ClientInstallFlags)
-> (ClientInstallFlags -> SavedConfig -> SavedConfig)
-> FieldDescr ClientInstallFlags
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField SavedConfig -> ClientInstallFlags
savedClientInstallFlags
  (\ClientInstallFlags
flags SavedConfig
conf -> SavedConfig
conf { savedClientInstallFlags :: ClientInstallFlags
savedClientInstallFlags = ClientInstallFlags
flags })

liftUploadFlag :: FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag :: FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag = (SavedConfig -> UploadFlags)
-> (UploadFlags -> SavedConfig -> SavedConfig)
-> FieldDescr UploadFlags
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
  SavedConfig -> UploadFlags
savedUploadFlags (\UploadFlags
flags SavedConfig
conf -> SavedConfig
conf { savedUploadFlags :: UploadFlags
savedUploadFlags = UploadFlags
flags })

liftReportFlag :: FieldDescr ReportFlags -> FieldDescr SavedConfig
liftReportFlag :: FieldDescr ReportFlags -> FieldDescr SavedConfig
liftReportFlag = (SavedConfig -> ReportFlags)
-> (ReportFlags -> SavedConfig -> SavedConfig)
-> FieldDescr ReportFlags
-> FieldDescr SavedConfig
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField
  SavedConfig -> ReportFlags
savedReportFlags (\ReportFlags
flags SavedConfig
conf -> SavedConfig
conf { savedReportFlags :: ReportFlags
savedReportFlags = ReportFlags
flags })

parseConfig :: ConstraintSource
            -> SavedConfig
            -> BS.ByteString
            -> ParseResult SavedConfig
parseConfig :: ConstraintSource
-> SavedConfig -> ByteString -> ParseResult SavedConfig
parseConfig ConstraintSource
src SavedConfig
initial = \ByteString
str -> do
  [Field]
fields <- ByteString -> ParseResult [Field]
readFields ByteString
str
  let ([Field]
knownSections, [Field]
others) = (Field -> Bool) -> [Field] -> ([Field], [Field])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Field -> Bool
isKnownSection [Field]
fields
  SavedConfig
config <- [Field] -> ParseResult SavedConfig
parse [Field]
others
  let init0 :: InitFlags
init0   = SavedConfig -> InitFlags
savedInitFlags SavedConfig
config
      user0 :: InstallDirs (Flag PathTemplate)
user0   = SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs SavedConfig
config
      global0 :: InstallDirs (Flag PathTemplate)
global0 = SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs SavedConfig
config
  ([RemoteRepo]
remoteRepoSections0, [LocalRepo]
localRepoSections0, HaddockFlags
haddockFlags, InitFlags
initFlags, InstallDirs (Flag PathTemplate)
user, InstallDirs (Flag PathTemplate)
global, [(FilePath, FilePath)]
paths, [(FilePath, [FilePath])]
args) <-
    (([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
  InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
  [(FilePath, FilePath)], [(FilePath, [FilePath])])
 -> Field
 -> ParseResult
      ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
       InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
       [(FilePath, FilePath)], [(FilePath, [FilePath])]))
-> ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
    InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
    [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> [Field]
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> Field
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
parseSections
          ([], [], SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
config, InitFlags
init0, InstallDirs (Flag PathTemplate)
user0, InstallDirs (Flag PathTemplate)
global0, [], [])
          [Field]
knownSections

  let remoteRepoSections :: [RemoteRepo]
remoteRepoSections =
          [RemoteRepo] -> [RemoteRepo]
forall a. [a] -> [a]
reverse
        ([RemoteRepo] -> [RemoteRepo])
-> ([RemoteRepo] -> [RemoteRepo]) -> [RemoteRepo] -> [RemoteRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRepo -> RemoteRepo -> Bool) -> [RemoteRepo] -> [RemoteRepo]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (RepoName -> RepoName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (RepoName -> RepoName -> Bool)
-> (RemoteRepo -> RepoName) -> RemoteRepo -> RemoteRepo -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RemoteRepo -> RepoName
remoteRepoName)
        ([RemoteRepo] -> [RemoteRepo]) -> [RemoteRepo] -> [RemoteRepo]
forall a b. (a -> b) -> a -> b
$ [RemoteRepo]
remoteRepoSections0

  let localRepoSections :: [LocalRepo]
localRepoSections =
          [LocalRepo] -> [LocalRepo]
forall a. [a] -> [a]
reverse
        ([LocalRepo] -> [LocalRepo])
-> ([LocalRepo] -> [LocalRepo]) -> [LocalRepo] -> [LocalRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalRepo -> LocalRepo -> Bool) -> [LocalRepo] -> [LocalRepo]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (RepoName -> RepoName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (RepoName -> RepoName -> Bool)
-> (LocalRepo -> RepoName) -> LocalRepo -> LocalRepo -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LocalRepo -> RepoName
localRepoName)
        ([LocalRepo] -> [LocalRepo]) -> [LocalRepo] -> [LocalRepo]
forall a b. (a -> b) -> a -> b
$ [LocalRepo]
localRepoSections0

  SavedConfig -> ParseResult SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (SavedConfig -> ParseResult SavedConfig)
-> (SavedConfig -> SavedConfig)
-> SavedConfig
-> ParseResult SavedConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> SavedConfig
fixConfigMultilines (SavedConfig -> ParseResult SavedConfig)
-> SavedConfig -> ParseResult SavedConfig
forall a b. (a -> b) -> a -> b
$ SavedConfig
config {
    savedGlobalFlags :: GlobalFlags
savedGlobalFlags       = (SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config) {
       globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos   = [RemoteRepo] -> NubList RemoteRepo
forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo]
remoteRepoSections,
       globalLocalNoIndexRepos :: NubList LocalRepo
globalLocalNoIndexRepos = [LocalRepo] -> NubList LocalRepo
forall a. Ord a => [a] -> NubList a
toNubList [LocalRepo]
localRepoSections,
       -- the global extra prog path comes from the configure flag prog path
       globalProgPathExtra :: NubList FilePath
globalProgPathExtra = ConfigFlags -> NubList FilePath
configProgramPathExtra (SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config)
       },
    savedConfigureFlags :: ConfigFlags
savedConfigureFlags    = (SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config) {
       configProgramPaths :: [(FilePath, FilePath)]
configProgramPaths  = [(FilePath, FilePath)]
paths,
       configProgramArgs :: [(FilePath, [FilePath])]
configProgramArgs   = [(FilePath, [FilePath])]
args
       },
    savedHaddockFlags :: HaddockFlags
savedHaddockFlags      = HaddockFlags
haddockFlags,
    savedInitFlags :: InitFlags
savedInitFlags         = InitFlags
initFlags,
    savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs   = InstallDirs (Flag PathTemplate)
user,
    savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs = InstallDirs (Flag PathTemplate)
global
  }

  where
    isKnownSection :: Field -> Bool
isKnownSection (ParseUtils.Section Int
_ FilePath
"repository" FilePath
_ [Field]
_)              = Bool
True
    isKnownSection (ParseUtils.F Int
_ FilePath
"remote-repo" FilePath
_)                     = Bool
True
    isKnownSection (ParseUtils.Section Int
_ FilePath
"haddock" FilePath
_ [Field]
_)                 = Bool
True
    isKnownSection (ParseUtils.Section Int
_ FilePath
"init" FilePath
_ [Field]
_)                    = Bool
True
    isKnownSection (ParseUtils.Section Int
_ FilePath
"install-dirs" FilePath
_ [Field]
_)            = Bool
True
    isKnownSection (ParseUtils.Section Int
_ FilePath
"program-locations" FilePath
_ [Field]
_)       = Bool
True
    isKnownSection (ParseUtils.Section Int
_ FilePath
"program-default-options" FilePath
_ [Field]
_) = Bool
True
    isKnownSection Field
_                                                    = Bool
False

    -- Attempt to split fields that can represent lists of paths into
    -- actual lists on failure, leave the field untouched.
    splitMultiPath :: [String] -> [String]
    splitMultiPath :: [FilePath] -> [FilePath]
splitMultiPath [FilePath
s] = case Int
-> FilePath
-> ReadP [FilePath] [FilePath]
-> FilePath
-> ParseResult [FilePath]
forall a. Int -> FilePath -> ReadP a a -> FilePath -> ParseResult a
runP Int
0 FilePath
"" (ReadP [FilePath] FilePath -> ReadP [FilePath] [FilePath]
forall r a. ReadP r a -> ReadP r [a]
parseOptCommaList ReadP [FilePath] FilePath
forall r. ReadP r FilePath
parseTokenQ) FilePath
s of
            ParseOk [PWarning]
_ [FilePath]
res -> [FilePath]
res
            ParseResult [FilePath]
_ -> [FilePath
s]
    splitMultiPath [FilePath]
xs = [FilePath]
xs

    -- This is a fixup, pending a full config parser rewrite, to
    -- ensure that config fields which can be comma-separated lists
    -- actually parse as comma-separated lists.
    fixConfigMultilines :: SavedConfig -> SavedConfig
fixConfigMultilines SavedConfig
conf = SavedConfig
conf {
         savedConfigureFlags :: ConfigFlags
savedConfigureFlags =
           let scf :: ConfigFlags
scf = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
conf
           in  ConfigFlags
scf {
                     configProgramPathExtra :: NubList FilePath
configProgramPathExtra   =
                       [FilePath] -> NubList FilePath
forall a. Ord a => [a] -> NubList a
toNubList ([FilePath] -> NubList FilePath) -> [FilePath] -> NubList FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
splitMultiPath
                       (NubList FilePath -> [FilePath]
forall a. NubList a -> [a]
fromNubList (NubList FilePath -> [FilePath]) -> NubList FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> NubList FilePath
configProgramPathExtra ConfigFlags
scf)
                   , configExtraLibDirs :: [FilePath]
configExtraLibDirs       = [FilePath] -> [FilePath]
splitMultiPath
                                                (ConfigFlags -> [FilePath]
configExtraLibDirs ConfigFlags
scf)
                   , configExtraLibDirsStatic :: [FilePath]
configExtraLibDirsStatic = [FilePath] -> [FilePath]
splitMultiPath
                                                (ConfigFlags -> [FilePath]
configExtraLibDirsStatic ConfigFlags
scf)
                   , configExtraFrameworkDirs :: [FilePath]
configExtraFrameworkDirs = [FilePath] -> [FilePath]
splitMultiPath
                                                (ConfigFlags -> [FilePath]
configExtraFrameworkDirs ConfigFlags
scf)
                   , configExtraIncludeDirs :: [FilePath]
configExtraIncludeDirs   = [FilePath] -> [FilePath]
splitMultiPath
                                                (ConfigFlags -> [FilePath]
configExtraIncludeDirs ConfigFlags
scf)
                   , configConfigureArgs :: [FilePath]
configConfigureArgs      = [FilePath] -> [FilePath]
splitMultiPath
                                                (ConfigFlags -> [FilePath]
configConfigureArgs ConfigFlags
scf)
               }
      }

    parse :: [Field] -> ParseResult SavedConfig
parse = [FieldDescr SavedConfig]
-> SavedConfig -> [Field] -> ParseResult SavedConfig
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields (ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions ConstraintSource
src
                      [FieldDescr SavedConfig]
-> [FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [a] -> [a] -> [a]
++ [FieldDescr SavedConfig]
deprecatedFieldDescriptions) SavedConfig
initial

    parseSections :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> Field
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
parseSections ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
                 (ParseUtils.Section Int
lineno FilePath
"repository" FilePath
name [Field]
fs) = do
      RepoName
name' <- ParseResult RepoName
-> (RepoName -> ParseResult RepoName)
-> Maybe RepoName
-> ParseResult RepoName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PError -> ParseResult RepoName
forall a. PError -> ParseResult a
ParseFailed (PError -> ParseResult RepoName) -> PError -> ParseResult RepoName
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> PError
NoParse FilePath
"repository name" Int
lineno) RepoName -> ParseResult RepoName
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RepoName -> ParseResult RepoName)
-> Maybe RepoName -> ParseResult RepoName
forall a b. (a -> b) -> a -> b
$
          FilePath -> Maybe RepoName
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
name
      RemoteRepo
r' <- [FieldDescr RemoteRepo]
-> RemoteRepo -> [Field] -> ParseResult RemoteRepo
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr RemoteRepo]
remoteRepoFields (RepoName -> RemoteRepo
emptyRemoteRepo RepoName
name') [Field]
fs
      Either LocalRepo RemoteRepo
r'' <- Int
-> FilePath
-> RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
postProcessRepo Int
lineno FilePath
name RemoteRepo
r'
      case Either LocalRepo RemoteRepo
r'' of
          Left LocalRepo
local   -> ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs,        LocalRepo
localLocalRepo -> [LocalRepo] -> [LocalRepo]
forall a. a -> [a] -> [a]
:[LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
          Right RemoteRepo
remote -> ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRepo
remoteRemoteRepo -> [RemoteRepo] -> [RemoteRepo]
forall a. a -> [a] -> [a]
:[RemoteRepo]
rs, [LocalRepo]
ls,       HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)

    parseSections ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
                 (ParseUtils.F Int
lno FilePath
"remote-repo" FilePath
raw) = do
      let mr' :: Maybe RemoteRepo
mr' = FilePath -> Maybe RemoteRepo
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
raw
      RemoteRepo
r' <- ParseResult RemoteRepo
-> (RemoteRepo -> ParseResult RemoteRepo)
-> Maybe RemoteRepo
-> ParseResult RemoteRepo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PError -> ParseResult RemoteRepo
forall a. PError -> ParseResult a
ParseFailed (PError -> ParseResult RemoteRepo)
-> PError -> ParseResult RemoteRepo
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> PError
NoParse FilePath
"remote-repo" Int
lno) RemoteRepo -> ParseResult RemoteRepo
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RemoteRepo
mr'
      ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRepo
r'RemoteRepo -> [RemoteRepo] -> [RemoteRepo]
forall a. a -> [a] -> [a]
:[RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)

    parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
                 (ParseUtils.Section Int
_ FilePath
"haddock" FilePath
name [Field]
fs)
      | FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
""        = do HaddockFlags
h' <- [FieldDescr HaddockFlags]
-> HaddockFlags -> [Field] -> ParseResult HaddockFlags
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr HaddockFlags]
haddockFlagsFields HaddockFlags
h [Field]
fs
                               ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h', InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
      | Bool
otherwise         = do
          FilePath -> ParseResult ()
warning FilePath
"The 'haddock' section should be unnamed"
          ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum

    parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
                 (ParseUtils.Section Int
_ FilePath
"init" FilePath
name [Field]
fs)
      | FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
""        = do InitFlags
i' <- [FieldDescr InitFlags]
-> InitFlags -> [Field] -> ParseResult InitFlags
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr InitFlags]
initFlagsFields InitFlags
i [Field]
fs
                               ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i', InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
      | Bool
otherwise         = do
          FilePath -> ParseResult ()
warning FilePath
"The 'init' section should be unnamed"
          ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum

    parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
                  (ParseUtils.Section Int
_ FilePath
"install-dirs" FilePath
name [Field]
fs)
      | FilePath
name' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"user"   = do InstallDirs (Flag PathTemplate)
u' <- [FieldDescr (InstallDirs (Flag PathTemplate))]
-> InstallDirs (Flag PathTemplate)
-> [Field]
-> ParseResult (InstallDirs (Flag PathTemplate))
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields InstallDirs (Flag PathTemplate)
u [Field]
fs
                               ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u', InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
      | FilePath
name' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"global" = do InstallDirs (Flag PathTemplate)
g' <- [FieldDescr (InstallDirs (Flag PathTemplate))]
-> InstallDirs (Flag PathTemplate)
-> [Field]
-> ParseResult (InstallDirs (Flag PathTemplate))
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields InstallDirs (Flag PathTemplate)
g [Field]
fs
                               ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g', [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
      | Bool
otherwise         = do
          FilePath -> ParseResult ()
warning FilePath
"The 'install-paths' section should be for 'user' or 'global'"
          ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum
      where name' :: FilePath
name' = FilePath -> FilePath
lowercase FilePath
name
    parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
                 (ParseUtils.Section Int
_ FilePath
"program-locations" FilePath
name [Field]
fs)
      | FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
""        = do [(FilePath, FilePath)]
p' <- [FieldDescr [(FilePath, FilePath)]]
-> [(FilePath, FilePath)]
-> [Field]
-> ParseResult [(FilePath, FilePath)]
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr [(FilePath, FilePath)]]
withProgramsFields [(FilePath, FilePath)]
p [Field]
fs
                               ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p', [(FilePath, [FilePath])]
a)
      | Bool
otherwise         = do
          FilePath -> ParseResult ()
warning FilePath
"The 'program-locations' section should be unnamed"
          ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum
    parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a)
                  (ParseUtils.Section Int
_ FilePath
"program-default-options" FilePath
name [Field]
fs)
      | FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
""        = do [(FilePath, [FilePath])]
a' <- [FieldDescr [(FilePath, [FilePath])]]
-> [(FilePath, [FilePath])]
-> [Field]
-> ParseResult [(FilePath, [FilePath])]
forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr [(FilePath, [FilePath])]]
withProgramOptionsFields [(FilePath, [FilePath])]
a [Field]
fs
                               ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(FilePath, FilePath)]
p, [(FilePath, [FilePath])]
a')
      | Bool
otherwise         = do
          FilePath -> ParseResult ()
warning FilePath
"The 'program-default-options' section should be unnamed"
          ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum
    parseSections ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum Field
f = do
      FilePath -> ParseResult ()
warning (FilePath -> ParseResult ()) -> FilePath -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Unrecognized stanza on line " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Field -> Int
lineNo Field
f)
      ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
-> ParseResult
     ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
      InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
      [(FilePath, FilePath)], [(FilePath, [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
 InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
 [(FilePath, FilePath)], [(FilePath, [FilePath])])
accum

postProcessRepo :: Int -> String -> RemoteRepo -> ParseResult (Either LocalRepo RemoteRepo)
postProcessRepo :: Int
-> FilePath
-> RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
postProcessRepo Int
lineno FilePath
reponameStr RemoteRepo
repo0 = do
    Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
reponameStr) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
        Int -> FilePath -> ParseResult ()
forall a. Int -> FilePath -> ParseResult a
syntaxError Int
lineno (FilePath -> ParseResult ()) -> FilePath -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ FilePath
"a 'repository' section requires the "
                          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"repository name as an argument"

    RepoName
reponame <- ParseResult RepoName
-> (RepoName -> ParseResult RepoName)
-> Maybe RepoName
-> ParseResult RepoName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> ParseResult RepoName
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParseResult RepoName)
-> FilePath -> ParseResult RepoName
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid repository name " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
reponameStr) RepoName -> ParseResult RepoName
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RepoName -> ParseResult RepoName)
-> Maybe RepoName -> ParseResult RepoName
forall a b. (a -> b) -> a -> b
$
        FilePath -> Maybe RepoName
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
reponameStr

    case URI -> FilePath
uriScheme (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo0) of
        -- TODO: check that there are no authority, query or fragment
        -- Note: the trailing colon is important
        FilePath
"file+noindex:" -> do
            let uri :: URI
uri = RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo0
            Either LocalRepo RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LocalRepo RemoteRepo
 -> ParseResult (Either LocalRepo RemoteRepo))
-> Either LocalRepo RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
forall a b. (a -> b) -> a -> b
$ LocalRepo -> Either LocalRepo RemoteRepo
forall a b. a -> Either a b
Left (LocalRepo -> Either LocalRepo RemoteRepo)
-> LocalRepo -> Either LocalRepo RemoteRepo
forall a b. (a -> b) -> a -> b
$ RepoName -> FilePath -> Bool -> LocalRepo
LocalRepo RepoName
reponame (URI -> FilePath
uriPath URI
uri) (URI -> FilePath
uriFragment URI
uri FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"#shared-cache")

        FilePath
_              -> do
            let repo :: RemoteRepo
repo = RemoteRepo
repo0 { remoteRepoName :: RepoName
remoteRepoName = RepoName
reponame }

            Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RemoteRepo -> Int
remoteRepoKeyThreshold RemoteRepo
repo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (RemoteRepo -> [FilePath]
remoteRepoRootKeys RemoteRepo
repo)) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
                FilePath -> ParseResult ()
warning (FilePath -> ParseResult ()) -> FilePath -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ FilePath
"'key-threshold' for repository "
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
forall a. Show a => a -> FilePath
show (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repo)
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" higher than number of keys"

            Bool -> ParseResult () -> ParseResult ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RemoteRepo -> [FilePath]
remoteRepoRootKeys RemoteRepo
repo)) Bool -> Bool -> Bool
&& RemoteRepo -> Maybe Bool
remoteRepoSecure RemoteRepo
repo Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (ParseResult () -> ParseResult ())
-> ParseResult () -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
                FilePath -> ParseResult ()
warning (FilePath -> ParseResult ()) -> FilePath -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ FilePath
"'root-keys' for repository "
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
forall a. Show a => a -> FilePath
show (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repo)
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" non-empty, but 'secure' not set to True."

            Either LocalRepo RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LocalRepo RemoteRepo
 -> ParseResult (Either LocalRepo RemoteRepo))
-> Either LocalRepo RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
forall a b. (a -> b) -> a -> b
$ RemoteRepo -> Either LocalRepo RemoteRepo
forall a b. b -> Either a b
Right RemoteRepo
repo

showConfig :: SavedConfig -> String
showConfig :: SavedConfig -> FilePath
showConfig = SavedConfig -> SavedConfig -> FilePath
showConfigWithComments SavedConfig
forall a. Monoid a => a
mempty

showConfigWithComments :: SavedConfig -> SavedConfig -> String
showConfigWithComments :: SavedConfig -> SavedConfig -> FilePath
showConfigWithComments SavedConfig
comment SavedConfig
vals = Doc -> FilePath
Disp.render (Doc -> FilePath) -> Doc -> FilePath
forall a b. (a -> b) -> a -> b
$
      case ((RemoteRepo, RemoteRepo) -> Doc)
-> [(RemoteRepo, RemoteRepo)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RemoteRepo -> RemoteRepo -> Doc)
-> (RemoteRepo, RemoteRepo) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RemoteRepo -> RemoteRepo -> Doc
ppRemoteRepoSection)
           ([RemoteRepo] -> [RemoteRepo] -> [(RemoteRepo, RemoteRepo)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SavedConfig -> [RemoteRepo]
getRemoteRepos SavedConfig
comment) (SavedConfig -> [RemoteRepo]
getRemoteRepos SavedConfig
vals)) of
        [] -> FilePath -> Doc
Disp.text FilePath
""
        (Doc
x:[Doc]
xs) -> (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Doc
r Doc
r' -> Doc
r Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
"" Doc -> Doc -> Doc
$+$ Doc
r') Doc
x [Doc]
xs
  Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
""
  Doc -> Doc -> Doc
$+$ [FieldDescr SavedConfig] -> Maybe SavedConfig -> SavedConfig -> Doc
forall a. [FieldDescr a] -> Maybe a -> a -> Doc
ppFields
      ([FieldDescr SavedConfig] -> [FieldDescr SavedConfig]
forall a. [FieldDescr a] -> [FieldDescr a]
skipSomeFields (ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions ConstraintSource
ConstraintSourceUnknown))
      Maybe SavedConfig
mcomment SavedConfig
vals
  Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
""
  Doc -> Doc -> Doc
$+$ FilePath
-> FilePath
-> [FieldDescr HaddockFlags]
-> Maybe HaddockFlags
-> HaddockFlags
-> Doc
forall a.
FilePath -> FilePath -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection FilePath
"haddock" FilePath
"" [FieldDescr HaddockFlags]
haddockFlagsFields
                ((SavedConfig -> HaddockFlags)
-> Maybe SavedConfig -> Maybe HaddockFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SavedConfig -> HaddockFlags
savedHaddockFlags Maybe SavedConfig
mcomment) (SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
vals)
  Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
""
  Doc -> Doc -> Doc
$+$ FilePath
-> FilePath
-> [FieldDescr InitFlags]
-> Maybe InitFlags
-> InitFlags
-> Doc
forall a.
FilePath -> FilePath -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection FilePath
"init" FilePath
"" [FieldDescr InitFlags]
initFlagsFields
                ((SavedConfig -> InitFlags) -> Maybe SavedConfig -> Maybe InitFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SavedConfig -> InitFlags
savedInitFlags Maybe SavedConfig
mcomment) (SavedConfig -> InitFlags
savedInitFlags SavedConfig
vals)
  Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
""
  Doc -> Doc -> Doc
$+$ FilePath -> (SavedConfig -> InstallDirs (Flag PathTemplate)) -> Doc
installDirsSection FilePath
"user"   SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs
  Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
""
  Doc -> Doc -> Doc
$+$ FilePath -> (SavedConfig -> InstallDirs (Flag PathTemplate)) -> Doc
installDirsSection FilePath
"global" SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs
  Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
""
  Doc -> Doc -> Doc
$+$ FilePath
-> [FieldDescr [(FilePath, FilePath)]]
-> (ConfigFlags -> [(FilePath, FilePath)])
-> Doc
forall c. FilePath -> [FieldDescr c] -> (ConfigFlags -> c) -> Doc
configFlagsSection FilePath
"program-locations" [FieldDescr [(FilePath, FilePath)]]
withProgramsFields
                         ConfigFlags -> [(FilePath, FilePath)]
configProgramPaths
  Doc -> Doc -> Doc
$+$ FilePath -> Doc
Disp.text FilePath
""
  Doc -> Doc -> Doc
$+$ FilePath
-> [FieldDescr [(FilePath, [FilePath])]]
-> (ConfigFlags -> [(FilePath, [FilePath])])
-> Doc
forall c. FilePath -> [FieldDescr c] -> (ConfigFlags -> c) -> Doc
configFlagsSection FilePath
"program-default-options" [FieldDescr [(FilePath, [FilePath])]]
withProgramOptionsFields
                         ConfigFlags -> [(FilePath, [FilePath])]
configProgramArgs
  where
    getRemoteRepos :: SavedConfig -> [RemoteRepo]
getRemoteRepos = NubList RemoteRepo -> [RemoteRepo]
forall a. NubList a -> [a]
fromNubList (NubList RemoteRepo -> [RemoteRepo])
-> (SavedConfig -> NubList RemoteRepo)
-> SavedConfig
-> [RemoteRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> NubList RemoteRepo
globalRemoteRepos (GlobalFlags -> NubList RemoteRepo)
-> (SavedConfig -> GlobalFlags)
-> SavedConfig
-> NubList RemoteRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> GlobalFlags
savedGlobalFlags
    mcomment :: Maybe SavedConfig
mcomment = SavedConfig -> Maybe SavedConfig
forall a. a -> Maybe a
Just SavedConfig
comment
    installDirsSection :: FilePath -> (SavedConfig -> InstallDirs (Flag PathTemplate)) -> Doc
installDirsSection FilePath
name SavedConfig -> InstallDirs (Flag PathTemplate)
field =
      FilePath
-> FilePath
-> [FieldDescr (InstallDirs (Flag PathTemplate))]
-> Maybe (InstallDirs (Flag PathTemplate))
-> InstallDirs (Flag PathTemplate)
-> Doc
forall a.
FilePath -> FilePath -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection FilePath
"install-dirs" FilePath
name [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields
                ((SavedConfig -> InstallDirs (Flag PathTemplate))
-> Maybe SavedConfig -> Maybe (InstallDirs (Flag PathTemplate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SavedConfig -> InstallDirs (Flag PathTemplate)
field Maybe SavedConfig
mcomment) (SavedConfig -> InstallDirs (Flag PathTemplate)
field SavedConfig
vals)
    configFlagsSection :: FilePath -> [FieldDescr c] -> (ConfigFlags -> c) -> Doc
configFlagsSection FilePath
name [FieldDescr c]
fields ConfigFlags -> c
field =
      FilePath -> FilePath -> [FieldDescr c] -> Maybe c -> c -> Doc
forall a.
FilePath -> FilePath -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection FilePath
name FilePath
"" [FieldDescr c]
fields
               ((SavedConfig -> c) -> Maybe SavedConfig -> Maybe c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConfigFlags -> c
field (ConfigFlags -> c)
-> (SavedConfig -> ConfigFlags) -> SavedConfig -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags) Maybe SavedConfig
mcomment)
               ((ConfigFlags -> c
field (ConfigFlags -> c)
-> (SavedConfig -> ConfigFlags) -> SavedConfig -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags) SavedConfig
vals)

    -- skip fields based on field name.  currently only skips "remote-repo",
    -- because that is rendered as a section.  (see 'ppRemoteRepoSection'.)
    skipSomeFields :: [FieldDescr a] -> [FieldDescr a]
skipSomeFields = (FieldDescr a -> Bool) -> [FieldDescr a] -> [FieldDescr a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"remote-repo") (FilePath -> Bool)
-> (FieldDescr a -> FilePath) -> FieldDescr a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescr a -> FilePath
forall a. FieldDescr a -> FilePath
fieldName)

-- | Fields for the 'install-dirs' sections.
installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields = (OptionField (InstallDirs (Flag PathTemplate))
 -> FieldDescr (InstallDirs (Flag PathTemplate)))
-> [OptionField (InstallDirs (Flag PathTemplate))]
-> [FieldDescr (InstallDirs (Flag PathTemplate))]
forall a b. (a -> b) -> [a] -> [b]
map OptionField (InstallDirs (Flag PathTemplate))
-> FieldDescr (InstallDirs (Flag PathTemplate))
forall a. OptionField a -> FieldDescr a
viewAsFieldDescr [OptionField (InstallDirs (Flag PathTemplate))]
installDirsOptions

ppRemoteRepoSection :: RemoteRepo -> RemoteRepo -> Doc
ppRemoteRepoSection :: RemoteRepo -> RemoteRepo -> Doc
ppRemoteRepoSection RemoteRepo
def RemoteRepo
vals = FilePath
-> FilePath
-> [FieldDescr RemoteRepo]
-> Maybe RemoteRepo
-> RemoteRepo
-> Doc
forall a.
FilePath -> FilePath -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection FilePath
"repository" (RepoName -> FilePath
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
vals))
    [FieldDescr RemoteRepo]
remoteRepoFields (RemoteRepo -> Maybe RemoteRepo
forall a. a -> Maybe a
Just RemoteRepo
def) RemoteRepo
vals

remoteRepoFields :: [FieldDescr RemoteRepo]
remoteRepoFields :: [FieldDescr RemoteRepo]
remoteRepoFields =
  [ FilePath
-> (URI -> Doc)
-> ReadP URI URI
-> (RemoteRepo -> URI)
-> (URI -> RemoteRepo -> RemoteRepo)
-> FieldDescr RemoteRepo
forall a b.
FilePath
-> (a -> Doc)
-> ReadP a a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleField FilePath
"url"
    (FilePath -> Doc
text (FilePath -> Doc) -> (URI -> FilePath) -> URI -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> FilePath
forall a. Show a => a -> FilePath
show)            (ReadP URI FilePath
forall r. ReadP r FilePath
parseTokenQ ReadP URI FilePath -> (FilePath -> ReadP URI URI) -> ReadP URI URI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ReadP URI URI
forall (m :: * -> *). MonadFail m => FilePath -> m URI
parseURI')
    RemoteRepo -> URI
remoteRepoURI            (\URI
x RemoteRepo
repo -> RemoteRepo
repo { remoteRepoURI :: URI
remoteRepoURI = URI
x })
  , FilePath
-> (Maybe Bool -> Doc)
-> ParsecParser (Maybe Bool)
-> (RemoteRepo -> Maybe Bool)
-> (Maybe Bool -> RemoteRepo -> RemoteRepo)
-> FieldDescr RemoteRepo
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"secure"
    Maybe Bool -> Doc
showSecure               (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> ParsecParser Bool -> ParsecParser (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecParser Bool
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec)
    RemoteRepo -> Maybe Bool
remoteRepoSecure         (\Maybe Bool
x RemoteRepo
repo -> RemoteRepo
repo { remoteRepoSecure :: Maybe Bool
remoteRepoSecure = Maybe Bool
x })
  , FilePath
-> (FilePath -> Doc)
-> ReadP [FilePath] FilePath
-> (RemoteRepo -> [FilePath])
-> ([FilePath] -> RemoteRepo -> RemoteRepo)
-> FieldDescr RemoteRepo
forall a b.
FilePath
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listField FilePath
"root-keys"
    FilePath -> Doc
text                     ReadP [FilePath] FilePath
forall r. ReadP r FilePath
parseTokenQ
    RemoteRepo -> [FilePath]
remoteRepoRootKeys       (\[FilePath]
x RemoteRepo
repo -> RemoteRepo
repo { remoteRepoRootKeys :: [FilePath]
remoteRepoRootKeys = [FilePath]
x })
  , FilePath
-> (Int -> Doc)
-> ParsecParser Int
-> (RemoteRepo -> Int)
-> (Int -> RemoteRepo -> RemoteRepo)
-> FieldDescr RemoteRepo
forall a b.
FilePath
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec FilePath
"key-threshold"
    Int -> Doc
forall a. (Eq a, Num a, Show a) => a -> Doc
showThreshold            ParsecParser Int
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
P.integral
    RemoteRepo -> Int
remoteRepoKeyThreshold   (\Int
x RemoteRepo
repo -> RemoteRepo
repo { remoteRepoKeyThreshold :: Int
remoteRepoKeyThreshold = Int
x })
  ]
  where
    parseURI' :: FilePath -> m URI
parseURI' FilePath
uriString =
      case FilePath -> Maybe URI
parseURI FilePath
uriString of
        Maybe URI
Nothing  -> FilePath -> m URI
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m URI) -> FilePath -> m URI
forall a b. (a -> b) -> a -> b
$ FilePath
"remote-repo: no parse on " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
uriString
        Just URI
uri -> URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
uri

    showSecure :: Maybe Bool -> Doc
showSecure  Maybe Bool
Nothing      = Doc
forall a. Monoid a => a
mempty       -- default 'secure' setting
    showSecure  (Just Bool
True)  = FilePath -> Doc
text FilePath
"True"  -- user explicitly enabled it
    showSecure  (Just Bool
False) = FilePath -> Doc
text FilePath
"False" -- user explicitly disabled it

    -- If the key-threshold is set to 0, we omit it as this is the default
    -- and it looks odd to have a value for key-threshold but not for 'secure'
    -- (note that an empty list of keys is already omitted by default, since
    -- that is what we do for all list fields)
    showThreshold :: a -> Doc
showThreshold a
0 = Doc
forall a. Monoid a => a
mempty
    showThreshold a
t = FilePath -> Doc
text (a -> FilePath
forall a. Show a => a -> FilePath
show a
t)

-- | Fields for the 'haddock' section.
haddockFlagsFields :: [FieldDescr HaddockFlags]
haddockFlagsFields :: [FieldDescr HaddockFlags]
haddockFlagsFields = [ FieldDescr HaddockFlags
field
                     | OptionField HaddockFlags
opt <- ShowOrParseArgs -> [OptionField HaddockFlags]
haddockOptions ShowOrParseArgs
ParseArgs
                     , let field :: FieldDescr HaddockFlags
field = OptionField HaddockFlags -> FieldDescr HaddockFlags
forall a. OptionField a -> FieldDescr a
viewAsFieldDescr OptionField HaddockFlags
opt
                           name :: FilePath
name  = FieldDescr HaddockFlags -> FilePath
forall a. FieldDescr a -> FilePath
fieldName FieldDescr HaddockFlags
field
                     , FilePath
name FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
exclusions ]
  where
    exclusions :: [FilePath]
exclusions = [FilePath
"verbose", FilePath
"builddir", FilePath
"for-hackage"]

-- | Fields for the 'init' section.
initFlagsFields :: [FieldDescr IT.InitFlags]
initFlagsFields :: [FieldDescr InitFlags]
initFlagsFields = [ FieldDescr InitFlags
field
                  | OptionField InitFlags
opt <- ShowOrParseArgs -> [OptionField InitFlags]
initOptions ShowOrParseArgs
ParseArgs
                  , let field :: FieldDescr InitFlags
field = OptionField InitFlags -> FieldDescr InitFlags
forall a. OptionField a -> FieldDescr a
viewAsFieldDescr OptionField InitFlags
opt
                        name :: FilePath
name  = FieldDescr InitFlags -> FilePath
forall a. FieldDescr a -> FilePath
fieldName FieldDescr InitFlags
field
                  , FilePath
name FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
exclusions ]
  where
    exclusions :: [FilePath]
exclusions =
      [ FilePath
"author", FilePath
"email", FilePath
"quiet", FilePath
"no-comments", FilePath
"minimal", FilePath
"overwrite"
      , FilePath
"package-dir", FilePath
"packagedir", FilePath
"package-name", FilePath
"version", FilePath
"homepage"
      , FilePath
"synopsis", FilePath
"category", FilePath
"extra-source-file", FilePath
"lib", FilePath
"exe", FilePath
"libandexe"
      , FilePath
"simple", FilePath
"main-is", FilePath
"expose-module", FilePath
"exposed-modules", FilePath
"extension"
      , FilePath
"dependency", FilePath
"build-tool", FilePath
"with-compiler"
      , FilePath
"verbose"
      ]

-- | Fields for the 'program-locations' section.
withProgramsFields :: [FieldDescr [(String, FilePath)]]
withProgramsFields :: [FieldDescr [(FilePath, FilePath)]]
withProgramsFields =
  (OptionField [(FilePath, FilePath)]
 -> FieldDescr [(FilePath, FilePath)])
-> [OptionField [(FilePath, FilePath)]]
-> [FieldDescr [(FilePath, FilePath)]]
forall a b. (a -> b) -> [a] -> [b]
map OptionField [(FilePath, FilePath)]
-> FieldDescr [(FilePath, FilePath)]
forall a. OptionField a -> FieldDescr a
viewAsFieldDescr ([OptionField [(FilePath, FilePath)]]
 -> [FieldDescr [(FilePath, FilePath)]])
-> [OptionField [(FilePath, FilePath)]]
-> [FieldDescr [(FilePath, FilePath)]]
forall a b. (a -> b) -> a -> b
$
  (FilePath -> FilePath)
-> ProgramDb
-> ShowOrParseArgs
-> ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> ([(FilePath, FilePath)]
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [OptionField [(FilePath, FilePath)]]
forall flags.
(FilePath -> FilePath)
-> ProgramDb
-> ShowOrParseArgs
-> (flags -> [(FilePath, FilePath)])
-> ([(FilePath, FilePath)] -> flags -> flags)
-> [OptionField flags]
programDbPaths' (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-location") ProgramDb
defaultProgramDb
                             ShowOrParseArgs
ParseArgs [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> a
id [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
(++)

-- | Fields for the 'program-default-options' section.
withProgramOptionsFields :: [FieldDescr [(String, [String])]]
withProgramOptionsFields :: [FieldDescr [(FilePath, [FilePath])]]
withProgramOptionsFields =
  (OptionField [(FilePath, [FilePath])]
 -> FieldDescr [(FilePath, [FilePath])])
-> [OptionField [(FilePath, [FilePath])]]
-> [FieldDescr [(FilePath, [FilePath])]]
forall a b. (a -> b) -> [a] -> [b]
map OptionField [(FilePath, [FilePath])]
-> FieldDescr [(FilePath, [FilePath])]
forall a. OptionField a -> FieldDescr a
viewAsFieldDescr ([OptionField [(FilePath, [FilePath])]]
 -> [FieldDescr [(FilePath, [FilePath])]])
-> [OptionField [(FilePath, [FilePath])]]
-> [FieldDescr [(FilePath, [FilePath])]]
forall a b. (a -> b) -> a -> b
$
  ProgramDb
-> ShowOrParseArgs
-> ([(FilePath, [FilePath])] -> [(FilePath, [FilePath])])
-> ([(FilePath, [FilePath])]
    -> [(FilePath, [FilePath])] -> [(FilePath, [FilePath])])
-> [OptionField [(FilePath, [FilePath])]]
forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(FilePath, [FilePath])])
-> ([(FilePath, [FilePath])] -> flags -> flags)
-> [OptionField flags]
programDbOptions ProgramDb
defaultProgramDb ShowOrParseArgs
ParseArgs [(FilePath, [FilePath])] -> [(FilePath, [FilePath])]
forall a. a -> a
id [(FilePath, [FilePath])]
-> [(FilePath, [FilePath])] -> [(FilePath, [FilePath])]
forall a. [a] -> [a] -> [a]
(++)

parseExtraLines :: Verbosity -> [String] -> IO SavedConfig
parseExtraLines :: Verbosity -> [FilePath] -> IO SavedConfig
parseExtraLines Verbosity
verbosity [FilePath]
extraLines =
  case ConstraintSource
-> SavedConfig -> ByteString -> ParseResult SavedConfig
parseConfig (FilePath -> ConstraintSource
ConstraintSourceMainConfig FilePath
"additional lines")
       SavedConfig
forall a. Monoid a => a
mempty (FilePath -> ByteString
toUTF8BS ([FilePath] -> FilePath
unlines [FilePath]
extraLines)) of
    ParseFailed PError
err ->
      let (Maybe Int
line, FilePath
msg) = PError -> (Maybe Int, FilePath)
locatedErrorMsg PError
err
      in Verbosity -> FilePath -> IO SavedConfig
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO SavedConfig) -> FilePath -> IO SavedConfig
forall a b. (a -> b) -> a -> b
$
         FilePath
"Error parsing additional config lines\n"
         FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (Int -> FilePath) -> Maybe Int -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\Int
n -> Char
':' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n) Maybe Int
line FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg
    ParseOk [] SavedConfig
r -> SavedConfig -> IO SavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
r
    ParseOk [PWarning]
ws SavedConfig
_ ->
      Verbosity -> FilePath -> IO SavedConfig
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO SavedConfig) -> FilePath -> IO SavedConfig
forall a b. (a -> b) -> a -> b
$
      [FilePath] -> FilePath
unlines ((PWarning -> FilePath) -> [PWarning] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PWarning -> FilePath
showPWarning FilePath
"Error parsing additional config lines") [PWarning]
ws)

-- | Get the differences (as a pseudo code diff) between the user's
-- '~/.cabal/config' and the one that cabal would generate if it didn't exist.
userConfigDiff :: Verbosity -> GlobalFlags -> [String] -> IO [String]
userConfigDiff :: Verbosity -> GlobalFlags -> [FilePath] -> IO [FilePath]
userConfigDiff Verbosity
verbosity GlobalFlags
globalFlags [FilePath]
extraLines = do
  SavedConfig
userConfig <- Verbosity -> Flag FilePath -> IO SavedConfig
loadRawConfig Verbosity
normal (GlobalFlags -> Flag FilePath
globalConfigFile GlobalFlags
globalFlags)
  SavedConfig
extraConfig <- Verbosity -> [FilePath] -> IO SavedConfig
parseExtraLines Verbosity
verbosity [FilePath]
extraLines
  SavedConfig
testConfig <- IO SavedConfig
initialSavedConfig
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
    [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (Map FilePath (Maybe FilePath, Maybe FilePath) -> [FilePath])
-> Map FilePath (Maybe FilePath, Maybe FilePath)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath]
 -> (FilePath, (Maybe FilePath, Maybe FilePath)) -> [FilePath])
-> [FilePath]
-> [(FilePath, (Maybe FilePath, Maybe FilePath))]
-> [FilePath]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [FilePath]
-> (FilePath, (Maybe FilePath, Maybe FilePath)) -> [FilePath]
createDiff [] ([(FilePath, (Maybe FilePath, Maybe FilePath))] -> [FilePath])
-> (Map FilePath (Maybe FilePath, Maybe FilePath)
    -> [(FilePath, (Maybe FilePath, Maybe FilePath))])
-> Map FilePath (Maybe FilePath, Maybe FilePath)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath (Maybe FilePath, Maybe FilePath)
-> [(FilePath, (Maybe FilePath, Maybe FilePath))]
forall k a. Map k a -> [(k, a)]
M.toList
    (Map FilePath (Maybe FilePath, Maybe FilePath) -> [FilePath])
-> Map FilePath (Maybe FilePath, Maybe FilePath) -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((Maybe FilePath, Maybe FilePath)
 -> (Maybe FilePath, Maybe FilePath)
 -> (Maybe FilePath, Maybe FilePath))
-> Map FilePath (Maybe FilePath, Maybe FilePath)
-> Map FilePath (Maybe FilePath, Maybe FilePath)
-> Map FilePath (Maybe FilePath, Maybe FilePath)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (Maybe FilePath, Maybe FilePath)
-> (Maybe FilePath, Maybe FilePath)
-> (Maybe FilePath, Maybe FilePath)
forall a a.
(Show a, Show a) =>
(Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a)
combine
      ([(FilePath, (Maybe FilePath, Maybe FilePath))]
-> Map FilePath (Maybe FilePath, Maybe FilePath)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FilePath, (Maybe FilePath, Maybe FilePath))]
 -> Map FilePath (Maybe FilePath, Maybe FilePath))
-> ([(FilePath, FilePath)]
    -> [(FilePath, (Maybe FilePath, Maybe FilePath))])
-> [(FilePath, FilePath)]
-> Map FilePath (Maybe FilePath, Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath)
 -> (FilePath, (Maybe FilePath, Maybe FilePath)))
-> [(FilePath, FilePath)]
-> [(FilePath, (Maybe FilePath, Maybe FilePath))]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath)
-> (FilePath, (Maybe FilePath, Maybe FilePath))
forall a a a. (a, a) -> (a, (Maybe a, Maybe a))
justFst ([(FilePath, FilePath)]
 -> Map FilePath (Maybe FilePath, Maybe FilePath))
-> [(FilePath, FilePath)]
-> Map FilePath (Maybe FilePath, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ SavedConfig -> [(FilePath, FilePath)]
filterShow SavedConfig
testConfig)
      ([(FilePath, (Maybe FilePath, Maybe FilePath))]
-> Map FilePath (Maybe FilePath, Maybe FilePath)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FilePath, (Maybe FilePath, Maybe FilePath))]
 -> Map FilePath (Maybe FilePath, Maybe FilePath))
-> ([(FilePath, FilePath)]
    -> [(FilePath, (Maybe FilePath, Maybe FilePath))])
-> [(FilePath, FilePath)]
-> Map FilePath (Maybe FilePath, Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath)
 -> (FilePath, (Maybe FilePath, Maybe FilePath)))
-> [(FilePath, FilePath)]
-> [(FilePath, (Maybe FilePath, Maybe FilePath))]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath)
-> (FilePath, (Maybe FilePath, Maybe FilePath))
forall a a a. (a, a) -> (a, (Maybe a, Maybe a))
justSnd ([(FilePath, FilePath)]
 -> Map FilePath (Maybe FilePath, Maybe FilePath))
-> [(FilePath, FilePath)]
-> Map FilePath (Maybe FilePath, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ SavedConfig -> [(FilePath, FilePath)]
filterShow (SavedConfig
userConfig SavedConfig -> SavedConfig -> SavedConfig
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
extraConfig))
  where
    justFst :: (a, a) -> (a, (Maybe a, Maybe a))
justFst (a
a, a
b) = (a
a, (a -> Maybe a
forall a. a -> Maybe a
Just a
b, Maybe a
forall a. Maybe a
Nothing))
    justSnd :: (a, a) -> (a, (Maybe a, Maybe a))
justSnd (a
a, a
b) = (a
a, (Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just a
b))

    combine :: (Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a)
combine (Maybe a
Nothing, Just a
b) (Just a
a, Maybe a
Nothing) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
b)
    combine (Just a
a, Maybe a
Nothing) (Maybe a
Nothing, Just a
b) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
b)
    combine (Maybe a, Maybe a)
x (Maybe a, Maybe a)
y = FilePath -> (Maybe a, Maybe a)
forall a. HasCallStack => FilePath -> a
error (FilePath -> (Maybe a, Maybe a)) -> FilePath -> (Maybe a, Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't happen : userConfigDiff "
                  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Maybe a, Maybe a) -> FilePath
forall a. Show a => a -> FilePath
show (Maybe a, Maybe a)
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Maybe a, Maybe a) -> FilePath
forall a. Show a => a -> FilePath
show (Maybe a, Maybe a)
y

    createDiff :: [String] -> (String, (Maybe String, Maybe String)) -> [String]
    createDiff :: [FilePath]
-> (FilePath, (Maybe FilePath, Maybe FilePath)) -> [FilePath]
createDiff [FilePath]
acc (FilePath
key, (Just FilePath
a, Just FilePath
b))
        | FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b = [FilePath]
acc
        | Bool
otherwise = (FilePath
"+ " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b)
                      FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath
"- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
a) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
acc
    createDiff [FilePath]
acc (FilePath
key, (Maybe FilePath
Nothing, Just FilePath
b)) = (FilePath
"+ " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
acc
    createDiff [FilePath]
acc (FilePath
key, (Just FilePath
a, Maybe FilePath
Nothing)) = (FilePath
"- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
a) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
acc
    createDiff [FilePath]
acc (FilePath
_, (Maybe FilePath
Nothing, Maybe FilePath
Nothing)) = [FilePath]
acc

    filterShow :: SavedConfig -> [(String, String)]
    filterShow :: SavedConfig -> [(FilePath, FilePath)]
filterShow SavedConfig
cfg = (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> (FilePath, FilePath)
keyValueSplit
        ([FilePath] -> [(FilePath, FilePath)])
-> (FilePath -> [FilePath]) -> FilePath -> [(FilePath, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
s -> Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s) Bool -> Bool -> Bool
&& Char
':' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
s)
        ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
nonComment
        ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
        (FilePath -> [(FilePath, FilePath)])
-> FilePath -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ SavedConfig -> FilePath
showConfig SavedConfig
cfg

    nonComment :: FilePath -> FilePath
nonComment [] = []
    nonComment (Char
'-':Char
'-':FilePath
_) = []
    nonComment (Char
x:FilePath
xs) = Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
nonComment FilePath
xs

    topAndTail :: FilePath -> FilePath
topAndTail = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

    keyValueSplit :: FilePath -> (FilePath, FilePath)
keyValueSplit FilePath
s =
        let (FilePath
left, FilePath
right) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') FilePath
s
        in (FilePath -> FilePath
topAndTail FilePath
left, FilePath -> FilePath
topAndTail (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
right))


-- | Update the user's ~/.cabal/config' keeping the user's customizations.
userConfigUpdate :: Verbosity -> GlobalFlags -> [String] -> IO ()
userConfigUpdate :: Verbosity -> GlobalFlags -> [FilePath] -> IO ()
userConfigUpdate Verbosity
verbosity GlobalFlags
globalFlags [FilePath]
extraLines = do
  SavedConfig
userConfig  <- Verbosity -> Flag FilePath -> IO SavedConfig
loadRawConfig Verbosity
normal (GlobalFlags -> Flag FilePath
globalConfigFile GlobalFlags
globalFlags)
  SavedConfig
extraConfig <- Verbosity -> [FilePath] -> IO SavedConfig
parseExtraLines Verbosity
verbosity [FilePath]
extraLines
  SavedConfig
newConfig   <- IO SavedConfig
initialSavedConfig
  SavedConfig
commentConf <- IO SavedConfig
commentSavedConfig
  FilePath
cabalFile <- Flag FilePath -> IO FilePath
getConfigFilePath (Flag FilePath -> IO FilePath) -> Flag FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ GlobalFlags -> Flag FilePath
globalConfigFile GlobalFlags
globalFlags
  let backup :: FilePath
backup = FilePath
cabalFile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".backup"
  Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Renaming " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cabalFile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
backup FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
  FilePath -> FilePath -> IO ()
renameFile FilePath
cabalFile FilePath
backup
  Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing merged config to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cabalFile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
  FilePath -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile FilePath
cabalFile SavedConfig
commentConf
    (SavedConfig
newConfig SavedConfig -> SavedConfig -> SavedConfig
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
userConfig SavedConfig -> SavedConfig -> SavedConfig
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
extraConfig)