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

    , parsePackageArgs
53 54 55
    --TODO: stop exporting these:
    , showRepo
    , parseRepo
56
    , readRepo
57 58
    ) where

59 60 61
import Prelude ()
import Distribution.Client.Compat.Prelude hiding (get)

62
import Distribution.Client.Types
63
         ( Username(..), Password(..), RemoteRepo(..) )
64 65
import Distribution.Client.BuildReports.Types
         ( ReportLevel(..) )
66
import Distribution.Client.Dependency.Types
67
         ( PreSolver(..) )
68 69 70 71

import Distribution.Client.IndexUtils.Timestamp
         ( IndexState )

72 73
import qualified Distribution.Client.Init.Types as IT
         ( InitFlags(..), PackageType(..) )
74 75
import Distribution.Client.Targets
         ( UserConstraint, readUserConstraint )
76 77
import Distribution.Utils.NubList
         ( NubList, toNubList, fromNubList)
78

79
import Distribution.Solver.Types.ConstraintSource
80
import Distribution.Solver.Types.Settings
81

82 83
import Distribution.Simple.Compiler ( Compiler, PackageDB, PackageDBStack )
import Distribution.Simple.Program (ProgramDb, defaultProgramDb)
84 85
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import qualified Distribution.Simple.Command as Command
86
import Distribution.Simple.Configure
87
       ( configCompilerAuxEx, interpretPackageDbFlags, computeEffectiveProfiling )
Duncan Coutts's avatar
Duncan Coutts committed
88
import qualified Distribution.Simple.Setup as Cabal
89
import Distribution.Simple.Setup
90 91
         ( ConfigFlags(..), BuildFlags(..), ReplFlags
         , TestFlags(..), BenchmarkFlags(..)
92
         , SDistFlags(..), HaddockFlags(..)
93
         , readPackageDbList, showPackageDbList
Edsko de Vries's avatar
Edsko de Vries committed
94
         , Flag(..), toFlag, flagToMaybe, flagToList
95 96
         , BooleanFlag(..), optionVerbosity
         , boolOpt, boolOpt', trueArg, falseArg
97
         , optionNumJobs )
98
import Distribution.Simple.InstallDirs
Christiaan Baaij's avatar
Christiaan Baaij committed
99
         ( PathTemplate, InstallDirs(dynlibdir, sysconfdir)
100
         , toPathTemplate, fromPathTemplate )
101
import Distribution.Version
102
         ( Version, mkVersion, nullVersion, anyVersion, thisVersion )
103
import Distribution.Package
104
         ( PackageIdentifier, PackageName, packageName, packageVersion )
105
import Distribution.Types.Dependency
106
import Distribution.PackageDescription
107
         ( BuildType(..), RepoKind(..) )
108
import Distribution.System ( Platform )
109
import Distribution.Text
110
         ( Text(..), display )
111
import Distribution.ReadE
112
         ( ReadE(..), readP_to_E, succeedReadE )
113
import qualified Distribution.Compat.ReadP as Parse
114
         ( ReadP, char, munch1, pfail, sepBy1, (+++) )
115 116
import Distribution.ParseUtils
         ( readPToMaybe )
117
import Distribution.Verbosity
118
         ( Verbosity, lessVerbose, normal )
119
import Distribution.Simple.Utils
120
         ( wrapText, wrapLine )
121
import Distribution.Client.GlobalFlags
Edsko de Vries's avatar
Edsko de Vries committed
122 123 124
         ( GlobalFlags(..), defaultGlobalFlags
         , RepoContext(..), withRepoContext
         )
125

126
import Data.List
127
         ( deleteFirstsBy )
128 129 130 131
import System.FilePath
         ( (</>) )
import Network.URI
         ( parseAbsoluteURI, uriToString )
132

133 134
globalCommand :: [Command action] -> CommandUI GlobalFlags
globalCommand commands = CommandUI {
135
    commandName         = "",
136 137
    commandSynopsis     =
         "Command line interface to the Haskell Cabal infrastructure.",
138 139 140 141
    commandUsage        = \pname ->
         "See http://www.haskell.org/cabal/ for more information.\n"
      ++ "\n"
      ++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n",
142
    commandDescription  = Just $ \pname ->
143 144 145
      let
        commands' = commands ++ [commandAddAction helpCommandUI undefined]
        cmdDescs = getNormalCommandDescriptions commands'
146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
        -- 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"
174
          , "gen-bounds"
175
          , "outdated"
176 177 178 179 180 181 182
          , "haddock"
          , "hscolour"
          , "copy"
          , "register"
          , "sandbox"
          , "exec"
          ]
