Setup.hs 122 KB
Newer Older
Edsko de Vries's avatar
Edsko de Vries committed
1
{-# LANGUAGE ScopedTypeVariables #-}
2 3 4 5
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE LambdaCase          #-}
6 7
-----------------------------------------------------------------------------
-- |
8
-- Module      :  Distribution.Client.Setup
9 10 11 12 13 14 15 16 17
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
--
-----------------------------------------------------------------------------
18
module Distribution.Client.Setup
Edsko de Vries's avatar
Edsko de Vries committed
19 20
    ( globalCommand, GlobalFlags(..), defaultGlobalFlags
    , RepoContext(..), withRepoContext
21
    , configureCommand, ConfigFlags(..), configureOptions, filterConfigureFlags
22
    , configPackageDB', configCompilerAux'
23
    , configureExCommand, ConfigExFlags(..), defaultConfigExFlags
24
    , buildCommand, BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..)
25
    , filterTestFlags
26
    , replCommand, testCommand, benchmarkCommand, testOptions, benchmarkOptions
ttuegel's avatar
ttuegel committed
27
                        , configureExOptions, reconfigureCommand
28
    , installCommand, InstallFlags(..), installOptions, defaultInstallFlags
29
    , filterHaddockArgs, filterHaddockFlags, haddockOptions
30
    , defaultSolver, defaultMaxBackjumps
31
    , listCommand, ListFlags(..)
Moritz Angermann's avatar
Moritz Angermann committed
32
    , updateCommand, UpdateFlags(..), defaultUpdateFlags
ijones's avatar
ijones committed
33
    , upgradeCommand
34
    , uninstallCommand
35
    , infoCommand, InfoFlags(..)
36
    , fetchCommand, FetchFlags(..)
37
    , freezeCommand, FreezeFlags(..)
38
    , genBoundsCommand
39
    , outdatedCommand, OutdatedFlags(..), IgnoreMajorVersionBumps(..)
40
    , getCommand, unpackCommand, GetFlags(..)
41
    , checkCommand
42
    , formatCommand
43
    , uploadCommand, UploadFlags(..), IsCandidate(..)
44
    , reportCommand, ReportFlags(..)
refold's avatar
refold committed
45
    , runCommand
46
    , initCommand, initOptions, IT.InitFlags(..)
47
    , sdistCommand, SDistFlags(..)
48
    , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
49
    , actAsSetupCommand, ActAsSetupFlags(..)
refold's avatar
refold committed
50
    , sandboxCommand, defaultSandboxLocation, SandboxFlags(..)
Daniel Wagner's avatar
Daniel Wagner committed
51
    , execCommand, ExecFlags(..), defaultExecFlags
52
    , userConfigCommand, UserConfigFlags(..)
Maciek Makowski's avatar
Maciek Makowski committed
53
    , manpageCommand
54 55
    , haddockCommand
    , cleanCommand
56 57 58
    , doctestCommand
    , copyCommand
    , registerCommand
Duncan Coutts's avatar
Duncan Coutts committed
59 60

    , parsePackageArgs
Alexis Williams's avatar
Alexis Williams committed
61
    , liftOptions
62
    , yesNoOpt
63 64
    ) where

65 66 67
import Prelude ()
import Distribution.Client.Compat.Prelude hiding (get)

68 69
import Distribution.Deprecated.ReadP (readP_to_E)

Oleg Grenrus's avatar
Oleg Grenrus committed
70 71 72 73 74
import Distribution.Client.Types.Credentials (Username (..), Password (..))
import Distribution.Client.Types.Repo (RemoteRepo(..), LocalRepo (..))
import Distribution.Client.Types.AllowNewer (AllowNewer(..), AllowOlder(..), RelaxDeps(..))
import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy

75 76
import Distribution.Client.BuildReports.Types
         ( ReportLevel(..) )
77
import Distribution.Client.Dependency.Types
78
         ( PreSolver(..) )
Oleg Grenrus's avatar
Oleg Grenrus committed
79
import Distribution.Client.IndexUtils.IndexState
80
         ( TotalIndexState, headTotalIndexState )
81 82
import qualified Distribution.Client.Init.Types as IT
         ( InitFlags(..), PackageType(..) )
83 84
import Distribution.Client.Targets
         ( UserConstraint, readUserConstraint )
85 86
import Distribution.Utils.NubList
         ( NubList, toNubList, fromNubList)
Oleg Grenrus's avatar
Oleg Grenrus committed
87 88
import Distribution.Parsec (simpleParsec, parsec)
import Distribution.Pretty (prettyShow)
89

90
import Distribution.Solver.Types.ConstraintSource
91
import Distribution.Solver.Types.Settings
92

93 94
import Distribution.Simple.Compiler ( Compiler, PackageDB, PackageDBStack )
import Distribution.Simple.Program (ProgramDb, defaultProgramDb)
95 96
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import qualified Distribution.Simple.Command as Command
97
import Distribution.Simple.Configure
98
       ( configCompilerAuxEx, interpretPackageDbFlags, computeEffectiveProfiling )
Duncan Coutts's avatar
Duncan Coutts committed
99
import qualified Distribution.Simple.Setup as Cabal
100
import Distribution.Simple.Setup
101
         ( ConfigFlags(..), BuildFlags(..), ReplFlags
102
         , TestFlags, BenchmarkFlags
103
         , SDistFlags(..), HaddockFlags(..)
104 105
         , CleanFlags(..), DoctestFlags(..)
         , CopyFlags(..), RegisterFlags(..)
106
         , readPackageDbList, showPackageDbList
107
         , Flag(..), toFlag, flagToMaybe, flagToList, maybeToFlag
108 109
         , BooleanFlag(..), optionVerbosity
         , boolOpt, boolOpt', trueArg, falseArg
110
         , optionNumJobs )
