{-# LANGUAGE DeriveGeneric #-}
module Distribution.Client.Config (
SavedConfig(..),
loadConfig,
getConfigFilePath,
showConfig,
showConfigWithComments,
parseConfig,
defaultConfigFile,
defaultCacheDir,
defaultScriptBuildsDir,
defaultStoreDir,
defaultCompiler,
defaultInstallPath,
defaultLogsDir,
defaultReportsDir,
defaultUserInstall,
baseSavedConfig,
commentSavedConfig,
initialSavedConfig,
configFieldDescriptions,
haddockFlagsFields,
installDirsFields,
withProgramsFields,
withProgramOptionsFields,
userConfigDiff,
userConfigUpdate,
createDefaultConfigFile,
remoteRepoFields,
postProcessRepo,
) where
import Distribution.Compat.Environment (lookupEnv)
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, getHomeDirectory, getXdgDirectory, XdgDirectory(XdgCache, XdgConfig, XdgState), renameFile, getAppUserDataDirectory, doesDirectoryExist )
import Network.URI
( URI(..), URIAuth(..), parseURI )
import System.FilePath
( (<.>), (</>), takeDirectory )
import System.IO.Error
( isDoesNotExistError )
import Distribution.Compat.Environment
( getEnvironment )
import qualified Data.Map as M
import qualified Data.ByteString as BS
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. 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 = forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
mappend :: SavedConfig -> SavedConfig -> SavedConfig
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup SavedConfig where
SavedConfig
a <> :: SavedConfig -> SavedConfig -> SavedConfig
<> SavedConfig
b = 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
combine' :: (SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' :: forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> flags
field flags -> Flag a
subfield =
(flags -> Flag a
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
a) forall a. Monoid a => a -> a -> a
`mappend` (flags -> Flag a
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
b)
combineMonoid :: Monoid mon => (SavedConfig -> flags) -> (flags -> mon)
-> mon
combineMonoid :: forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> flags
field flags -> mon
subfield =
(flags -> mon
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
a) forall a. Monoid a => a -> a -> a
`mappend` (flags -> mon
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
b)
lastNonEmpty' :: (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' :: forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' SavedConfig -> flags
field flags -> [a]
subfield =
let a' :: [a]
a' = flags -> [a]
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
a
b' :: [a]
b' = flags -> [a]
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field 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' :: forall a flags.
(Eq a, Monoid a) =>
(SavedConfig -> flags) -> (flags -> a) -> a
lastNonMempty' SavedConfig -> flags
field flags -> a
subfield =
let a' :: a
a' = flags -> a
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
a
b' :: a
b' = flags -> a
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
b
in if a
b' forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then a
a' else a
b'
lastNonEmptyNL' :: (SavedConfig -> flags) -> (flags -> NubList a)
-> NubList a
lastNonEmptyNL' :: forall flags a.
(SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> flags
field flags -> NubList a
subfield =
let a' :: NubList a
a' = flags -> NubList a
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
a
b' :: NubList a
b' = flags -> NubList a
subfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> flags
field forall a b. (a -> b) -> a -> b
$ SavedConfig
b
in case forall a. NubList a -> [a]
fromNubList NubList a
b' of [] -> NubList a
a'
[a]
_ -> NubList a
b'
combinedSavedGlobalFlags :: GlobalFlags
combinedSavedGlobalFlags = GlobalFlags {
globalVersion :: Flag Bool
globalVersion = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalVersion,
globalNumericVersion :: Flag Bool
globalNumericVersion = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalNumericVersion,
globalConfigFile :: Flag String
globalConfigFile = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag String
globalConfigFile,
globalConstraintsFile :: Flag String
globalConstraintsFile = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag String
globalConstraintsFile,
globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = forall {a}. (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL GlobalFlags -> NubList RemoteRepo
globalRemoteRepos,
globalCacheDir :: Flag String
globalCacheDir = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag String
globalCacheDir,
globalLocalNoIndexRepos :: NubList LocalRepo
globalLocalNoIndexRepos = forall {a}. (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL GlobalFlags -> NubList LocalRepo
globalLocalNoIndexRepos,
globalActiveRepos :: Flag ActiveRepos
globalActiveRepos = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag ActiveRepos
globalActiveRepos,
globalLogsDir :: Flag String
globalLogsDir = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag String
globalLogsDir,
globalIgnoreExpiry :: Flag Bool
globalIgnoreExpiry = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalIgnoreExpiry,
globalHttpTransport :: Flag String
globalHttpTransport = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag String
globalHttpTransport,
globalNix :: Flag Bool
globalNix = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag Bool
globalNix,
globalStoreDir :: Flag String
globalStoreDir = forall {a}. (GlobalFlags -> Flag a) -> Flag a
combine GlobalFlags -> Flag String
globalStoreDir,
globalProgPathExtra :: NubList String
globalProgPathExtra = forall {a}. (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL GlobalFlags -> NubList String
globalProgPathExtra
}
where
combine :: (GlobalFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> GlobalFlags
savedGlobalFlags
lastNonEmptyNL :: (GlobalFlags -> NubList a) -> NubList a
lastNonEmptyNL = forall flags a.
(SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> GlobalFlags
savedGlobalFlags
combinedSavedInitFlags :: InitFlags
combinedSavedInitFlags = IT.InitFlags {
applicationDirs :: Flag [String]
IT.applicationDirs = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [String]
IT.applicationDirs,
author :: Flag String
IT.author = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.author,
buildTools :: Flag [String]
IT.buildTools = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [String]
IT.buildTools,
cabalVersion :: Flag CabalSpecVersion
IT.cabalVersion = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag CabalSpecVersion
IT.cabalVersion,
category :: Flag String
IT.category = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.category,
dependencies :: Flag [Dependency]
IT.dependencies = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [Dependency]
IT.dependencies,
email :: Flag String
IT.email = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.email,
exposedModules :: Flag [ModuleName]
IT.exposedModules = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [ModuleName]
IT.exposedModules,
extraSrc :: Flag [String]
IT.extraSrc = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [String]
IT.extraSrc,
extraDoc :: Flag [String]
IT.extraDoc = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [String]
IT.extraDoc,
homepage :: Flag String
IT.homepage = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.homepage,
initHcPath :: Flag String
IT.initHcPath = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.initHcPath,
initVerbosity :: Flag Verbosity
IT.initVerbosity = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Verbosity
IT.initVerbosity,
initializeTestSuite :: Flag Bool
IT.initializeTestSuite = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.initializeTestSuite,
interactive :: Flag Bool
IT.interactive = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.interactive,
language :: Flag Language
IT.language = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Language
IT.language,
license :: Flag SpecLicense
IT.license = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag SpecLicense
IT.license,
mainIs :: Flag String
IT.mainIs = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.mainIs,
minimal :: Flag Bool
IT.minimal = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.minimal,
noComments :: Flag Bool
IT.noComments = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.noComments,
otherExts :: Flag [Extension]
IT.otherExts = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [Extension]
IT.otherExts,
otherModules :: Flag [ModuleName]
IT.otherModules = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [ModuleName]
IT.otherModules,
overwrite :: Flag Bool
IT.overwrite = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.overwrite,
packageDir :: Flag String
IT.packageDir = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.packageDir,
packageName :: Flag PackageName
IT.packageName = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag PackageName
IT.packageName,
packageType :: Flag PackageType
IT.packageType = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag PackageType
IT.packageType,
quiet :: Flag Bool
IT.quiet = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.quiet,
simpleProject :: Flag Bool
IT.simpleProject = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Bool
IT.simpleProject,
sourceDirs :: Flag [String]
IT.sourceDirs = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [String]
IT.sourceDirs,
synopsis :: Flag String
IT.synopsis = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag String
IT.synopsis,
testDirs :: Flag [String]
IT.testDirs = forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> InitFlags
savedInitFlags InitFlags -> Flag [String]
IT.testDirs,
version :: Flag Version
IT.version = forall {a}. (InitFlags -> Flag a) -> Flag a
combine InitFlags -> Flag Version
IT.version
}
where
combine :: (InitFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> InitFlags
savedInitFlags
combinedSavedInstallFlags :: InstallFlags
combinedSavedInstallFlags = InstallFlags {
installDocumentation :: Flag Bool
installDocumentation = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installDocumentation,
installHaddockIndex :: Flag PathTemplate
installHaddockIndex = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag PathTemplate
installHaddockIndex,
installDryRun :: Flag Bool
installDryRun = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installDryRun,
installOnlyDownload :: Flag Bool
installOnlyDownload = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOnlyDownload,
installDest :: Flag CopyDest
installDest = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag CopyDest
installDest,
installMaxBackjumps :: Flag Int
installMaxBackjumps = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Int
installMaxBackjumps,
installReorderGoals :: Flag ReorderGoals
installReorderGoals = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag ReorderGoals
installReorderGoals,
installCountConflicts :: Flag CountConflicts
installCountConflicts = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag CountConflicts
installCountConflicts,
installFineGrainedConflicts :: Flag FineGrainedConflicts
installFineGrainedConflicts = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag FineGrainedConflicts
installFineGrainedConflicts,
installMinimizeConflictSet :: Flag MinimizeConflictSet
installMinimizeConflictSet = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag MinimizeConflictSet
installMinimizeConflictSet,
installIndependentGoals :: Flag IndependentGoals
installIndependentGoals = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag IndependentGoals
installIndependentGoals,
installPreferOldest :: Flag PreferOldest
installPreferOldest = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag PreferOldest
installPreferOldest,
installShadowPkgs :: Flag ShadowPkgs
installShadowPkgs = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag ShadowPkgs
installShadowPkgs,
installStrongFlags :: Flag StrongFlags
installStrongFlags = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag StrongFlags
installStrongFlags,
installAllowBootLibInstalls :: Flag AllowBootLibInstalls
installAllowBootLibInstalls = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag AllowBootLibInstalls
installAllowBootLibInstalls,
installOnlyConstrained :: Flag OnlyConstrained
installOnlyConstrained = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag OnlyConstrained
installOnlyConstrained,
installReinstall :: Flag Bool
installReinstall = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installReinstall,
installAvoidReinstalls :: Flag AvoidReinstalls
installAvoidReinstalls = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag AvoidReinstalls
installAvoidReinstalls,
installOverrideReinstall :: Flag Bool
installOverrideReinstall = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOverrideReinstall,
installUpgradeDeps :: Flag Bool
installUpgradeDeps = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installUpgradeDeps,
installOnly :: Flag Bool
installOnly = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOnly,
installOnlyDeps :: Flag Bool
installOnlyDeps = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOnlyDeps,
installIndexState :: Flag TotalIndexState
installIndexState = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag TotalIndexState
installIndexState,
installRootCmd :: Flag String
installRootCmd = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag String
installRootCmd,
installSummaryFile :: NubList PathTemplate
installSummaryFile = forall {a}. (InstallFlags -> NubList a) -> NubList a
lastNonEmptyNL InstallFlags -> NubList PathTemplate
installSummaryFile,
installLogFile :: Flag PathTemplate
installLogFile = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag PathTemplate
installLogFile,
installBuildReports :: Flag ReportLevel
installBuildReports = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag ReportLevel
installBuildReports,
installReportPlanningFailure :: Flag Bool
installReportPlanningFailure = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installReportPlanningFailure,
installSymlinkBinDir :: Flag String
installSymlinkBinDir = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag String
installSymlinkBinDir,
installPerComponent :: Flag Bool
installPerComponent = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installPerComponent,
installNumJobs :: Flag (Maybe Int)
installNumJobs = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag (Maybe Int)
installNumJobs,
installKeepGoing :: Flag Bool
installKeepGoing = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installKeepGoing,
installRunTests :: Flag Bool
installRunTests = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installRunTests,
installOfflineMode :: Flag Bool
installOfflineMode = forall {a}. (InstallFlags -> Flag a) -> Flag a
combine InstallFlags -> Flag Bool
installOfflineMode
}
where
combine :: (InstallFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> InstallFlags
savedInstallFlags
lastNonEmptyNL :: (InstallFlags -> NubList a) -> NubList a
lastNonEmptyNL = forall flags a.
(SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> InstallFlags
savedInstallFlags
combinedSavedClientInstallFlags :: ClientInstallFlags
combinedSavedClientInstallFlags = ClientInstallFlags
{ cinstInstallLibs :: Flag Bool
cinstInstallLibs = forall {a}. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag Bool
cinstInstallLibs
, cinstEnvironmentPath :: Flag String
cinstEnvironmentPath = forall {a}. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag String
cinstEnvironmentPath
, cinstOverwritePolicy :: Flag OverwritePolicy
cinstOverwritePolicy = forall {a}. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag OverwritePolicy
cinstOverwritePolicy
, cinstInstallMethod :: Flag InstallMethod
cinstInstallMethod = forall {a}. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag InstallMethod
cinstInstallMethod
, cinstInstalldir :: Flag String
cinstInstalldir = forall {a}. (ClientInstallFlags -> Flag a) -> Flag a
combine ClientInstallFlags -> Flag String
cinstInstalldir
}
where
combine :: (ClientInstallFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> ClientInstallFlags
savedClientInstallFlags
combinedSavedConfigureFlags :: ConfigFlags
combinedSavedConfigureFlags = ConfigFlags {
configArgs :: [String]
configArgs = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [String]
configArgs,
configPrograms_ :: Option' (Last' ProgramDb)
configPrograms_ = ConfigFlags -> Option' (Last' ProgramDb)
configPrograms_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags forall a b. (a -> b) -> a -> b
$ SavedConfig
b,
configProgramPaths :: [(String, String)]
configProgramPaths = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [(String, String)]
configProgramPaths,
configProgramArgs :: [(String, [String])]
configProgramArgs = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [(String, [String])]
configProgramArgs,
configProgramPathExtra :: NubList String
configProgramPathExtra = forall {a}. (ConfigFlags -> NubList a) -> NubList a
lastNonEmptyNL ConfigFlags -> NubList String
configProgramPathExtra,
configInstantiateWith :: [(ModuleName, Module)]
configInstantiateWith = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [(ModuleName, Module)]
configInstantiateWith,
configHcFlavor :: Flag CompilerFlavor
configHcFlavor = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag CompilerFlavor
configHcFlavor,
configHcPath :: Flag String
configHcPath = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag String
configHcPath,
configHcPkg :: Flag String
configHcPkg = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag String
configHcPkg,
configVanillaLib :: Flag Bool
configVanillaLib = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configVanillaLib,
configProfLib :: Flag Bool
configProfLib = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configProfLib,
configProf :: Flag Bool
configProf = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configProf,
configSharedLib :: Flag Bool
configSharedLib = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configSharedLib,
configStaticLib :: Flag Bool
configStaticLib = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configStaticLib,
configDynExe :: Flag Bool
configDynExe = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configDynExe,
configFullyStaticExe :: Flag Bool
configFullyStaticExe = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configFullyStaticExe,
configProfExe :: Flag Bool
configProfExe = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configProfExe,
configProfDetail :: Flag ProfDetailLevel
configProfDetail = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag ProfDetailLevel
configProfDetail,
configProfLibDetail :: Flag ProfDetailLevel
configProfLibDetail = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag ProfDetailLevel
configProfLibDetail,
configConfigureArgs :: [String]
configConfigureArgs = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [String]
configConfigureArgs,
configOptimization :: Flag OptimisationLevel
configOptimization = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag OptimisationLevel
configOptimization,
configDebugInfo :: Flag DebugInfoLevel
configDebugInfo = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag DebugInfoLevel
configDebugInfo,
configProgPrefix :: Flag PathTemplate
configProgPrefix = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag PathTemplate
configProgPrefix,
configProgSuffix :: Flag PathTemplate
configProgSuffix = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag PathTemplate
configProgSuffix,
configInstallDirs :: InstallDirs (Flag PathTemplate)
configInstallDirs =
(ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags forall a b. (a -> b) -> a -> b
$ SavedConfig
a)
forall a. Monoid a => a -> a -> a
`mappend` (ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags forall a b. (a -> b) -> a -> b
$ SavedConfig
b),
configScratchDir :: Flag String
configScratchDir = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag String
configScratchDir,
configExtraLibDirs :: [String]
configExtraLibDirs = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [String]
configExtraLibDirs,
configExtraLibDirsStatic :: [String]
configExtraLibDirsStatic = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [String]
configExtraLibDirsStatic,
configExtraFrameworkDirs :: [String]
configExtraFrameworkDirs = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [String]
configExtraFrameworkDirs,
configExtraIncludeDirs :: [String]
configExtraIncludeDirs = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [String]
configExtraIncludeDirs,
configDeterministic :: Flag Bool
configDeterministic = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configDeterministic,
configIPID :: Flag String
configIPID = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag String
configIPID,
configCID :: Flag ComponentId
configCID = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag ComponentId
configCID,
configDistPref :: Flag String
configDistPref = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag String
configDistPref,
configCabalFilePath :: Flag String
configCabalFilePath = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag String
configCabalFilePath,
configVerbosity :: Flag Verbosity
configVerbosity = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Verbosity
configVerbosity,
configUserInstall :: Flag Bool
configUserInstall = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configUserInstall,
configPackageDBs :: [Maybe PackageDB]
configPackageDBs = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [Maybe PackageDB]
configPackageDBs,
configGHCiLib :: Flag Bool
configGHCiLib = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configGHCiLib,
configSplitSections :: Flag Bool
configSplitSections = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configSplitSections,
configSplitObjs :: Flag Bool
configSplitObjs = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configSplitObjs,
configStripExes :: Flag Bool
configStripExes = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configStripExes,
configStripLibs :: Flag Bool
configStripLibs = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configStripLibs,
configConstraints :: [PackageVersionConstraint]
configConstraints = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [PackageVersionConstraint]
configConstraints,
configDependencies :: [GivenComponent]
configDependencies = forall {a}. (ConfigFlags -> [a]) -> [a]
lastNonEmpty ConfigFlags -> [GivenComponent]
configDependencies,
configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = (ConfigFlags -> FlagAssignment) -> FlagAssignment
lastNonMempty ConfigFlags -> FlagAssignment
configConfigurationsFlags,
configTests :: Flag Bool
configTests = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configTests,
configBenchmarks :: Flag Bool
configBenchmarks = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configBenchmarks,
configCoverage :: Flag Bool
configCoverage = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configCoverage,
configLibCoverage :: Flag Bool
configLibCoverage = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configLibCoverage,
configExactConfiguration :: Flag Bool
configExactConfiguration = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configExactConfiguration,
configFlagError :: Flag String
configFlagError = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag String
configFlagError,
configRelocatable :: Flag Bool
configRelocatable = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configRelocatable,
configUseResponseFiles :: Flag Bool
configUseResponseFiles = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configUseResponseFiles,
configDumpBuildInfo :: Flag DumpBuildInfo
configDumpBuildInfo = forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag DumpBuildInfo
configDumpBuildInfo,
configAllowDependingOnPrivateLibs :: Flag Bool
configAllowDependingOnPrivateLibs =
forall {a}. (ConfigFlags -> Flag a) -> Flag a
combine ConfigFlags -> Flag Bool
configAllowDependingOnPrivateLibs
}
where
combine :: (ConfigFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> ConfigFlags
savedConfigureFlags
lastNonEmpty :: (ConfigFlags -> [a]) -> [a]
lastNonEmpty = forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' SavedConfig -> ConfigFlags
savedConfigureFlags
lastNonEmptyNL :: (ConfigFlags -> NubList a) -> NubList a
lastNonEmptyNL = forall flags a.
(SavedConfig -> flags) -> (flags -> NubList a) -> NubList a
lastNonEmptyNL' SavedConfig -> ConfigFlags
savedConfigureFlags
lastNonMempty :: (ConfigFlags -> FlagAssignment) -> FlagAssignment
lastNonMempty = forall a flags.
(Eq a, Monoid a) =>
(SavedConfig -> flags) -> (flags -> a) -> a
lastNonMempty' SavedConfig -> ConfigFlags
savedConfigureFlags
combinedSavedConfigureExFlags :: ConfigExFlags
combinedSavedConfigureExFlags = ConfigExFlags {
configCabalVersion :: Flag Version
configCabalVersion = forall {a}. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag Version
configCabalVersion,
configAppend :: Flag Bool
configAppend = forall {a}. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag Bool
configAppend,
configBackup :: Flag Bool
configBackup = forall {a}. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag Bool
configBackup,
configExConstraints :: [(UserConstraint, ConstraintSource)]
configExConstraints = forall {a}. (ConfigExFlags -> [a]) -> [a]
lastNonEmpty ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints,
configPreferences :: [PackageVersionConstraint]
configPreferences = forall {a}. (ConfigExFlags -> [a]) -> [a]
lastNonEmpty ConfigExFlags -> [PackageVersionConstraint]
configPreferences,
configSolver :: Flag PreSolver
configSolver = forall {a}. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag PreSolver
configSolver,
configAllowNewer :: Maybe AllowNewer
configAllowNewer =
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> ConfigExFlags
savedConfigureExFlags ConfigExFlags -> Maybe AllowNewer
configAllowNewer,
configAllowOlder :: Maybe AllowOlder
configAllowOlder =
forall mon flags.
Monoid mon =>
(SavedConfig -> flags) -> (flags -> mon) -> mon
combineMonoid SavedConfig -> ConfigExFlags
savedConfigureExFlags ConfigExFlags -> Maybe AllowOlder
configAllowOlder,
configWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
configWriteGhcEnvironmentFilesPolicy
= forall {a}. (ConfigExFlags -> Flag a) -> Flag a
combine ConfigExFlags -> Flag WriteGhcEnvironmentFilesPolicy
configWriteGhcEnvironmentFilesPolicy
}
where
combine :: (ConfigExFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> ConfigExFlags
savedConfigureExFlags
lastNonEmpty :: (ConfigExFlags -> [a]) -> [a]
lastNonEmpty = forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' SavedConfig -> ConfigExFlags
savedConfigureExFlags
combinedSavedUserInstallDirs :: InstallDirs (Flag PathTemplate)
combinedSavedUserInstallDirs = SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs SavedConfig
a
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs SavedConfig
b
combinedSavedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
combinedSavedGlobalInstallDirs = SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs SavedConfig
a
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs SavedConfig
b
combinedSavedUploadFlags :: UploadFlags
combinedSavedUploadFlags = UploadFlags {
uploadCandidate :: Flag IsCandidate
uploadCandidate = forall {a}. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag IsCandidate
uploadCandidate,
uploadDoc :: Flag Bool
uploadDoc = forall {a}. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Bool
uploadDoc,
uploadUsername :: Flag Username
uploadUsername = forall {a}. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Username
uploadUsername,
uploadPassword :: Flag Password
uploadPassword = forall {a}. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Password
uploadPassword,
uploadPasswordCmd :: Flag [String]
uploadPasswordCmd = forall {a}. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag [String]
uploadPasswordCmd,
uploadVerbosity :: Flag Verbosity
uploadVerbosity = forall {a}. (UploadFlags -> Flag a) -> Flag a
combine UploadFlags -> Flag Verbosity
uploadVerbosity
}
where
combine :: (UploadFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> UploadFlags
savedUploadFlags
combinedSavedReportFlags :: ReportFlags
combinedSavedReportFlags = ReportFlags {
reportUsername :: Flag Username
reportUsername = forall {a}. (ReportFlags -> Flag a) -> Flag a
combine ReportFlags -> Flag Username
reportUsername,
reportPassword :: Flag Password
reportPassword = forall {a}. (ReportFlags -> Flag a) -> Flag a
combine ReportFlags -> Flag Password
reportPassword,
reportVerbosity :: Flag Verbosity
reportVerbosity = forall {a}. (ReportFlags -> Flag a) -> Flag a
combine ReportFlags -> Flag Verbosity
reportVerbosity
}
where
combine :: (ReportFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> ReportFlags
savedReportFlags
combinedSavedHaddockFlags :: HaddockFlags
combinedSavedHaddockFlags = HaddockFlags {
haddockProgramPaths :: [(String, String)]
haddockProgramPaths = forall {a}. (HaddockFlags -> [a]) -> [a]
lastNonEmpty HaddockFlags -> [(String, String)]
haddockProgramPaths,
haddockProgramArgs :: [(String, [String])]
haddockProgramArgs = forall {a}. (HaddockFlags -> [a]) -> [a]
lastNonEmpty HaddockFlags -> [(String, [String])]
haddockProgramArgs,
haddockHoogle :: Flag Bool
haddockHoogle = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockHoogle,
haddockHtml :: Flag Bool
haddockHtml = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockHtml,
haddockHtmlLocation :: Flag String
haddockHtmlLocation = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag String
haddockHtmlLocation,
haddockForHackage :: Flag HaddockTarget
haddockForHackage = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag HaddockTarget
haddockForHackage,
haddockExecutables :: Flag Bool
haddockExecutables = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockExecutables,
haddockTestSuites :: Flag Bool
haddockTestSuites = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockTestSuites,
haddockBenchmarks :: Flag Bool
haddockBenchmarks = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockBenchmarks,
haddockForeignLibs :: Flag Bool
haddockForeignLibs = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockForeignLibs,
haddockInternal :: Flag Bool
haddockInternal = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockInternal,
haddockCss :: Flag String
haddockCss = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag String
haddockCss,
haddockLinkedSource :: Flag Bool
haddockLinkedSource = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockLinkedSource,
haddockQuickJump :: Flag Bool
haddockQuickJump = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockQuickJump,
haddockHscolourCss :: Flag String
haddockHscolourCss = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag String
haddockHscolourCss,
haddockContents :: Flag PathTemplate
haddockContents = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag PathTemplate
haddockContents,
haddockDistPref :: Flag String
haddockDistPref = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag String
haddockDistPref,
haddockKeepTempFiles :: Flag Bool
haddockKeepTempFiles = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Bool
haddockKeepTempFiles,
haddockVerbosity :: Flag Verbosity
haddockVerbosity = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag Verbosity
haddockVerbosity,
haddockCabalFilePath :: Flag String
haddockCabalFilePath = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag String
haddockCabalFilePath,
haddockIndex :: Flag PathTemplate
haddockIndex = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag PathTemplate
haddockIndex,
haddockBaseUrl :: Flag String
haddockBaseUrl = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag String
haddockBaseUrl,
haddockLib :: Flag String
haddockLib = forall {a}. (HaddockFlags -> Flag a) -> Flag a
combine HaddockFlags -> Flag String
haddockLib,
haddockArgs :: [String]
haddockArgs = forall {a}. (HaddockFlags -> [a]) -> [a]
lastNonEmpty HaddockFlags -> [String]
haddockArgs
}
where
combine :: (HaddockFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> HaddockFlags
savedHaddockFlags
lastNonEmpty :: (HaddockFlags -> [a]) -> [a]
lastNonEmpty = forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' SavedConfig -> HaddockFlags
savedHaddockFlags
combinedSavedTestFlags :: TestFlags
combinedSavedTestFlags = TestFlags {
testDistPref :: Flag String
testDistPref = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag String
testDistPref,
testVerbosity :: Flag Verbosity
testVerbosity = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag Verbosity
testVerbosity,
testHumanLog :: Flag PathTemplate
testHumanLog = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag PathTemplate
testHumanLog,
testMachineLog :: Flag PathTemplate
testMachineLog = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag PathTemplate
testMachineLog,
testShowDetails :: Flag TestShowDetails
testShowDetails = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag TestShowDetails
testShowDetails,
testKeepTix :: Flag Bool
testKeepTix = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag Bool
testKeepTix,
testWrapper :: Flag String
testWrapper = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag String
testWrapper,
testFailWhenNoTestSuites :: Flag Bool
testFailWhenNoTestSuites = forall {a}. (TestFlags -> Flag a) -> Flag a
combine TestFlags -> Flag Bool
testFailWhenNoTestSuites,
testOptions :: [PathTemplate]
testOptions = forall {a}. (TestFlags -> [a]) -> [a]
lastNonEmpty TestFlags -> [PathTemplate]
testOptions
}
where
combine :: (TestFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> TestFlags
savedTestFlags
lastNonEmpty :: (TestFlags -> [a]) -> [a]
lastNonEmpty = forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' SavedConfig -> TestFlags
savedTestFlags
combinedSavedBenchmarkFlags :: BenchmarkFlags
combinedSavedBenchmarkFlags = BenchmarkFlags {
benchmarkDistPref :: Flag String
benchmarkDistPref = forall {a}. (BenchmarkFlags -> Flag a) -> Flag a
combine BenchmarkFlags -> Flag String
benchmarkDistPref,
benchmarkVerbosity :: Flag Verbosity
benchmarkVerbosity = forall {a}. (BenchmarkFlags -> Flag a) -> Flag a
combine BenchmarkFlags -> Flag Verbosity
benchmarkVerbosity,
benchmarkOptions :: [PathTemplate]
benchmarkOptions = forall {a}. (BenchmarkFlags -> [a]) -> [a]
lastNonEmpty BenchmarkFlags -> [PathTemplate]
benchmarkOptions
}
where
combine :: (BenchmarkFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> BenchmarkFlags
savedBenchmarkFlags
lastNonEmpty :: (BenchmarkFlags -> [a]) -> [a]
lastNonEmpty = forall flags a. (SavedConfig -> flags) -> (flags -> [a]) -> [a]
lastNonEmpty' SavedConfig -> BenchmarkFlags
savedBenchmarkFlags
combinedSavedProjectFlags :: ProjectFlags
combinedSavedProjectFlags = ProjectFlags
{ flagProjectFileName :: Flag String
flagProjectFileName = forall {a}. (ProjectFlags -> Flag a) -> Flag a
combine ProjectFlags -> Flag String
flagProjectFileName
, flagIgnoreProject :: Flag Bool
flagIgnoreProject = forall {a}. (ProjectFlags -> Flag a) -> Flag a
combine ProjectFlags -> Flag Bool
flagIgnoreProject
}
where
combine :: (ProjectFlags -> Flag a) -> Flag a
combine = forall flags a.
(SavedConfig -> flags) -> (flags -> Flag a) -> Flag a
combine' SavedConfig -> ProjectFlags
savedProjectFlags
baseSavedConfig :: IO SavedConfig
baseSavedConfig :: IO SavedConfig
baseSavedConfig = do
String
userPrefix <- IO String
defaultInstallPrefix
String
cacheDir <- IO String
defaultCacheDir
String
logsDir <- IO String
defaultLogsDir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty {
savedConfigureFlags :: ConfigFlags
savedConfigureFlags = forall a. Monoid a => a
mempty {
configHcFlavor :: Flag CompilerFlavor
configHcFlavor = forall a. a -> Flag a
toFlag CompilerFlavor
defaultCompiler,
configUserInstall :: Flag Bool
configUserInstall = forall a. a -> Flag a
toFlag Bool
defaultUserInstall,
configVerbosity :: Flag Verbosity
configVerbosity = forall a. a -> Flag a
toFlag Verbosity
normal
},
savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs = forall a. Monoid a => a
mempty {
prefix :: Flag PathTemplate
prefix = forall a. a -> Flag a
toFlag (String -> PathTemplate
toPathTemplate String
userPrefix)
},
savedGlobalFlags :: GlobalFlags
savedGlobalFlags = forall a. Monoid a => a
mempty {
globalCacheDir :: Flag String
globalCacheDir = forall a. a -> Flag a
toFlag String
cacheDir,
globalLogsDir :: Flag String
globalLogsDir = forall a. a -> Flag a
toFlag String
logsDir
}
}
initialSavedConfig :: IO SavedConfig
initialSavedConfig :: IO SavedConfig
initialSavedConfig = do
String
cacheDir <- IO String
defaultCacheDir
String
logsDir <- IO String
defaultLogsDir
[String]
extraPath <- IO [String]
defaultExtraPath
String
installPath <- IO String
defaultInstallPath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty {
savedGlobalFlags :: GlobalFlags
savedGlobalFlags = forall a. Monoid a => a
mempty {
globalCacheDir :: Flag String
globalCacheDir = forall a. a -> Flag a
toFlag String
cacheDir,
globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo
defaultRemoteRepo]
},
savedConfigureFlags :: ConfigFlags
savedConfigureFlags = forall a. Monoid a => a
mempty {
configProgramPathExtra :: NubList String
configProgramPathExtra = forall a. Ord a => [a] -> NubList a
toNubList [String]
extraPath
},
savedInstallFlags :: InstallFlags
savedInstallFlags = forall a. Monoid a => a
mempty {
installSummaryFile :: NubList PathTemplate
installSummaryFile = forall a. Ord a => [a] -> NubList a
toNubList [String -> PathTemplate
toPathTemplate (String
logsDir String -> String -> String
</> String
"build.log")],
installBuildReports :: Flag ReportLevel
installBuildReports= forall a. a -> Flag a
toFlag ReportLevel
NoReports,
installNumJobs :: Flag (Maybe Int)
installNumJobs = forall a. a -> Flag a
toFlag forall a. Maybe a
Nothing
},
savedClientInstallFlags :: ClientInstallFlags
savedClientInstallFlags = forall a. Monoid a => a
mempty {
cinstInstalldir :: Flag String
cinstInstalldir = forall a. a -> Flag a
toFlag String
installPath
}
}
maybeGetCabalDir :: IO (Maybe FilePath)
maybeGetCabalDir :: IO (Maybe String)
maybeGetCabalDir = do
Maybe String
mDir <- String -> IO (Maybe String)
lookupEnv String
"CABAL_DIR"
case Maybe String
mDir of
Just String
dir -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
dir
Maybe String
Nothing -> do
String
defaultDir <- String -> IO String
getAppUserDataDirectory String
"cabal"
Bool
dotCabalExists <- String -> IO Bool
doesDirectoryExist String
defaultDir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
dotCabalExists
then forall a. a -> Maybe a
Just String
defaultDir
else forall a. Maybe a
Nothing
getDefaultDir :: XdgDirectory -> FilePath -> IO FilePath
getDefaultDir :: XdgDirectory -> String -> IO String
getDefaultDir XdgDirectory
xdg String
subdir = do
Maybe String
mDir <- IO (Maybe String)
maybeGetCabalDir
case Maybe String
mDir of
Just String
dir -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
subdir
Maybe String
Nothing -> XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
xdg forall a b. (a -> b) -> a -> b
$ String
"cabal" String -> String -> String
</> String
subdir
defaultInstallPrefix :: IO FilePath
defaultInstallPrefix :: IO String
defaultInstallPrefix = do
Maybe String
mDir <- IO (Maybe String)
maybeGetCabalDir
case Maybe String
mDir of
Just String
dir ->
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
Maybe String
Nothing -> do
String
dir <- IO String
getHomeDirectory
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
".local"
defaultConfigFile :: IO FilePath
defaultConfigFile :: IO String
defaultConfigFile =
XdgDirectory -> String -> IO String
getDefaultDir XdgDirectory
XdgConfig String
"config"
defaultCacheDir :: IO FilePath
defaultCacheDir :: IO String
defaultCacheDir =
XdgDirectory -> String -> IO String
getDefaultDir XdgDirectory
XdgCache String
"packages"
defaultScriptBuildsDir :: IO FilePath
defaultScriptBuildsDir :: IO String
defaultScriptBuildsDir =
XdgDirectory -> String -> IO String
getDefaultDir XdgDirectory
XdgCache String
"script-builds"
defaultStoreDir :: IO FilePath
defaultStoreDir :: IO String
defaultStoreDir =
XdgDirectory -> String -> IO String
getDefaultDir XdgDirectory
XdgState String
"store"
defaultLogsDir :: IO FilePath
defaultLogsDir :: IO String
defaultLogsDir =
XdgDirectory -> String -> IO String
getDefaultDir XdgDirectory
XdgCache String
"logs"
defaultReportsDir :: IO FilePath
defaultReportsDir :: IO String
defaultReportsDir =
XdgDirectory -> String -> IO String
getDefaultDir XdgDirectory
XdgCache String
"reports"
defaultExtraPath :: IO [FilePath]
= do
Maybe String
mDir <- IO (Maybe String)
maybeGetCabalDir
case Maybe String
mDir of
Just String
dir ->
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dir String -> String -> String
</> String
"bin"]
Maybe String
Nothing -> do
String
dir <- IO String
getHomeDirectory
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dir String -> String -> String
</> String
".local" String -> String -> String
</> String
"bin"]
defaultInstallPath :: IO FilePath
defaultInstallPath :: IO String
defaultInstallPath = do
Maybe String
mDir <- IO (Maybe String)
maybeGetCabalDir
case Maybe String
mDir of
Just String
dir ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"bin"
Maybe String
Nothing -> do
String
dir <- IO String
getHomeDirectory
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
".local" String -> String -> String
</> String
"bin"
defaultCompiler :: CompilerFlavor
defaultCompiler :: CompilerFlavor
defaultCompiler = forall a. a -> Maybe a -> a
fromMaybe CompilerFlavor
GHC Maybe CompilerFlavor
defaultCompilerFlavor
defaultUserInstall :: Bool
defaultUserInstall :: Bool
defaultUserInstall = Bool
True
defaultRemoteRepo :: RemoteRepo
defaultRemoteRepo :: RemoteRepo
defaultRemoteRepo = RepoName
-> URI -> Maybe Bool -> [String] -> Int -> Bool -> RemoteRepo
RemoteRepo RepoName
name URI
uri forall a. Maybe a
Nothing [] Int
0 Bool
False
where
str :: String
str = String
"hackage.haskell.org"
name :: RepoName
name = String -> RepoName
RepoName String
str
uri :: URI
uri = String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
"http:" (forall a. a -> Maybe a
Just (String -> String -> String -> URIAuth
URIAuth String
"" String
str String
"")) String
"/" String
"" String
""
addInfoForKnownRepos :: RemoteRepo -> RemoteRepo
addInfoForKnownRepos :: RemoteRepo -> RemoteRepo
addInfoForKnownRepos RemoteRepo
repo
| RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repo forall a. Eq a => a -> a -> Bool
== RemoteRepo -> RepoName
remoteRepoName RemoteRepo
defaultRemoteRepo
= RemoteRepo -> RemoteRepo
useSecure forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> RemoteRepo
tryHttps forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> RemoteRepo
fixOldURI 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 -> [String]
remoteRepoRootKeys = [],
remoteRepoKeyThreshold :: RemoteRepo -> Int
remoteRepoKeyThreshold = Int
0
} | Maybe Bool
secure forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
False
= RemoteRepo
r {
remoteRepoSecure :: Maybe Bool
remoteRepoSecure = forall a. a -> Maybe a
Just Bool
True,
remoteRepoRootKeys :: [String]
remoteRepoRootKeys = [String]
defaultHackageRemoteRepoKeys,
remoteRepoKeyThreshold :: Int
remoteRepoKeyThreshold = Int
defaultHackageRemoteRepoKeyThreshold
}
useSecure RemoteRepo
r = RemoteRepo
r
addInfoForKnownRepos RemoteRepo
other = RemoteRepo
other
defaultHackageRemoteRepoKeys :: [String]
defaultHackageRemoteRepoKeys :: [String]
defaultHackageRemoteRepoKeys =
[ String
"fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0",
String
"1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42",
String
"2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3",
String
"0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d",
String
"51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
]
defaultHackageRemoteRepoKeyThreshold :: Int
defaultHackageRemoteRepoKeyThreshold :: Int
defaultHackageRemoteRepoKeyThreshold = Int
3
loadConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
loadConfig :: Verbosity -> Flag String -> IO SavedConfig
loadConfig Verbosity
verbosity Flag String
configFileFlag = do
SavedConfig
config <- Verbosity -> Flag String -> IO SavedConfig
loadRawConfig Verbosity
verbosity Flag String
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 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 =
forall a. Ord a => ([a] -> [a]) -> NubList a -> NubList a
overNubList (forall a b. (a -> b) -> [a] -> [b]
map RemoteRepo -> RemoteRepo
addInfoForKnownRepos)
(GlobalFlags -> NubList RemoteRepo
globalRemoteRepos GlobalFlags
globalFlags0)
}
}
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
effective
loadRawConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
loadRawConfig :: Verbosity -> Flag String -> IO SavedConfig
loadRawConfig Verbosity
verbosity Flag String
configFileFlag = do
(ConfigFileSource
source, String
configFile) <- Flag String -> IO (ConfigFileSource, String)
getConfigFilePathAndSource Flag String
configFileFlag
Maybe (ParseResult SavedConfig)
minp <- SavedConfig -> String -> IO (Maybe (ParseResult SavedConfig))
readConfigFile forall a. Monoid a => a
mempty String
configFile
case Maybe (ParseResult SavedConfig)
minp of
Maybe (ParseResult SavedConfig)
Nothing -> do
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Config file path source is " forall a. [a] -> [a] -> [a]
++ ConfigFileSource -> String
sourceMsg ConfigFileSource
source forall a. [a] -> [a] -> [a]
++ String
"."
case ConfigFileSource
source of
ConfigFileSource
Default -> do
Verbosity -> String -> IO ()
notice Verbosity
verbosity String
msgNotFound
Verbosity -> [String] -> String -> IO SavedConfig
createDefaultConfigFile Verbosity
verbosity [] String
configFile
ConfigFileSource
CommandlineOption -> forall {a}. IO a
failNoConfigFile
ConfigFileSource
EnvironmentVariable -> forall {a}. IO a
failNoConfigFile
where
msgNotFound :: String
msgNotFound = [String] -> String
unwords [ String
"Config file not found:", String
configFile ]
failNoConfigFile :: IO a
failNoConfigFile = forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
msgNotFound
, String
"(Config files can be created via the cabal-command 'user-config init'.)"
]
Just (ParseOk [PWarning]
ws SavedConfig
conf) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PWarning]
ws) forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> PWarning -> String
showPWarning String
configFile) [PWarning]
ws)
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
conf
Just (ParseFailed PError
err) -> do
let (Maybe Int
line, String
msg) = PError -> (Maybe Int, String)
locatedErrorMsg PError
err
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Error parsing config file " forall a. [a] -> [a] -> [a]
++ String
configFile
forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Int
n -> Char
':' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
n) Maybe Int
line forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String
msg
where
sourceMsg :: ConfigFileSource -> String
sourceMsg ConfigFileSource
CommandlineOption = String
"commandline option"
sourceMsg ConfigFileSource
EnvironmentVariable = String
"environment variable CABAL_CONFIG"
sourceMsg ConfigFileSource
Default = String
"default config file"
data ConfigFileSource = CommandlineOption
| EnvironmentVariable
| Default
getConfigFilePath :: Flag FilePath -> IO FilePath
getConfigFilePath :: Flag String -> IO String
getConfigFilePath = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag String -> IO (ConfigFileSource, String)
getConfigFilePathAndSource
getConfigFilePathAndSource :: Flag FilePath -> IO (ConfigFileSource, FilePath)
getConfigFilePathAndSource :: Flag String -> IO (ConfigFileSource, String)
getConfigFilePathAndSource Flag String
configFileFlag =
forall {m :: * -> *} {a} {a}.
Monad m =>
[(a, m (Maybe a))] -> m (a, a)
getSource [(ConfigFileSource, IO (Maybe String))]
sources
where
sources :: [(ConfigFileSource, IO (Maybe String))]
sources =
[ (ConfigFileSource
CommandlineOption, forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flag a -> Maybe a
flagToMaybe forall a b. (a -> b) -> a -> b
$ Flag String
configFileFlag)
, (ConfigFileSource
EnvironmentVariable, forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"CABAL_CONFIG" forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO [(String, String)]
getEnvironment)
, (ConfigFileSource
Default, forall a. a -> Maybe a
Just forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO String
defaultConfigFile) ]
getSource :: [(a, m (Maybe a))] -> m (a, a)
getSource [] = forall a. HasCallStack => String -> a
error String
"no config file path candidate found."
getSource ((a
source,m (Maybe a)
action): [(a, m (Maybe a))]
xs) =
m (Maybe a)
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(a, m (Maybe a))] -> m (a, a)
getSource [(a, m (Maybe a))]
xs) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
source)
readConfigFile
:: SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig))
readConfigFile :: SavedConfig -> String -> IO (Maybe (ParseResult SavedConfig))
readConfigFile SavedConfig
initial String
file = forall {a}. IO (Maybe a) -> IO (Maybe a)
handleNotExists forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintSource
-> SavedConfig -> ByteString -> ParseResult SavedConfig
parseConfig (String -> ConstraintSource
ConstraintSourceMainConfig String
file) SavedConfig
initial)
(String -> IO ByteString
BS.readFile String
file)
where
handleNotExists :: IO (Maybe a) -> IO (Maybe a)
handleNotExists IO (Maybe a)
action = forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO (Maybe a)
action forall a b. (a -> b) -> a -> b
$ \IOException
ioe ->
if IOException -> Bool
isDoesNotExistError IOException
ioe
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. IOException -> IO a
ioError IOException
ioe
createDefaultConfigFile :: Verbosity -> [String] -> FilePath -> IO SavedConfig
createDefaultConfigFile :: Verbosity -> [String] -> String -> IO SavedConfig
createDefaultConfigFile Verbosity
verbosity [String]
extraLines String
filePath = do
SavedConfig
commentConf <- IO SavedConfig
commentSavedConfig
SavedConfig
initialConf <- IO SavedConfig
initialSavedConfig
SavedConfig
extraConf <- Verbosity -> [String] -> IO SavedConfig
parseExtraLines Verbosity
verbosity [String]
extraLines
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Writing default configuration to " forall a. [a] -> [a] -> [a]
++ String
filePath
String -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile String
filePath SavedConfig
commentConf (SavedConfig
initialConf forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
extraConf)
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
initialConf
writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile :: String -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile String
file SavedConfig
comments SavedConfig
vals = do
let tmpFile :: String
tmpFile = String
file String -> String -> String
<.> String
"tmp"
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
file)
String -> String -> IO ()
writeFile String
tmpFile forall a b. (a -> b) -> a -> b
$
String
explanation forall a. [a] -> [a] -> [a]
++ SavedConfig -> SavedConfig -> String
showConfigWithComments SavedConfig
comments SavedConfig
vals forall a. [a] -> [a] -> [a]
++ String
"\n"
String -> String -> IO ()
renameFile String
tmpFile String
file
where
explanation :: String
explanation = [String] -> String
unlines
[String
"-- This is the configuration file for the 'cabal' command line tool."
,String
"--"
,String
"-- The available configuration options are listed below."
,String
"-- Some of them have default values listed."
,String
"--"
,String
"-- Lines (like this one) beginning with '--' are comments."
,String
"-- Be careful with spaces and indentation because they are"
,String
"-- used to indicate layout for nested sections."
,String
"--"
,String
"-- This config file was generated using the following versions"
,String
"-- of Cabal and cabal-install:"
,String
"-- Cabal library version: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
cabalVersion
,String
"-- cabal-install version: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
cabalInstallVersion
,String
"",String
""
]
commentSavedConfig :: IO SavedConfig
= 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 = forall a. Monoid a => a
mempty {
savedGlobalFlags :: GlobalFlags
savedGlobalFlags = GlobalFlags
defaultGlobalFlags {
globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo
defaultRemoteRepo]
},
savedInitFlags :: InitFlags
savedInitFlags = forall a. Monoid a => a
mempty {
interactive :: Flag Bool
IT.interactive = forall a. a -> Flag a
toFlag Bool
False,
cabalVersion :: Flag CabalSpecVersion
IT.cabalVersion = forall a. a -> Flag a
toFlag CabalSpecVersion
IT.defaultCabalVersion,
language :: Flag Language
IT.language = forall a. a -> Flag a
toFlag Language
Haskell2010,
license :: Flag SpecLicense
IT.license = forall a. Flag a
NoFlag,
sourceDirs :: Flag [String]
IT.sourceDirs = forall a. a -> Flag a
Flag [String
IT.defaultSourceDir],
applicationDirs :: Flag [String]
IT.applicationDirs = forall a. a -> Flag a
Flag [String
IT.defaultApplicationDir]
},
savedInstallFlags :: InstallFlags
savedInstallFlags = InstallFlags
defaultInstallFlags,
savedClientInstallFlags :: ClientInstallFlags
savedClientInstallFlags= ClientInstallFlags
defaultClientInstallFlags,
savedConfigureExFlags :: ConfigExFlags
savedConfigureExFlags = ConfigExFlags
defaultConfigExFlags {
configAllowNewer :: Maybe AllowNewer
configAllowNewer = forall a. a -> Maybe a
Just (RelaxDeps -> AllowNewer
AllowNewer forall a. Monoid a => a
mempty),
configAllowOlder :: Maybe AllowOlder
configAllowOlder = forall a. a -> Maybe a
Just (RelaxDeps -> AllowOlder
AllowOlder forall a. Monoid a => a
mempty)
},
savedConfigureFlags :: ConfigFlags
savedConfigureFlags = (ProgramDb -> ConfigFlags
defaultConfigFlags ProgramDb
defaultProgramDb) {
configUserInstall :: Flag Bool
configUserInstall = forall a. a -> Flag a
toFlag Bool
defaultUserInstall
},
savedUserInstallDirs :: InstallDirs (Flag PathTemplate)
savedUserInstallDirs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Flag a
toFlag InstallDirTemplates
userInstallDirs,
savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Flag a
toFlag InstallDirTemplates
globalInstallDirs,
savedUploadFlags :: UploadFlags
savedUploadFlags = forall flags. CommandUI flags -> flags
commandDefaultFlags CommandUI UploadFlags
uploadCommand,
savedReportFlags :: ReportFlags
savedReportFlags = 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 = forall a. Ord a => ([a] -> [a]) -> NubList a -> NubList a
overNubList (forall a b. (a -> b) -> [a] -> [b]
map RemoteRepo -> RemoteRepo
removeRootKeys)
(GlobalFlags -> NubList RemoteRepo
globalRemoteRepos GlobalFlags
globalFlagsConf1)
}
}
forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
conf2
where
removeRootKeys :: RemoteRepo -> RemoteRepo
removeRootKeys :: RemoteRepo -> RemoteRepo
removeRootKeys RemoteRepo
r = RemoteRepo
r { remoteRepoRootKeys :: [String]
remoteRepoRootKeys = [] }
configFieldDescriptions :: ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions :: ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions ConstraintSource
src =
forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t String -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag
(forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions (forall action. [Command action] -> CommandUI GlobalFlags
globalCommand []) ShowOrParseArgs
ParseArgs)
[String
"version", String
"numeric-version", String
"config-file"] []
forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t String -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr ConfigFlags -> FieldDescr SavedConfig
liftConfigFlag
(ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions ShowOrParseArgs
ParseArgs)
([String
"builddir", String
"constraint", String
"dependency", String
"ipid"]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. FieldDescr a -> String
fieldName [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields)
[forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"compiler"
(forall a. a -> Flag a -> a
fromFlagOrDefault Doc
Disp.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Pretty a => a -> Doc
pretty) (forall a. a -> Flag a
Flag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Flag a
NoFlag)
ConfigFlags -> Flag CompilerFlavor
configHcFlavor (\Flag CompilerFlavor
v ConfigFlags
flags -> ConfigFlags
flags { configHcFlavor :: Flag CompilerFlavor
configHcFlavor = Flag CompilerFlavor
v })
,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 }) forall a b. (a -> b) -> a -> b
$
let name :: String
name = String
"optimization" in
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr String
name
(\Flag OptimisationLevel
f -> case Flag OptimisationLevel
f of
Flag OptimisationLevel
NoOptimisation -> String -> Doc
Disp.text String
"False"
Flag OptimisationLevel
NormalOptimisation -> String -> Doc
Disp.text String
"True"
Flag OptimisationLevel
MaximumOptimisation -> String -> Doc
Disp.text String
"2"
Flag OptimisationLevel
_ -> Doc
Disp.empty)
(\Int
line String
str Flag OptimisationLevel
_ -> case () of
()
_ | String
str forall a. Eq a => a -> a -> Bool
== String
"False" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
| String
str forall a. Eq a => a -> a -> Bool
== String
"True" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
| String
str forall a. Eq a => a -> a -> Bool
== String
"0" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
| String
str forall a. Eq a => a -> a -> Bool
== String
"1" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
| String
str forall a. Eq a => a -> a -> Bool
== String
"2" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag OptimisationLevel
MaximumOptimisation)
| String
lstr forall a. Eq a => a -> a -> Bool
== String
"false" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning] (forall a. a -> Flag a
Flag OptimisationLevel
NoOptimisation)
| String
lstr forall a. Eq a => a -> a -> Bool
== String
"true" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning]
(forall a. a -> Flag a
Flag OptimisationLevel
NormalOptimisation)
| Bool
otherwise -> forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
NoParse String
name Int
line)
where
lstr :: String
lstr = String -> String
lowercase String
str
caseWarning :: PWarning
caseWarning = String -> PWarning
PWarning forall a b. (a -> b) -> a -> b
$
String
"The '" forall a. [a] -> [a] -> [a]
++ String
name
forall a. [a] -> [a] -> [a]
++ String
"' field is case sensitive, use 'True' or 'False'.")
,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 }) forall a b. (a -> b) -> a -> b
$
let name :: String
name = String
"debug-info" in
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr String
name
(\Flag DebugInfoLevel
f -> case Flag DebugInfoLevel
f of
Flag DebugInfoLevel
NoDebugInfo -> String -> Doc
Disp.text String
"False"
Flag DebugInfoLevel
MinimalDebugInfo -> String -> Doc
Disp.text String
"1"
Flag DebugInfoLevel
NormalDebugInfo -> String -> Doc
Disp.text String
"True"
Flag DebugInfoLevel
MaximalDebugInfo -> String -> Doc
Disp.text String
"3"
Flag DebugInfoLevel
_ -> Doc
Disp.empty)
(\Int
line String
str Flag DebugInfoLevel
_ -> case () of
()
_ | String
str forall a. Eq a => a -> a -> Bool
== String
"False" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
| String
str forall a. Eq a => a -> a -> Bool
== String
"True" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
| String
str forall a. Eq a => a -> a -> Bool
== String
"0" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
| String
str forall a. Eq a => a -> a -> Bool
== String
"1" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag DebugInfoLevel
MinimalDebugInfo)
| String
str forall a. Eq a => a -> a -> Bool
== String
"2" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
| String
str forall a. Eq a => a -> a -> Bool
== String
"3" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [] (forall a. a -> Flag a
Flag DebugInfoLevel
MaximalDebugInfo)
| String
lstr forall a. Eq a => a -> a -> Bool
== String
"false" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning] (forall a. a -> Flag a
Flag DebugInfoLevel
NoDebugInfo)
| String
lstr forall a. Eq a => a -> a -> Bool
== String
"true" -> forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning
caseWarning] (forall a. a -> Flag a
Flag DebugInfoLevel
NormalDebugInfo)
| Bool
otherwise -> forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
NoParse String
name Int
line)
where
lstr :: String
lstr = String -> String
lowercase String
str
caseWarning :: PWarning
caseWarning = String -> PWarning
PWarning forall a b. (a -> b) -> a -> b
$
String
"The '" forall a. [a] -> [a] -> [a]
++ String
name
forall a. [a] -> [a] -> [a]
++ String
"' field is case sensitive, use 'True' or 'False'.")
]
forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t String -> 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 = (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowOlder
AllowOlder forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelaxedDep] -> RelaxDeps
RelaxDepsSome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
parseAllowOlder :: ParsecParser (Maybe AllowOlder)
parseAllowOlder = ((forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowOlder
AllowOlder forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RelaxDeps
toRelaxDeps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecParser (Maybe AllowOlder)
pkgs
in forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"allow-older"
(Maybe RelaxDeps -> Doc
showRelaxDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowNewer
AllowNewer forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelaxedDep] -> RelaxDeps
RelaxDepsSome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
parseAllowNewer :: ParsecParser (Maybe AllowNewer)
parseAllowNewer = ((forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelaxDeps -> AllowNewer
AllowNewer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RelaxDeps
toRelaxDeps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecParser (Maybe AllowNewer)
pkgs
in forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"allow-newer"
(Maybe RelaxDeps -> Doc
showRelaxDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 })
]
forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t String -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr InstallFlags -> FieldDescr SavedConfig
liftInstallFlag
(ShowOrParseArgs -> [OptionField InstallFlags]
installOptions ShowOrParseArgs
ParseArgs)
[String
"dry-run", String
"only", String
"only-dependencies", String
"dependencies-only"] []
forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t String -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr ClientInstallFlags -> FieldDescr SavedConfig
liftClientInstallFlag
(ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions ShowOrParseArgs
ParseArgs)
[] []
forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t String -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag
(forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions CommandUI UploadFlags
uploadCommand ShowOrParseArgs
ParseArgs)
[String
"verbose", String
"check", String
"documentation", String
"publish"] []
forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
(FieldDescr a -> a)
-> [OptionField a] -> t String -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr ReportFlags -> FieldDescr SavedConfig
liftReportFlag
(forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions CommandUI ReportFlags
reportCommand ShowOrParseArgs
ParseArgs)
[String
"verbose", String
"username", String
"password"] []
forall a. [a] -> [a] -> [a]
++ [ forall a. OptionField a -> FieldDescr a
viewAsFieldDescr
forall a b. (a -> b) -> a -> b
$ forall flags.
(flags -> Flag String)
-> (Flag String -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref
(ConfigFlags -> Flag String
configDistPref forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags)
(\Flag String
distPref SavedConfig
config ->
SavedConfig
config
{ savedConfigureFlags :: ConfigFlags
savedConfigureFlags = (SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config) {
configDistPref :: Flag String
configDistPref = Flag String
distPref }
, savedHaddockFlags :: HaddockFlags
savedHaddockFlags = (SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
config) {
haddockDistPref :: Flag String
haddockDistPref = Flag String
distPref }
}
)
ShowOrParseArgs
ParseArgs
]
where
toSavedConfig :: (FieldDescr a -> a)
-> [OptionField a] -> t String -> t (FieldDescr a) -> [a]
toSavedConfig FieldDescr a -> a
lift [OptionField a]
options t String
exclusions t (FieldDescr a)
replacements =
[ FieldDescr a -> a
lift (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 = forall a. OptionField a -> FieldDescr a
viewAsFieldDescr OptionField a
opt
name :: String
name = forall a. FieldDescr a -> String
fieldName FieldDescr a
field
replacement :: Maybe (FieldDescr a)
replacement = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== String
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FieldDescr a -> String
fieldName) t (FieldDescr a)
replacements
, String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t String
exclusions ]
showRelaxDeps :: Maybe RelaxDeps -> Doc
showRelaxDeps Maybe RelaxDeps
Nothing = forall a. Monoid a => a
mempty
showRelaxDeps (Just RelaxDeps
rd) | RelaxDeps -> Bool
isRelaxDeps RelaxDeps
rd = String -> Doc
Disp.text String
"True"
| Bool
otherwise = String -> Doc
Disp.text String
"False"
toRelaxDeps :: Bool -> RelaxDeps
toRelaxDeps Bool
True = RelaxDeps
RelaxDepsAll
toRelaxDeps Bool
False = forall a. Monoid a => a
mempty
deprecatedFieldDescriptions :: [FieldDescr SavedConfig]
deprecatedFieldDescriptions :: [FieldDescr SavedConfig]
deprecatedFieldDescriptions =
[ FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag forall a b. (a -> b) -> a -> b
$
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldParsec String
"repos"
forall a. Pretty a => a -> Doc
pretty forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
(forall a. NubList a -> [a]
fromNubList forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> NubList RemoteRepo
globalRemoteRepos)
(\[RemoteRepo]
rs GlobalFlags
cfg -> GlobalFlags
cfg { globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo]
rs })
, FieldDescr GlobalFlags -> FieldDescr SavedConfig
liftGlobalFlag forall a b. (a -> b) -> a -> b
$
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"cachedir"
(String -> Doc
Disp.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Flag a -> a
fromFlagOrDefault String
"") (forall a. ParsecParser a -> ParsecParser (Flag a)
optionalFlag forall (m :: * -> *). CabalParsing m => m String
parsecFilePath)
GlobalFlags -> Flag String
globalCacheDir (\Flag String
d GlobalFlags
cfg -> GlobalFlags
cfg { globalCacheDir :: Flag String
globalCacheDir = Flag String
d })
, FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag forall a b. (a -> b) -> a -> b
$
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"hackage-username"
(String -> Doc
Disp.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Flag a -> a
fromFlagOrDefault String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Username -> String
unUsername)
(forall a. ParsecParser a -> ParsecParser (Flag a)
optionalFlag (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Username
Username forall (m :: * -> *). CabalParsing m => m String
parsecToken))
UploadFlags -> Flag Username
uploadUsername (\Flag Username
d UploadFlags
cfg -> UploadFlags
cfg { uploadUsername :: Flag Username
uploadUsername = Flag Username
d })
, FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag forall a b. (a -> b) -> a -> b
$
forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"hackage-password"
(String -> Doc
Disp.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Flag a -> a
fromFlagOrDefault String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Password -> String
unPassword)
(forall a. ParsecParser a -> ParsecParser (Flag a)
optionalFlag (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Password
Password forall (m :: * -> *). CabalParsing m => m String
parsecToken))
UploadFlags -> Flag Password
uploadPassword (\Flag Password
d UploadFlags
cfg -> UploadFlags
cfg { uploadPassword :: Flag Password
uploadPassword = Flag Password
d })
, FieldDescr UploadFlags -> FieldDescr SavedConfig
liftUploadFlag forall a b. (a -> b) -> a -> b
$
forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
spaceListField String
"hackage-password-command"
String -> Doc
Disp.text forall r. ReadP r String
parseTokenQ
(forall a. a -> Flag a -> a
fromFlagOrDefault [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. UploadFlags -> Flag [String]
uploadPasswordCmd)
(\[String]
d UploadFlags
cfg -> UploadFlags
cfg { uploadPasswordCmd :: Flag [String]
uploadPasswordCmd = forall a. a -> Flag a
Flag [String]
d })
]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. (String -> String) -> FieldDescr a -> FieldDescr a
modifyFieldName (String
"user-"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
liftUserInstallDirs)
[FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. (String -> String) -> FieldDescr a -> FieldDescr a
modifyFieldName (String
"global-"forall a. [a] -> [a] -> [a]
++) 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 :: forall a. ParsecParser a -> ParsecParser (Flag a)
optionalFlag ParsecParser a
p = forall a. a -> Flag a
toFlag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
modifyFieldName :: (String -> String) -> FieldDescr a -> FieldDescr a
modifyFieldName :: forall a. (String -> String) -> FieldDescr a -> FieldDescr a
modifyFieldName String -> String
f FieldDescr a
d = FieldDescr a
d { fieldName :: String
fieldName = String -> String
f (forall a. FieldDescr a -> String
fieldName FieldDescr a
d) }
liftUserInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
liftUserInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))
-> FieldDescr SavedConfig
liftUserInstallDirs = 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 =
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 = 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 = 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 = 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 = 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 =
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 = 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 = 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) = 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, [(String, String)]
paths, [(String, [String])]
args) <-
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),
[(String, String)], [(String, [String])])
-> Field
-> ParseResult
([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
parseSections
([], [], SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
config, InitFlags
init0, InstallDirs (Flag PathTemplate)
user0, InstallDirs (Flag PathTemplate)
global0, [], [])
[Field]
knownSections
let remoteRepoSections :: [RemoteRepo]
remoteRepoSections =
forall a. [a] -> [a]
reverse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RemoteRepo -> RepoName
remoteRepoName)
forall a b. (a -> b) -> a -> b
$ [RemoteRepo]
remoteRepoSections0
let localRepoSections :: [LocalRepo]
localRepoSections =
forall a. [a] -> [a]
reverse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LocalRepo -> RepoName
localRepoName)
forall a b. (a -> b) -> a -> b
$ [LocalRepo]
localRepoSections0
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> SavedConfig
fixConfigMultilines forall a b. (a -> b) -> a -> b
$ SavedConfig
config {
savedGlobalFlags :: GlobalFlags
savedGlobalFlags = (SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config) {
globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = forall a. Ord a => [a] -> NubList a
toNubList [RemoteRepo]
remoteRepoSections,
globalLocalNoIndexRepos :: NubList LocalRepo
globalLocalNoIndexRepos = forall a. Ord a => [a] -> NubList a
toNubList [LocalRepo]
localRepoSections,
globalProgPathExtra :: NubList String
globalProgPathExtra = ConfigFlags -> NubList String
configProgramPathExtra (SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config)
},
savedConfigureFlags :: ConfigFlags
savedConfigureFlags = (SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config) {
configProgramPaths :: [(String, String)]
configProgramPaths = [(String, String)]
paths,
configProgramArgs :: [(String, [String])]
configProgramArgs = [(String, [String])]
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
_ String
"repository" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.F Int
_ String
"remote-repo" String
_) = Bool
True
isKnownSection (ParseUtils.Section Int
_ String
"haddock" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.Section Int
_ String
"init" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.Section Int
_ String
"install-dirs" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.Section Int
_ String
"program-locations" String
_ [Field]
_) = Bool
True
isKnownSection (ParseUtils.Section Int
_ String
"program-default-options" String
_ [Field]
_) = Bool
True
isKnownSection Field
_ = Bool
False
splitMultiPath :: [String] -> [String]
splitMultiPath :: [String] -> [String]
splitMultiPath [String
s] = case forall a. Int -> String -> ReadP a a -> String -> ParseResult a
runP Int
0 String
"" (forall r a. ReadP r a -> ReadP r [a]
parseOptCommaList forall r. ReadP r String
parseTokenQ) String
s of
ParseOk [PWarning]
_ [String]
res -> [String]
res
ParseResult [String]
_ -> [String
s]
splitMultiPath [String]
xs = [String]
xs
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 String
configProgramPathExtra =
forall a. Ord a => [a] -> NubList a
toNubList forall a b. (a -> b) -> a -> b
$ [String] -> [String]
splitMultiPath
(forall a. NubList a -> [a]
fromNubList forall a b. (a -> b) -> a -> b
$ ConfigFlags -> NubList String
configProgramPathExtra ConfigFlags
scf)
, configExtraLibDirs :: [String]
configExtraLibDirs = [String] -> [String]
splitMultiPath
(ConfigFlags -> [String]
configExtraLibDirs ConfigFlags
scf)
, configExtraLibDirsStatic :: [String]
configExtraLibDirsStatic = [String] -> [String]
splitMultiPath
(ConfigFlags -> [String]
configExtraLibDirsStatic ConfigFlags
scf)
, configExtraFrameworkDirs :: [String]
configExtraFrameworkDirs = [String] -> [String]
splitMultiPath
(ConfigFlags -> [String]
configExtraFrameworkDirs ConfigFlags
scf)
, configExtraIncludeDirs :: [String]
configExtraIncludeDirs = [String] -> [String]
splitMultiPath
(ConfigFlags -> [String]
configExtraIncludeDirs ConfigFlags
scf)
, configConfigureArgs :: [String]
configConfigureArgs = [String] -> [String]
splitMultiPath
(ConfigFlags -> [String]
configConfigureArgs ConfigFlags
scf)
}
}
parse :: [Field] -> ParseResult SavedConfig
parse = forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields (ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions ConstraintSource
src
forall a. [a] -> [a] -> [a]
++ [FieldDescr SavedConfig]
deprecatedFieldDescriptions) SavedConfig
initial
parseSections :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
-> Field
-> ParseResult
([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
parseSections ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.Section Int
lineno String
"repository" String
name [Field]
fs) = do
RepoName
name' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. PError -> ParseResult a
ParseFailed forall a b. (a -> b) -> a -> b
$ String -> Int -> PError
NoParse String
"repository name" Int
lineno) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. Parsec a => String -> Maybe a
simpleParsec String
name
RemoteRepo
r' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr RemoteRepo]
remoteRepoFields (RepoName -> RemoteRepo
emptyRemoteRepo RepoName
name') [Field]
fs
Either LocalRepo RemoteRepo
r'' <- Int
-> String
-> RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
postProcessRepo Int
lineno String
name RemoteRepo
r'
case Either LocalRepo RemoteRepo
r'' of
Left LocalRepo
local -> forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo]
rs, LocalRepo
localforall a. a -> [a] -> [a]
:[LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
Right RemoteRepo
remote -> forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRepo
remoteforall a. a -> [a] -> [a]
:[RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
parseSections ([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.F Int
lno String
"remote-repo" String
raw) = do
let mr' :: Maybe RemoteRepo
mr' = forall a. Parsec a => String -> Maybe a
simpleParsec String
raw
RemoteRepo
r' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. PError -> ParseResult a
ParseFailed forall a b. (a -> b) -> a -> b
$ String -> Int -> PError
NoParse String
"remote-repo" Int
lno) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RemoteRepo
mr'
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRepo
r'forall a. a -> [a] -> [a]
:[RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.Section Int
_ String
"haddock" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do HaddockFlags
h' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr HaddockFlags]
haddockFlagsFields HaddockFlags
h [Field]
fs
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, [(String, String)]
p, [(String, [String])]
a)
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'haddock' section should be unnamed"
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum
parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.Section Int
_ String
"init" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do InitFlags
i' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr InitFlags]
initFlagsFields InitFlags
i [Field]
fs
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, [(String, String)]
p, [(String, [String])]
a)
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'init' section should be unnamed"
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum
parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.Section Int
_ String
"install-dirs" String
name [Field]
fs)
| String
name' forall a. Eq a => a -> a -> Bool
== String
"user" = do InstallDirs (Flag PathTemplate)
u' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields InstallDirs (Flag PathTemplate)
u [Field]
fs
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, [(String, String)]
p, [(String, [String])]
a)
| String
name' forall a. Eq a => a -> a -> Bool
== String
"global" = do InstallDirs (Flag PathTemplate)
g' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields InstallDirs (Flag PathTemplate)
g [Field]
fs
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', [(String, String)]
p, [(String, [String])]
a)
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'install-paths' section should be for 'user' or 'global'"
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum
where name' :: String
name' = String -> String
lowercase String
name
parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.Section Int
_ String
"program-locations" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do [(String, String)]
p' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr [(String, String)]]
withProgramsFields [(String, String)]
p [Field]
fs
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, [(String, String)]
p', [(String, [String])]
a)
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'program-locations' section should be unnamed"
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum
parseSections accum :: ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum@([RemoteRepo]
rs, [LocalRepo]
ls, HaddockFlags
h, InitFlags
i, InstallDirs (Flag PathTemplate)
u, InstallDirs (Flag PathTemplate)
g, [(String, String)]
p, [(String, [String])]
a)
(ParseUtils.Section Int
_ String
"program-default-options" String
name [Field]
fs)
| String
name forall a. Eq a => a -> a -> Bool
== String
"" = do [(String, [String])]
a' <- forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr [(String, [String])]]
withProgramOptionsFields [(String, [String])]
a [Field]
fs
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, [(String, String)]
p, [(String, [String])]
a')
| Bool
otherwise = do
String -> ParseResult ()
warning String
"The 'program-default-options' section should be unnamed"
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum
parseSections ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum Field
f = do
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"Unrecognized stanza on line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Field -> Int
lineNo Field
f)
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteRepo], [LocalRepo], HaddockFlags, InitFlags,
InstallDirs (Flag PathTemplate), InstallDirs (Flag PathTemplate),
[(String, String)], [(String, [String])])
accum
postProcessRepo :: Int -> String -> RemoteRepo -> ParseResult (Either LocalRepo RemoteRepo)
postProcessRepo :: Int
-> String
-> RemoteRepo
-> ParseResult (Either LocalRepo RemoteRepo)
postProcessRepo Int
lineno String
reponameStr RemoteRepo
repo0 = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
reponameStr) forall a b. (a -> b) -> a -> b
$
forall a. Int -> String -> ParseResult a
syntaxError Int
lineno forall a b. (a -> b) -> a -> b
$ String
"a 'repository' section requires the "
forall a. [a] -> [a] -> [a]
++ String
"repository name as an argument"
RepoName
reponame <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid repository name " forall a. [a] -> [a] -> [a]
++ String
reponameStr) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. Parsec a => String -> Maybe a
simpleParsec String
reponameStr
case URI -> String
uriScheme (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo0) of
String
"file+noindex:" -> do
let uri :: URI
uri = RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ RepoName -> String -> Bool -> LocalRepo
LocalRepo RepoName
reponame (URI -> String
uriPath URI
uri) (URI -> String
uriFragment URI
uri forall a. Eq a => a -> a -> Bool
== String
"#shared-cache")
String
_ -> do
let repo :: RemoteRepo
repo = RemoteRepo
repo0 { remoteRepoName :: RepoName
remoteRepoName = RepoName
reponame }
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RemoteRepo -> Int
remoteRepoKeyThreshold RemoteRepo
repo forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. Foldable t => t a -> Int
length (RemoteRepo -> [String]
remoteRepoRootKeys RemoteRepo
repo)) forall a b. (a -> b) -> a -> b
$
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"'key-threshold' for repository "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repo)
forall a. [a] -> [a] -> [a]
++ String
" higher than number of keys"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RemoteRepo -> [String]
remoteRepoRootKeys RemoteRepo
repo)) Bool -> Bool -> Bool
&& RemoteRepo -> Maybe Bool
remoteRepoSecure RemoteRepo
repo forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True) forall a b. (a -> b) -> a -> b
$
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"'root-keys' for repository "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repo)
forall a. [a] -> [a] -> [a]
++ String
" non-empty, but 'secure' not set to True."
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right RemoteRepo
repo
showConfig :: SavedConfig -> String
showConfig :: SavedConfig -> String
showConfig = SavedConfig -> SavedConfig -> String
showConfigWithComments forall a. Monoid a => a
mempty
showConfigWithComments :: SavedConfig -> SavedConfig -> String
SavedConfig
comment SavedConfig
vals = Doc -> String
Disp.render forall a b. (a -> b) -> a -> b
$
case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RemoteRepo -> RemoteRepo -> Doc
ppRemoteRepoSection)
(forall a b. [a] -> [b] -> [(a, b)]
zip (SavedConfig -> [RemoteRepo]
getRemoteRepos SavedConfig
comment) (SavedConfig -> [RemoteRepo]
getRemoteRepos SavedConfig
vals)) of
[] -> String -> Doc
Disp.text String
""
(Doc
x:[Doc]
xs) -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Doc
r Doc
r' -> Doc
r Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
"" Doc -> Doc -> Doc
$+$ Doc
r') Doc
x [Doc]
xs
Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ forall a. [FieldDescr a] -> Maybe a -> a -> Doc
ppFields
(forall {a}. [FieldDescr a] -> [FieldDescr a]
skipSomeFields (ConstraintSource -> [FieldDescr SavedConfig]
configFieldDescriptions ConstraintSource
ConstraintSourceUnknown))
Maybe SavedConfig
mcomment SavedConfig
vals
Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ forall a. String -> String -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection String
"haddock" String
"" [FieldDescr HaddockFlags]
haddockFlagsFields
(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
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ forall a. String -> String -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection String
"init" String
"" [FieldDescr InitFlags]
initFlagsFields
(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
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ String -> (SavedConfig -> InstallDirs (Flag PathTemplate)) -> Doc
installDirsSection String
"user" SavedConfig -> InstallDirs (Flag PathTemplate)
savedUserInstallDirs
Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ String -> (SavedConfig -> InstallDirs (Flag PathTemplate)) -> Doc
installDirsSection String
"global" SavedConfig -> InstallDirs (Flag PathTemplate)
savedGlobalInstallDirs
Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ forall {a}. String -> [FieldDescr a] -> (ConfigFlags -> a) -> Doc
configFlagsSection String
"program-locations" [FieldDescr [(String, String)]]
withProgramsFields
ConfigFlags -> [(String, String)]
configProgramPaths
Doc -> Doc -> Doc
$+$ String -> Doc
Disp.text String
""
Doc -> Doc -> Doc
$+$ forall {a}. String -> [FieldDescr a] -> (ConfigFlags -> a) -> Doc
configFlagsSection String
"program-default-options" [FieldDescr [(String, [String])]]
withProgramOptionsFields
ConfigFlags -> [(String, [String])]
configProgramArgs
where
getRemoteRepos :: SavedConfig -> [RemoteRepo]
getRemoteRepos = forall a. NubList a -> [a]
fromNubList forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> NubList RemoteRepo
globalRemoteRepos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> GlobalFlags
savedGlobalFlags
mcomment :: Maybe SavedConfig
mcomment = forall a. a -> Maybe a
Just SavedConfig
comment
installDirsSection :: String -> (SavedConfig -> InstallDirs (Flag PathTemplate)) -> Doc
installDirsSection String
name SavedConfig -> InstallDirs (Flag PathTemplate)
field =
forall a. String -> String -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection String
"install-dirs" String
name [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields
(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 :: String -> [FieldDescr a] -> (ConfigFlags -> a) -> Doc
configFlagsSection String
name [FieldDescr a]
fields ConfigFlags -> a
field =
forall a. String -> String -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection String
name String
"" [FieldDescr a]
fields
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConfigFlags -> a
field forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags) Maybe SavedConfig
mcomment)
((ConfigFlags -> a
field forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigFlags
savedConfigureFlags) SavedConfig
vals)
skipSomeFields :: [FieldDescr a] -> [FieldDescr a]
skipSomeFields = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= String
"remote-repo") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FieldDescr a -> String
fieldName)
installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields = forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a. String -> String -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection String
"repository" (RepoName -> String
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
vals))
[FieldDescr RemoteRepo]
remoteRepoFields (forall a. a -> Maybe a
Just RemoteRepo
def) RemoteRepo
vals
remoteRepoFields :: [FieldDescr RemoteRepo]
remoteRepoFields :: [FieldDescr RemoteRepo]
remoteRepoFields =
[ forall a b.
String
-> (a -> Doc)
-> ReadP a a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleField String
"url"
(String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall r. ReadP r String
parseTokenQ forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. MonadFail m => String -> m URI
parseURI')
RemoteRepo -> URI
remoteRepoURI (\URI
x RemoteRepo
repo -> RemoteRepo
repo { remoteRepoURI :: URI
remoteRepoURI = URI
x })
, forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"secure"
Maybe Bool -> Doc
showSecure (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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 })
, forall a b.
String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listField String
"root-keys"
String -> Doc
text forall r. ReadP r String
parseTokenQ
RemoteRepo -> [String]
remoteRepoRootKeys (\[String]
x RemoteRepo
repo -> RemoteRepo
repo { remoteRepoRootKeys :: [String]
remoteRepoRootKeys = [String]
x })
, forall a b.
String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
"key-threshold"
forall {a}. (Eq a, Num a, Show a) => a -> Doc
showThreshold 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' :: String -> m URI
parseURI' String
uriString =
case String -> Maybe URI
parseURI String
uriString of
Maybe URI
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"remote-repo: no parse on " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
uriString
Just URI
uri -> forall (m :: * -> *) a. Monad m => a -> m a
return URI
uri
showSecure :: Maybe Bool -> Doc
showSecure Maybe Bool
Nothing = forall a. Monoid a => a
mempty
showSecure (Just Bool
True) = String -> Doc
text String
"True"
showSecure (Just Bool
False) = String -> Doc
text String
"False"
showThreshold :: a -> Doc
showThreshold a
0 = forall a. Monoid a => a
mempty
showThreshold a
t = String -> Doc
text (forall a. Show a => a -> String
show a
t)
haddockFlagsFields :: [FieldDescr HaddockFlags]
haddockFlagsFields :: [FieldDescr HaddockFlags]
haddockFlagsFields = [ FieldDescr HaddockFlags
field
| OptionField HaddockFlags
opt <- ShowOrParseArgs -> [OptionField HaddockFlags]
haddockOptions ShowOrParseArgs
ParseArgs
, let field :: FieldDescr HaddockFlags
field = forall a. OptionField a -> FieldDescr a
viewAsFieldDescr OptionField HaddockFlags
opt
name :: String
name = forall a. FieldDescr a -> String
fieldName FieldDescr HaddockFlags
field
, String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
exclusions ]
where
exclusions :: [String]
exclusions = [String
"verbose", String
"builddir", String
"for-hackage"]
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 = forall a. OptionField a -> FieldDescr a
viewAsFieldDescr OptionField InitFlags
opt
name :: String
name = forall a. FieldDescr a -> String
fieldName FieldDescr InitFlags
field
, String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
exclusions ]
where
exclusions :: [String]
exclusions =
[ String
"author", String
"email", String
"quiet", String
"no-comments", String
"minimal", String
"overwrite"
, String
"package-dir", String
"packagedir", String
"package-name", String
"version", String
"homepage"
, String
"synopsis", String
"category", String
"extra-source-file", String
"lib", String
"exe", String
"libandexe"
, String
"simple", String
"main-is", String
"expose-module", String
"exposed-modules", String
"extension"
, String
"dependency", String
"build-tool", String
"with-compiler"
, String
"verbose"
]
withProgramsFields :: [FieldDescr [(String, FilePath)]]
withProgramsFields :: [FieldDescr [(String, String)]]
withProgramsFields =
forall a b. (a -> b) -> [a] -> [b]
map forall a. OptionField a -> FieldDescr a
viewAsFieldDescr forall a b. (a -> b) -> a -> b
$
forall flags.
(String -> String)
-> ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> [OptionField flags]
programDbPaths' (forall a. [a] -> [a] -> [a]
++ String
"-location") ProgramDb
defaultProgramDb
ShowOrParseArgs
ParseArgs forall a. a -> a
id forall a. [a] -> [a] -> [a]
(++)
withProgramOptionsFields :: [FieldDescr [(String, [String])]]
withProgramOptionsFields :: [FieldDescr [(String, [String])]]
withProgramOptionsFields =
forall a b. (a -> b) -> [a] -> [b]
map forall a. OptionField a -> FieldDescr a
viewAsFieldDescr forall a b. (a -> b) -> a -> b
$
forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> [OptionField flags]
programDbOptions ProgramDb
defaultProgramDb ShowOrParseArgs
ParseArgs forall a. a -> a
id forall a. [a] -> [a] -> [a]
(++)
parseExtraLines :: Verbosity -> [String] -> IO SavedConfig
Verbosity
verbosity [String]
extraLines =
case ConstraintSource
-> SavedConfig -> ByteString -> ParseResult SavedConfig
parseConfig (String -> ConstraintSource
ConstraintSourceMainConfig String
"additional lines")
forall a. Monoid a => a
mempty (String -> ByteString
toUTF8BS ([String] -> String
unlines [String]
extraLines)) of
ParseFailed PError
err ->
let (Maybe Int
line, String
msg) = PError -> (Maybe Int, String)
locatedErrorMsg PError
err
in forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Error parsing additional config lines\n"
forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Int
n -> Char
':' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
n) Maybe Int
line forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String
msg
ParseOk [] SavedConfig
r -> forall (m :: * -> *) a. Monad m => a -> m a
return SavedConfig
r
ParseOk [PWarning]
ws SavedConfig
_ ->
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> PWarning -> String
showPWarning String
"Error parsing additional config lines") [PWarning]
ws)
userConfigDiff :: Verbosity -> GlobalFlags -> [String] -> IO [String]
userConfigDiff :: Verbosity -> GlobalFlags -> [String] -> IO [String]
userConfigDiff Verbosity
verbosity GlobalFlags
globalFlags [String]
extraLines = do
SavedConfig
userConfig <- Verbosity -> Flag String -> IO SavedConfig
loadRawConfig Verbosity
normal (GlobalFlags -> Flag String
globalConfigFile GlobalFlags
globalFlags)
SavedConfig
extraConfig <- Verbosity -> [String] -> IO SavedConfig
parseExtraLines Verbosity
verbosity [String]
extraLines
SavedConfig
testConfig <- IO SavedConfig
initialSavedConfig
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [String] -> (String, (Maybe String, Maybe String)) -> [String]
createDiff [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall {a} {a}.
(Show a, Show a) =>
(Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a)
combine
(forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a}. (a, a) -> (a, (Maybe a, Maybe a))
justFst forall a b. (a -> b) -> a -> b
$ SavedConfig -> [(String, String)]
filterShow SavedConfig
testConfig)
(forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a}. (a, a) -> (a, (Maybe a, Maybe a))
justSnd forall a b. (a -> b) -> a -> b
$ SavedConfig -> [(String, String)]
filterShow (SavedConfig
userConfig 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, (forall a. a -> Maybe a
Just a
b, forall a. Maybe a
Nothing))
justSnd :: (a, a) -> (a, (Maybe a, Maybe a))
justSnd (a
a, a
b) = (a
a, (forall a. Maybe a
Nothing, 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) = (forall a. a -> Maybe a
Just a
a, forall a. a -> Maybe a
Just a
b)
combine (Just a
a, Maybe a
Nothing) (Maybe a
Nothing, Just a
b) = (forall a. a -> Maybe a
Just a
a, forall a. a -> Maybe a
Just a
b)
combine (Maybe a, Maybe a)
x (Maybe a, Maybe a)
y = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Can't happen : userConfigDiff "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Maybe a, Maybe a)
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Maybe a, Maybe a)
y
createDiff :: [String] -> (String, (Maybe String, Maybe String)) -> [String]
createDiff :: [String] -> (String, (Maybe String, Maybe String)) -> [String]
createDiff [String]
acc (String
key, (Just String
a, Just String
b))
| String
a forall a. Eq a => a -> a -> Bool
== String
b = [String]
acc
| Bool
otherwise = (String
"+ " forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
b)
forall a. a -> [a] -> [a]
: (String
"- " forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
a) forall a. a -> [a] -> [a]
: [String]
acc
createDiff [String]
acc (String
key, (Maybe String
Nothing, Just String
b)) = (String
"+ " forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
b) forall a. a -> [a] -> [a]
: [String]
acc
createDiff [String]
acc (String
key, (Just String
a, Maybe String
Nothing)) = (String
"- " forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
a) forall a. a -> [a] -> [a]
: [String]
acc
createDiff [String]
acc (String
_, (Maybe String
Nothing, Maybe String
Nothing)) = [String]
acc
filterShow :: SavedConfig -> [(String, String)]
filterShow :: SavedConfig -> [(String, String)]
filterShow SavedConfig
cfg = forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
keyValueSplit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) Bool -> Bool -> Bool
&& Char
':' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> String
nonComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
forall a b. (a -> b) -> a -> b
$ SavedConfig -> String
showConfig SavedConfig
cfg
nonComment :: String -> String
nonComment [] = []
nonComment (Char
'-':Char
'-':String
_) = []
nonComment (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: String -> String
nonComment String
xs
topAndTail :: String -> String
topAndTail = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
keyValueSplit :: String -> (String, String)
keyValueSplit String
s =
let (String
left, String
right) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
':') String
s
in (String -> String
topAndTail String
left, String -> String
topAndTail (forall a. Int -> [a] -> [a]
drop Int
1 String
right))
userConfigUpdate :: Verbosity -> GlobalFlags -> [String] -> IO ()
userConfigUpdate :: Verbosity -> GlobalFlags -> [String] -> IO ()
userConfigUpdate Verbosity
verbosity GlobalFlags
globalFlags [String]
extraLines = do
SavedConfig
userConfig <- Verbosity -> Flag String -> IO SavedConfig
loadRawConfig Verbosity
normal (GlobalFlags -> Flag String
globalConfigFile GlobalFlags
globalFlags)
SavedConfig
extraConfig <- Verbosity -> [String] -> IO SavedConfig
parseExtraLines Verbosity
verbosity [String]
extraLines
SavedConfig
newConfig <- IO SavedConfig
initialSavedConfig
SavedConfig
commentConf <- IO SavedConfig
commentSavedConfig
String
cabalFile <- Flag String -> IO String
getConfigFilePath forall a b. (a -> b) -> a -> b
$ GlobalFlags -> Flag String
globalConfigFile GlobalFlags
globalFlags
let backup :: String
backup = String
cabalFile forall a. [a] -> [a] -> [a]
++ String
".backup"
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Renaming " forall a. [a] -> [a] -> [a]
++ String
cabalFile forall a. [a] -> [a] -> [a]
++ String
" to " forall a. [a] -> [a] -> [a]
++ String
backup forall a. [a] -> [a] -> [a]
++ String
"."
String -> String -> IO ()
renameFile String
cabalFile String
backup
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Writing merged config to " forall a. [a] -> [a] -> [a]
++ String
cabalFile forall a. [a] -> [a] -> [a]
++ String
"."
String -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile String
cabalFile SavedConfig
commentConf
(SavedConfig
newConfig forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
userConfig forall a. Monoid a => a -> a -> a
`mappend` SavedConfig
extraConfig)