183 184
        maxlen    = maximum $ [length name | (name, _) <- cmdDescs]
        align str = str ++ replicate (maxlen - length str) ' '
185 186 187 188 189 190 191 192 193
        startGroup n = " ["++n++"]"
        par          = ""
        addCmd n     = case lookup n cmdDescs of
                         Nothing -> ""
                         Just d -> "  " ++ align n ++ "    " ++ d
        addCmdCustom n d = case lookup n cmdDescs of -- make sure that the
                                                  -- command still exists.
                         Nothing -> ""
                         Just _ -> "  " ++ align n ++ "    " ++ d
194 195
      in
         "Commands:\n"
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225
      ++ 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"
226
        , addCmd "gen-bounds"
227
        , addCmd "outdated"
228 229 230 231 232 233
        , addCmd "haddock"
        , addCmd "hscolour"
        , addCmd "copy"
        , addCmd "register"
        , par
        , startGroup "sandbox"
234
        , addCmd "sandbox"
235 236 237 238 239
        , addCmd "exec"
        , addCmdCustom "repl" "Open interpreter with access to sandbox packages."
        ] ++ if null otherCmds then [] else par
                                           :startGroup "other"
                                           :[addCmd n | n <- otherCmds])
240 241
      ++ "\n"
      ++ "For more information about a command use:\n"
242 243
      ++ "   " ++ pname ++ " COMMAND --help\n"
      ++ "or " ++ pname ++ " help COMMAND\n"
244
      ++ "\n"
245
      ++ "To install Cabal packages from hackage use:\n"
246 247
      ++ "  " ++ pname ++ " install foo [--dry-run]\n"
      ++ "\n"
248 249
      ++ "Occasionally you need to update the list of available packages:\n"
      ++ "  " ++ pname ++ " update\n",
250
    commandNotes = Nothing,
251
    commandDefaultFlags = mempty,
252 253 254 255 256 257 258 259 260 261 262
    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"]
263 264 265 266 267 268 269 270 271 272 273 274 275 276
         "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")

277
      ,option [] ["sandbox-config-file"]
278
         "Set an alternate location for the sandbox config file (default: './cabal.sandbox.config')"
279
         globalSandboxConfigFile (\v flags -> flags { globalSandboxConfigFile = v })
280 281
         (reqArgFlag "FILE")

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

287
      ,option [] ["require-sandbox"]
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
288
         "requiring the presence of a sandbox for sandbox-aware commands"
289 290 291
         globalRequireSandbox (\v flags -> flags { globalRequireSandbox = v })
         (boolOpt' ([], ["require-sandbox"]) ([], ["no-require-sandbox"]))

292 293 294 295 296
      ,option [] ["ignore-sandbox"]
         "Ignore any existing sandbox"
         globalIgnoreSandbox (\v flags -> flags { globalIgnoreSandbox = v })
         trueArg

297
      ,option [] ["ignore-expiry"]
Edsko de Vries's avatar
Edsko de Vries committed
298
         "Ignore expiry dates on signed metadata (use only in exceptional circumstances)"
299 300 301
         globalIgnoreExpiry (\v flags -> flags { globalIgnoreExpiry = v })
         trueArg

302
      ,option [] ["http-transport"]
303
         "Set a transport for http(s) requests. Accepts 'curl', 'wget', 'powershell', and 'plain-http'. (default: 'curl')"
304
         globalHttpTransport (\v flags -> flags { globalHttpTransport = v })
305
         (reqArgFlag "HttpTransport")
ttuegel's avatar
ttuegel committed
306 307 308 309
      ,option [] ["nix"]
         "Nix integration: run commands through nix-shell if a 'shell.nix' file exists"
         globalNix (\v flags -> flags { globalNix = v })
         (boolOpt [] [])
310
      ]
311

312 313 314 315
    -- arguments we don't want shown in the help
    argsNotShown :: [OptionField GlobalFlags]
    argsNotShown = [
       option [] ["remote-repo"]
316 317
         "The name and url for a remote repository"
         globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v })
318
         (reqArg' "NAME:URL" (toNubList . maybeToList . readRepo) (map showRepo . fromNubList))
319 320 321 322 323 324 325 326 327

      ,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 })