111
import Distribution.Simple.InstallDirs
112 113
         ( PathTemplate, InstallDirs(..)
         , toPathTemplate, fromPathTemplate, combinePathTemplate )
114
import Distribution.Version
115
         ( Version, mkVersion, nullVersion, anyVersion, thisVersion )
116
import Distribution.Package
117
         ( PackageName, PackageIdentifier, packageName, packageVersion )
118
import Distribution.Types.Dependency
119 120
import Distribution.Types.GivenComponent
         ( GivenComponent(..) )
121 122
import Distribution.Types.PackageVersionConstraint
         ( PackageVersionConstraint(..) )
123
import Distribution.Types.UnqualComponentName
124
         ( unqualComponentNameToPackageName )
125
import Distribution.PackageDescription
126
         ( BuildType(..), RepoKind(..), LibraryName(..) )
127
import Distribution.System ( Platform )
128
import Distribution.Deprecated.Text
129
         ( Text(..), display )
130
import Distribution.ReadE
Oleg Grenrus's avatar
Oleg Grenrus committed
131
         ( ReadE(..), succeedReadE, parsecToReadE )
132
import qualified Distribution.Deprecated.ReadP as Parse
Oleg Grenrus's avatar
Oleg Grenrus committed
133
         ( ReadP, char, sepBy1, (+++) )
134
import Distribution.Deprecated.ParseUtils
135
         ( readPToMaybe )
136
import Distribution.Verbosity
137
         ( Verbosity, lessVerbose, normal, verboseNoFlags, verboseNoTimestamp )
138
import Distribution.Simple.Utils
139
         ( wrapText, wrapLine )
140
import Distribution.Client.GlobalFlags
Edsko de Vries's avatar
Edsko de Vries committed
141 142 143
         ( GlobalFlags(..), defaultGlobalFlags
         , RepoContext(..), withRepoContext
         )
Oleg Grenrus's avatar
Oleg Grenrus committed
144
import Distribution.Client.ManpageFlags (ManpageFlags, defaultManpageFlags, manpageOptions)
145

146
import Data.List
147
         ( deleteFirstsBy )
148
import qualified Data.Set as Set
149 150
import System.FilePath
         ( (</>) )
151

