Config.hs 62.1 KB
Newer Older
1
{-# LANGUAGE DeriveGeneric #-}
2

3 4
-----------------------------------------------------------------------------
-- |
5
-- Module      :  Distribution.Client.Config
6 7 8 9 10 11 12
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
refold's avatar
refold committed
13 14
-- Utilities for handling saved state such as known packages, known servers and
-- downloaded packages.
15
-----------------------------------------------------------------------------
16 17 18
module Distribution.Client.Config (
    SavedConfig(..),
    loadConfig,
19
    getConfigFilePath,
20 21 22 23 24

    showConfig,
    showConfigWithComments,
    parseConfig,

25
    getCabalDir,
26
    defaultConfigFile,
27
    defaultCacheDir,
28
    defaultCompiler,
29
    defaultLogsDir,
30
    defaultUserInstall,
31 32

    baseSavedConfig,
refold's avatar
refold committed
33 34
    commentSavedConfig,
    initialSavedConfig,
35
    configFieldDescriptions,
36
    haddockFlagsFields,
37 38
    installDirsFields,
    withProgramsFields,
39 40
    withProgramOptionsFields,
    userConfigDiff,
41
    userConfigUpdate,
42 43
    createDefaultConfigFile,

44 45
    remoteRepoFields,
    postProcessRepo,
46 47
  ) where

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

50 51 52
import Distribution.Deprecated.ViewAsFieldDescr
         ( viewAsFieldDescr )

53
import Distribution.Client.Types
Oleg Grenrus's avatar
Oleg Grenrus committed
54
         ( RemoteRepo(..), LocalRepo (..), emptyRemoteRepo
55
         , AllowOlder(..), AllowNewer(..), RelaxDeps(..), isRelaxDeps
Oleg Grenrus's avatar
Oleg Grenrus committed
56
         , RepoName (..), unRepoName
57
         )
Oleg Grenrus's avatar
Oleg Grenrus committed
58
import Distribution.Client.Types.Credentials (Username (..), Password (..))
59 60
import Distribution.Client.BuildReports.Types
         ( ReportLevel(..) )
61 62
import qualified Distribution.Client.Init.Types as IT
         ( InitFlags(..) )
63
import Distribution.Client.Setup
64
         ( GlobalFlags(..), globalCommand, defaultGlobalFlags
65
         , ConfigExFlags(..), configureExOptions, defaultConfigExFlags
66
         , initOptions
67 68
         , InstallFlags(..), installOptions, defaultInstallFlags
         , UploadFlags(..), uploadCommand
Oleg Grenrus's avatar
Oleg Grenrus committed
69
         , ReportFlags(..), reportCommand )
70 71 72
import Distribution.Client.CmdInstall.ClientInstallFlags
         ( ClientInstallFlags(..), defaultClientInstallFlags
         , clientInstallOptions )
73
import Distribution.Utils.NubList
74
         ( NubList, fromNubList, toNubList, overNubList )
75

76 77
import Distribution.License
         ( License(BSD3) )
78
import Distribution.Simple.Compiler
tibbe's avatar
tibbe committed
79
         ( DebugInfoLevel(..), OptimisationLevel(..) )
80
import Distribution.Simple.Setup
81
         ( ConfigFlags(..), configureOptions, defaultConfigFlags
82
         , HaddockFlags(..), haddockOptions, defaultHaddockFlags
83
         , TestFlags(..), defaultTestFlags
84
         , BenchmarkFlags(..), defaultBenchmarkFlags
85
         , installDirsOptions, optionDistPref
86
         , programDbPaths', programDbOptions
87
         , Flag(..), toFlag, flagToMaybe, fromFlagOrDefault )
88
import Distribution.Simple.InstallDirs
89
         ( InstallDirs(..), defaultInstallDirs
90
         , PathTemplate, toPathTemplate )
91
import Distribution.Deprecated.ParseUtils
92
         ( FieldDescr(..), liftField, runP
93 94
         , ParseResult(..), PError(..), PWarning(..)
         , locatedErrorMsg, showPWarning
95
         , readFields, warning, lineNo
96
         , simpleField, listField, spaceListField
97
         , parseFilePathQ, parseOptCommaList, parseTokenQ, syntaxError)
98 99
import Distribution.Client.ParseUtils
         ( parseFields, ppFields, ppSection )
100 101
import Distribution.Client.HttpUtils
         ( isOldHackageURI )
102
import qualified Distribution.Deprecated.ParseUtils as ParseUtils
103
         ( Field(..) )
104
import qualified Distribution.Deprecated.Text as Text
105
         ( Text(..), display )
106
import Distribution.Simple.Command
107
         ( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..) )
108
import Distribution.Simple.Program
109
         ( defaultProgramDb )