328
         (reqArg' "DIR" (\x -> toNubList [x]) fromNubList)
329

330 331 332 333 334
      ,option [] ["logs-dir"]
         "The location to put log files"
         globalLogsDir (\v flags -> flags { globalLogsDir = v })
         (reqArgFlag "DIR")

335 336 337 338
      ,option [] ["world-file"]
         "The location of the world file"
         globalWorldFile (\v flags -> flags { globalWorldFile = v })
         (reqArgFlag "FILE")
339 340 341 342 343
      ]

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

345
configureCommand :: CommandUI ConfigFlags
346 347
configureCommand = c
  { commandDefaultFlags = mempty
348 349 350
  , commandNotes = Just $ \pname -> (case commandNotes c of
         Nothing -> ""
         Just n  -> n pname ++ "\n")
351 352 353 354 355 356
       ++ "Examples:\n"
       ++ "  " ++ pname ++ " configure\n"
       ++ "    Configure with defaults;\n"
       ++ "  " ++ pname ++ " configure --enable-tests -fcustomflag\n"
       ++ "    Configure building package including tests,\n"
       ++ "    with some package-specific flag.\n"
Duncan Coutts's avatar
Duncan Coutts committed
357
  }
358
 where
359
  c = Cabal.configureCommand defaultProgramDb
Duncan Coutts's avatar
Duncan Coutts committed
360

361 362 363
configureOptions ::  ShowOrParseArgs -> [OptionField ConfigFlags]
configureOptions = commandOptions configureCommand

364 365 366 367 368 369 370 371
-- | 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.
372
filterConfigureFlags :: ConfigFlags -> Version -> ConfigFlags
373
filterConfigureFlags flags cabalLibVersion
374 375
  -- NB: we expect the latest version to be the most common case,
  -- so test it first.
Christiaan Baaij's avatar
Christiaan Baaij committed
376
  | cabalLibVersion >= mkVersion [1,25,0] = flags_latest
377 378 379 380 381
  -- 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.
382 383 384 385 386 387 388 389 390 391
  | 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
  | cabalLibVersion < mkVersion [1,23,0] = flags_1_23_0
Christiaan Baaij's avatar
Christiaan Baaij committed
392
  | cabalLibVersion < mkVersion [1,25,0] = flags_1_25_0
393
  | otherwise = flags_latest
394
  where
395 396 397
    flags_latest = flags        {
      -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'.
      configConstraints = [],
398
      -- Passing '--allow-{older,newer}' to Setup.hs is unnecessary, we use
399
      -- '--exact-configuration' instead.
400
      configAllowOlder  = Just (Cabal.AllowOlder Cabal.RelaxDepsNone),
401
      configAllowNewer  = Just (Cabal.AllowNewer Cabal.RelaxDepsNone)
402
      }
403

Christiaan Baaij's avatar
Christiaan Baaij committed
404 405 406 407
    -- Cabal < 1.25.0 doesn't know about --dynlibdir.
    flags_1_25_0 = flags_latest { configInstallDirs = configInstallDirs_1_25_0}
    configInstallDirs_1_25_0 = (configInstallDirs flags) { dynlibdir = NoFlag }

408
    -- Cabal < 1.23 doesn't know about '--profiling-detail'.
409 410 411
    -- 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
412
    flags_1_23_0 = flags_1_25_0 { configProfDetail    = NoFlag
413
                                , configProfLibDetail = NoFlag
414
                                , configIPID          = NoFlag
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
415 416 417
                                , configProf          = NoFlag
                                , configProfExe       = Flag tryExeProfiling
                                , configProfLib       = Flag tryLibProfiling
418
                                }
419

420
    -- Cabal < 1.22 doesn't know about '--disable-debug-info'.
421
    flags_1_22_0 = flags_1_23_0 { configDebugInfo = NoFlag }
422

423
    -- Cabal < 1.21.1 doesn't know about 'disable-relocatable'
424
    -- Cabal < 1.21.1 doesn't know about 'enable-profiling'
425
    -- (but we already dealt with it in flags_1_23_0)
426 427
    flags_1_21_1 =
      flags_1_22_0 { configRelocatable = NoFlag
428 429
                   , configCoverage = NoFlag
                   , configLibCoverage = configCoverage flags
430
                   }
431 432
    -- Cabal < 1.19.2 doesn't know about '--exact-configuration' and
    -- '--enable-library-stripping'.
433
    flags_1_19_2 = flags_1_21_1 { configExactConfiguration = NoFlag
434
                                , configStripLibs = NoFlag }