152 153
globalCommand :: [Command action] -> CommandUI GlobalFlags
globalCommand commands = CommandUI {
154
    commandName         = "",
155 156
    commandSynopsis     =
         "Command line interface to the Haskell Cabal infrastructure.",
157 158 159 160
    commandUsage        = \pname ->
         "See http://www.haskell.org/cabal/ for more information.\n"
      ++ "\n"
      ++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n",
161
    commandDescription  = Just $ \pname ->
162 163 164
      let
        commands' = commands ++ [commandAddAction helpCommandUI undefined]
        cmdDescs = getNormalCommandDescriptions commands'
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
        -- if new commands are added, we want them to appear even if they
        -- are not included in the custom listing below. Thus, we calculate
        -- the `otherCmds` list and append it under the `other` category.
        -- Alternatively, a new testcase could be added that ensures that
        -- the set of commands listed here is equal to the set of commands
        -- that are actually available.
        otherCmds = deleteFirstsBy (==) (map fst cmdDescs)
          [ "help"
          , "update"
          , "install"
          , "fetch"
          , "list"
          , "info"
          , "user-config"
          , "get"
          , "init"
          , "configure"
          , "build"
          , "clean"
          , "run"
          , "repl"
          , "test"
          , "bench"
          , "check"
          , "sdist"
          , "upload"
          , "report"
          , "freeze"
193
          , "gen-bounds"
194
          , "outdated"
195 196 197
          , "haddock"
          , "hscolour"
          , "exec"
198 199 200 201
          , "new-build"
          , "new-configure"
          , "new-repl"
          , "new-freeze"
202 203 204
          , "new-run"
          , "new-test"
          , "new-bench"
205
          , "new-haddock"
206 207 208
          , "new-exec"
          , "new-update"
          , "new-install"
209
          , "new-clean"
Alexis Williams's avatar
Alexis Williams committed
210
          , "new-sdist"
211
          -- v1 commands, stateful style
212 213 214 215 216 217 218 219 220 221 222 223
          , "v1-build"
          , "v1-configure"
          , "v1-repl"
          , "v1-freeze"
          , "v1-run"
          , "v1-test"
          , "v1-bench"
          , "v1-haddock"
          , "v1-exec"
          , "v1-update"
          , "v1-install"
          , "v1-clean"
224 225 226 227 228 229
          , "v1-sdist"
          , "v1-doctest"
          , "v1-copy"
          , "v1-register"
          , "v1-reconfigure"
          , "v1-sandbox"
230 231 232 233 234 235 236 237 238 239 240 241 242 243
          -- v2 commands, nix-style
          , "v2-build"
          , "v2-configure"
          , "v2-repl"
          , "v2-freeze"
          , "v2-run"
          , "v2-test"
          , "v2-bench"
          , "v2-haddock"
          , "v2-exec"
          , "v2-update"
          , "v2-install"
          , "v2-clean"
          , "v2-sdist"
244
          ]
245 246
        maxlen    = maximum $ [length name | (name, _) <- cmdDescs]
        align str = str ++ replicate (maxlen - length str) ' '
247 248 249 250 251
        startGroup n = " ["++n++"]"
        par          = ""
        addCmd n     = case lookup n cmdDescs of
                         Nothing -> ""
                         Just d -> "  " ++ align n ++ "    " ++ d
252 253
      in
         "Commands:\n"
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283
      ++ unlines (
        [ startGroup "global"
        , addCmd "update"
        , addCmd "install"
        , par
        , addCmd "help"
        , addCmd "info"
        , addCmd "list"
        , addCmd "fetch"
        , addCmd "user-config"
        , par
        , startGroup "package"
        , addCmd "get"
        , addCmd "init"
        , par
        , addCmd "configure"
        , addCmd "build"
        , addCmd "clean"
        , par
        , addCmd "run"
        , addCmd "repl"
        , addCmd "test"
        , addCmd "bench"
        , par
        , addCmd "check"
        , addCmd "sdist"
        , addCmd "upload"
        , addCmd "report"
        , par
        , addCmd "freeze"
284
        , addCmd "gen-bounds"
285
        , addCmd "outdated"
286 287 288
        , addCmd "haddock"
        , addCmd "hscolour"
        , addCmd "exec"
289 290 291 292 293
        , par
        , startGroup "new-style projects (beta)"
        , addCmd "new-build"
        , addCmd "new-configure"
        , addCmd "new-repl"
294 295 296
        , addCmd "new-run"
        , addCmd "new-test"
        , addCmd "new-bench"
297 298
        , addCmd "new-freeze"
        , addCmd "new-haddock"
299 300 301
        , addCmd "new-exec"
        , addCmd "new-update"
        , addCmd "new-install"
302
        , addCmd "new-clean"
Alexis Williams's avatar
Alexis Williams committed
303
        , addCmd "new-sdist"
304
        , par
305 306 307 308 309 310 311 312 313 314 315 316 317 318 319
        , startGroup "new-style projects (forwards-compatible aliases)"
        , addCmd "v2-build"
        , addCmd "v2-configure"
        , addCmd "v2-repl"
        , addCmd "v2-run"
        , addCmd "v2-test"
        , addCmd "v2-bench"
        , addCmd "v2-freeze"
        , addCmd "v2-haddock"
        , addCmd "v2-exec"
        , addCmd "v2-update"
        , addCmd "v2-install"
        , addCmd "v2-clean"
        , addCmd "v2-sdist"
        , par
320 321 322 323 324 325 326 327 328 329 330 331 332
        , startGroup "legacy command aliases"
        , addCmd "v1-build"
        , addCmd "v1-configure"
        , addCmd "v1-repl"
        , addCmd "v1-run"
        , addCmd "v1-test"
        , addCmd "v1-bench"
        , addCmd "v1-freeze"
        , addCmd "v1-haddock"
        , addCmd "v1-exec"
        , addCmd "v1-update"
        , addCmd "v1-install"
        , addCmd "v1-clean"
333 334 335 336 337 338
        , addCmd "v1-sdist"
        , addCmd "v1-doctest"
        , addCmd "v1-copy"
        , addCmd "v1-register"
        , addCmd "v1-reconfigure"
        , addCmd "v1-sandbox"
339 340 341
        ] ++ if null otherCmds then [] else par
                                           :startGroup "other"
                                           :[addCmd n | n <- otherCmds])
342 343
      ++ "\n"
      ++ "For more information about a command use:\n"
344 345
      ++ "   " ++ pname ++ " COMMAND --help\n"
      ++ "or " ++ pname ++ " help COMMAND\n"
346
      ++ "\n"
347
      ++ "To install Cabal packages from hackage use:\n"
348 349
      ++ "  " ++ pname ++ " install foo [--dry-run]\n"
      ++ "\n"
350 351
      ++ "Occasionally you need to update the list of available packages:\n"
      ++ "  " ++ pname ++ " update\n",
352
    commandNotes = Nothing,
353
    commandDefaultFlags = mempty,
354 355 356 357 358 359 360 361 362 363 364
    commandOptions = args
  }
  where
    args :: ShowOrParseArgs -> [OptionField GlobalFlags]
    args ShowArgs  = argsShown
    args ParseArgs = argsShown ++ argsNotShown

    -- arguments we want to show in the help
    argsShown :: [OptionField GlobalFlags]
    argsShown = [
       option ['V'] ["version"]
365 366 367 368 369 370 371 372 373 374 375 376 377 378
         "Print version information"
         globalVersion (\v flags -> flags { globalVersion = v })
         trueArg

      ,option [] ["numeric-version"]
         "Print just the version number"
         globalNumericVersion (\v flags -> flags { globalNumericVersion = v })
         trueArg

      ,option [] ["config-file"]
         "Set an alternate location for the config file"
         globalConfigFile (\v flags -> flags { globalConfigFile = v })
         (reqArgFlag "FILE")

379
      ,option [] ["sandbox-config-file"]
380
         "Set an alternate location for the sandbox config file (default: './cabal.sandbox.config')"
381
         globalSandboxConfigFile (\v flags -> flags { globalSandboxConfigFile = v })
382 383
         (reqArgFlag "FILE")

U-CIQDEV\gbazerman's avatar
U-CIQDEV\gbazerman committed
384 385
      ,option [] ["default-user-config"]
         "Set a location for a cabal.config file for projects without their own cabal.config freeze file."
386
         globalConstraintsFile (\v flags -> flags {globalConstraintsFile = v})
U-CIQDEV\gbazerman's avatar
U-CIQDEV\gbazerman committed
387 388
         (reqArgFlag "FILE")

389
      ,option [] ["require-sandbox"]
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
390
         "requiring the presence of a sandbox for sandbox-aware commands"
391 392 393
         globalRequireSandbox (\v flags -> flags { globalRequireSandbox = v })
         (boolOpt' ([], ["require-sandbox"]) ([], ["no-require-sandbox"]))

394 395 396 397 398
      ,option [] ["ignore-sandbox"]
         "Ignore any existing sandbox"
         globalIgnoreSandbox (\v flags -> flags { globalIgnoreSandbox = v })
         trueArg

399
      ,option [] ["ignore-expiry"]
Edsko de Vries's avatar
Edsko de Vries committed
400
         "Ignore expiry dates on signed metadata (use only in exceptional circumstances)"
401 402 403
         globalIgnoreExpiry (\v flags -> flags { globalIgnoreExpiry = v })
         trueArg

404
      ,option [] ["http-transport"]
405
         "Set a transport for http(s) requests. Accepts 'curl', 'wget', 'powershell', and 'plain-http'. (default: 'curl')"
406
         globalHttpTransport (\v flags -> flags { globalHttpTransport = v })
407
         (reqArgFlag "HttpTransport")
ttuegel's avatar
ttuegel committed
408 409 410 411
      ,option [] ["nix"]
         "Nix integration: run commands through nix-shell if a 'shell.nix' file exists"
         globalNix (\v flags -> flags { globalNix = v })
         (boolOpt [] [])
412
      ]
413

414 415 416 417
    -- arguments we don't want shown in the help
    argsNotShown :: [OptionField GlobalFlags]
    argsNotShown = [
       option [] ["remote-repo"]
418 419
         "The name and url for a remote repository"
         globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v })