110
import Distribution.Simple.Utils
111
         ( die', notice, warn, lowercase, cabalVersion )
112 113 114 115
import Distribution.Compiler
         ( CompilerFlavor(..), defaultCompilerFlavor )
import Distribution.Verbosity
         ( Verbosity, normal )
116 117
import Distribution.Version
         ( mkVersion )
118

119 120
import Distribution.Solver.Types.ConstraintSource

121
import Data.List
Francesco Gazzetta's avatar
Francesco Gazzetta committed
122
         ( partition, find, foldl', nubBy )
123 124 125
import Data.Maybe
         ( fromMaybe )
import Control.Monad
126
         ( when, unless, foldM, liftM )
127
import qualified Distribution.Deprecated.ReadP as Parse
128
         ( (<++), option )
129
import Distribution.Compat.Semigroup
dterei's avatar
dterei committed
130
import qualified Text.PrettyPrint as Disp
131
         ( render, text, empty )
Oleg Grenrus's avatar
Oleg Grenrus committed
132 133
import Distribution.Parsec (parsec, simpleParsec)
import Distribution.Pretty (pretty)
dterei's avatar
dterei committed
134
import Text.PrettyPrint
135
         ( ($+$) )
Matthias Fischmann's avatar
Matthias Fischmann committed
136 137
import Text.PrettyPrint.HughesPJ
         ( text, Doc )
138
import System.Directory
139
         ( createDirectoryIfMissing, getAppUserDataDirectory, renameFile )
140
import Network.URI
141
         ( URI(..), URIAuth(..), parseURI )
142
import System.FilePath
143
         ( (<.>), (</>), takeDirectory )
144 145
import System.IO.Error
         ( isDoesNotExistError )
146
import Distribution.Compat.Environment
147
         ( getEnvironment, lookupEnv )
148
import Distribution.Compat.Exception
refold's avatar
refold committed
149
         ( catchIO )
150 151 152 153
import qualified Paths_cabal_install
         ( version )
import Data.Version
         ( showVersion )
154 155 156
import Data.Char
         ( isSpace )
import qualified Data.Map as M
157 158
import Data.Function
         ( on )
159
import GHC.Generics ( Generic )
160 161

--
162
-- * Configuration saved in the config file
163 164
--

165
data SavedConfig = SavedConfig {
166
    savedGlobalFlags       :: GlobalFlags,
167
    savedInitFlags         :: IT.InitFlags,
168
    savedInstallFlags      :: InstallFlags,
169
    savedClientInstallFlags :: ClientInstallFlags,
170
    savedConfigureFlags    :: ConfigFlags,
171
    savedConfigureExFlags  :: ConfigExFlags,
172 173
    savedUserInstallDirs   :: InstallDirs (Flag PathTemplate),
    savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate),
174
    savedUploadFlags       :: UploadFlags,
175
    savedReportFlags       :: ReportFlags,
176
    savedHaddockFlags      :: HaddockFlags,
177 178
    savedTestFlags         :: TestFlags,
    savedBenchmarkFlags    :: BenchmarkFlags
179
  } deriving Generic
180

181
instance Monoid SavedConfig where
182
  mempty = gmempty
183 184 185 186
  mappend = (<>)

instance Semigroup SavedConfig where
  a <> b = SavedConfig {
187
    savedGlobalFlags       = combinedSavedGlobalFlags,
188
    savedInitFlags         = combinedSavedInitFlags,
189
    savedInstallFlags      = combinedSavedInstallFlags,
190
    savedClientInstallFlags = combinedSavedClientInstallFlags,
191 192 193 194 195 196
    savedConfigureFlags    = combinedSavedConfigureFlags,
    savedConfigureExFlags  = combinedSavedConfigureExFlags,
    savedUserInstallDirs   = combinedSavedUserInstallDirs,
    savedGlobalInstallDirs = combinedSavedGlobalInstallDirs,
    savedUploadFlags       = combinedSavedUploadFlags,
    savedReportFlags       = combinedSavedReportFlags,
197
    savedHaddockFlags      = combinedSavedHaddockFlags,
198 199
    savedTestFlags         = combinedSavedTestFlags,
    savedBenchmarkFlags    = combinedSavedBenchmarkFlags
200
  }
201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222
    where
      -- This is ugly, but necessary. If we're mappending two config files, we
      -- want the values of the *non-empty* list fields from the second one to
      -- *override* the corresponding values from the first one. Default
      -- behaviour (concatenation) is confusing and makes some use cases (see
      -- #1884) impossible.
      --
      -- However, we also want to allow specifying multiple values for a list
      -- field in a *single* config file. For example, we want the following to
      -- continue to work:
      --
      -- remote-repo: hackage.haskell.org:http://hackage.haskell.org/
      -- remote-repo: private-collection:http://hackage.local/
      --
      -- So we can't just wrap the list fields inside Flags; we have to do some
      -- special-casing just for SavedConfig.

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

223 224 225 226 227
      combineMonoid :: Monoid mon => (SavedConfig -> flags) -> (flags -> mon)
                    -> mon
      combineMonoid field subfield =
        (subfield . field $ a) `mappend` (subfield . field $ b)

228 229 230 231 232 233 234
      lastNonEmpty' :: (SavedConfig -> flags) -> (flags -> [a]) -> [a]
      lastNonEmpty'   field subfield =
        let a' = subfield . field $ a
            b' = subfield . field $ b
        in case b' of [] -> a'
                      _  -> b'

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
235 236
      lastNonMempty'
        :: (Eq a, Monoid a) => (SavedConfig -> flags) -> (flags -> a) -> a
237 238 239 240 241
      lastNonMempty'   field subfield =
        let a' = subfield . field $ a
            b' = subfield . field $ b
        in if b' == mempty then a' else b'

242 243 244 245 246 247 248 249 250 251 252 253 254
      lastNonEmptyNL' :: (SavedConfig -> flags) -> (flags -> NubList a)
                      -> NubList a
      lastNonEmptyNL' field subfield =
        let a' = subfield . field $ a
            b' = subfield . field $ b
        in case fromNubList b' of [] -> a'
                                  _  -> b'

      combinedSavedGlobalFlags = GlobalFlags {
        globalVersion           = combine globalVersion,
        globalNumericVersion    = combine globalNumericVersion,
        globalConfigFile        = combine globalConfigFile,
        globalSandboxConfigFile = combine globalSandboxConfigFile,
U-CIQDEV\gbazerman's avatar
U-CIQDEV\gbazerman committed
255
        globalConstraintsFile   = combine globalConstraintsFile,
256 257 258
        globalRemoteRepos       = lastNonEmptyNL globalRemoteRepos,
        globalCacheDir          = combine globalCacheDir,
        globalLocalRepos        = lastNonEmptyNL globalLocalRepos,
259
        globalLocalNoIndexRepos = lastNonEmptyNL globalLocalNoIndexRepos,
260 261 262
        globalLogsDir           = combine globalLogsDir,
        globalWorldFile         = combine globalWorldFile,
        globalRequireSandbox    = combine globalRequireSandbox,
263
        globalIgnoreSandbox     = combine globalIgnoreSandbox,
264
        globalIgnoreExpiry      = combine globalIgnoreExpiry,
ttuegel's avatar
ttuegel committed
265
        globalHttpTransport     = combine globalHttpTransport,
266
        globalNix               = combine globalNix,
267 268
        globalStoreDir          = combine globalStoreDir,
        globalProgPathExtra     = lastNonEmptyNL globalProgPathExtra
269 270 271 272 273
        }
        where
          combine        = combine'        savedGlobalFlags
          lastNonEmptyNL = lastNonEmptyNL' savedGlobalFlags

274
      combinedSavedInitFlags = IT.InitFlags {
275
        IT.applicationDirs = combineMonoid savedInitFlags IT.applicationDirs,
276 277 278 279 280 281 282 283 284 285 286 287
        IT.author              = combine IT.author,
        IT.buildTools          = combineMonoid savedInitFlags IT.buildTools,
        IT.cabalVersion        = combine IT.cabalVersion,
        IT.category            = combine IT.category,
        IT.dependencies        = combineMonoid savedInitFlags IT.dependencies,
        IT.email               = combine IT.email,
        IT.exposedModules      = combineMonoid savedInitFlags IT.exposedModules,
        IT.extraSrc            = combineMonoid savedInitFlags IT.extraSrc,
        IT.homepage            = combine IT.homepage,
        IT.initHcPath          = combine IT.initHcPath,
        IT.initVerbosity       = combine IT.initVerbosity,
        IT.initializeTestSuite = combine IT.initializeTestSuite,
288
        IT.interactive         = combine IT.interactive,
289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305
        IT.language            = combine IT.language,
        IT.license             = combine IT.license,
        IT.mainIs              = combine IT.mainIs,
        IT.minimal             = combine IT.minimal,
        IT.noComments          = combine IT.noComments,
        IT.otherExts           = combineMonoid savedInitFlags IT.otherExts,
        IT.otherModules        = combineMonoid savedInitFlags IT.otherModules,
        IT.overwrite           = combine IT.overwrite,
        IT.packageDir          = combine IT.packageDir,
        IT.packageName         = combine IT.packageName,
        IT.packageType         = combine IT.packageType,
        IT.quiet               = combine IT.quiet,
        IT.simpleProject       = combine IT.simpleProject,
        IT.sourceDirs          = combineMonoid savedInitFlags IT.sourceDirs,
        IT.synopsis            = combine IT.synopsis,
        IT.testDirs            = combineMonoid savedInitFlags IT.testDirs,
        IT.version             = combine IT.version
306 307 308 309
        }
        where
          combine = combine' savedInitFlags

310 311 312 313
      combinedSavedInstallFlags = InstallFlags {
        installDocumentation         = combine installDocumentation,
        installHaddockIndex          = combine installHaddockIndex,
        installDryRun                = combine installDryRun,
Moritz Angermann's avatar
Moritz Angermann committed
314
        installDest                  = combine installDest,
315 316
        installMaxBackjumps          = combine installMaxBackjumps,
        installReorderGoals          = combine installReorderGoals,
317
        installCountConflicts        = combine installCountConflicts,
318
        installFineGrainedConflicts  = combine installFineGrainedConflicts,
319
        installMinimizeConflictSet   = combine installMinimizeConflictSet,
320 321 322
        installIndependentGoals      = combine installIndependentGoals,
        installShadowPkgs            = combine installShadowPkgs,
        installStrongFlags           = combine installStrongFlags,
323
        installAllowBootLibInstalls  = combine installAllowBootLibInstalls,
324
        installOnlyConstrained       = combine installOnlyConstrained,
325 326 327 328 329 330
        installReinstall             = combine installReinstall,
        installAvoidReinstalls       = combine installAvoidReinstalls,
        installOverrideReinstall     = combine installOverrideReinstall,
        installUpgradeDeps           = combine installUpgradeDeps,
        installOnly                  = combine installOnly,
        installOnlyDeps              = combine installOnlyDeps,
331
        installIndexState            = combine installIndexState,
332
        installRootCmd               = combine installRootCmd,
333 334 335 336 337
        installSummaryFile           = lastNonEmptyNL installSummaryFile,
        installLogFile               = combine installLogFile,
        installBuildReports          = combine installBuildReports,
        installReportPlanningFailure = combine installReportPlanningFailure,
        installSymlinkBinDir         = combine installSymlinkBinDir,
338
        installPerComponent          = combine installPerComponent,
339 340
        installOneShot               = combine installOneShot,
        installNumJobs               = combine installNumJobs,
341
        installKeepGoing             = combine installKeepGoing,
342
        installRunTests              = combine installRunTests,
343 344
        installOfflineMode           = combine installOfflineMode,
        installProjectFileName       = combine installProjectFileName
345 346 347 348 349
        }
        where
          combine        = combine'        savedInstallFlags
          lastNonEmptyNL = lastNonEmptyNL' savedInstallFlags

Oleg Grenrus's avatar
Oleg Grenrus committed
350 351 352 353 354 355 356
      combinedSavedClientInstallFlags = ClientInstallFlags
        { cinstInstallLibs     = combine cinstInstallLibs
        , cinstIgnoreProject   = combine cinstIgnoreProject
        , cinstEnvironmentPath = combine cinstEnvironmentPath
        , cinstOverwritePolicy = combine cinstOverwritePolicy
        , cinstInstallMethod   = combine cinstInstallMethod
        , cinstInstalldir      = combine cinstInstalldir
357 358 359 360
        }
        where
          combine        = combine'        savedClientInstallFlags

361
      combinedSavedConfigureFlags = ConfigFlags {
362
        configArgs                = lastNonEmpty configArgs,
363
        configPrograms_           = configPrograms_ . savedConfigureFlags $ b,
364 365 366 367 368
        -- TODO: NubListify
        configProgramPaths        = lastNonEmpty configProgramPaths,
        -- TODO: NubListify
        configProgramArgs         = lastNonEmpty configProgramArgs,
        configProgramPathExtra    = lastNonEmptyNL configProgramPathExtra,
369
        configInstantiateWith     = lastNonEmpty configInstantiateWith,
370 371 372 373 374
        configHcFlavor            = combine configHcFlavor,
        configHcPath              = combine configHcPath,
        configHcPkg               = combine configHcPkg,
        configVanillaLib          = combine configVanillaLib,
        configProfLib             = combine configProfLib,
375
        configProf                = combine configProf,
376
        configSharedLib           = combine configSharedLib,
Moritz Angermann's avatar
Moritz Angermann committed
377
        configStaticLib           = combine configStaticLib,
378
        configDynExe              = combine configDynExe,
379
        configFullyStaticExe      = combine configFullyStaticExe,
380
        configProfExe             = combine configProfExe,
381 382
        configProfDetail          = combine configProfDetail,
        configProfLibDetail       = combine configProfLibDetail,
383 384 385
        -- TODO: NubListify
        configConfigureArgs       = lastNonEmpty configConfigureArgs,
        configOptimization        = combine configOptimization,
tibbe's avatar
tibbe committed
386
        configDebugInfo           = combine configDebugInfo,
387 388 389 390 391 392 393 394 395 396
        configProgPrefix          = combine configProgPrefix,
        configProgSuffix          = combine configProgSuffix,
        -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
        configInstallDirs         =
          (configInstallDirs . savedConfigureFlags $ a)
          `mappend` (configInstallDirs . savedConfigureFlags $ b),
        configScratchDir          = combine configScratchDir,
        -- TODO: NubListify
        configExtraLibDirs        = lastNonEmpty configExtraLibDirs,
        -- TODO: NubListify
397 398
        configExtraFrameworkDirs  = lastNonEmpty configExtraFrameworkDirs,
        -- TODO: NubListify
399
        configExtraIncludeDirs    = lastNonEmpty configExtraIncludeDirs,
400
        configDeterministic       = combine configDeterministic,
401
        configIPID                = combine configIPID,
402
        configCID                 = combine configCID,
403
        configDistPref            = combine configDistPref,
404
        configCabalFilePath       = combine configCabalFilePath,
405 406 407 408 409
        configVerbosity           = combine configVerbosity,
        configUserInstall         = combine configUserInstall,
        -- TODO: NubListify
        configPackageDBs          = lastNonEmpty configPackageDBs,
        configGHCiLib             = combine configGHCiLib,
Ben Gamari's avatar
Ben Gamari committed
410
        configSplitSections       = combine configSplitSections,
411 412 413 414 415 416 417 418
        configSplitObjs           = combine configSplitObjs,
        configStripExes           = combine configStripExes,
        configStripLibs           = combine configStripLibs,
        -- TODO: NubListify
        configConstraints         = lastNonEmpty configConstraints,
        -- TODO: NubListify
        configDependencies        = lastNonEmpty configDependencies,
        -- TODO: NubListify
419
        configConfigurationsFlags = lastNonMempty configConfigurationsFlags,
420 421 422 423 424
        configTests               = combine configTests,
        configBenchmarks          = combine configBenchmarks,
        configCoverage            = combine configCoverage,
        configLibCoverage         = combine configLibCoverage,
        configExactConfiguration  = combine configExactConfiguration,
425
        configFlagError           = combine configFlagError,
426
        configRelocatable         = combine configRelocatable,
427
        configUseResponseFiles    = combine configUseResponseFiles,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
428 429
        configAllowDependingOnPrivateLibs =
            combine configAllowDependingOnPrivateLibs
430 431 432 433 434
        }
        where
          combine        = combine'        savedConfigureFlags
          lastNonEmpty   = lastNonEmpty'   savedConfigureFlags
          lastNonEmptyNL = lastNonEmptyNL' savedConfigureFlags
435
          lastNonMempty  = lastNonMempty'  savedConfigureFlags
436 437 438 439 440 441 442

      combinedSavedConfigureExFlags = ConfigExFlags {
        configCabalVersion  = combine configCabalVersion,
        -- TODO: NubListify
        configExConstraints = lastNonEmpty configExConstraints,
        -- TODO: NubListify
        configPreferences   = lastNonEmpty configPreferences,
443
        configSolver        = combine configSolver,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
444 445 446 447
        configAllowNewer    =
            combineMonoid savedConfigureExFlags configAllowNewer,
        configAllowOlder    =
            combineMonoid savedConfigureExFlags configAllowOlder,
448 449
        configWriteGhcEnvironmentFilesPolicy
                            = combine configWriteGhcEnvironmentFilesPolicy
450 451 452 453 454 455 456 457 458 459 460 461 462 463
        }
        where
          combine      = combine' savedConfigureExFlags
          lastNonEmpty = lastNonEmpty' savedConfigureExFlags

      -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
      combinedSavedUserInstallDirs = savedUserInstallDirs a
                                     `mappend` savedUserInstallDirs b

      -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
      combinedSavedGlobalInstallDirs = savedGlobalInstallDirs a
                                       `mappend` savedGlobalInstallDirs b

      combinedSavedUploadFlags = UploadFlags {
464
        uploadCandidate   = combine uploadCandidate,
465
        uploadDoc         = combine uploadDoc,
strake's avatar
strake committed
466 467 468 469
        uploadUsername    = combine uploadUsername,
        uploadPassword    = combine uploadPassword,
        uploadPasswordCmd = combine uploadPasswordCmd,
        uploadVerbosity   = combine uploadVerbosity
470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
        }
        where
          combine = combine' savedUploadFlags

      combinedSavedReportFlags = ReportFlags {
        reportUsername  = combine reportUsername,
        reportPassword  = combine reportPassword,
        reportVerbosity = combine reportVerbosity
        }
        where
          combine = combine' savedReportFlags

      combinedSavedHaddockFlags = HaddockFlags {
        -- TODO: NubListify
        haddockProgramPaths  = lastNonEmpty haddockProgramPaths,
        -- TODO: NubListify
        haddockProgramArgs   = lastNonEmpty haddockProgramArgs,
        haddockHoogle        = combine haddockHoogle,
        haddockHtml          = combine haddockHtml,
        haddockHtmlLocation  = combine haddockHtmlLocation,
490
        haddockForHackage    = combine haddockForHackage,
491 492 493
        haddockExecutables   = combine haddockExecutables,
        haddockTestSuites    = combine haddockTestSuites,
        haddockBenchmarks    = combine haddockBenchmarks,
494
        haddockForeignLibs   = combine haddockForeignLibs,
495 496
        haddockInternal      = combine haddockInternal,
        haddockCss           = combine haddockCss,
497
        haddockLinkedSource  = combine haddockLinkedSource,
498
        haddockQuickJump     = combine haddockQuickJump,
499 500 501 502
        haddockHscolourCss   = combine haddockHscolourCss,
        haddockContents      = combine haddockContents,
        haddockDistPref      = combine haddockDistPref,
        haddockKeepTempFiles = combine haddockKeepTempFiles,
503
        haddockVerbosity     = combine haddockVerbosity,
504 505
        haddockCabalFilePath = combine haddockCabalFilePath,
        haddockArgs          = lastNonEmpty haddockArgs
506 507 508 509 510
        }
        where
          combine      = combine'        savedHaddockFlags
          lastNonEmpty = lastNonEmpty'   savedHaddockFlags

511 512 513 514 515 516 517
      combinedSavedTestFlags = TestFlags {
        testDistPref    = combine testDistPref,
        testVerbosity   = combine testVerbosity,
        testHumanLog    = combine testHumanLog,
        testMachineLog  = combine testMachineLog,
        testShowDetails = combine testShowDetails,
        testKeepTix     = combine testKeepTix,
Moritz Angermann's avatar
Moritz Angermann committed
518
        testWrapper     = combine testWrapper,
519
        testFailWhenNoTestSuites = combine testFailWhenNoTestSuites,
520 521 522 523 524 525
        testOptions     = lastNonEmpty testOptions
        }
        where
          combine      = combine'        savedTestFlags
          lastNonEmpty = lastNonEmpty'   savedTestFlags

526 527 528 529 530 531 532 533 534
      combinedSavedBenchmarkFlags = BenchmarkFlags {
        benchmarkDistPref  = combine benchmarkDistPref,
        benchmarkVerbosity = combine benchmarkVerbosity,
        benchmarkOptions   = lastNonEmpty benchmarkOptions
        }
        where
          combine      = combine'        savedBenchmarkFlags
          lastNonEmpty = lastNonEmpty'   savedBenchmarkFlags

535 536 537 538 539

--
-- * Default config
--

Duncan Coutts's avatar
Duncan Coutts committed
540 541 542 543
-- | These are the absolute basic defaults. The fields that must be
-- initialised. When we load the config from the file we layer the loaded
-- values over these ones, so any missing fields in the file take their values
-- from here.
544
--
Duncan Coutts's avatar
Duncan Coutts committed
545 546
baseSavedConfig :: IO SavedConfig
baseSavedConfig = do
547
  userPrefix <- getCabalDir
548
  cacheDir   <- defaultCacheDir
549
  logsDir    <- defaultLogsDir
550
  worldFile  <- defaultWorldFile
Duncan Coutts's avatar
Duncan Coutts committed
551 552 553 554 555 556 557 558
  return mempty {
    savedConfigureFlags  = mempty {
      configHcFlavor     = toFlag defaultCompiler,
      configUserInstall  = toFlag defaultUserInstall,
      configVerbosity    = toFlag normal
    },
    savedUserInstallDirs = mempty {
      prefix             = toFlag (toPathTemplate userPrefix)
559 560
    },
    savedGlobalFlags = mempty {
561
      globalCacheDir     = toFlag cacheDir,
562
      globalLogsDir      = toFlag logsDir,
563
      globalWorldFile    = toFlag worldFile
564
    }
565 566 567 568
  }

-- | This is the initial configuration that we write out to to the config file
-- if the file does not exist (or the config we use if the file cannot be read
Duncan Coutts's avatar
Duncan Coutts committed
569 570 571
-- for some other reason). When the config gets loaded it gets layered on top
-- of 'baseSavedConfig' so we do not need to include it into the initial
-- values we save into the config file.
572 573 574
--
initialSavedConfig :: IO SavedConfig
initialSavedConfig = do
575 576 577 578 579
  cacheDir    <- defaultCacheDir
  logsDir     <- defaultLogsDir
  worldFile   <- defaultWorldFile
  extraPath   <- defaultExtraPath
  installPath <- defaultInstallPath
580 581 582
  return mempty {
    savedGlobalFlags     = mempty {
      globalCacheDir     = toFlag cacheDir,
583
      globalRemoteRepos  = toNubList [defaultRemoteRepo],
584
      globalWorldFile    = toFlag worldFile
585
    },
586
    savedConfigureFlags  = mempty {
587
      configProgramPathExtra = toNubList extraPath
588
    },
589
    savedInstallFlags    = mempty {
590
      installSummaryFile = toNubList [toPathTemplate (logsDir </> "build.log")],
591
      installBuildReports= toFlag AnonymousReports,
592 593 594 595
      installNumJobs     = toFlag Nothing
    },
    savedClientInstallFlags = mempty {
      cinstInstalldir = toFlag installPath
596
    }
597 598
  }

599 600
defaultCabalDir :: IO FilePath
defaultCabalDir = getAppUserDataDirectory "cabal"
601

602 603 604 605 606 607 608
getCabalDir :: IO FilePath
getCabalDir = do
  mDir <- lookupEnv "CABAL_DIR"
  case mDir of
    Nothing -> defaultCabalDir
    Just dir -> return dir

609
defaultConfigFile :: IO FilePath
610
defaultConfigFile = do
611
  dir <- getCabalDir
612
  return $ dir </> "config"
613 614

defaultCacheDir :: IO FilePath
615
defaultCacheDir = do
616
  dir <- getCabalDir
617
  return $ dir </> "packages"
618

619
defaultLogsDir :: IO FilePath
620
defaultLogsDir = do
621
  dir <- getCabalDir
622
  return $ dir </> "logs"
623

624 625 626
-- | Default position of the world file
defaultWorldFile :: IO FilePath
defaultWorldFile = do
627
  dir <- getCabalDir
628 629
  return $ dir </> "world"

630 631
defaultExtraPath :: IO [FilePath]
defaultExtraPath = do
632
  dir <- getCabalDir
633 634
  return [dir </> "bin"]

635 636
defaultInstallPath :: IO FilePath
defaultInstallPath = do
637
  dir <- getCabalDir
638 639
  return (dir </> "bin")

640 641 642
defaultCompiler :: CompilerFlavor
defaultCompiler = fromMaybe GHC defaultCompilerFlavor

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

648
defaultRemoteRepo :: RemoteRepo
Edsko de Vries's avatar
Edsko de Vries committed
649
defaultRemoteRepo = RemoteRepo name uri Nothing [] 0 False
650
  where
Oleg Grenrus's avatar
Oleg Grenrus committed
651 652 653
    str  = "hackage.haskell.org"
    name = RepoName str
    uri  = URI "http:" (Just (URIAuth "" str "")) "/" "" ""
654 655 656 657
    -- Note that lots of old ~/.cabal/config files will have the old url
    -- http://hackage.haskell.org/packages/archive
    -- but new config files can use the new url (without the /packages/archive)
    -- and avoid having to do a http redirect
658

659 660 661 662 663 664 665 666
-- For the default repo we know extra information, fill this in.
--
-- We need this because the 'defaultRemoteRepo' above is only used for the
-- first time when a config file is made. So for users with older config files
-- we might have only have older info. This lets us fill that in even for old
-- config files.
--
addInfoForKnownRepos :: RemoteRepo -> RemoteRepo
667 668 669
addInfoForKnownRepos repo
  | remoteRepoName repo == remoteRepoName defaultRemoteRepo
  = useSecure . tryHttps . fixOldURI $ repo
670
  where
671 672 673 674 675
    fixOldURI r
      | isOldHackageURI (remoteRepoURI r)
                  = r { remoteRepoURI = remoteRepoURI defaultRemoteRepo }
      | otherwise = r

Edsko de Vries's avatar
Edsko de Vries committed
676
    tryHttps r = r { remoteRepoShouldTryHttps = True }
677 678 679 680 681 682 683

    useSecure r@RemoteRepo{
                  remoteRepoSecure       = secure,
                  remoteRepoRootKeys     = [],
                  remoteRepoKeyThreshold = 0
                } | secure /= Just False
            = r {
684 685 686
                -- Use hackage-security by default unless you opt-out with
                -- secure: False
                remoteRepoSecure       = Just True,
687 688 689 690
                remoteRepoRootKeys     = defaultHackageRemoteRepoKeys,
                remoteRepoKeyThreshold = defaultHackageRemoteRepoKeyThreshold
              }
    useSecure r = r
691 692
addInfoForKnownRepos other = other

693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712
-- | The current hackage.haskell.org repo root keys that we ship with cabal.
---
-- This lets us bootstrap trust in this repo without user intervention.
-- These keys need to be periodically updated when new root keys are added.
-- See the root key procedures for details.
--
defaultHackageRemoteRepoKeys :: [String]
defaultHackageRemoteRepoKeys =
    [ "fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0",
      "1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42",
      "2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3",
      "0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d",
      "51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
    ]

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

713 714 715 716
--
-- * Config file reading
--

717 718 719 720
-- | Loads the main configuration, and applies additional defaults to give the
-- effective configuration. To loads just what is actually in the config file,
-- use 'loadRawConfig'.
--
721
loadConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746
loadConfig verbosity configFileFlag = do
  config <- loadRawConfig verbosity configFileFlag
  extendToEffectiveConfig config

extendToEffectiveConfig :: SavedConfig -> IO SavedConfig
extendToEffectiveConfig config = do
  base <- baseSavedConfig
  let effective0   = base `mappend` config
      globalFlags0 = savedGlobalFlags effective0
      effective  = effective0 {
                     savedGlobalFlags = globalFlags0 {
                       globalRemoteRepos =
                         overNubList (map addInfoForKnownRepos)
                                     (globalRemoteRepos globalFlags0)
                     }
                   }
  return effective

-- | Like 'loadConfig' but does not apply any additional defaults, it just
-- loads what is actually in the config file. This is thus suitable for
-- comparing or editing a config file, but not suitable for using as the
-- effective configuration.
--
loadRawConfig :: Verbosity -> Flag FilePath -> IO SavedConfig
loadRawConfig verbosity configFileFlag = do
747
  (source, configFile) <- getConfigFilePathAndSource configFileFlag
Duncan Coutts's avatar
Duncan Coutts committed
748
  minp <- readConfigFile mempty configFile
749 750
  case minp of
    Nothing -> do
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
751 752
      notice verbosity $
        "Config file path source is " ++ sourceMsg source ++ "."
753
      notice verbosity $ "Config file " ++ configFile ++ " not found."
754
      createDefaultConfigFile verbosity [] configFile
755
    Just (ParseOk ws conf) -> do
EyalLotem's avatar
EyalLotem committed
756
      unless (null ws) $ warn verbosity $
757
        unlines (map (showPWarning configFile) ws)
Duncan Coutts's avatar
Duncan Coutts committed
758
      return conf
759 760
    Just (ParseFailed err) -> do
      let (line, msg) = locatedErrorMsg err
761
      die' verbosity $
762
          "Error parsing config file " ++ configFile
EyalLotem's avatar
EyalLotem committed
763
        ++ maybe "" (\n -> ':' : show n) line ++ ":\n" ++ msg
764 765

  where
766 767 768 769
    sourceMsg CommandlineOption =   "commandline option"
    sourceMsg EnvironmentVariable = "env var CABAL_CONFIG"
    sourceMsg Default =             "default config file"

770 771 772 773
data ConfigFileSource = CommandlineOption
                      | EnvironmentVariable
                      | Default

774 775 776 777 778 779 780
-- | Returns the config file path, without checking that the file exists.
-- The order of precedence is: input flag, CABAL_CONFIG, default location.
getConfigFilePath :: Flag FilePath -> IO FilePath
getConfigFilePath = fmap snd . getConfigFilePathAndSource

getConfigFilePathAndSource :: Flag FilePath -> IO (ConfigFileSource, FilePath)
getConfigFilePathAndSource configFileFlag =
781 782 783 784 785 786 787 788 789 790 791
    getSource sources
  where
    sources =
      [ (CommandlineOption,   return . flagToMaybe $ configFileFlag)
      , (EnvironmentVariable, lookup "CABAL_CONFIG" `liftM` getEnvironment)
      , (Default,             Just `liftM` defaultConfigFile) ]

    getSource [] = error "no config file path candidate found."
    getSource ((source,action): xs) =
                      action >>= maybe (getSource xs) (return . (,) source)

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
792 793
readConfigFile
  :: SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig))