435
    -- Cabal < 1.19.1 uses '--constraint' instead of '--dependency'.
436
    flags_1_19_1 = flags_1_19_2 { configDependencies = []
437
                                , configConstraints  = configConstraints flags }
438
    -- Cabal < 1.18.0 doesn't know about --extra-prog-path and --sysconfdir.
439
    flags_1_18_0 = flags_1_19_1 { configProgramPathExtra = toNubList []
440
                                , configInstallDirs = configInstallDirs_1_18_0}
Christiaan Baaij's avatar
Christiaan Baaij committed
441
    configInstallDirs_1_18_0 = (configInstallDirs flags_1_19_1) { sysconfdir = NoFlag }
442
    -- Cabal < 1.14.0 doesn't know about '--disable-benchmarks'.
443
    flags_1_14_0 = flags_1_18_0 { configBenchmarks  = NoFlag }
444 445 446 447
    -- 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 }
448
    -- Cabal < 1.10.0 doesn't know about '--disable-tests'.
449
    flags_1_10_0 = flags_1_12_0 { configTests       = NoFlag }
450
    -- Cabal < 1.3.10 does not grok the '--constraints' flag.
451
    flags_1_3_10 = flags_1_10_0 { configConstraints = [] }
452

453 454
-- | Get the package database settings from 'ConfigFlags', accounting for
-- @--package-db@ and @--user@ flags.
455 456 457 458 459 460
configPackageDB' :: ConfigFlags -> PackageDBStack
configPackageDB' cfg =
    interpretPackageDbFlags userInstall (configPackageDBs cfg)
  where
    userInstall = Cabal.fromFlagOrDefault True (configUserInstall cfg)

461
-- | Configure the compiler, but reduce verbosity during this step.
462 463 464 465 466 467
configCompilerAux' :: ConfigFlags -> IO (Compiler, Platform, ProgramDb)
configCompilerAux' configFlags =
  configCompilerAuxEx configFlags
    --FIXME: make configCompilerAux use a sensible verbosity
    { configVerbosity = fmap lessVerbose (configVerbosity configFlags) }

468 469 470 471 472 473 474 475
-- ------------------------------------------------------------
-- * Config extra flags
-- ------------------------------------------------------------

-- | cabal configure takes some extra flags beyond runghc Setup configure
--
data ConfigExFlags = ConfigExFlags {
    configCabalVersion :: Flag Version,
476
    configExConstraints:: [(UserConstraint, ConstraintSource)],
477
    configPreferences  :: [Dependency],
478
    configSolver       :: Flag PreSolver
479
  }
480
  deriving (Eq, Generic)
481 482

defaultConfigExFlags :: ConfigExFlags
483
defaultConfigExFlags = mempty { configSolver     = Flag defaultSolver }
484 485 486 487 488

configureExCommand :: CommandUI (ConfigFlags, ConfigExFlags)
configureExCommand = configureCommand {
    commandDefaultFlags = (mempty, defaultConfigExFlags),
    commandOptions      = \showOrParseArgs ->
489
         liftOptions fst setFst
490
         (filter ((`notElem` ["constraint", "dependency", "exact-configuration"])
491
                  . optionName) $ configureOptions  showOrParseArgs)
492 493
      ++ liftOptions snd setSnd
         (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag)
494 495 496 497 498
  }
  where
    setFst a (_,b) = (a,b)
    setSnd b (a,_) = (a,b)

499 500 501 502
configureExOptions :: ShowOrParseArgs
                   -> ConstraintSource
                   -> [OptionField ConfigExFlags]
configureExOptions _showOrParseArgs src =
503 504 505 506 507 508 509
  [ 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))
510 511 512 513
  , option [] ["constraint"]
      "Specify constraints on a package (version, installed/source, flags)"
      configExConstraints (\v flags -> flags { configExConstraints = v })
      (reqArg "CONSTRAINT"
514 515
              ((\x -> [(x, src)]) `fmap` ReadE readUserConstraint)
              (map $ display . fst))
516 517 518 519

  , option [] ["preference"]
      "Specify preferences (soft constraints) on the version of a package"
      configPreferences (\v flags -> flags { configPreferences = v })
520 521 522 523
      (reqArg "CONSTRAINT"
              (readP_to_E (const "dependency expected")
                          (fmap (\x -> [x]) parse))
              (map display))
524 525

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

527 528 529
  ]

instance Monoid ConfigExFlags where
530
  mempty = gmempty
531 532 533
  mappend = (<>)