420 421 422 423 424 425
         (reqArg' "NAME:URL" (toNubList . maybeToList . readRemoteRepo) (map showRemoteRepo . fromNubList))

      ,option [] ["local-no-index-repo"]
         "The name and a path for a local no-index repository"
         globalLocalNoIndexRepos (\v flags -> flags { globalLocalNoIndexRepos = v })
         (reqArg' "NAME:PATH" (toNubList . maybeToList . readLocalRepo) (map showLocalRepo . fromNubList))
426 427 428 429 430 431 432 433 434

      ,option [] ["remote-repo-cache"]
         "The location where downloads from all remote repos are cached"
         globalCacheDir (\v flags -> flags { globalCacheDir = v })
         (reqArgFlag "DIR")

      ,option [] ["local-repo"]
         "The location of a local repository"
         globalLocalRepos (\v flags -> flags { globalLocalRepos = v })
435
         (reqArg' "DIR" (\x -> toNubList [x]) fromNubList)
436

Dmitrii Kovanikov's avatar
Dmitrii Kovanikov committed
437
      ,option [] ["logs-dir", "logsdir"]
438 439 440 441
         "The location to put log files"
         globalLogsDir (\v flags -> flags { globalLogsDir = v })
         (reqArgFlag "DIR")

442 443 444 445
      ,option [] ["world-file"]
         "The location of the world file"
         globalWorldFile (\v flags -> flags { globalWorldFile = v })
         (reqArgFlag "FILE")
446

Dmitrii Kovanikov's avatar
Dmitrii Kovanikov committed
447
      ,option [] ["store-dir", "storedir"]
448 449 450
         "The location of the nix-local-build store"
         globalStoreDir (\v flags -> flags { globalStoreDir = v })
         (reqArgFlag "DIR")
451 452 453 454 455
      ]

-- ------------------------------------------------------------
-- * Config flags
-- ------------------------------------------------------------
Duncan Coutts's avatar
Duncan Coutts committed
456

457
configureCommand :: CommandUI ConfigFlags
458
configureCommand = c
459 460 461 462 463 464 465 466 467 468
  { commandName         = "configure"
  , commandDefaultFlags = mempty
  , commandDescription  = Just $ \_ -> wrapText $
         "Configure how the package is built by setting "
      ++ "package (and other) flags.\n"
      ++ "\n"
      ++ "The configuration affects several other commands, "
      ++ "including v1-build, v1-test, v1-bench, v1-run, v1-repl.\n"
  , commandUsage        = \pname ->
    "Usage: " ++ pname ++ " v1-configure [FLAGS]\n"
469
  , commandNotes = Just $ \pname ->
470 471 472 473 474 475 476
    (Cabal.programFlagsDescription defaultProgramDb ++ "\n")
      ++ "Examples:\n"
      ++ "  " ++ pname ++ " v1-configure\n"
      ++ "    Configure with defaults;\n"
      ++ "  " ++ pname ++ " v1-configure --enable-tests -fcustomflag\n"
      ++ "    Configure building package including tests,\n"
      ++ "    with some package-specific flag.\n"
Duncan Coutts's avatar
Duncan Coutts committed
477
  }
478
 where
479
  c = Cabal.configureCommand defaultProgramDb
Duncan Coutts's avatar
Duncan Coutts committed
480

481 482 483
configureOptions ::  ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions = commandOptions configureCommand

484 485 486 487 488 489 490 491
-- | Given some 'ConfigFlags' for the version of Cabal that
-- cabal-install was built with, and a target older 'Version' of
-- Cabal that we want to pass these flags to, convert the
-- flags into a form that will be accepted by the older
-- Setup script.  Generally speaking, this just means filtering
-- out flags that the old Cabal library doesn't understand, but
-- in some cases it may also mean "emulating" a feature using
-- some more legacy flags.
492
filterConfigureFlags :: ConfigFlags -> Version -> ConfigFlags
493
filterConfigureFlags flags cabalLibVersion
494 495
  -- NB: we expect the latest version to be the most common case,
  -- so test it first.
496
  | cabalLibVersion >= mkVersion [2,5,0]  = flags_latest
497 498 499 500 501
  -- The naming convention is that flags_version gives flags with
  -- all flags *introduced* in version eliminated.
  -- It is NOT the latest version of Cabal library that
  -- these flags work for; version of introduction is a more
  -- natural metric.
502 503 504 505 506 507 508 509 510
  | cabalLibVersion < mkVersion [1,3,10] = flags_1_3_10
  | cabalLibVersion < mkVersion [1,10,0] = flags_1_10_0
  | cabalLibVersion < mkVersion [1,12,0] = flags_1_12_0
  | cabalLibVersion < mkVersion [1,14,0] = flags_1_14_0
  | cabalLibVersion < mkVersion [1,18,0] = flags_1_18_0
  | cabalLibVersion < mkVersion [1,19,1] = flags_1_19_1
  | cabalLibVersion < mkVersion [1,19,2] = flags_1_19_2
  | cabalLibVersion < mkVersion [1,21,1] = flags_1_21_1
  | cabalLibVersion < mkVersion [1,22,0] = flags_1_22_0
511
  | cabalLibVersion < mkVersion [1,22,1] = flags_1_22_1
512
  | cabalLibVersion < mkVersion [1,23,0] = flags_1_23_0
Christiaan Baaij's avatar
Christiaan Baaij committed
513
  | cabalLibVersion < mkVersion [1,25,0] = flags_1_25_0
514
  | cabalLibVersion < mkVersion [2,1,0]  = flags_2_1_0
515
  | cabalLibVersion < mkVersion [2,5,0]  = flags_2_5_0
516
  | otherwise = error "the impossible just happened" -- see first guard
517
  where
518 519
    flags_latest = flags        {
      -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'.
520 521 522
      -- Note: this is not in the wrong place. configConstraints gets
      -- repopulated in flags_1_19_1 but it needs to be set to empty for
      -- newer versions first.
523
      configConstraints = []
524
      }
525

526
    flags_2_5_0 = flags_latest {
527
      -- Cabal < 2.5 does not understand --dependency=pkg:component=cid
528 529
      -- (public sublibraries), so we convert it to the legacy
      -- --dependency=pkg_or_internal_compoent=cid
530 531 532
        configDependencies =
          let convertToLegacyInternalDep (GivenComponent _ (LSubLibName cn) cid) =
                Just $ GivenComponent
533
                       (unqualComponentNameToPackageName cn)
534
                       LMainLibName
535
                       cid
536 537 538 539 540
              convertToLegacyInternalDep (GivenComponent pn LMainLibName cid) =
                Just $ GivenComponent pn LMainLibName cid
          in catMaybes $ convertToLegacyInternalDep <$> configDependencies flags
        -- Cabal < 2.5 doesn't know about '--enable/disable-executable-static'.
      , configFullyStaticExe = NoFlag
541 542 543
      }

    flags_2_1_0 = flags_2_5_0 {
544
      -- Cabal < 2.1 doesn't know about -v +timestamp modifier
Moritz Angermann's avatar
Moritz Angermann committed
545 546 547
        configVerbosity   = fmap verboseNoTimestamp (configVerbosity flags_latest)
      -- Cabal < 2.1 doesn't know about --<enable|disable>-static
      , configStaticLib   = NoFlag
Ben Gamari's avatar
Ben Gamari committed
548
      , configSplitSections = NoFlag
549 550 551
      }

    flags_1_25_0 = flags_2_1_0 {
552 553 554
      -- Cabal < 1.25.0 doesn't know about --dynlibdir.
      configInstallDirs = configInstallDirs_1_25_0,
      -- Cabal < 1.25 doesn't have extended verbosity syntax
555
      configVerbosity   = fmap verboseNoFlags (configVerbosity flags_2_1_0),
556 557
      -- Cabal < 1.25 doesn't support --deterministic
      configDeterministic = mempty
558
      }
559 560 561 562 563 564 565
    configInstallDirs_1_25_0 = let dirs = configInstallDirs flags in
        dirs { dynlibdir = NoFlag
             , libexecsubdir = NoFlag
             , libexecdir = maybeToFlag $
                 combinePathTemplate <$> flagToMaybe (libexecdir dirs)
                                     <*> flagToMaybe (libexecsubdir dirs)
             }
566
    -- Cabal < 1.23 doesn't know about '--profiling-detail'.
567 568 569
    -- Cabal < 1.23 has a hacked up version of 'enable-profiling'
    -- which we shouldn't use.
    (tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling flags
Christiaan Baaij's avatar
Christiaan Baaij committed
570
    flags_1_23_0 = flags_1_25_0 { configProfDetail    = NoFlag
571
                                , configProfLibDetail = NoFlag
572
                                , configIPID          = NoFlag
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
573 574 575
                                , configProf          = NoFlag
                                , configProfExe       = Flag tryExeProfiling
                                , configProfLib       = Flag tryLibProfiling
576
                                }
577

578 579 580 581 582 583
    -- Cabal == 1.22.0.* had a discontinuity (see #5946 or e9a8d48a3adce34d)
    -- due to temporary amnesia of the --*-executable-profiling flags
    flags_1_22_1 = flags_1_23_0 { configDebugInfo = NoFlag
                                , configProfExe   = NoFlag
                                }

584
    -- Cabal < 1.22 doesn't know about '--disable-debug-info'.
585
    flags_1_22_0 = flags_1_23_0 { configDebugInfo = NoFlag }
586

587
    -- Cabal < 1.21.1 doesn't know about 'disable-relocatable'
588
    -- Cabal < 1.21.1 doesn't know about 'enable-profiling'
589
    -- (but we already dealt with it in flags_1_23_0)
590 591
    flags_1_21_1 =
      flags_1_22_0 { configRelocatable = NoFlag
592 593
                   , configCoverage = NoFlag
                   , configLibCoverage = configCoverage flags
594
                   }
595 596
    -- Cabal < 1.19.2 doesn't know about '--exact-configuration' and
    -- '--enable-library-stripping'.
597
    flags_1_19_2 = flags_1_21_1 { configExactConfiguration = NoFlag
598
                                , configStripLibs = NoFlag }
599
    -- Cabal < 1.19.1 uses '--constraint' instead of '--dependency'.
600
    flags_1_19_1 = flags_1_19_2 { configDependencies = []
601
                                , configConstraints  = configConstraints flags }
602
    -- Cabal < 1.18.0 doesn't know about --extra-prog-path and --sysconfdir.
603
    flags_1_18_0 = flags_1_19_1 { configProgramPathExtra = toNubList []
604
                                , configInstallDirs = configInstallDirs_1_18_0}
Christiaan Baaij's avatar
Christiaan Baaij committed
605
    configInstallDirs_1_18_0 = (configInstallDirs flags_1_19_1) { sysconfdir = NoFlag }
606
    -- Cabal < 1.14.0 doesn't know about '--disable-benchmarks'.
607
    flags_1_14_0 = flags_1_18_0 { configBenchmarks  = NoFlag }
608 609 610 611
    -- Cabal < 1.12.0 doesn't know about '--enable/disable-executable-dynamic'
    -- and '--enable/disable-library-coverage'.
    flags_1_12_0 = flags_1_14_0 { configLibCoverage = NoFlag
                                , configDynExe      = NoFlag }
612
    -- Cabal < 1.10.0 doesn't know about '--disable-tests'.
613
    flags_1_10_0 = flags_1_12_0 { configTests       = NoFlag }
614
    -- Cabal < 1.3.10 does not grok the '--constraints' flag.
615
    flags_1_3_10 = flags_1_10_0 { configConstraints = [] }
616

617 618
-- | Get the package database settings from 'ConfigFlags', accounting for
-- @--package-db@ and @--user@ flags.
619 620 621 622 623 624
configPackageDB' :: ConfigFlags -> PackageDBStack
configPackageDB' cfg =
    interpretPackageDbFlags userInstall (configPackageDBs cfg)
  where
    userInstall = Cabal.fromFlagOrDefault True (configUserInstall cfg)

625
-- | Configure the compiler, but reduce verbosity during this step.
626 627 628 629 630 631
configCompilerAux' :: ConfigFlags -> IO (Compiler, Platform, ProgramDb)
configCompilerAux' configFlags =
  configCompilerAuxEx configFlags
    --FIXME: make configCompilerAux use a sensible verbosity
    { configVerbosity = fmap lessVerbose (configVerbosity configFlags) }

632 633 634 635 636 637 638
-- ------------------------------------------------------------
-- * Config extra flags
-- ------------------------------------------------------------

-- | cabal configure takes some extra flags beyond runghc Setup configure
--
data ConfigExFlags = ConfigExFlags {
639 640 641 642 643 644 645 646
    configCabalVersion  :: Flag Version,
    configExConstraints :: [(UserConstraint, ConstraintSource)],
    configPreferences   :: [PackageVersionConstraint],
    configSolver        :: Flag PreSolver,
    configAllowNewer    :: Maybe AllowNewer,
    configAllowOlder    :: Maybe AllowOlder,
    configWriteGhcEnvironmentFilesPolicy
      :: Flag WriteGhcEnvironmentFilesPolicy
647
  }
648
  deriving (Eq, Generic)
649 650

defaultConfigExFlags :: ConfigExFlags
651
defaultConfigExFlags = mempty { configSolver     = Flag defaultSolver }
652 653 654 655 656

configureExCommand :: CommandUI (ConfigFlags, ConfigExFlags)
configureExCommand = configureCommand {
    commandDefaultFlags = (mempty, defaultConfigExFlags),
    commandOptions      = \showOrParseArgs ->
657
         liftOptions fst setFst
658
         (filter ((`notElem` ["constraint", "dependency", "exact-configuration"])
659
                  . optionName) $ configureOptions  showOrParseArgs)
660 661
      ++ liftOptions snd setSnd
         (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag)
662 663 664 665 666
  }
  where
    setFst a (_,b) = (a,b)
    setSnd b (a,_) = (a,b)

667 668 669 670
configureExOptions :: ShowOrParseArgs
                   -> ConstraintSource
                   -> [OptionField ConfigExFlags]
configureExOptions _showOrParseArgs src =
671 672 673 674 675 676 677
  [ option [] ["cabal-lib-version"]
      ("Select which version of the Cabal lib to use to build packages "
      ++ "(useful for testing).")
      configCabalVersion (\v flags -> flags { configCabalVersion = v })
      (reqArg "VERSION" (readP_to_E ("Cannot parse cabal lib version: "++)
                                    (fmap toFlag parse))
                        (map display . flagToList))
678 679 680 681
  , option [] ["constraint"]
      "Specify constraints on a package (version, installed/source, flags)"
      configExConstraints (\v flags -> flags { configExConstraints = v })
      (reqArg "CONSTRAINT"
682 683
              ((\x -> [(x, src)]) `fmap` ReadE readUserConstraint)
              (map $ display . fst))
684 685 686 687

  , option [] ["preference"]
      "Specify preferences (soft constraints) on the version of a package"
      configPreferences (\v flags -> flags { configPreferences = v })
688 689 690 691
      (reqArg "CONSTRAINT"
              (readP_to_E (const "dependency expected")
                          (fmap (\x -> [x]) parse))
              (map display))
692 693

  , optionSolver configSolver (\v flags -> flags { configSolver = v })
694

695
  , option [] ["allow-older"]
696
    ("Ignore lower bounds in all dependencies or DEPS")
697 698 699 700 701 702 703 704 705 706 707 708 709 710
    (fmap unAllowOlder . configAllowOlder)
    (\v flags -> flags { configAllowOlder = fmap AllowOlder v})
    (optArg "DEPS"
     (readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser)
     (Just RelaxDepsAll) relaxDepsPrinter)

  , option [] ["allow-newer"]
    ("Ignore upper bounds in all dependencies or DEPS")
    (fmap unAllowNewer . configAllowNewer)
    (\v flags -> flags { configAllowNewer = fmap AllowNewer v})
    (optArg "DEPS"
     (readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser)
     (Just RelaxDepsAll) relaxDepsPrinter)

711 712 713 714 715 716 717 718
  , option [] ["write-ghc-environment-files"]
    ("Whether to create a .ghc.environment file after a successful build"
      ++ " (v2-build only)")
    configWriteGhcEnvironmentFilesPolicy
    (\v flags -> flags { configWriteGhcEnvironmentFilesPolicy = v})
    (reqArg "always|never|ghc8.4.4+"
     writeGhcEnvironmentFilesPolicyParser
     writeGhcEnvironmentFilesPolicyPrinter)
719 720
  ]

721

722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738
writeGhcEnvironmentFilesPolicyParser :: ReadE (Flag WriteGhcEnvironmentFilesPolicy)
writeGhcEnvironmentFilesPolicyParser = ReadE $ \case
  "always"    -> Right $ Flag AlwaysWriteGhcEnvironmentFiles
  "never"     -> Right $ Flag NeverWriteGhcEnvironmentFiles
  "ghc8.4.4+" -> Right $ Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer
  policy      -> Left  $ "Cannot parse the GHC environment file write policy '"
                 <> policy <> "'"

writeGhcEnvironmentFilesPolicyPrinter
  :: Flag WriteGhcEnvironmentFilesPolicy -> [String]
writeGhcEnvironmentFilesPolicyPrinter = \case
  (Flag AlwaysWriteGhcEnvironmentFiles)                -> ["always"]
  (Flag NeverWriteGhcEnvironmentFiles)                 -> ["never"]
  (Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer) -> ["ghc8.4.4+"]
  NoFlag                                               -> []


739 740 741 742 743 744 745 746 747 748
relaxDepsParser :: Parse.ReadP r (Maybe RelaxDeps)
relaxDepsParser =
  (Just . RelaxDepsSome) `fmap` Parse.sepBy1 parse (Parse.char ',')

relaxDepsPrinter :: (Maybe RelaxDeps) -> [Maybe String]
relaxDepsPrinter Nothing                     = []
relaxDepsPrinter (Just RelaxDepsAll)         = [Nothing]
relaxDepsPrinter (Just (RelaxDepsSome pkgs)) = map (Just . display) $ pkgs


749
instance Monoid ConfigExFlags where
750
  mempty = gmempty
751 752 753
  mappend = (<>)

instance Semigroup ConfigExFlags where
754
  (<>) = gmappend
755

ttuegel's avatar
ttuegel committed
756 757 758 759 760 761
reconfigureCommand :: CommandUI (ConfigFlags, ConfigExFlags)
reconfigureCommand
  = configureExCommand
    { commandName         = "reconfigure"
    , commandSynopsis     = "Reconfigure the package if necessary."
    , commandDescription  = Just $ \pname -> wrapText $
762 763
         "Run `configure` with the most recently used flags, or append FLAGS "
         ++ "to the most recently used configuration. "
764
         ++ "Accepts the same flags as `" ++ pname ++ " v1-configure'. "
765 766 767 768
         ++ "If the package has never been configured, the default flags are "
         ++ "used."
    , commandNotes        = Just $ \pname ->
        "Examples:\n"
769
        ++ "  " ++ pname ++ " v1-reconfigure\n"
770
        ++ "    Configure with the most recently used flags.\n"
771
        ++ "  " ++ pname ++ " v1-reconfigure -w PATH\n"
772 773
        ++ "    Reconfigure with the most recently used flags,\n"
        ++ "    but use the compiler at PATH.\n\n"
774
    , commandUsage        = usageAlternatives "v1-reconfigure" [ "[FLAGS]" ]
ttuegel's avatar
ttuegel committed
775 776 777
    , commandDefaultFlags = mempty
    }

ttuegel's avatar
ttuegel committed
778 779 780 781
-- ------------------------------------------------------------
-- * Build flags
-- ------------------------------------------------------------

782 783 784 785 786 787
data SkipAddSourceDepsCheck =
  SkipAddSourceDepsCheck | DontSkipAddSourceDepsCheck
  deriving Eq

data BuildExFlags = BuildExFlags {
  buildOnly     :: Flag SkipAddSourceDepsCheck
788
} deriving Generic
789 790 791

buildExOptions :: ShowOrParseArgs -> [OptionField BuildExFlags]
buildExOptions _showOrParseArgs =
792
  option [] ["only"]
793 794 795 796 797 798 799 800
  "Don't reinstall add-source dependencies (sandbox-only)"
  buildOnly (\v flags -> flags { buildOnly = v })
  (noArg (Flag SkipAddSourceDepsCheck))

  : []

buildCommand :: CommandUI (BuildFlags, BuildExFlags)
buildCommand = parent {
801 802 803 804 805
    commandName = "build",
    commandDescription  = Just $ \_ -> wrapText $
      "Components encompass executables, tests, and benchmarks.\n"
        ++ "\n"
        ++ "Affected by configuration options, see `v1-configure`.\n",
806
    commandDefaultFlags = (commandDefaultFlags parent, mempty),
807 808
    commandUsage        = usageAlternatives "v1-build" $
      [ "[FLAGS]", "COMPONENTS [FLAGS]" ],
809 810 811 812 813
    commandOptions      =
      \showOrParseArgs -> liftOptions fst setFst
                          (commandOptions parent showOrParseArgs)
                          ++
                          liftOptions snd setSnd (buildExOptions showOrParseArgs)
814 815 816 817 818 819 820
    , commandNotes        = Just $ \pname ->
      "Examples:\n"
        ++ "  " ++ pname ++ " v1-build           "
        ++ "    All the components in the package\n"
        ++ "  " ++ pname ++ " v1-build foo       "
        ++ "    A component (i.e. lib, exe, test suite)\n\n"
        ++ Cabal.programFlagsDescription defaultProgramDb
821 822 823 824 825
  }
  where
    setFst a (_,b) = (a,b)
    setSnd b (a,_) = (a,b)

826
    parent = Cabal.buildCommand defaultProgramDb
827 828

instance Monoid BuildExFlags where
829
  mempty = gmempty
830 831 832
  mappend = (<>)

instance Semigroup BuildExFlags where
833
  (<>) = gmappend
834

Josh Meredith's avatar
Josh Meredith committed
835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865
-- ------------------------------------------------------------
-- * Test flags
-- ------------------------------------------------------------

-- | Given some 'TestFlags' for the version of Cabal that
-- cabal-install was built with, and a target older 'Version' of
-- Cabal that we want to pass these flags to, convert the
-- flags into a form that will be accepted by the older
-- Setup script.  Generally speaking, this just means filtering
-- out flags that the old Cabal library doesn't understand, but
-- in some cases it may also mean "emulating" a feature using
-- some more legacy flags.
filterTestFlags :: TestFlags -> Version -> TestFlags
filterTestFlags flags cabalLibVersion
  -- NB: we expect the latest version to be the most common case,
  -- so test it first.
  | cabalLibVersion >= mkVersion [3,0,0] = flags_latest
  -- The naming convention is that flags_version gives flags with
  -- all flags *introduced* in version eliminated.
  -- It is NOT the latest version of Cabal library that
  -- these flags work for; version of introduction is a more
  -- natural metric.
  | cabalLibVersion <  mkVersion [3,0,0] = flags_3_0_0
  | otherwise = error "the impossible just happened" -- see first guard
  where
    flags_latest = flags
    flags_3_0_0  = flags_latest {
      -- Cabal < 3.0 doesn't know about --test-wrapper
      Cabal.testWrapper = NoFlag
      }

866
-- ------------------------------------------------------------
867 868 869 870 871
-- * Repl command
-- ------------------------------------------------------------

replCommand :: CommandUI (ReplFlags, BuildExFlags)
replCommand = parent {
872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891
    commandName = "repl",
    commandDescription  = Just $ \pname -> wrapText $
         "If the current directory contains no package, ignores COMPONENT "
      ++ "parameters and opens an interactive interpreter session; if a "
      ++ "sandbox is present, its package database will be used.\n"
      ++ "\n"
      ++ "Otherwise, (re)configures with the given or default flags, and "
      ++ "loads the interpreter with the relevant modules. For executables, "
      ++ "tests and benchmarks, loads the main module (and its "
      ++ "dependencies); for libraries all exposed/other modules.\n"
      ++ "\n"
      ++ "The default component is the library itself, or the executable "
      ++ "if that is the only component.\n"
      ++ "\n"
      ++ "Support for loading specific modules is planned but not "
      ++ "implemented yet. For certain scenarios, `" ++ pname
      ++ " v1-exec -- ghci :l Foo` may be used instead. Note that `v1-exec` will "
      ++ "not (re)configure and you will have to specify the location of "
      ++ "other modules, if required.\n",
    commandUsage =  \pname -> "Usage: " ++ pname ++ " v1-repl [COMPONENT] [FLAGS]\n",
892 893 894 895 896
    commandDefaultFlags = (commandDefaultFlags parent, mempty),
    commandOptions      =
      \showOrParseArgs -> liftOptions fst setFst
                          (commandOptions parent showOrParseArgs)
                          ++
897 898 899 900 901 902 903 904 905
                          liftOptions snd setSnd (buildExOptions showOrParseArgs),
    commandNotes        = Just $ \pname ->
      "Examples:\n"
    ++ "  " ++ pname ++ " v1-repl           "
    ++ "    The first component in the package\n"
    ++ "  " ++ pname ++ " v1-repl foo       "
    ++ "    A named component (i.e. lib, exe, test suite)\n"
    ++ "  " ++ pname ++ " v1-repl --ghc-options=\"-lstdc++\""
    ++ "  Specifying flags for interpreter\n"
906 907 908 909 910
  }
  where
    setFst a (_,b) = (a,b)
    setSnd b (a,_) = (a,b)

911
    parent = Cabal.replCommand defaultProgramDb
912

913 914 915 916
-- ------------------------------------------------------------
-- * Test command
-- ------------------------------------------------------------

917
testCommand :: CommandUI (TestFlags, BuildFlags, BuildExFlags)
918
testCommand = parent {
919 920 921 922 923 924