794
readConfigFile initial file = handleNotExists $
795 796
  fmap (Just . parseConfig (ConstraintSourceMainConfig file) initial)
       (readFile file)
797

798
  where
refold's avatar
refold committed
799
    handleNotExists action = catchIO action $ \ioe ->
800 801 802 803
      if isDoesNotExistError ioe
        then return Nothing
        else ioError ioe

804 805
createDefaultConfigFile :: Verbosity -> [String] -> FilePath -> IO SavedConfig
createDefaultConfigFile verbosity extraLines filePath  = do
806 807
  commentConf <- commentSavedConfig
  initialConf <- initialSavedConfig
808
  extraConf   <- parseExtraLines verbosity extraLines
809
  notice verbosity $ "Writing default configuration to " ++ filePath
810
  writeConfigFile filePath commentConf (initialConf `mappend` extraConf)
811
  return initialConf
812

813 814
writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile file comments vals = do
815
  let tmpFile = file <.> "tmp"
816
  createDirectoryIfMissing True (takeDirectory file)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
817 818
  writeFile tmpFile $
    explanation ++ showConfigWithComments comments vals ++ "\n"
819
  renameFile tmpFile file
820 821 822
  where
    explanation = unlines
      ["-- This is the configuration file for the 'cabal' command line tool."
823
      ,"--"
824 825
      ,"-- The available configuration options are listed below."
      ,"-- Some of them have default values listed."
826
      ,"--"
827 828 829
      ,"-- Lines (like this one) beginning with '--' are comments."
      ,"-- Be careful with spaces and indentation because they are"
      ,"-- used to indicate layout for nested sections."
830 831 832
      ,"--"
      ,"-- This config file was generated using the following versions"
      ,"-- of Cabal and cabal-install:"
833
      ,"-- Cabal library version: " ++ Text.display cabalVersion
834
      ,"-- cabal-install version: " ++ showVersion Paths_cabal_install.version
835 836
      ,"",""
      ]
837 838 839 840 841 842 843 844 845

-- | These are the default values that get used in Cabal if a no value is
-- given. We use these here to include in comments when we write out the
-- initial config file so that the user can see what default value they are
-- overriding.
--
commentSavedConfig :: IO SavedConfig
commentSavedConfig = do
  userInstallDirs   <- defaultInstallDirs defaultCompiler True True
846
  globalInstallDirs <- defaultInstallDirs defaultCompiler False True
847 848 849 850
  let conf0 = mempty {
        savedGlobalFlags       = defaultGlobalFlags {
            globalRemoteRepos = toNubList [defaultRemoteRepo]
            },
851
        savedInitFlags       = mempty {
Matt Renaud's avatar
Matt Renaud committed
852
            IT.interactive     = toFlag False,
853 854
            IT.cabalVersion    = toFlag (mkVersion [1,10]),
            IT.language        = toFlag Haskell2010,
855
            IT.license         = toFlag BSD3,
856 857
            IT.sourceDirs      = Nothing,
            IT.applicationDirs = Nothing
858
            },