instance Semigroup ConfigExFlags where
534
  (<>) = gmappend
535

ttuegel's avatar
ttuegel committed
536 537 538 539 540 541
reconfigureCommand :: CommandUI (ConfigFlags, ConfigExFlags)
reconfigureCommand
  = configureExCommand
    { commandName         = "reconfigure"
    , commandSynopsis     = "Reconfigure the package if necessary."
    , commandDescription  = Just $ \pname -> wrapText $
542 543
         "Run `configure` with the most recently used flags, or append FLAGS "
         ++ "to the most recently used configuration. "
ttuegel's avatar
ttuegel committed
544
         ++ "Accepts the same flags as `" ++ pname ++ " configure'. "
545 546 547 548 549 550 551 552 553
         ++ "If the package has never been configured, the default flags are "
         ++ "used."
    , commandNotes        = Just $ \pname ->
        "Examples:\n"
        ++ "  " ++ pname ++ " reconfigure\n"
        ++ "    Configure with the most recently used flags.\n"
        ++ "  " ++ pname ++ " reconfigure -w PATH\n"
        ++ "    Reconfigure with the most recently used flags,\n"
        ++ "    but use the compiler at PATH.\n\n"
ttuegel's avatar
ttuegel committed
554 555 556 557
    , commandUsage        = usageAlternatives "reconfigure" [ "[FLAGS]" ]
    , commandDefaultFlags = mempty
    }

ttuegel's avatar
ttuegel committed
558 559 560 561
-- ------------------------------------------------------------
-- * Build flags
-- ------------------------------------------------------------

562 563 564 565 566 567
data SkipAddSourceDepsCheck =
  SkipAddSourceDepsCheck | DontSkipAddSourceDepsCheck
  deriving Eq

data BuildExFlags = BuildExFlags {
  buildOnly     :: Flag SkipAddSourceDepsCheck
568
} deriving Generic
569 570 571

buildExOptions :: ShowOrParseArgs -> [OptionField BuildExFlags]
buildExOptions _showOrParseArgs =
572
  option [] ["only"]
573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591
  "Don't reinstall add-source dependencies (sandbox-only)"
  buildOnly (\v flags -> flags { buildOnly = v })
  (noArg (Flag SkipAddSourceDepsCheck))

  : []

buildCommand :: CommandUI (BuildFlags, BuildExFlags)
buildCommand = parent {
    commandDefaultFlags = (commandDefaultFlags parent, mempty),
    commandOptions      =
      \showOrParseArgs -> liftOptions fst setFst
                          (commandOptions parent showOrParseArgs)
                          ++
                          liftOptions snd setSnd (buildExOptions showOrParseArgs)
  }
  where
    setFst a (_,b) = (a,b)
    setSnd b (a,_) = (a,b)

592
    parent = Cabal.buildCommand defaultProgramDb
593 594

instance Monoid BuildExFlags where
595
  mempty = gmempty
596 597 598
  mappend = (<>)

instance Semigroup BuildExFlags where
599
  (<>) = gmappend
600 601

-- ------------------------------------------------------------
602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617
-- * Repl command
-- ------------------------------------------------------------

replCommand :: CommandUI (ReplFlags, BuildExFlags)
replCommand = parent {
    commandDefaultFlags = (commandDefaultFlags parent, mempty),
    commandOptions      =
      \showOrParseArgs -> liftOptions fst setFst
                          (commandOptions parent showOrParseArgs)
                          ++
                          liftOptions snd setSnd (buildExOptions showOrParseArgs)
  }
  where
    setFst a (_,b) = (a,b)
    setSnd b (a,_) = (a,b)

618
    parent = Cabal.replCommand defaultProgramDb
619

620 621 622 623
-- ------------------------------------------------------------
-- * Test command
-- ------------------------------------------------------------

624
testCommand :: CommandUI (TestFlags, BuildFlags, BuildExFlags)
625
testCommand = parent {
626 627
  commandDefaultFlags = (commandDefaultFlags parent,
                         Cabal.defaultBuildFlags, mempty),
628
  commandOptions      =
629
    \showOrParseArgs -> liftOptions get1 set1
630 631
                        (commandOptions parent showOrParseArgs)
                        ++
632
                        liftOptions get2 set2
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
633
                        (Cabal.buildOptions progDb showOrParseArgs)
634 635
                        ++
                        liftOptions get3 set3 (buildExOptions showOrParseArgs)
636 637
  }
  where
638 639 640
    get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c)
    get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c)
    get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c)
641

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
642 643
    parent = Cabal.testCommand
    progDb = defaultProgramDb
644 645 646 647 648

-- ------------------------------------------------------------
-- * Bench command
-- ------------------------------------------------------------

649
benchmarkCommand :: CommandUI (BenchmarkFlags, BuildFlags, BuildExFlags)
650
benchmarkCommand = parent {
651 652
  commandDefaultFlags = (commandDefaultFlags parent,
                         Cabal.defaultBuildFlags, mempty),
653
  commandOptions      =
654
    \showOrParseArgs -> liftOptions get1 set1
655 656
                        (commandOptions parent showOrParseArgs)
                        ++
657
                        liftOptions get2 set2
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
658
                        (Cabal.buildOptions progDb showOrParseArgs)
659 660
                        ++
                        liftOptions get3 set3 (buildExOptions showOrParseArgs)
ttuegel's avatar
ttuegel committed
661
  }
662
  where
663 664 665
    get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c)
    get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c)
    get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c)
666

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
667 668
    parent = Cabal.benchmarkCommand
    progDb = defaultProgramDb
ttuegel's avatar
ttuegel committed
669

670
-- ------------------------------------------------------------
671
-- * Fetch command
672
-- ------------------------------------------------------------
673

674 675 676 677
data FetchFlags = FetchFlags {
--    fetchOutput    :: Flag FilePath,
      fetchDeps      :: Flag Bool,
      fetchDryRun    :: Flag Bool,
678
      fetchSolver           :: Flag PreSolver,
679
      fetchMaxBackjumps     :: Flag Int,
680
      fetchReorderGoals     :: Flag ReorderGoals,
681
      fetchCountConflicts   :: Flag CountConflicts,
682 683 684
      fetchIndependentGoals :: Flag IndependentGoals,
      fetchShadowPkgs       :: Flag ShadowPkgs,
      fetchStrongFlags      :: Flag StrongFlags,
685
      fetchAllowBootLibInstalls :: Flag AllowBootLibInstalls,
686 687 688 689 690 691 692 693
      fetchVerbosity :: Flag Verbosity
    }

defaultFetchFlags :: FetchFlags
defaultFetchFlags = FetchFlags {
--  fetchOutput    = mempty,
    fetchDeps      = toFlag True,
    fetchDryRun    = toFlag False,
694 695
    fetchSolver           = Flag defaultSolver,
    fetchMaxBackjumps     = Flag defaultMaxBackjumps,
696
    fetchReorderGoals     = Flag (ReorderGoals False),
697
    fetchCountConflicts   = Flag (CountConflicts True),
698 699 700
    fetchIndependentGoals = Flag (IndependentGoals False),
    fetchShadowPkgs       = Flag (ShadowPkgs False),
    fetchStrongFlags      = Flag (StrongFlags False),
701
    fetchAllowBootLibInstalls = Flag (AllowBootLibInstalls False),
702 703 704 705
    fetchVerbosity = toFlag normal
   }

fetchCommand :: CommandUI FetchFlags
Duncan Coutts's avatar
Duncan Coutts committed
706 707
fetchCommand = CommandUI {
    commandName         = "fetch",
708
    commandSynopsis     = "Downloads packages for later installation.",
709 710 711 712 713
    commandUsage        = usageAlternatives "fetch" [ "[FLAGS] PACKAGES"
                                                    ],
    commandDescription  = Just $ \_ ->
          "Note that it currently is not possible to fetch the dependencies for a\n"
       ++ "package in the current directory.\n",
714
    commandNotes        = Nothing,
715
    commandDefaultFlags = defaultFetchFlags,
716
    commandOptions      = \ showOrParseArgs -> [
717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737
         optionVerbosity fetchVerbosity (\v flags -> flags { fetchVerbosity = v })

--     , option "o" ["output"]
--         "Put the package(s) somewhere specific rather than the usual cache."
--         fetchOutput (\v flags -> flags { fetchOutput = v })
--         (reqArgFlag "PATH")

       , option [] ["dependencies", "deps"]
           "Resolve and fetch dependencies (default)"
           fetchDeps (\v flags -> flags { fetchDeps = v })
           trueArg

       , option [] ["no-dependencies", "no-deps"]
           "Ignore dependencies"
           fetchDeps (\v flags -> flags { fetchDeps = v })
           falseArg

       , option [] ["dry-run"]
           "Do not install anything, only print what would be installed."
           fetchDryRun (\v flags -> flags { fetchDryRun = v })
           trueArg
738 739 740 741

       ] ++

       optionSolver      fetchSolver           (\v flags -> flags { fetchSolver           = v }) :
742 743
       optionSolverFlags showOrParseArgs
                         fetchMaxBackjumps     (\v flags -> flags { fetchMaxBackjumps     = v })
744
                         fetchReorderGoals     (\v flags -> flags { fetchReorderGoals     = v })
745
                         fetchCountConflicts   (\v flags -> flags { fetchCountConflicts   = v })
746
                         fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v })
747
                         fetchShadowPkgs       (\v flags -> flags { fetchShadowPkgs       = v })
Andres Löh's avatar
Andres Löh committed
748
                         fetchStrongFlags      (\v flags -> flags { fetchStrongFlags      = v })
749
                         fetchAllowBootLibInstalls (\v flags -> flags { fetchAllowBootLibInstalls = v })
750

Duncan Coutts's avatar
Duncan Coutts committed
751 752
  }

753 754 755 756 757 758
-- ------------------------------------------------------------
-- * Freeze command
-- ------------------------------------------------------------

data FreezeFlags = FreezeFlags {
      freezeDryRun           :: Flag Bool,
759 760
      freezeTests            :: Flag Bool,
      freezeBenchmarks       :: Flag Bool,
761 762
      freezeSolver           :: Flag PreSolver,
      freezeMaxBackjumps     :: Flag Int,
763
      freezeReorderGoals     :: Flag ReorderGoals,
764
      freezeCountConflicts   :: Flag CountConflicts,
765 766 767
      freezeIndependentGoals :: Flag IndependentGoals,
      freezeShadowPkgs       :: Flag ShadowPkgs,
      freezeStrongFlags      :: Flag StrongFlags,
768
      freezeAllowBootLibInstalls :: Flag AllowBootLibInstalls,
769 770 771 772 773 774
      freezeVerbosity        :: Flag Verbosity
    }

defaultFreezeFlags :: FreezeFlags
defaultFreezeFlags = FreezeFlags {
    freezeDryRun           = toFlag False,
775 776
    freezeTests            = toFlag False,
    freezeBenchmarks       = toFlag False,
777 778
    freezeSolver           = Flag defaultSolver,
    freezeMaxBackjumps     = Flag defaultMaxBackjumps,
779
    freezeReorderGoals     = Flag (ReorderGoals False),
780
    freezeCountConflicts   = Flag (CountConflicts True),
781 782 783
    freezeIndependentGoals = Flag (IndependentGoals False),
    freezeShadowPkgs       = Flag (ShadowPkgs False),
    freezeStrongFlags      = Flag (StrongFlags False),
784
    freezeAllowBootLibInstalls = Flag (AllowBootLibInstalls False),
785 786 787 788 789 790 791
    freezeVerbosity        = toFlag normal
   }

freezeCommand :: CommandUI FreezeFlags
freezeCommand = CommandUI {
    commandName         = "freeze",
    commandSynopsis     = "Freeze dependencies.",
792 793 794 795 796 797 798 799
    commandDescription  = Just $ \_ -> wrapText $
         "Calculates a valid set of dependencies and their exact versions. "
      ++ "If successful, saves the result to the file `cabal.config`.\n"
      ++ "\n"
      ++ "The package versions specified in `cabal.config` will be used for "
      ++ "any future installs.\n"
      ++ "\n"
      ++ "An existing `cabal.config` is ignored and overwritten.\n",
800
    commandNotes        = Nothing,
801
    commandUsage        = usageFlags "freeze",
802 803
    commandDefaultFlags = defaultFreezeFlags,
    commandOptions      = \ showOrParseArgs -> [
804 805
         optionVerbosity freezeVerbosity
         (\v flags -> flags { freezeVerbosity = v })
806 807 808 809 810 811

       , option [] ["dry-run"]
           "Do not freeze anything, only print what would be frozen"
           freezeDryRun (\v flags -> flags { freezeDryRun = v })
           trueArg

812
       , option [] ["tests"]
813 814
           ("freezing of the dependencies of any tests suites "
            ++ "in the package description file.")
815 816 817 818
           freezeTests (\v flags -> flags { freezeTests = v })
           (boolOpt [] [])

       , option [] ["benchmarks"]
819 820
           ("freezing of the dependencies of any benchmarks suites "
            ++ "in the package description file.")
821 822 823
           freezeBenchmarks (\v flags -> flags { freezeBenchmarks = v })
           (boolOpt [] [])

824 825
       ] ++

826 827
       optionSolver
         freezeSolver           (\v flags -> flags { freezeSolver           = v }):
828 829 830
       optionSolverFlags showOrParseArgs
                         freezeMaxBackjumps     (\v flags -> flags { freezeMaxBackjumps     = v })
                         freezeReorderGoals     (\v flags -> flags { freezeReorderGoals     = v })
831
                         freezeCountConflicts   (\v flags -> flags { freezeCountConflicts   = v })
832 833
                         freezeIndependentGoals (\v flags -> flags { freezeIndependentGoals = v })
                         freezeShadowPkgs       (\v flags -> flags { freezeShadowPkgs       = v })
Andres Löh's avatar
Andres Löh committed
834
                         freezeStrongFlags      (\v flags -> flags { freezeStrongFlags      = v })
835
                         freezeAllowBootLibInstalls (\v flags -> flags { freezeAllowBootLibInstalls = v })
836 837 838

  }

839 840 841 842
-- ------------------------------------------------------------
-- * 'gen-bounds' command
-- ------------------------------------------------------------

843 844 845 846 847 848
genBoundsCommand :: CommandUI FreezeFlags
genBoundsCommand = CommandUI {
    commandName         = "gen-bounds",
    commandSynopsis     = "Generate dependency bounds.",
    commandDescription  = Just $ \_ -> wrapText $
         "Generates bounds for all dependencies that do not currently have them. "
849 850
      ++ "Generated bounds are printed to stdout.  "
      ++ "You can then paste them into your .cabal file.\n"
851 852 853 854 855 856 857 858 859
      ++ "\n",
    commandNotes        = Nothing,
    commandUsage        = usageFlags "gen-bounds",
    commandDefaultFlags = defaultFreezeFlags,
    commandOptions      = \ _ -> [
     optionVerbosity freezeVerbosity (\v flags -> flags { freezeVerbosity = v })
     ]
  }

860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920
-- ------------------------------------------------------------
-- * 'outdated' command
-- ------------------------------------------------------------

data OutdatedFlags = OutdatedFlags {
  outdatedVerbosity :: Flag Verbosity,
  outdatedFreeze    :: Flag Bool,
  outdatedExitCode  :: Flag Bool,
  outdatedIgnore    :: [PackageName],
  outdatedMinor     :: [PackageName]
  }

defaultOutdatedFlags :: OutdatedFlags
defaultOutdatedFlags = OutdatedFlags {
  outdatedVerbosity = toFlag normal,
  outdatedFreeze    = mempty,
  outdatedExitCode  = mempty,
  outdatedIgnore    = mempty,
  outdatedMinor     = mempty
  }

outdatedCommand :: CommandUI OutdatedFlags
outdatedCommand = CommandUI {
  commandName = "outdated",
  commandSynopsis = "Check for outdated dependencies",
  commandDescription  = Just $ \_ -> wrapText $
    "Checks for outdated dependencies in the package description file "
    ++ "or freeze file",
  commandNotes = Nothing,
  commandUsage = usageFlags "outdated",
  commandDefaultFlags = defaultOutdatedFlags,
  commandOptions      = \ _ -> [
    optionVerbosity outdatedVerbosity
      (\v flags -> flags { outdatedVerbosity = v })

    ,option [] ["freeze"]
     "Act on the freeze file"
     outdatedFreeze (\v flags -> flags { outdatedFreeze = v })
     trueArg

    ,option [] ["exit-code"]
     "Exit with non-zero when there are outdated dependencies"
     outdatedExitCode (\v flags -> flags { outdatedExitCode = v })
     trueArg

   ,option [] ["ignore"]
    "Packages to ignore"
    outdatedIgnore (\v flags -> flags { outdatedIgnore = v })
    (reqArg "PKGS" pkgNameListParser (map display))

   ,option [] ["minor"]
    "Ignore major version bumps for these packages"
    outdatedMinor (\v flags -> flags { outdatedMinor = v })
    (reqArg "PKGS" pkgNameListParser (map display))
   ]
  }
  where
    pkgNameListParser = readP_to_E
      ("Couldn't parse the list of package names: " ++)
      (Parse.sepBy1 parse (Parse.char ','))

921 922 923 924
-- ------------------------------------------------------------
-- * Other commands
-- ------------------------------------------------------------

925
updateCommand  :: CommandUI (Flag <