1{-# LANGUAGE ScopedTypeVariables #-} 2{-# LANGUAGE RecordWildCards #-} 3{-# LANGUAGE RankNTypes #-} 4{-# LANGUAGE DeriveGeneric #-} 5{-# LANGUAGE LambdaCase #-} 6----------------------------------------------------------------------------- 7-- | 8-- Module : Distribution.Client.Setup 9-- Copyright : (c) David Himmelstrup 2005 10-- License : BSD-like 11-- 12-- Maintainer : lemmih@gmail.com 13-- Stability : provisional 14-- Portability : portable 15-- 16-- 17----------------------------------------------------------------------------- 18module Distribution.Client.Setup 19 ( globalCommand, GlobalFlags(..), defaultGlobalFlags 20 , 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 27 , configureExOptions, reconfigureCommand 28 , installCommand, InstallFlags(..), installOptions, defaultInstallFlags 29 , filterHaddockArgs, filterHaddockFlags, haddockOptions 30 , defaultSolver, defaultMaxBackjumps 31 , listCommand, ListFlags(..) 32 , updateCommand, UpdateFlags(..), defaultUpdateFlags 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(..) 45 , runCommand 46 , initCommand, initOptions, IT.InitFlags(..) 47 , sdistCommand, SDistFlags(..) 48 , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..) 49 , actAsSetupCommand, ActAsSetupFlags(..) 50 , sandboxCommand, defaultSandboxLocation, SandboxFlags(..) 51 , execCommand, ExecFlags(..), defaultExecFlags 52 , userConfigCommand, UserConfigFlags(..) 53 , manpageCommand 54 , haddockCommand 55 , cleanCommand 56 , doctestCommand 57 , copyCommand 58 , registerCommand 59 60 , parsePackageArgs 61 , liftOptions 62 , yesNoOpt 63 --TODO: stop exporting these: 64 , showRemoteRepo 65 , parseRemoteRepo 66 , readRemoteRepo 67 ) where 68 69import Prelude () 70import Distribution.Client.Compat.Prelude hiding (get) 71 72import Distribution.Deprecated.ReadP (readP_to_E) 73 74import Distribution.Client.Types 75 ( Username(..), Password(..), RemoteRepo(..) 76 , LocalRepo (..), emptyLocalRepo 77 , AllowNewer(..), AllowOlder(..), RelaxDeps(..) 78 , WriteGhcEnvironmentFilesPolicy(..) 79 ) 80import Distribution.Client.BuildReports.Types 81 ( ReportLevel(..) ) 82import Distribution.Client.Dependency.Types 83 ( PreSolver(..) ) 84import Distribution.Client.IndexUtils.Timestamp 85 ( IndexState(..) ) 86import qualified Distribution.Client.Init.Types as IT 87 ( InitFlags(..), PackageType(..) ) 88import Distribution.Client.Targets 89 ( UserConstraint, readUserConstraint ) 90import Distribution.Utils.NubList 91 ( NubList, toNubList, fromNubList) 92 93import Distribution.Solver.Types.ConstraintSource 94import Distribution.Solver.Types.Settings 95 96import Distribution.Simple.Compiler ( Compiler, PackageDB, PackageDBStack ) 97import Distribution.Simple.Program (ProgramDb, defaultProgramDb) 98import Distribution.Simple.Command hiding (boolOpt, boolOpt') 99import qualified Distribution.Simple.Command as Command 100import Distribution.Simple.Configure 101 ( configCompilerAuxEx, interpretPackageDbFlags, computeEffectiveProfiling ) 102import qualified Distribution.Simple.Setup as Cabal 103import Distribution.Simple.Setup 104 ( ConfigFlags(..), BuildFlags(..), ReplFlags 105 , TestFlags, BenchmarkFlags 106 , SDistFlags(..), HaddockFlags(..) 107 , CleanFlags(..), DoctestFlags(..) 108 , CopyFlags(..), RegisterFlags(..) 109 , readPackageDbList, showPackageDbList 110 , Flag(..), toFlag, flagToMaybe, flagToList, maybeToFlag 111 , BooleanFlag(..), optionVerbosity 112 , boolOpt, boolOpt', trueArg, falseArg 113 , optionNumJobs ) 114import Distribution.Simple.InstallDirs 115 ( PathTemplate, InstallDirs(..) 116 , toPathTemplate, fromPathTemplate, combinePathTemplate ) 117import Distribution.Version 118 ( Version, mkVersion, nullVersion, anyVersion, thisVersion ) 119import Distribution.Package 120 ( PackageName, PackageIdentifier, packageName, packageVersion ) 121import Distribution.Types.Dependency 122import Distribution.Types.GivenComponent 123 ( GivenComponent(..) ) 124import Distribution.Types.PackageVersionConstraint 125 ( PackageVersionConstraint(..) ) 126import Distribution.Types.UnqualComponentName 127 ( unqualComponentNameToPackageName ) 128import Distribution.PackageDescription 129 ( BuildType(..), RepoKind(..), LibraryName(..) ) 130import Distribution.System ( Platform ) 131import Distribution.Deprecated.Text 132 ( Text(..), display ) 133import Distribution.ReadE 134 ( ReadE(..), succeedReadE ) 135import qualified Distribution.Deprecated.ReadP as Parse 136 ( ReadP, char, munch1, pfail, sepBy1, (+++) ) 137import Distribution.Deprecated.ParseUtils 138 ( readPToMaybe ) 139import Distribution.Verbosity 140 ( Verbosity, lessVerbose, normal, verboseNoFlags, verboseNoTimestamp ) 141import Distribution.Simple.Utils 142 ( wrapText, wrapLine ) 143import Distribution.Client.GlobalFlags 144 ( GlobalFlags(..), defaultGlobalFlags 145 , RepoContext(..), withRepoContext 146 ) 147 148import Data.List 149 ( deleteFirstsBy ) 150import qualified Data.Set as Set 151import System.FilePath 152 ( (</>) ) 153import Network.URI 154 ( parseAbsoluteURI, uriToString ) 155 156globalCommand :: [Command action] -> CommandUI GlobalFlags 157globalCommand commands = CommandUI { 158 commandName = "", 159 commandSynopsis = 160 "Command line interface to the Haskell Cabal infrastructure.", 161 commandUsage = \pname -> 162 "See http://www.haskell.org/cabal/ for more information.\n" 163 ++ "\n" 164 ++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n", 165 commandDescription = Just $ \pname -> 166 let 167 commands' = commands ++ [commandAddAction helpCommandUI undefined] 168 cmdDescs = getNormalCommandDescriptions commands' 169 -- if new commands are added, we want them to appear even if they 170 -- are not included in the custom listing below. Thus, we calculate 171 -- the `otherCmds` list and append it under the `other` category. 172 -- Alternatively, a new testcase could be added that ensures that 173 -- the set of commands listed here is equal to the set of commands 174 -- that are actually available. 175 otherCmds = deleteFirstsBy (==) (map fst cmdDescs) 176 [ "help" 177 , "update" 178 , "install" 179 , "fetch" 180 , "list" 181 , "info" 182 , "user-config" 183 , "get" 184 , "init" 185 , "configure" 186 , "build" 187 , "clean" 188 , "run" 189 , "repl" 190 , "test" 191 , "bench" 192 , "check" 193 , "sdist" 194 , "upload" 195 , "report" 196 , "freeze" 197 , "gen-bounds" 198 , "outdated" 199 , "haddock" 200 , "hscolour" 201 , "exec" 202 , "new-build" 203 , "new-configure" 204 , "new-repl" 205 , "new-freeze" 206 , "new-run" 207 , "new-test" 208 , "new-bench" 209 , "new-haddock" 210 , "new-exec" 211 , "new-update" 212 , "new-install" 213 , "new-clean" 214 , "new-sdist" 215 -- v1 commands, stateful style 216 , "v1-build" 217 , "v1-configure" 218 , "v1-repl" 219 , "v1-freeze" 220 , "v1-run" 221 , "v1-test" 222 , "v1-bench" 223 , "v1-haddock" 224 , "v1-exec" 225 , "v1-update" 226 , "v1-install" 227 , "v1-clean" 228 , "v1-sdist" 229 , "v1-doctest" 230 , "v1-copy" 231 , "v1-register" 232 , "v1-reconfigure" 233 , "v1-sandbox" 234 -- v2 commands, nix-style 235 , "v2-build" 236 , "v2-configure" 237 , "v2-repl" 238 , "v2-freeze" 239 , "v2-run" 240 , "v2-test" 241 , "v2-bench" 242 , "v2-haddock" 243 , "v2-exec" 244 , "v2-update" 245 , "v2-install" 246 , "v2-clean" 247 , "v2-sdist" 248 ] 249 maxlen = maximum $ [length name | (name, _) <- cmdDescs] 250 align str = str ++ replicate (maxlen - length str) ' ' 251 startGroup n = " ["++n++"]" 252 par = "" 253 addCmd n = case lookup n cmdDescs of 254 Nothing -> "" 255 Just d -> " " ++ align n ++ " " ++ d 256 in 257 "Commands:\n" 258 ++ unlines ( 259 [ startGroup "global" 260 , addCmd "update" 261 , addCmd "install" 262 , par 263 , addCmd "help" 264 , addCmd "info" 265 , addCmd "list" 266 , addCmd "fetch" 267 , addCmd "user-config" 268 , par 269 , startGroup "package" 270 , addCmd "get" 271 , addCmd "init" 272 , par 273 , addCmd "configure" 274 , addCmd "build" 275 , addCmd "clean" 276 , par 277 , addCmd "run" 278 , addCmd "repl" 279 , addCmd "test" 280 , addCmd "bench" 281 , par 282 , addCmd "check" 283 , addCmd "sdist" 284 , addCmd "upload" 285 , addCmd "report" 286 , par 287 , addCmd "freeze" 288 , addCmd "gen-bounds" 289 , addCmd "outdated" 290 , addCmd "haddock" 291 , addCmd "hscolour" 292 , addCmd "exec" 293 , par 294 , startGroup "new-style projects (beta)" 295 , addCmd "new-build" 296 , addCmd "new-configure" 297 , addCmd "new-repl" 298 , addCmd "new-run" 299 , addCmd "new-test" 300 , addCmd "new-bench" 301 , addCmd "new-freeze" 302 , addCmd "new-haddock" 303 , addCmd "new-exec" 304 , addCmd "new-update" 305 , addCmd "new-install" 306 , addCmd "new-clean" 307 , addCmd "new-sdist" 308 , par 309 , startGroup "new-style projects (forwards-compatible aliases)" 310 , addCmd "v2-build" 311 , addCmd "v2-configure" 312 , addCmd "v2-repl" 313 , addCmd "v2-run" 314 , addCmd "v2-test" 315 , addCmd "v2-bench" 316 , addCmd "v2-freeze" 317 , addCmd "v2-haddock" 318 , addCmd "v2-exec" 319 , addCmd "v2-update" 320 , addCmd "v2-install" 321 , addCmd "v2-clean" 322 , addCmd "v2-sdist" 323 , par 324 , startGroup "legacy command aliases" 325 , addCmd "v1-build" 326 , addCmd "v1-configure" 327 , addCmd "v1-repl" 328 , addCmd "v1-run" 329 , addCmd "v1-test" 330 , addCmd "v1-bench" 331 , addCmd "v1-freeze" 332 , addCmd "v1-haddock" 333 , addCmd "v1-exec" 334 , addCmd "v1-update" 335 , addCmd "v1-install" 336 , addCmd "v1-clean" 337 , addCmd "v1-sdist" 338 , addCmd "v1-doctest" 339 , addCmd "v1-copy" 340 , addCmd "v1-register" 341 , addCmd "v1-reconfigure" 342 , addCmd "v1-sandbox" 343 ] ++ if null otherCmds then [] else par 344 :startGroup "other" 345 :[addCmd n | n <- otherCmds]) 346 ++ "\n" 347 ++ "For more information about a command use:\n" 348 ++ " " ++ pname ++ " COMMAND --help\n" 349 ++ "or " ++ pname ++ " help COMMAND\n" 350 ++ "\n" 351 ++ "To install Cabal packages from hackage use:\n" 352 ++ " " ++ pname ++ " install foo [--dry-run]\n" 353 ++ "\n" 354 ++ "Occasionally you need to update the list of available packages:\n" 355 ++ " " ++ pname ++ " update\n", 356 commandNotes = Nothing, 357 commandDefaultFlags = mempty, 358 commandOptions = args 359 } 360 where 361 args :: ShowOrParseArgs -> [OptionField GlobalFlags] 362 args ShowArgs = argsShown 363 args ParseArgs = argsShown ++ argsNotShown 364 365 -- arguments we want to show in the help 366 argsShown :: [OptionField GlobalFlags] 367 argsShown = [ 368 option ['V'] ["version"] 369 "Print version information" 370 globalVersion (\v flags -> flags { globalVersion = v }) 371 trueArg 372 373 ,option [] ["numeric-version"] 374 "Print just the version number" 375 globalNumericVersion (\v flags -> flags { globalNumericVersion = v }) 376 trueArg 377 378 ,option [] ["config-file"] 379 "Set an alternate location for the config file" 380 globalConfigFile (\v flags -> flags { globalConfigFile = v }) 381 (reqArgFlag "FILE") 382 383 ,option [] ["sandbox-config-file"] 384 "Set an alternate location for the sandbox config file (default: './cabal.sandbox.config')" 385 globalSandboxConfigFile (\v flags -> flags { globalSandboxConfigFile = v }) 386 (reqArgFlag "FILE") 387 388 ,option [] ["default-user-config"] 389 "Set a location for a cabal.config file for projects without their own cabal.config freeze file." 390 globalConstraintsFile (\v flags -> flags {globalConstraintsFile = v}) 391 (reqArgFlag "FILE") 392 393 ,option [] ["require-sandbox"] 394 "requiring the presence of a sandbox for sandbox-aware commands" 395 globalRequireSandbox (\v flags -> flags { globalRequireSandbox = v }) 396 (boolOpt' ([], ["require-sandbox"]) ([], ["no-require-sandbox"])) 397 398 ,option [] ["ignore-sandbox"] 399 "Ignore any existing sandbox" 400 globalIgnoreSandbox (\v flags -> flags { globalIgnoreSandbox = v }) 401 trueArg 402 403 ,option [] ["ignore-expiry"] 404 "Ignore expiry dates on signed metadata (use only in exceptional circumstances)" 405 globalIgnoreExpiry (\v flags -> flags { globalIgnoreExpiry = v }) 406 trueArg 407 408 ,option [] ["http-transport"] 409 "Set a transport for http(s) requests. Accepts 'curl', 'wget', 'powershell', and 'plain-http'. (default: 'curl')" 410 globalHttpTransport (\v flags -> flags { globalHttpTransport = v }) 411 (reqArgFlag "HttpTransport") 412 ,option [] ["nix"] 413 "Nix integration: run commands through nix-shell if a 'shell.nix' file exists" 414 globalNix (\v flags -> flags { globalNix = v }) 415 (boolOpt [] []) 416 ] 417 418 -- arguments we don't want shown in the help 419 argsNotShown :: [OptionField GlobalFlags] 420 argsNotShown = [ 421 option [] ["remote-repo"] 422 "The name and url for a remote repository" 423 globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v }) 424 (reqArg' "NAME:URL" (toNubList . maybeToList . readRemoteRepo) (map showRemoteRepo . fromNubList)) 425 426 ,option [] ["local-no-index-repo"] 427 "The name and a path for a local no-index repository" 428 globalLocalNoIndexRepos (\v flags -> flags { globalLocalNoIndexRepos = v }) 429 (reqArg' "NAME:PATH" (toNubList . maybeToList . readLocalRepo) (map showLocalRepo . fromNubList)) 430 431 ,option [] ["remote-repo-cache"] 432 "The location where downloads from all remote repos are cached" 433 globalCacheDir (\v flags -> flags { globalCacheDir = v }) 434 (reqArgFlag "DIR") 435 436 ,option [] ["local-repo"] 437 "The location of a local repository" 438 globalLocalRepos (\v flags -> flags { globalLocalRepos = v }) 439 (reqArg' "DIR" (\x -> toNubList [x]) fromNubList) 440 441 ,option [] ["logs-dir", "logsdir"] 442 "The location to put log files" 443 globalLogsDir (\v flags -> flags { globalLogsDir = v }) 444 (reqArgFlag "DIR") 445 446 ,option [] ["world-file"] 447 "The location of the world file" 448 globalWorldFile (\v flags -> flags { globalWorldFile = v }) 449 (reqArgFlag "FILE") 450 451 ,option [] ["store-dir", "storedir"] 452 "The location of the nix-local-build store" 453 globalStoreDir (\v flags -> flags { globalStoreDir = v }) 454 (reqArgFlag "DIR") 455 ] 456 457-- ------------------------------------------------------------ 458-- * Config flags 459-- ------------------------------------------------------------ 460 461configureCommand :: CommandUI ConfigFlags 462configureCommand = c 463 { commandName = "configure" 464 , commandDefaultFlags = mempty 465 , commandDescription = Just $ \_ -> wrapText $ 466 "Configure how the package is built by setting " 467 ++ "package (and other) flags.\n" 468 ++ "\n" 469 ++ "The configuration affects several other commands, " 470 ++ "including v1-build, v1-test, v1-bench, v1-run, v1-repl.\n" 471 , commandUsage = \pname -> 472 "Usage: " ++ pname ++ " v1-configure [FLAGS]\n" 473 , commandNotes = Just $ \pname -> 474 (Cabal.programFlagsDescription defaultProgramDb ++ "\n") 475 ++ "Examples:\n" 476 ++ " " ++ pname ++ " v1-configure\n" 477 ++ " Configure with defaults;\n" 478 ++ " " ++ pname ++ " v1-configure --enable-tests -fcustomflag\n" 479 ++ " Configure building package including tests,\n" 480 ++ " with some package-specific flag.\n" 481 } 482 where 483 c = Cabal.configureCommand defaultProgramDb 484 485configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags] 486configureOptions = commandOptions configureCommand 487 488-- | Given some 'ConfigFlags' for the version of Cabal that 489-- cabal-install was built with, and a target older 'Version' of 490-- Cabal that we want to pass these flags to, convert the 491-- flags into a form that will be accepted by the older 492-- Setup script. Generally speaking, this just means filtering 493-- out flags that the old Cabal library doesn't understand, but 494-- in some cases it may also mean "emulating" a feature using 495-- some more legacy flags. 496filterConfigureFlags :: ConfigFlags -> Version -> ConfigFlags 497filterConfigureFlags flags cabalLibVersion 498 -- NB: we expect the latest version to be the most common case, 499 -- so test it first. 500 | cabalLibVersion >= mkVersion [2,5,0] = flags_latest 501 -- The naming convention is that flags_version gives flags with 502 -- all flags *introduced* in version eliminated. 503 -- It is NOT the latest version of Cabal library that 504 -- these flags work for; version of introduction is a more 505 -- natural metric. 506 | cabalLibVersion < mkVersion [1,3,10] = flags_1_3_10 507 | cabalLibVersion < mkVersion [1,10,0] = flags_1_10_0 508 | cabalLibVersion < mkVersion [1,12,0] = flags_1_12_0 509 | cabalLibVersion < mkVersion [1,14,0] = flags_1_14_0 510 | cabalLibVersion < mkVersion [1,18,0] = flags_1_18_0 511 | cabalLibVersion < mkVersion [1,19,1] = flags_1_19_1 512 | cabalLibVersion < mkVersion [1,19,2] = flags_1_19_2 513 | cabalLibVersion < mkVersion [1,21,1] = flags_1_21_1 514 | cabalLibVersion < mkVersion [1,22,0] = flags_1_22_0 515 | cabalLibVersion < mkVersion [1,22,1] = flags_1_22_1 516 | cabalLibVersion < mkVersion [1,23,0] = flags_1_23_0 517 | cabalLibVersion < mkVersion [1,25,0] = flags_1_25_0 518 | cabalLibVersion < mkVersion [2,1,0] = flags_2_1_0 519 | cabalLibVersion < mkVersion [2,5,0] = flags_2_5_0 520 | otherwise = error "the impossible just happened" -- see first guard 521 where 522 flags_latest = flags { 523 -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. 524 -- Note: this is not in the wrong place. configConstraints gets 525 -- repopulated in flags_1_19_1 but it needs to be set to empty for 526 -- newer versions first. 527 configConstraints = [] 528 } 529 530 flags_2_5_0 = flags_latest { 531 -- Cabal < 2.5 does not understand --dependency=pkg:component=cid 532 -- (public sublibraries), so we convert it to the legacy 533 -- --dependency=pkg_or_internal_compoent=cid 534 configDependencies = 535 let convertToLegacyInternalDep (GivenComponent _ (LSubLibName cn) cid) = 536 Just $ GivenComponent 537 (unqualComponentNameToPackageName cn) 538 LMainLibName 539 cid 540 convertToLegacyInternalDep (GivenComponent pn LMainLibName cid) = 541 Just $ GivenComponent pn LMainLibName cid 542 in catMaybes $ convertToLegacyInternalDep <$> configDependencies flags 543 -- Cabal < 2.5 doesn't know about '--allow-depending-on-private-libs'. 544 , configAllowDependingOnPrivateLibs = NoFlag 545 -- Cabal < 2.5 doesn't know about '--enable/disable-executable-static'. 546 , configFullyStaticExe = NoFlag 547 } 548 549 flags_2_1_0 = flags_2_5_0 { 550 -- Cabal < 2.1 doesn't know about -v +timestamp modifier 551 configVerbosity = fmap verboseNoTimestamp (configVerbosity flags_latest) 552 -- Cabal < 2.1 doesn't know about --<enable|disable>-static 553 , configStaticLib = NoFlag 554 , configSplitSections = NoFlag 555 } 556 557 flags_1_25_0 = flags_2_1_0 { 558 -- Cabal < 1.25.0 doesn't know about --dynlibdir. 559 configInstallDirs = configInstallDirs_1_25_0, 560 -- Cabal < 1.25 doesn't have extended verbosity syntax 561 configVerbosity = fmap verboseNoFlags (configVerbosity flags_2_1_0), 562 -- Cabal < 1.25 doesn't support --deterministic 563 configDeterministic = mempty 564 } 565 configInstallDirs_1_25_0 = let dirs = configInstallDirs flags in 566 dirs { dynlibdir = NoFlag 567 , libexecsubdir = NoFlag 568 , libexecdir = maybeToFlag $ 569 combinePathTemplate <$> flagToMaybe (libexecdir dirs) 570 <*> flagToMaybe (libexecsubdir dirs) 571 } 572 -- Cabal < 1.23 doesn't know about '--profiling-detail'. 573 -- Cabal < 1.23 has a hacked up version of 'enable-profiling' 574 -- which we shouldn't use. 575 (tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling flags 576 flags_1_23_0 = flags_1_25_0 { configProfDetail = NoFlag 577 , configProfLibDetail = NoFlag 578 , configIPID = NoFlag 579 , configProf = NoFlag 580 , configProfExe = Flag tryExeProfiling 581 , configProfLib = Flag tryLibProfiling 582 } 583 584 -- Cabal == 1.22.0.* had a discontinuity (see #5946 or e9a8d48a3adce34d) 585 -- due to temporary amnesia of the --*-executable-profiling flags 586 flags_1_22_1 = flags_1_23_0 { configDebugInfo = NoFlag 587 , configProfExe = NoFlag 588 } 589 590 -- Cabal < 1.22 doesn't know about '--disable-debug-info'. 591 flags_1_22_0 = flags_1_23_0 { configDebugInfo = NoFlag } 592 593 -- Cabal < 1.21.1 doesn't know about 'disable-relocatable' 594 -- Cabal < 1.21.1 doesn't know about 'enable-profiling' 595 -- (but we already dealt with it in flags_1_23_0) 596 flags_1_21_1 = 597 flags_1_22_0 { configRelocatable = NoFlag 598 , configCoverage = NoFlag 599 , configLibCoverage = configCoverage flags 600 } 601 -- Cabal < 1.19.2 doesn't know about '--exact-configuration' and 602 -- '--enable-library-stripping'. 603 flags_1_19_2 = flags_1_21_1 { configExactConfiguration = NoFlag 604 , configStripLibs = NoFlag } 605 -- Cabal < 1.19.1 uses '--constraint' instead of '--dependency'. 606 flags_1_19_1 = flags_1_19_2 { configDependencies = [] 607 , configConstraints = configConstraints flags } 608 -- Cabal < 1.18.0 doesn't know about --extra-prog-path and --sysconfdir. 609 flags_1_18_0 = flags_1_19_1 { configProgramPathExtra = toNubList [] 610 , configInstallDirs = configInstallDirs_1_18_0} 611 configInstallDirs_1_18_0 = (configInstallDirs flags_1_19_1) { sysconfdir = NoFlag } 612 -- Cabal < 1.14.0 doesn't know about '--disable-benchmarks'. 613 flags_1_14_0 = flags_1_18_0 { configBenchmarks = NoFlag } 614 -- Cabal < 1.12.0 doesn't know about '--enable/disable-executable-dynamic' 615 -- and '--enable/disable-library-coverage'. 616 flags_1_12_0 = flags_1_14_0 { configLibCoverage = NoFlag 617 , configDynExe = NoFlag } 618 -- Cabal < 1.10.0 doesn't know about '--disable-tests'. 619 flags_1_10_0 = flags_1_12_0 { configTests = NoFlag } 620 -- Cabal < 1.3.10 does not grok the '--constraints' flag. 621 flags_1_3_10 = flags_1_10_0 { configConstraints = [] } 622 623-- | Get the package database settings from 'ConfigFlags', accounting for 624-- @--package-db@ and @--user@ flags. 625configPackageDB' :: ConfigFlags -> PackageDBStack 626configPackageDB' cfg = 627 interpretPackageDbFlags userInstall (configPackageDBs cfg) 628 where 629 userInstall = Cabal.fromFlagOrDefault True (configUserInstall cfg) 630 631-- | Configure the compiler, but reduce verbosity during this step. 632configCompilerAux' :: ConfigFlags -> IO (Compiler, Platform, ProgramDb) 633configCompilerAux' configFlags = 634 configCompilerAuxEx configFlags 635 --FIXME: make configCompilerAux use a sensible verbosity 636 { configVerbosity = fmap lessVerbose (configVerbosity configFlags) } 637 638-- ------------------------------------------------------------ 639-- * Config extra flags 640-- ------------------------------------------------------------ 641 642-- | cabal configure takes some extra flags beyond runghc Setup configure 643-- 644data ConfigExFlags = ConfigExFlags { 645 configCabalVersion :: Flag Version, 646 configExConstraints :: [(UserConstraint, ConstraintSource)], 647 configPreferences :: [PackageVersionConstraint], 648 configSolver :: Flag PreSolver, 649 configAllowNewer :: Maybe AllowNewer, 650 configAllowOlder :: Maybe AllowOlder, 651 configWriteGhcEnvironmentFilesPolicy 652 :: Flag WriteGhcEnvironmentFilesPolicy 653 } 654 deriving (Eq, Generic) 655 656defaultConfigExFlags :: ConfigExFlags 657defaultConfigExFlags = mempty { configSolver = Flag defaultSolver } 658 659configureExCommand :: CommandUI (ConfigFlags, ConfigExFlags) 660configureExCommand = configureCommand { 661 commandDefaultFlags = (mempty, defaultConfigExFlags), 662 commandOptions = \showOrParseArgs -> 663 liftOptions fst setFst 664 (filter ((`notElem` ["constraint", "dependency", "exact-configuration"]) 665 . optionName) $ configureOptions showOrParseArgs) 666 ++ liftOptions snd setSnd 667 (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag) 668 } 669 where 670 setFst a (_,b) = (a,b) 671 setSnd b (a,_) = (a,b) 672 673configureExOptions :: ShowOrParseArgs 674 -> ConstraintSource 675 -> [OptionField ConfigExFlags] 676configureExOptions _showOrParseArgs src = 677 [ option [] ["cabal-lib-version"] 678 ("Select which version of the Cabal lib to use to build packages " 679 ++ "(useful for testing).") 680 configCabalVersion (\v flags -> flags { configCabalVersion = v }) 681 (reqArg "VERSION" (readP_to_E ("Cannot parse cabal lib version: "++) 682 (fmap toFlag parse)) 683 (map display . flagToList)) 684 , option [] ["constraint"] 685 "Specify constraints on a package (version, installed/source, flags)" 686 configExConstraints (\v flags -> flags { configExConstraints = v }) 687 (reqArg "CONSTRAINT" 688 ((\x -> [(x, src)]) `fmap` ReadE readUserConstraint) 689 (map $ display . fst)) 690 691 , option [] ["preference"] 692 "Specify preferences (soft constraints) on the version of a package" 693 configPreferences (\v flags -> flags { configPreferences = v }) 694 (reqArg "CONSTRAINT" 695 (readP_to_E (const "dependency expected") 696 (fmap (\x -> [x]) parse)) 697 (map display)) 698 699 , optionSolver configSolver (\v flags -> flags { configSolver = v }) 700 701 , option [] ["allow-older"] 702 ("Ignore lower bounds in all dependencies or DEPS") 703 (fmap unAllowOlder . configAllowOlder) 704 (\v flags -> flags { configAllowOlder = fmap AllowOlder v}) 705 (optArg "DEPS" 706 (readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser) 707 (Just RelaxDepsAll) relaxDepsPrinter) 708 709 , option [] ["allow-newer"] 710 ("Ignore upper bounds in all dependencies or DEPS") 711 (fmap unAllowNewer . configAllowNewer) 712 (\v flags -> flags { configAllowNewer = fmap AllowNewer v}) 713 (optArg "DEPS" 714 (readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser) 715 (Just RelaxDepsAll) relaxDepsPrinter) 716 717 , option [] ["write-ghc-environment-files"] 718 ("Whether to create a .ghc.environment file after a successful build" 719 ++ " (v2-build only)") 720 configWriteGhcEnvironmentFilesPolicy 721 (\v flags -> flags { configWriteGhcEnvironmentFilesPolicy = v}) 722 (reqArg "always|never|ghc8.4.4+" 723 writeGhcEnvironmentFilesPolicyParser 724 writeGhcEnvironmentFilesPolicyPrinter) 725 ] 726 727 728writeGhcEnvironmentFilesPolicyParser :: ReadE (Flag WriteGhcEnvironmentFilesPolicy) 729writeGhcEnvironmentFilesPolicyParser = ReadE $ \case 730 "always" -> Right $ Flag AlwaysWriteGhcEnvironmentFiles 731 "never" -> Right $ Flag NeverWriteGhcEnvironmentFiles 732 "ghc8.4.4+" -> Right $ Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer 733 policy -> Left $ "Cannot parse the GHC environment file write policy '" 734 <> policy <> "'" 735 736writeGhcEnvironmentFilesPolicyPrinter 737 :: Flag WriteGhcEnvironmentFilesPolicy -> [String] 738writeGhcEnvironmentFilesPolicyPrinter = \case 739 (Flag AlwaysWriteGhcEnvironmentFiles) -> ["always"] 740 (Flag NeverWriteGhcEnvironmentFiles) -> ["never"] 741 (Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer) -> ["ghc8.4.4+"] 742 NoFlag -> [] 743 744 745relaxDepsParser :: Parse.ReadP r (Maybe RelaxDeps) 746relaxDepsParser = 747 (Just . RelaxDepsSome) `fmap` Parse.sepBy1 parse (Parse.char ',') 748 749relaxDepsPrinter :: (Maybe RelaxDeps) -> [Maybe String] 750relaxDepsPrinter Nothing = [] 751relaxDepsPrinter (Just RelaxDepsAll) = [Nothing] 752relaxDepsPrinter (Just (RelaxDepsSome pkgs)) = map (Just . display) $ pkgs 753 754 755instance Monoid ConfigExFlags where 756 mempty = gmempty 757 mappend = (<>) 758 759instance Semigroup ConfigExFlags where 760 (<>) = gmappend 761 762reconfigureCommand :: CommandUI (ConfigFlags, ConfigExFlags) 763reconfigureCommand 764 = configureExCommand 765 { commandName = "reconfigure" 766 , commandSynopsis = "Reconfigure the package if necessary." 767 , commandDescription = Just $ \pname -> wrapText $ 768 "Run `configure` with the most recently used flags, or append FLAGS " 769 ++ "to the most recently used configuration. " 770 ++ "Accepts the same flags as `" ++ pname ++ " v1-configure'. " 771 ++ "If the package has never been configured, the default flags are " 772 ++ "used." 773 , commandNotes = Just $ \pname -> 774 "Examples:\n" 775 ++ " " ++ pname ++ " v1-reconfigure\n" 776 ++ " Configure with the most recently used flags.\n" 777 ++ " " ++ pname ++ " v1-reconfigure -w PATH\n" 778 ++ " Reconfigure with the most recently used flags,\n" 779 ++ " but use the compiler at PATH.\n\n" 780 , commandUsage = usageAlternatives "v1-reconfigure" [ "[FLAGS]" ] 781 , commandDefaultFlags = mempty 782 } 783 784-- ------------------------------------------------------------ 785-- * Build flags 786-- ------------------------------------------------------------ 787 788data SkipAddSourceDepsCheck = 789 SkipAddSourceDepsCheck | DontSkipAddSourceDepsCheck 790 deriving Eq 791 792data BuildExFlags = BuildExFlags { 793 buildOnly :: Flag SkipAddSourceDepsCheck 794} deriving Generic 795 796buildExOptions :: ShowOrParseArgs -> [OptionField BuildExFlags] 797buildExOptions _showOrParseArgs = 798 option [] ["only"] 799 "Don't reinstall add-source dependencies (sandbox-only)" 800 buildOnly (\v flags -> flags { buildOnly = v }) 801 (noArg (Flag SkipAddSourceDepsCheck)) 802 803 : [] 804 805buildCommand :: CommandUI (BuildFlags, BuildExFlags) 806buildCommand = parent { 807 commandName = "build", 808 commandDescription = Just $ \_ -> wrapText $ 809 "Components encompass executables, tests, and benchmarks.\n" 810 ++ "\n" 811 ++ "Affected by configuration options, see `v1-configure`.\n", 812 commandDefaultFlags = (commandDefaultFlags parent, mempty), 813 commandUsage = usageAlternatives "v1-build" $ 814 [ "[FLAGS]", "COMPONENTS [FLAGS]" ], 815 commandOptions = 816 \showOrParseArgs -> liftOptions fst setFst 817 (commandOptions parent showOrParseArgs) 818 ++ 819 liftOptions snd setSnd (buildExOptions showOrParseArgs) 820 , commandNotes = Just $ \pname -> 821 "Examples:\n" 822 ++ " " ++ pname ++ " v1-build " 823 ++ " All the components in the package\n" 824 ++ " " ++ pname ++ " v1-build foo " 825 ++ " A component (i.e. lib, exe, test suite)\n\n" 826 ++ Cabal.programFlagsDescription defaultProgramDb 827 } 828 where 829 setFst a (_,b) = (a,b) 830 setSnd b (a,_) = (a,b) 831 832 parent = Cabal.buildCommand defaultProgramDb 833 834instance Monoid BuildExFlags where 835 mempty = gmempty 836 mappend = (<>) 837 838instance Semigroup BuildExFlags where 839 (<>) = gmappend 840 841-- ------------------------------------------------------------ 842-- * Test flags 843-- ------------------------------------------------------------ 844 845-- | Given some 'TestFlags' for the version of Cabal that 846-- cabal-install was built with, and a target older 'Version' of 847-- Cabal that we want to pass these flags to, convert the 848-- flags into a form that will be accepted by the older 849-- Setup script. Generally speaking, this just means filtering 850-- out flags that the old Cabal library doesn't understand, but 851-- in some cases it may also mean "emulating" a feature using 852-- some more legacy flags. 853filterTestFlags :: TestFlags -> Version -> TestFlags 854filterTestFlags flags cabalLibVersion 855 -- NB: we expect the latest version to be the most common case, 856 -- so test it first. 857 | cabalLibVersion >= mkVersion [3,0,0] = flags_latest 858 -- The naming convention is that flags_version gives flags with 859 -- all flags *introduced* in version eliminated. 860 -- It is NOT the latest version of Cabal library that 861 -- these flags work for; version of introduction is a more 862 -- natural metric. 863 | cabalLibVersion < mkVersion [3,0,0] = flags_3_0_0 864 | otherwise = error "the impossible just happened" -- see first guard 865 where 866 flags_latest = flags 867 flags_3_0_0 = flags_latest { 868 -- Cabal < 3.0 doesn't know about --test-wrapper 869 Cabal.testWrapper = NoFlag 870 } 871 872-- ------------------------------------------------------------ 873-- * Repl command 874-- ------------------------------------------------------------ 875 876replCommand :: CommandUI (ReplFlags, BuildExFlags) 877replCommand = parent { 878 commandName = "repl", 879 commandDescription = Just $ \pname -> wrapText $ 880 "If the current directory contains no package, ignores COMPONENT " 881 ++ "parameters and opens an interactive interpreter session; if a " 882 ++ "sandbox is present, its package database will be used.\n" 883 ++ "\n" 884 ++ "Otherwise, (re)configures with the given or default flags, and " 885 ++ "loads the interpreter with the relevant modules. For executables, " 886 ++ "tests and benchmarks, loads the main module (and its " 887 ++ "dependencies); for libraries all exposed/other modules.\n" 888 ++ "\n" 889 ++ "The default component is the library itself, or the executable " 890 ++ "if that is the only component.\n" 891 ++ "\n" 892 ++ "Support for loading specific modules is planned but not " 893 ++ "implemented yet. For certain scenarios, `" ++ pname 894 ++ " v1-exec -- ghci :l Foo` may be used instead. Note that `v1-exec` will " 895 ++ "not (re)configure and you will have to specify the location of " 896 ++ "other modules, if required.\n", 897 commandUsage = \pname -> "Usage: " ++ pname ++ " v1-repl [COMPONENT] [FLAGS]\n", 898 commandDefaultFlags = (commandDefaultFlags parent, mempty), 899 commandOptions = 900 \showOrParseArgs -> liftOptions fst setFst 901 (commandOptions parent showOrParseArgs) 902 ++ 903 liftOptions snd setSnd (buildExOptions showOrParseArgs), 904 commandNotes = Just $ \pname -> 905 "Examples:\n" 906 ++ " " ++ pname ++ " v1-repl " 907 ++ " The first component in the package\n" 908 ++ " " ++ pname ++ " v1-repl foo " 909 ++ " A named component (i.e. lib, exe, test suite)\n" 910 ++ " " ++ pname ++ " v1-repl --ghc-options=\"-lstdc++\"" 911 ++ " Specifying flags for interpreter\n" 912 } 913 where 914 setFst a (_,b) = (a,b) 915 setSnd b (a,_) = (a,b) 916 917 parent = Cabal.replCommand defaultProgramDb 918 919-- ------------------------------------------------------------ 920-- * Test command 921-- ------------------------------------------------------------ 922 923testCommand :: CommandUI (TestFlags, BuildFlags, BuildExFlags) 924testCommand = parent { 925 commandName = "test", 926 commandDescription = Just $ \pname -> wrapText $ 927 "If necessary (re)configures with `--enable-tests` flag and builds" 928 ++ " the test suite.\n" 929 ++ "\n" 930 ++ "Remember that the tests' dependencies must be installed if there" 931 ++ " are additional ones; e.g. with `" ++ pname 932 ++ " v1-install --only-dependencies --enable-tests`.\n" 933 ++ "\n" 934 ++ "By defining UserHooks in a custom Setup.hs, the package can" 935 ++ " define actions to be executed before and after running tests.\n", 936 commandUsage = usageAlternatives "v1-test" 937 [ "[FLAGS]", "TESTCOMPONENTS [FLAGS]" ], 938 commandDefaultFlags = (commandDefaultFlags parent, 939 Cabal.defaultBuildFlags, mempty), 940 commandOptions = 941 \showOrParseArgs -> liftOptions get1 set1 942 (commandOptions parent showOrParseArgs) 943 ++ 944 liftOptions get2 set2 945 (Cabal.buildOptions progDb showOrParseArgs) 946 ++ 947 liftOptions get3 set3 (buildExOptions showOrParseArgs) 948 } 949 where 950 get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c) 951 get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c) 952 get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c) 953 954 parent = Cabal.testCommand 955 progDb = defaultProgramDb 956 957-- ------------------------------------------------------------ 958-- * Bench command 959-- ------------------------------------------------------------ 960 961benchmarkCommand :: CommandUI (BenchmarkFlags, BuildFlags, BuildExFlags) 962benchmarkCommand = parent { 963 commandName = "bench", 964 commandUsage = usageAlternatives "v1-bench" 965 [ "[FLAGS]", "BENCHCOMPONENTS [FLAGS]" ], 966 commandDescription = Just $ \pname -> wrapText $ 967 "If necessary (re)configures with `--enable-benchmarks` flag and" 968 ++ " builds the benchmarks.\n" 969 ++ "\n" 970 ++ "Remember that the benchmarks' dependencies must be installed if" 971 ++ " there are additional ones; e.g. with `" ++ pname 972 ++ " v1-install --only-dependencies --enable-benchmarks`.\n" 973 ++ "\n" 974 ++ "By defining UserHooks in a custom Setup.hs, the package can" 975 ++ " define actions to be executed before and after running" 976 ++ " benchmarks.\n", 977 commandDefaultFlags = (commandDefaultFlags parent, 978 Cabal.defaultBuildFlags, mempty), 979 commandOptions = 980 \showOrParseArgs -> liftOptions get1 set1 981 (commandOptions parent showOrParseArgs) 982 ++ 983 liftOptions get2 set2 984 (Cabal.buildOptions progDb showOrParseArgs) 985 ++ 986 liftOptions get3 set3 (buildExOptions showOrParseArgs) 987 } 988 where 989 get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c) 990 get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c) 991 get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c) 992 993 parent = Cabal.benchmarkCommand 994 progDb = defaultProgramDb 995 996-- ------------------------------------------------------------ 997-- * Fetch command 998-- ------------------------------------------------------------ 999 1000data FetchFlags = FetchFlags { 1001-- fetchOutput :: Flag FilePath, 1002 fetchDeps :: Flag Bool, 1003 fetchDryRun :: Flag Bool, 1004 fetchSolver :: Flag PreSolver, 1005 fetchMaxBackjumps :: Flag Int, 1006 fetchReorderGoals :: Flag ReorderGoals, 1007 fetchCountConflicts :: Flag CountConflicts, 1008 fetchFineGrainedConflicts :: Flag FineGrainedConflicts, 1009 fetchMinimizeConflictSet :: Flag MinimizeConflictSet, 1010 fetchIndependentGoals :: Flag IndependentGoals, 1011 fetchShadowPkgs :: Flag ShadowPkgs, 1012 fetchStrongFlags :: Flag StrongFlags, 1013 fetchAllowBootLibInstalls :: Flag AllowBootLibInstalls, 1014 fetchOnlyConstrained :: Flag OnlyConstrained, 1015 fetchTests :: Flag Bool, 1016 fetchBenchmarks :: Flag Bool, 1017 fetchVerbosity :: Flag Verbosity 1018 } 1019 1020defaultFetchFlags :: FetchFlags 1021defaultFetchFlags = FetchFlags { 1022-- fetchOutput = mempty, 1023 fetchDeps = toFlag True, 1024 fetchDryRun = toFlag False, 1025 fetchSolver = Flag defaultSolver, 1026 fetchMaxBackjumps = Flag defaultMaxBackjumps, 1027 fetchReorderGoals = Flag (ReorderGoals False), 1028 fetchCountConflicts = Flag (CountConflicts True), 1029 fetchFineGrainedConflicts = Flag (FineGrainedConflicts True), 1030 fetchMinimizeConflictSet = Flag (MinimizeConflictSet False), 1031 fetchIndependentGoals = Flag (IndependentGoals False), 1032 fetchShadowPkgs = Flag (ShadowPkgs False), 1033 fetchStrongFlags = Flag (StrongFlags False), 1034 fetchAllowBootLibInstalls = Flag (AllowBootLibInstalls False), 1035 fetchOnlyConstrained = Flag OnlyConstrainedNone, 1036 fetchTests = toFlag False, 1037 fetchBenchmarks = toFlag False, 1038 fetchVerbosity = toFlag normal 1039 } 1040 1041fetchCommand :: CommandUI FetchFlags 1042fetchCommand = CommandUI { 1043 commandName = "fetch", 1044 commandSynopsis = "Downloads packages for later installation.", 1045 commandUsage = usageAlternatives "fetch" [ "[FLAGS] PACKAGES" 1046 ], 1047 commandDescription = Just $ \_ -> 1048 "Note that it currently is not possible to fetch the dependencies for a\n" 1049 ++ "package in the current directory.\n", 1050 commandNotes = Nothing, 1051 commandDefaultFlags = defaultFetchFlags, 1052 commandOptions = \ showOrParseArgs -> [ 1053 optionVerbosity fetchVerbosity (\v flags -> flags { fetchVerbosity = v }) 1054 1055-- , option "o" ["output"] 1056-- "Put the package(s) somewhere specific rather than the usual cache." 1057-- fetchOutput (\v flags -> flags { fetchOutput = v }) 1058-- (reqArgFlag "PATH") 1059 1060 , option [] ["dependencies", "deps"] 1061 "Resolve and fetch dependencies (default)" 1062 fetchDeps (\v flags -> flags { fetchDeps = v }) 1063 trueArg 1064 1065 , option [] ["no-dependencies", "no-deps"] 1066 "Ignore dependencies" 1067 fetchDeps (\v flags -> flags { fetchDeps = v }) 1068 falseArg 1069 1070 , option [] ["dry-run"] 1071 "Do not install anything, only print what would be installed." 1072 fetchDryRun (\v flags -> flags { fetchDryRun = v }) 1073 trueArg 1074 1075 , option "" ["tests"] 1076 "dependency checking and compilation for test suites listed in the package description file." 1077 fetchTests (\v flags -> flags { fetchTests = v }) 1078 (boolOpt [] []) 1079 1080 , option "" ["benchmarks"] 1081 "dependency checking and compilation for benchmarks listed in the package description file." 1082 fetchBenchmarks (\v flags -> flags { fetchBenchmarks = v }) 1083 (boolOpt [] []) 1084 1085 ] ++ 1086 1087 optionSolver fetchSolver (\v flags -> flags { fetchSolver = v }) : 1088 optionSolverFlags showOrParseArgs 1089 fetchMaxBackjumps (\v flags -> flags { fetchMaxBackjumps = v }) 1090 fetchReorderGoals (\v flags -> flags { fetchReorderGoals = v }) 1091 fetchCountConflicts (\v flags -> flags { fetchCountConflicts = v }) 1092 fetchFineGrainedConflicts (\v flags -> flags { fetchFineGrainedConflicts = v }) 1093 fetchMinimizeConflictSet (\v flags -> flags { fetchMinimizeConflictSet = v }) 1094 fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v }) 1095 fetchShadowPkgs (\v flags -> flags { fetchShadowPkgs = v }) 1096 fetchStrongFlags (\v flags -> flags { fetchStrongFlags = v }) 1097 fetchAllowBootLibInstalls (\v flags -> flags { fetchAllowBootLibInstalls = v }) 1098 fetchOnlyConstrained (\v flags -> flags { fetchOnlyConstrained = v }) 1099 1100 } 1101 1102-- ------------------------------------------------------------ 1103-- * Freeze command 1104-- ------------------------------------------------------------ 1105 1106data FreezeFlags = FreezeFlags { 1107 freezeDryRun :: Flag Bool, 1108 freezeTests :: Flag Bool, 1109 freezeBenchmarks :: Flag Bool, 1110 freezeSolver :: Flag PreSolver, 1111 freezeMaxBackjumps :: Flag Int, 1112 freezeReorderGoals :: Flag ReorderGoals, 1113 freezeCountConflicts :: Flag CountConflicts, 1114 freezeFineGrainedConflicts :: Flag FineGrainedConflicts, 1115 freezeMinimizeConflictSet :: Flag MinimizeConflictSet, 1116 freezeIndependentGoals :: Flag IndependentGoals, 1117 freezeShadowPkgs :: Flag ShadowPkgs, 1118 freezeStrongFlags :: Flag StrongFlags, 1119 freezeAllowBootLibInstalls :: Flag AllowBootLibInstalls, 1120 freezeOnlyConstrained :: Flag OnlyConstrained, 1121 freezeVerbosity :: Flag Verbosity 1122 } 1123 1124defaultFreezeFlags :: FreezeFlags 1125defaultFreezeFlags = FreezeFlags { 1126 freezeDryRun = toFlag False, 1127 freezeTests = toFlag False, 1128 freezeBenchmarks = toFlag False, 1129 freezeSolver = Flag defaultSolver, 1130 freezeMaxBackjumps = Flag defaultMaxBackjumps, 1131 freezeReorderGoals = Flag (ReorderGoals False), 1132 freezeCountConflicts = Flag (CountConflicts True), 1133 freezeFineGrainedConflicts = Flag (FineGrainedConflicts True), 1134 freezeMinimizeConflictSet = Flag (MinimizeConflictSet False), 1135 freezeIndependentGoals = Flag (IndependentGoals False), 1136 freezeShadowPkgs = Flag (ShadowPkgs False), 1137 freezeStrongFlags = Flag (StrongFlags False), 1138 freezeAllowBootLibInstalls = Flag (AllowBootLibInstalls False), 1139 freezeOnlyConstrained = Flag OnlyConstrainedNone, 1140 freezeVerbosity = toFlag normal 1141 } 1142 1143freezeCommand :: CommandUI FreezeFlags 1144freezeCommand = CommandUI { 1145 commandName = "freeze", 1146 commandSynopsis = "Freeze dependencies.", 1147 commandDescription = Just $ \_ -> wrapText $ 1148 "Calculates a valid set of dependencies and their exact versions. " 1149 ++ "If successful, saves the result to the file `cabal.config`.\n" 1150 ++ "\n" 1151 ++ "The package versions specified in `cabal.config` will be used for " 1152 ++ "any future installs.\n" 1153 ++ "\n" 1154 ++ "An existing `cabal.config` is ignored and overwritten.\n", 1155 commandNotes = Nothing, 1156 commandUsage = usageFlags "freeze", 1157 commandDefaultFlags = defaultFreezeFlags, 1158 commandOptions = \ showOrParseArgs -> [ 1159 optionVerbosity freezeVerbosity 1160 (\v flags -> flags { freezeVerbosity = v }) 1161 1162 , option [] ["dry-run"] 1163 "Do not freeze anything, only print what would be frozen" 1164 freezeDryRun (\v flags -> flags { freezeDryRun = v }) 1165 trueArg 1166 1167 , option [] ["tests"] 1168 ("freezing of the dependencies of any tests suites " 1169 ++ "in the package description file.") 1170 freezeTests (\v flags -> flags { freezeTests = v }) 1171 (boolOpt [] []) 1172 1173 , option [] ["benchmarks"] 1174 ("freezing of the dependencies of any benchmarks suites " 1175 ++ "in the package description file.") 1176 freezeBenchmarks (\v flags -> flags { freezeBenchmarks = v }) 1177 (boolOpt [] []) 1178 1179 ] ++ 1180 1181 optionSolver 1182 freezeSolver (\v flags -> flags { freezeSolver = v }): 1183 optionSolverFlags showOrParseArgs 1184 freezeMaxBackjumps (\v flags -> flags { freezeMaxBackjumps = v }) 1185 freezeReorderGoals (\v flags -> flags { freezeReorderGoals = v }) 1186 freezeCountConflicts (\v flags -> flags { freezeCountConflicts = v }) 1187 freezeFineGrainedConflicts (\v flags -> flags { freezeFineGrainedConflicts = v }) 1188 freezeMinimizeConflictSet (\v flags -> flags { freezeMinimizeConflictSet = v }) 1189 freezeIndependentGoals (\v flags -> flags { freezeIndependentGoals = v }) 1190 freezeShadowPkgs (\v flags -> flags { freezeShadowPkgs = v }) 1191 freezeStrongFlags (\v flags -> flags { freezeStrongFlags = v }) 1192 freezeAllowBootLibInstalls (\v flags -> flags { freezeAllowBootLibInstalls = v }) 1193 freezeOnlyConstrained (\v flags -> flags { freezeOnlyConstrained = v }) 1194 1195 } 1196 1197-- ------------------------------------------------------------ 1198-- * 'gen-bounds' command 1199-- ------------------------------------------------------------ 1200 1201genBoundsCommand :: CommandUI FreezeFlags 1202genBoundsCommand = CommandUI { 1203 commandName = "gen-bounds", 1204 commandSynopsis = "Generate dependency bounds.", 1205 commandDescription = Just $ \_ -> wrapText $ 1206 "Generates bounds for all dependencies that do not currently have them. " 1207 ++ "Generated bounds are printed to stdout. " 1208 ++ "You can then paste them into your .cabal file.\n" 1209 ++ "\n", 1210 commandNotes = Nothing, 1211 commandUsage = usageFlags "gen-bounds", 1212 commandDefaultFlags = defaultFreezeFlags, 1213 commandOptions = \ _ -> [ 1214 optionVerbosity freezeVerbosity (\v flags -> flags { freezeVerbosity = v }) 1215 ] 1216 } 1217 1218-- ------------------------------------------------------------ 1219-- * 'outdated' command 1220-- ------------------------------------------------------------ 1221 1222data IgnoreMajorVersionBumps = IgnoreMajorVersionBumpsNone 1223 | IgnoreMajorVersionBumpsAll 1224 | IgnoreMajorVersionBumpsSome [PackageName] 1225 1226instance Monoid IgnoreMajorVersionBumps where 1227 mempty = IgnoreMajorVersionBumpsNone 1228 mappend = (<>) 1229 1230instance Semigroup IgnoreMajorVersionBumps where 1231 IgnoreMajorVersionBumpsNone <> r = r 1232 l@IgnoreMajorVersionBumpsAll <> _ = l 1233 l@(IgnoreMajorVersionBumpsSome _) <> IgnoreMajorVersionBumpsNone = l 1234 (IgnoreMajorVersionBumpsSome _) <> r@IgnoreMajorVersionBumpsAll = r 1235 (IgnoreMajorVersionBumpsSome a) <> (IgnoreMajorVersionBumpsSome b) = 1236 IgnoreMajorVersionBumpsSome (a ++ b) 1237 1238data OutdatedFlags = OutdatedFlags { 1239 outdatedVerbosity :: Flag Verbosity, 1240 outdatedFreezeFile :: Flag Bool, 1241 outdatedNewFreezeFile :: Flag Bool, 1242 outdatedProjectFile :: Flag FilePath, 1243 outdatedSimpleOutput :: Flag Bool, 1244 outdatedExitCode :: Flag Bool, 1245 outdatedQuiet :: Flag Bool, 1246 outdatedIgnore :: [PackageName], 1247 outdatedMinor :: Maybe IgnoreMajorVersionBumps 1248 } 1249 1250defaultOutdatedFlags :: OutdatedFlags 1251defaultOutdatedFlags = OutdatedFlags { 1252 outdatedVerbosity = toFlag normal, 1253 outdatedFreezeFile = mempty, 1254 outdatedNewFreezeFile = mempty, 1255 outdatedProjectFile = mempty, 1256 outdatedSimpleOutput = mempty, 1257 outdatedExitCode = mempty, 1258 outdatedQuiet = mempty, 1259 outdatedIgnore = mempty, 1260 outdatedMinor = mempty 1261 } 1262 1263outdatedCommand :: CommandUI OutdatedFlags 1264outdatedCommand = CommandUI { 1265 commandName = "outdated", 1266 commandSynopsis = "Check for outdated dependencies", 1267 commandDescription = Just $ \_ -> wrapText $ 1268 "Checks for outdated dependencies in the package description file " 1269 ++ "or freeze file", 1270 commandNotes = Nothing, 1271 commandUsage = usageFlags "outdated", 1272 commandDefaultFlags = defaultOutdatedFlags, 1273 commandOptions = \ _ -> [ 1274 optionVerbosity outdatedVerbosity 1275 (\v flags -> flags { outdatedVerbosity = v }) 1276 1277 ,option [] ["freeze-file", "v1-freeze-file"] 1278 "Act on the freeze file" 1279 outdatedFreezeFile (\v flags -> flags { outdatedFreezeFile = v }) 1280 trueArg 1281 1282 ,option [] ["v2-freeze-file", "new-freeze-file"] 1283 "Act on the new-style freeze file (default: cabal.project.freeze)" 1284 outdatedNewFreezeFile (\v flags -> flags { outdatedNewFreezeFile = v }) 1285 trueArg 1286 1287 ,option [] ["project-file"] 1288 "Act on the new-style freeze file named PROJECTFILE.freeze rather than the default cabal.project.freeze" 1289 outdatedProjectFile (\v flags -> flags { outdatedProjectFile = v }) 1290 (reqArgFlag "PROJECTFILE") 1291 1292 ,option [] ["simple-output"] 1293 "Only print names of outdated dependencies, one per line" 1294 outdatedSimpleOutput (\v flags -> flags { outdatedSimpleOutput = v }) 1295 trueArg 1296 1297 ,option [] ["exit-code"] 1298 "Exit with non-zero when there are outdated dependencies" 1299 outdatedExitCode (\v flags -> flags { outdatedExitCode = v }) 1300 trueArg 1301 1302 ,option ['q'] ["quiet"] 1303 "Don't print any output. Implies '--exit-code' and '-v0'" 1304 outdatedQuiet (\v flags -> flags { outdatedQuiet = v }) 1305 trueArg 1306 1307 ,option [] ["ignore"] 1308 "Packages to ignore" 1309 outdatedIgnore (\v flags -> flags { outdatedIgnore = v }) 1310 (reqArg "PKGS" pkgNameListParser (map display)) 1311 1312 ,option [] ["minor"] 1313 "Ignore major version bumps for these packages" 1314 outdatedMinor (\v flags -> flags { outdatedMinor = v }) 1315 (optArg "PKGS" ignoreMajorVersionBumpsParser 1316 (Just IgnoreMajorVersionBumpsAll) ignoreMajorVersionBumpsPrinter) 1317 ] 1318 } 1319 where 1320 ignoreMajorVersionBumpsPrinter :: (Maybe IgnoreMajorVersionBumps) 1321 -> [Maybe String] 1322 ignoreMajorVersionBumpsPrinter Nothing = [] 1323 ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumpsNone)= [] 1324 ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumpsAll) = [Nothing] 1325 ignoreMajorVersionBumpsPrinter (Just (IgnoreMajorVersionBumpsSome pkgs)) = 1326 map (Just . display) $ pkgs 1327 1328 ignoreMajorVersionBumpsParser = 1329 (Just . IgnoreMajorVersionBumpsSome) `fmap` pkgNameListParser 1330 1331 pkgNameListParser = readP_to_E 1332 ("Couldn't parse the list of package names: " ++) 1333 (Parse.sepBy1 parse (Parse.char ',')) 1334 1335-- ------------------------------------------------------------ 1336-- * Update command 1337-- ------------------------------------------------------------ 1338 1339data UpdateFlags 1340 = UpdateFlags { 1341 updateVerbosity :: Flag Verbosity, 1342 updateIndexState :: Flag IndexState 1343 } deriving Generic 1344 1345defaultUpdateFlags :: UpdateFlags 1346defaultUpdateFlags 1347 = UpdateFlags { 1348 updateVerbosity = toFlag normal, 1349 updateIndexState = toFlag IndexStateHead 1350 } 1351 1352updateCommand :: CommandUI UpdateFlags 1353updateCommand = CommandUI { 1354 commandName = "update", 1355 commandSynopsis = "Updates list of known packages.", 1356 commandDescription = Just $ \_ -> 1357 "For all known remote repositories, download the package list.\n", 1358 commandNotes = Just $ \_ -> 1359 relevantConfigValuesText ["remote-repo" 1360 ,"remote-repo-cache" 1361 ,"local-repo"], 1362 commandUsage = usageFlags "v1-update", 1363 commandDefaultFlags = defaultUpdateFlags, 1364 commandOptions = \_ -> [ 1365 optionVerbosity updateVerbosity (\v flags -> flags { updateVerbosity = v }), 1366 option [] ["index-state"] 1367 ("Update the source package index to its state as it existed at a previous time. " ++ 1368 "Accepts unix-timestamps (e.g. '@1474732068'), ISO8601 UTC timestamps " ++ 1369 "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD' (default: 'HEAD').") 1370 updateIndexState (\v flags -> flags { updateIndexState = v }) 1371 (reqArg "STATE" (readP_to_E (const $ "index-state must be a " ++ 1372 "unix-timestamps (e.g. '@1474732068'), " ++ 1373 "a ISO8601 UTC timestamp " ++ 1374 "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD'") 1375 (toFlag `fmap` parse)) 1376 (flagToList . fmap display)) 1377 ] 1378 } 1379 1380-- ------------------------------------------------------------ 1381-- * Other commands 1382-- ------------------------------------------------------------ 1383 1384upgradeCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags 1385 , HaddockFlags, TestFlags, BenchmarkFlags 1386 ) 1387upgradeCommand = configureCommand { 1388 commandName = "upgrade", 1389 commandSynopsis = "(command disabled, use install instead)", 1390 commandDescription = Nothing, 1391 commandUsage = usageFlagsOrPackages "upgrade", 1392 commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty), 1393 commandOptions = commandOptions installCommand 1394 } 1395 1396cleanCommand :: CommandUI CleanFlags 1397cleanCommand = Cabal.cleanCommand 1398 { commandUsage = \pname -> 1399 "Usage: " ++ pname ++ " v1-clean [FLAGS]\n" 1400 } 1401 1402checkCommand :: CommandUI (Flag Verbosity) 1403checkCommand = CommandUI { 1404 commandName = "check", 1405 commandSynopsis = "Check the package for common mistakes.", 1406 commandDescription = Just $ \_ -> wrapText $ 1407 "Expects a .cabal package file in the current directory.\n" 1408 ++ "\n" 1409 ++ "The checks correspond to the requirements to packages on Hackage. " 1410 ++ "If no errors and warnings are reported, Hackage will accept this " 1411 ++ "package.\n", 1412 commandNotes = Nothing, 1413 commandUsage = usageFlags "check", 1414 commandDefaultFlags = toFlag normal, 1415 commandOptions = \_ -> [optionVerbosity id const] 1416 } 1417 1418formatCommand :: CommandUI (Flag Verbosity) 1419formatCommand = CommandUI { 1420 commandName = "format", 1421 commandSynopsis = "Reformat the .cabal file using the standard style.", 1422 commandDescription = Nothing, 1423 commandNotes = Nothing, 1424 commandUsage = usageAlternatives "format" ["[FILE]"], 1425 commandDefaultFlags = toFlag normal, 1426 commandOptions = \_ -> [] 1427 } 1428 1429uninstallCommand :: CommandUI (Flag Verbosity) 1430uninstallCommand = CommandUI { 1431 commandName = "uninstall", 1432 commandSynopsis = "Warn about 'uninstall' not being implemented.", 1433 commandDescription = Nothing, 1434 commandNotes = Nothing, 1435 commandUsage = usageAlternatives "uninstall" ["PACKAGES"], 1436 commandDefaultFlags = toFlag normal, 1437 commandOptions = \_ -> [] 1438 } 1439 1440manpageCommand :: CommandUI (Flag Verbosity) 1441manpageCommand = CommandUI { 1442 commandName = "manpage", 1443 commandSynopsis = "Outputs manpage source.", 1444 commandDescription = Just $ \_ -> 1445 "Output manpage source to STDOUT.\n", 1446 commandNotes = Nothing, 1447 commandUsage = usageFlags "manpage", 1448 commandDefaultFlags = toFlag normal, 1449 commandOptions = \_ -> [optionVerbosity id const] 1450 } 1451 1452runCommand :: CommandUI (BuildFlags, BuildExFlags) 1453runCommand = CommandUI { 1454 commandName = "run", 1455 commandSynopsis = "Builds and runs an executable.", 1456 commandDescription = Just $ \pname -> wrapText $ 1457 "Builds and then runs the specified executable. If no executable is " 1458 ++ "specified, but the package contains just one executable, that one " 1459 ++ "is built and executed.\n" 1460 ++ "\n" 1461 ++ "Use `" ++ pname ++ " v1-test --show-details=streaming` to run a " 1462 ++ "test-suite and get its full output.\n", 1463 commandNotes = Just $ \pname -> 1464 "Examples:\n" 1465 ++ " " ++ pname ++ " v1-run\n" 1466 ++ " Run the only executable in the current package;\n" 1467 ++ " " ++ pname ++ " v1-run foo -- --fooflag\n" 1468 ++ " Works similar to `./foo --fooflag`.\n", 1469 commandUsage = usageAlternatives "v1-run" 1470 ["[FLAGS] [EXECUTABLE] [-- EXECUTABLE_FLAGS]"], 1471 commandDefaultFlags = mempty, 1472 commandOptions = 1473 \showOrParseArgs -> liftOptions fst setFst 1474 (commandOptions parent showOrParseArgs) 1475 ++ 1476 liftOptions snd setSnd 1477 (buildExOptions showOrParseArgs) 1478 } 1479 where 1480 setFst a (_,b) = (a,b) 1481 setSnd b (a,_) = (a,b) 1482 1483 parent = Cabal.buildCommand defaultProgramDb 1484 1485-- ------------------------------------------------------------ 1486-- * Report flags 1487-- ------------------------------------------------------------ 1488 1489data ReportFlags = ReportFlags { 1490 reportUsername :: Flag Username, 1491 reportPassword :: Flag Password, 1492 reportVerbosity :: Flag Verbosity 1493 } deriving Generic 1494 1495defaultReportFlags :: ReportFlags 1496defaultReportFlags = ReportFlags { 1497 reportUsername = mempty, 1498 reportPassword = mempty, 1499 reportVerbosity = toFlag normal 1500 } 1501 1502reportCommand :: CommandUI ReportFlags 1503reportCommand = CommandUI { 1504 commandName = "report", 1505 commandSynopsis = "Upload build reports to a remote server.", 1506 commandDescription = Nothing, 1507 commandNotes = Just $ \_ -> 1508 "You can store your Hackage login in the ~/.cabal/config file\n", 1509 commandUsage = usageAlternatives "report" ["[FLAGS]"], 1510 commandDefaultFlags = defaultReportFlags, 1511 commandOptions = \_ -> 1512 [optionVerbosity reportVerbosity (\v flags -> flags { reportVerbosity = v }) 1513 1514 ,option ['u'] ["username"] 1515 "Hackage username." 1516 reportUsername (\v flags -> flags { reportUsername = v }) 1517 (reqArg' "USERNAME" (toFlag . Username) 1518 (flagToList . fmap unUsername)) 1519 1520 ,option ['p'] ["password"] 1521 "Hackage password." 1522 reportPassword (\v flags -> flags { reportPassword = v }) 1523 (reqArg' "PASSWORD" (toFlag . Password) 1524 (flagToList . fmap unPassword)) 1525 ] 1526 } 1527 1528instance Monoid ReportFlags where 1529 mempty = gmempty 1530 mappend = (<>) 1531 1532instance Semigroup ReportFlags where 1533 (<>) = gmappend 1534 1535-- ------------------------------------------------------------ 1536-- * Get flags 1537-- ------------------------------------------------------------ 1538 1539data GetFlags = GetFlags { 1540 getDestDir :: Flag FilePath, 1541 getPristine :: Flag Bool, 1542 getIndexState :: Flag IndexState, 1543 getSourceRepository :: Flag (Maybe RepoKind), 1544 getVerbosity :: Flag Verbosity 1545 } deriving Generic 1546 1547defaultGetFlags :: GetFlags 1548defaultGetFlags = GetFlags { 1549 getDestDir = mempty, 1550 getPristine = mempty, 1551 getIndexState = mempty, 1552 getSourceRepository = mempty, 1553 getVerbosity = toFlag normal 1554 } 1555 1556getCommand :: CommandUI GetFlags 1557getCommand = CommandUI { 1558 commandName = "get", 1559 commandSynopsis = "Download/Extract a package's source code (repository).", 1560 commandDescription = Just $ \_ -> wrapText $ 1561 "Creates a local copy of a package's source code. By default it gets " 1562 ++ "the source\ntarball and unpacks it in a local subdirectory. " 1563 ++ "Alternatively, with -s it will\nget the code from the source " 1564 ++ "repository specified by the package.\n", 1565 commandNotes = Just $ \pname -> 1566 "Examples:\n" 1567 ++ " " ++ pname ++ " get hlint\n" 1568 ++ " Download the latest stable version of hlint;\n" 1569 ++ " " ++ pname ++ " get lens --source-repository=head\n" 1570 ++ " Download the source repository (i.e. git clone from github).\n", 1571 commandUsage = usagePackages "get", 1572 commandDefaultFlags = defaultGetFlags, 1573 commandOptions = \_ -> [ 1574 optionVerbosity getVerbosity (\v flags -> flags { getVerbosity = v }) 1575 1576 ,option "d" ["destdir"] 1577 "Where to place the package source, defaults to the current directory." 1578 getDestDir (\v flags -> flags { getDestDir = v }) 1579 (reqArgFlag "PATH") 1580 1581 ,option "s" ["source-repository"] 1582 "Copy the package's source repository (ie git clone, darcs get, etc as appropriate)." 1583 getSourceRepository (\v flags -> flags { getSourceRepository = v }) 1584 (optArg "[head|this|...]" (readP_to_E (const "invalid source-repository") 1585 (fmap (toFlag . Just) parse)) 1586 (Flag Nothing) 1587 (map (fmap show) . flagToList)) 1588 1589 , option [] ["index-state"] 1590 ("Use source package index state as it existed at a previous time. " ++ 1591 "Accepts unix-timestamps (e.g. '@1474732068'), ISO8601 UTC timestamps " ++ 1592 "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD' (default: 'HEAD'). " ++ 1593 "This determines which package versions are available as well as " ++ 1594 ".cabal file revision is selected (unless --pristine is used).") 1595 getIndexState (\v flags -> flags { getIndexState = v }) 1596 (reqArg "STATE" (readP_to_E (const $ "index-state must be a " ++ 1597 "unix-timestamps (e.g. '@1474732068'), " ++ 1598 "a ISO8601 UTC timestamp " ++ 1599 "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD'") 1600 (toFlag `fmap` parse)) 1601 (flagToList . fmap display)) 1602 1603 , option [] ["pristine"] 1604 ("Unpack the original pristine tarball, rather than updating the " 1605 ++ ".cabal file with the latest revision from the package archive.") 1606 getPristine (\v flags -> flags { getPristine = v }) 1607 trueArg 1608 ] 1609 } 1610 1611-- 'cabal unpack' is a deprecated alias for 'cabal get'. 1612unpackCommand :: CommandUI GetFlags 1613unpackCommand = getCommand { 1614 commandName = "unpack", 1615 commandUsage = usagePackages "unpack" 1616 } 1617 1618instance Monoid GetFlags where 1619 mempty = gmempty 1620 mappend = (<>) 1621 1622instance Semigroup GetFlags where 1623 (<>) = gmappend 1624 1625-- ------------------------------------------------------------ 1626-- * List flags 1627-- ------------------------------------------------------------ 1628 1629data ListFlags = ListFlags { 1630 listInstalled :: Flag Bool, 1631 listSimpleOutput :: Flag Bool, 1632 listVerbosity :: Flag Verbosity, 1633 listPackageDBs :: [Maybe PackageDB] 1634 } deriving Generic 1635 1636defaultListFlags :: ListFlags 1637defaultListFlags = ListFlags { 1638 listInstalled = Flag False, 1639 listSimpleOutput = Flag False, 1640 listVerbosity = toFlag normal, 1641 listPackageDBs = [] 1642 } 1643 1644listCommand :: CommandUI ListFlags 1645listCommand = CommandUI { 1646 commandName = "list", 1647 commandSynopsis = "List packages matching a search string.", 1648 commandDescription = Just $ \_ -> wrapText $ 1649 "List all packages, or all packages matching one of the search" 1650 ++ " strings.\n" 1651 ++ "\n" 1652 ++ "If there is a sandbox in the current directory and " 1653 ++ "config:ignore-sandbox is False, use the sandbox package database. " 1654 ++ "Otherwise, use the package database specified with --package-db. " 1655 ++ "If not specified, use the user package database.\n", 1656 commandNotes = Just $ \pname -> 1657 "Examples:\n" 1658 ++ " " ++ pname ++ " list pandoc\n" 1659 ++ " Will find pandoc, pandoc-citeproc, pandoc-lens, ...\n", 1660 commandUsage = usageAlternatives "list" [ "[FLAGS]" 1661 , "[FLAGS] STRINGS"], 1662 commandDefaultFlags = defaultListFlags, 1663 commandOptions = \_ -> [ 1664 optionVerbosity listVerbosity (\v flags -> flags { listVerbosity = v }) 1665 1666 , option [] ["installed"] 1667 "Only print installed packages" 1668 listInstalled (\v flags -> flags { listInstalled = v }) 1669 trueArg 1670 1671 , option [] ["simple-output"] 1672 "Print in a easy-to-parse format" 1673 listSimpleOutput (\v flags -> flags { listSimpleOutput = v }) 1674 trueArg 1675 1676 , option "" ["package-db"] 1677 ( "Append the given package database to the list of package" 1678 ++ " databases used (to satisfy dependencies and register into)." 1679 ++ " May be a specific file, 'global' or 'user'. The initial list" 1680 ++ " is ['global'], ['global', 'user'], or ['global', $sandbox]," 1681 ++ " depending on context. Use 'clear' to reset the list to empty." 1682 ++ " See the user guide for details.") 1683 listPackageDBs (\v flags -> flags { listPackageDBs = v }) 1684 (reqArg' "DB" readPackageDbList showPackageDbList) 1685 1686 ] 1687 } 1688 1689instance Monoid ListFlags where 1690 mempty = gmempty 1691 mappend = (<>) 1692 1693instance Semigroup ListFlags where 1694 (<>) = gmappend 1695 1696-- ------------------------------------------------------------ 1697-- * Info flags 1698-- ------------------------------------------------------------ 1699 1700data InfoFlags = InfoFlags { 1701 infoVerbosity :: Flag Verbosity, 1702 infoPackageDBs :: [Maybe PackageDB] 1703 } deriving Generic 1704 1705defaultInfoFlags :: InfoFlags 1706defaultInfoFlags = InfoFlags { 1707 infoVerbosity = toFlag normal, 1708 infoPackageDBs = [] 1709 } 1710 1711infoCommand :: CommandUI InfoFlags 1712infoCommand = CommandUI { 1713 commandName = "info", 1714 commandSynopsis = "Display detailed information about a particular package.", 1715 commandDescription = Just $ \_ -> wrapText $ 1716 "If there is a sandbox in the current directory and " 1717 ++ "config:ignore-sandbox is False, use the sandbox package database. " 1718 ++ "Otherwise, use the package database specified with --package-db. " 1719 ++ "If not specified, use the user package database.\n", 1720 commandNotes = Nothing, 1721 commandUsage = usageAlternatives "info" ["[FLAGS] PACKAGES"], 1722 commandDefaultFlags = defaultInfoFlags, 1723 commandOptions = \_ -> [ 1724 optionVerbosity infoVerbosity (\v flags -> flags { infoVerbosity = v }) 1725 1726 , option "" ["package-db"] 1727 ( "Append the given package database to the list of package" 1728 ++ " databases used (to satisfy dependencies and register into)." 1729 ++ " May be a specific file, 'global' or 'user'. The initial list" 1730 ++ " is ['global'], ['global', 'user'], or ['global', $sandbox]," 1731 ++ " depending on context. Use 'clear' to reset the list to empty." 1732 ++ " See the user guide for details.") 1733 infoPackageDBs (\v flags -> flags { infoPackageDBs = v }) 1734 (reqArg' "DB" readPackageDbList showPackageDbList) 1735 1736 ] 1737 } 1738 1739instance Monoid InfoFlags where 1740 mempty = gmempty 1741 mappend = (<>) 1742 1743instance Semigroup InfoFlags where 1744 (<>) = gmappend 1745 1746-- ------------------------------------------------------------ 1747-- * Install flags 1748-- ------------------------------------------------------------ 1749 1750-- | Install takes the same flags as configure along with a few extras. 1751-- 1752data InstallFlags = InstallFlags { 1753 installDocumentation :: Flag Bool, 1754 installHaddockIndex :: Flag PathTemplate, 1755 installDest :: Flag Cabal.CopyDest, 1756 installDryRun :: Flag Bool, 1757 installMaxBackjumps :: Flag Int, 1758 installReorderGoals :: Flag ReorderGoals, 1759 installCountConflicts :: Flag CountConflicts, 1760 installFineGrainedConflicts :: Flag FineGrainedConflicts, 1761 installMinimizeConflictSet :: Flag MinimizeConflictSet, 1762 installIndependentGoals :: Flag IndependentGoals, 1763 installShadowPkgs :: Flag ShadowPkgs, 1764 installStrongFlags :: Flag StrongFlags, 1765 installAllowBootLibInstalls :: Flag AllowBootLibInstalls, 1766 installOnlyConstrained :: Flag OnlyConstrained, 1767 installReinstall :: Flag Bool, 1768 installAvoidReinstalls :: Flag AvoidReinstalls, 1769 installOverrideReinstall :: Flag Bool, 1770 installUpgradeDeps :: Flag Bool, 1771 installOnly :: Flag Bool, 1772 installOnlyDeps :: Flag Bool, 1773 installIndexState :: Flag IndexState, 1774 installRootCmd :: Flag String, 1775 installSummaryFile :: NubList PathTemplate, 1776 installLogFile :: Flag PathTemplate, 1777 installBuildReports :: Flag ReportLevel, 1778 installReportPlanningFailure :: Flag Bool, 1779 -- Note: symlink-bindir is no longer used by v2-install and can be removed 1780 -- when removing v1 commands 1781 installSymlinkBinDir :: Flag FilePath, 1782 installPerComponent :: Flag Bool, 1783 installOneShot :: Flag Bool, 1784 installNumJobs :: Flag (Maybe Int), 1785 installKeepGoing :: Flag Bool, 1786 installRunTests :: Flag Bool, 1787 installOfflineMode :: Flag Bool, 1788 -- | The cabal project file name; defaults to @cabal.project@. 1789 -- Th name itself denotes the cabal project file name, but it also 1790 -- is the base of auxiliary project files, such as 1791 -- @cabal.project.local@ and @cabal.project.freeze@ which are also 1792 -- read and written out in some cases. If the path is not found 1793 -- in the current working directory, we will successively probe 1794 -- relative to parent directories until this name is found. 1795 installProjectFileName :: Flag FilePath 1796 } 1797 deriving (Eq, Generic) 1798 1799instance Binary InstallFlags 1800 1801defaultInstallFlags :: InstallFlags 1802defaultInstallFlags = InstallFlags { 1803 installDocumentation = Flag False, 1804 installHaddockIndex = Flag docIndexFile, 1805 installDest = Flag Cabal.NoCopyDest, 1806 installDryRun = Flag False, 1807 installMaxBackjumps = Flag defaultMaxBackjumps, 1808 installReorderGoals = Flag (ReorderGoals False), 1809 installCountConflicts = Flag (CountConflicts True), 1810 installFineGrainedConflicts = Flag (FineGrainedConflicts True), 1811 installMinimizeConflictSet = Flag (MinimizeConflictSet False), 1812 installIndependentGoals= Flag (IndependentGoals False), 1813 installShadowPkgs = Flag (ShadowPkgs False), 1814 installStrongFlags = Flag (StrongFlags False), 1815 installAllowBootLibInstalls = Flag (AllowBootLibInstalls False), 1816 installOnlyConstrained = Flag OnlyConstrainedNone, 1817 installReinstall = Flag False, 1818 installAvoidReinstalls = Flag (AvoidReinstalls False), 1819 installOverrideReinstall = Flag False, 1820 installUpgradeDeps = Flag False, 1821 installOnly = Flag False, 1822 installOnlyDeps = Flag False, 1823 installIndexState = mempty, 1824 installRootCmd = mempty, 1825 installSummaryFile = mempty, 1826 installLogFile = mempty, 1827 installBuildReports = Flag NoReports, 1828 installReportPlanningFailure = Flag False, 1829 installSymlinkBinDir = mempty, 1830 installPerComponent = Flag True, 1831 installOneShot = Flag False, 1832 installNumJobs = mempty, 1833 installKeepGoing = Flag False, 1834 installRunTests = mempty, 1835 installOfflineMode = Flag False, 1836 installProjectFileName = mempty 1837 } 1838 where 1839 docIndexFile = toPathTemplate ("$datadir" </> "doc" 1840 </> "$arch-$os-$compiler" </> "index.html") 1841 1842defaultMaxBackjumps :: Int 1843defaultMaxBackjumps = 4000 1844 1845defaultSolver :: PreSolver 1846defaultSolver = AlwaysModular 1847 1848allSolvers :: String 1849allSolvers = intercalate ", " (map display ([minBound .. maxBound] :: [PreSolver])) 1850 1851installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags 1852 , HaddockFlags, TestFlags, BenchmarkFlags 1853 ) 1854installCommand = CommandUI { 1855 commandName = "install", 1856 commandSynopsis = "Install packages.", 1857 commandUsage = usageAlternatives "v1-install" [ "[FLAGS]" 1858 , "[FLAGS] PACKAGES" 1859 ], 1860 commandDescription = Just $ \_ -> wrapText $ 1861 "Installs one or more packages. By default, the installed package" 1862 ++ " will be registered in the user's package database or, if a sandbox" 1863 ++ " is present in the current directory, inside the sandbox.\n" 1864 ++ "\n" 1865 ++ "If PACKAGES are specified, downloads and installs those packages." 1866 ++ " Otherwise, install the package in the current directory (and/or its" 1867 ++ " dependencies) (there must be exactly one .cabal file in the current" 1868 ++ " directory).\n" 1869 ++ "\n" 1870 ++ "When using a sandbox, the flags for `v1-install` only affect the" 1871 ++ " current command and have no effect on future commands. (To achieve" 1872 ++ " that, `v1-configure` must be used.)\n" 1873 ++ " In contrast, without a sandbox, the flags to `v1-install` are saved and" 1874 ++ " affect future commands such as `v1-build` and `v1-repl`. See the help for" 1875 ++ " `v1-configure` for a list of commands being affected.\n" 1876 ++ "\n" 1877 ++ "Installed executables will by default (and without a sandbox)" 1878 ++ " be put into `~/.cabal/bin/`." 1879 ++ " If you want installed executable to be available globally, make" 1880 ++ " sure that the PATH environment variable contains that directory.\n" 1881 ++ "When using a sandbox, executables will be put into" 1882 ++ " `$SANDBOX/bin/` (by default: `./.cabal-sandbox/bin/`).\n" 1883 ++ "\n" 1884 ++ "When specifying --bindir, consider also specifying --datadir;" 1885 ++ " this way the sandbox can be deleted and the executable should" 1886 ++ " continue working as long as bindir and datadir are left untouched.", 1887 commandNotes = Just $ \pname -> 1888 ( case commandNotes 1889 $ Cabal.configureCommand defaultProgramDb 1890 of Just desc -> desc pname ++ "\n" 1891 Nothing -> "" 1892 ) 1893 ++ "Examples:\n" 1894 ++ " " ++ pname ++ " v1-install " 1895 ++ " Package in the current directory\n" 1896 ++ " " ++ pname ++ " v1-install foo " 1897 ++ " Package from the hackage server\n" 1898 ++ " " ++ pname ++ " v1-install foo-1.0 " 1899 ++ " Specific version of a package\n" 1900 ++ " " ++ pname ++ " v1-install 'foo < 2' " 1901 ++ " Constrained package version\n" 1902 ++ " " ++ pname ++ " v1-install haddock --bindir=$HOME/hask-bin/ --datadir=$HOME/hask-data/\n" 1903 ++ " " ++ (map (const ' ') pname) 1904 ++ " " 1905 ++ " Change installation destination\n", 1906 commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty), 1907 commandOptions = \showOrParseArgs -> 1908 liftOptions get1 set1 1909 -- Note: [Hidden Flags] 1910 -- hide "constraint", "dependency", and 1911 -- "exact-configuration" from the configure options. 1912 (filter ((`notElem` ["constraint", "dependency" 1913 , "exact-configuration"]) 1914 . optionName) $ 1915 configureOptions showOrParseArgs) 1916 ++ liftOptions get2 set2 (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag) 1917 ++ liftOptions get3 set3 1918 -- hide "target-package-db" flag from the 1919 -- install options. 1920 (filter ((`notElem` ["target-package-db"]) 1921 . optionName) $ 1922 installOptions showOrParseArgs) 1923 ++ liftOptions get4 set4 (haddockOptions showOrParseArgs) 1924 ++ liftOptions get5 set5 (testOptions showOrParseArgs) 1925 ++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs) 1926 } 1927 where 1928 get1 (a,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f) = (a,b,c,d,e,f) 1929 get2 (_,b,_,_,_,_) = b; set2 b (a,_,c,d,e,f) = (a,b,c,d,e,f) 1930 get3 (_,_,c,_,_,_) = c; set3 c (a,b,_,d,e,f) = (a,b,c,d,e,f) 1931 get4 (_,_,_,d,_,_) = d; set4 d (a,b,c,_,e,f) = (a,b,c,d,e,f) 1932 get5 (_,_,_,_,e,_) = e; set5 e (a,b,c,d,_,f) = (a,b,c,d,e,f) 1933 get6 (_,_,_,_,_,f) = f; set6 f (a,b,c,d,e,_) = (a,b,c,d,e,f) 1934 1935haddockCommand :: CommandUI HaddockFlags 1936haddockCommand = Cabal.haddockCommand 1937 { commandUsage = usageAlternatives "v1-haddock" $ 1938 [ "[FLAGS]", "COMPONENTS [FLAGS]" ] 1939 } 1940 1941filterHaddockArgs :: [String] -> Version -> [String] 1942filterHaddockArgs args cabalLibVersion 1943 | cabalLibVersion >= mkVersion [2,3,0] = args_latest 1944 | cabalLibVersion < mkVersion [2,3,0] = args_2_3_0 1945 | otherwise = args_latest 1946 where 1947 args_latest = args 1948 1949 -- Cabal < 2.3 doesn't know about per-component haddock 1950 args_2_3_0 = [] 1951 1952filterHaddockFlags :: HaddockFlags -> Version -> HaddockFlags 1953filterHaddockFlags flags cabalLibVersion 1954 | cabalLibVersion >= mkVersion [2,3,0] = flags_latest 1955 | cabalLibVersion < mkVersion [2,3,0] = flags_2_3_0 1956 | otherwise = flags_latest 1957 where 1958 flags_latest = flags 1959 1960 flags_2_3_0 = flags_latest { 1961 -- Cabal < 2.3 doesn't know about per-component haddock 1962 haddockArgs = [] 1963 } 1964 1965haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags] 1966haddockOptions showOrParseArgs 1967 = [ opt { optionName = "haddock-" ++ name, 1968 optionDescr = [ fmapOptFlags (\(_, lflags) -> ([], map ("haddock-" ++) lflags)) descr 1969 | descr <- optionDescr opt] } 1970 | opt <- commandOptions Cabal.haddockCommand showOrParseArgs 1971 , let name = optionName opt 1972 , name `elem` ["hoogle", "html", "html-location" 1973 ,"executables", "tests", "benchmarks", "all", "internal", "css" 1974 ,"hyperlink-source", "quickjump", "hscolour-css" 1975 ,"contents-location", "for-hackage"] 1976 ] 1977 1978testOptions :: ShowOrParseArgs -> [OptionField TestFlags] 1979testOptions showOrParseArgs 1980 = [ opt { optionName = prefixTest name, 1981 optionDescr = [ fmapOptFlags (\(_, lflags) -> ([], map prefixTest lflags)) descr 1982 | descr <- optionDescr opt] } 1983 | opt <- commandOptions Cabal.testCommand showOrParseArgs 1984 , let name = optionName opt 1985 , name `elem` ["log", "machine-log", "show-details", "keep-tix-files" 1986 ,"fail-when-no-test-suites", "test-options", "test-option" 1987 ,"test-wrapper"] 1988 ] 1989 where 1990 prefixTest name | "test-" `isPrefixOf` name = name 1991 | otherwise = "test-" ++ name 1992 1993benchmarkOptions :: ShowOrParseArgs -> [OptionField BenchmarkFlags] 1994benchmarkOptions showOrParseArgs 1995 = [ opt { optionName = prefixBenchmark name, 1996 optionDescr = [ fmapOptFlags (\(_, lflags) -> ([], map prefixBenchmark lflags)) descr 1997 | descr <- optionDescr opt] } 1998 | opt <- commandOptions Cabal.benchmarkCommand showOrParseArgs 1999 , let name = optionName opt 2000 , name `elem` ["benchmark-options", "benchmark-option"] 2001 ] 2002 where 2003 prefixBenchmark name | "benchmark-" `isPrefixOf` name = name 2004 | otherwise = "benchmark-" ++ name 2005 2006fmapOptFlags :: (OptFlags -> OptFlags) -> OptDescr a -> OptDescr a 2007fmapOptFlags modify (ReqArg d f p r w) = ReqArg d (modify f) p r w 2008fmapOptFlags modify (OptArg d f p r i w) = OptArg d (modify f) p r i w 2009fmapOptFlags modify (ChoiceOpt xs) = ChoiceOpt [(d, modify f, i, w) | (d, f, i, w) <- xs] 2010fmapOptFlags modify (BoolOpt d f1 f2 r w) = BoolOpt d (modify f1) (modify f2) r w 2011 2012installOptions :: ShowOrParseArgs -> [OptionField InstallFlags] 2013installOptions showOrParseArgs = 2014 [ option "" ["documentation"] 2015 "building of documentation" 2016 installDocumentation (\v flags -> flags { installDocumentation = v }) 2017 (boolOpt [] []) 2018 2019 , option [] ["doc-index-file"] 2020 "A central index of haddock API documentation (template cannot use $pkgid)" 2021 installHaddockIndex (\v flags -> flags { installHaddockIndex = v }) 2022 (reqArg' "TEMPLATE" (toFlag.toPathTemplate) 2023 (flagToList . fmap fromPathTemplate)) 2024 2025 , option [] ["dry-run"] 2026 "Do not install anything, only print what would be installed." 2027 installDryRun (\v flags -> flags { installDryRun = v }) 2028 trueArg 2029 2030 , option "" ["target-package-db"] 2031 "package database to install into. Required when using ${pkgroot} prefix." 2032 installDest (\v flags -> flags { installDest = v }) 2033 (reqArg "DATABASE" (succeedReadE (Flag . Cabal.CopyToDb)) 2034 (\f -> case f of Flag (Cabal.CopyToDb p) -> [p]; _ -> [])) 2035 ] ++ 2036 2037 optionSolverFlags showOrParseArgs 2038 installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v }) 2039 installReorderGoals (\v flags -> flags { installReorderGoals = v }) 2040 installCountConflicts (\v flags -> flags { installCountConflicts = v }) 2041 installFineGrainedConflicts (\v flags -> flags { installFineGrainedConflicts = v }) 2042 installMinimizeConflictSet (\v flags -> flags { installMinimizeConflictSet = v }) 2043 installIndependentGoals (\v flags -> flags { installIndependentGoals = v }) 2044 installShadowPkgs (\v flags -> flags { installShadowPkgs = v }) 2045 installStrongFlags (\v flags -> flags { installStrongFlags = v }) 2046 installAllowBootLibInstalls (\v flags -> flags { installAllowBootLibInstalls = v }) 2047 installOnlyConstrained (\v flags -> flags { installOnlyConstrained = v }) ++ 2048 2049 [ option [] ["reinstall"] 2050 "Install even if it means installing the same version again." 2051 installReinstall (\v flags -> flags { installReinstall = v }) 2052 (yesNoOpt showOrParseArgs) 2053 2054 , option [] ["avoid-reinstalls"] 2055 "Do not select versions that would destructively overwrite installed packages." 2056 (fmap asBool . installAvoidReinstalls) 2057 (\v flags -> flags { installAvoidReinstalls = fmap AvoidReinstalls v }) 2058 (yesNoOpt showOrParseArgs) 2059 2060 , option [] ["force-reinstalls"] 2061 "Reinstall packages even if they will most likely break other installed packages." 2062 installOverrideReinstall (\v flags -> flags { installOverrideReinstall = v }) 2063 (yesNoOpt showOrParseArgs) 2064 2065 , option [] ["upgrade-dependencies"] 2066 "Pick the latest version for all dependencies, rather than trying to pick an installed version." 2067 installUpgradeDeps (\v flags -> flags { installUpgradeDeps = v }) 2068 (yesNoOpt showOrParseArgs) 2069 2070 , option [] ["only-dependencies"] 2071 "Install only the dependencies necessary to build the given packages" 2072 installOnlyDeps (\v flags -> flags { installOnlyDeps = v }) 2073 (yesNoOpt showOrParseArgs) 2074 2075 , option [] ["dependencies-only"] 2076 "A synonym for --only-dependencies" 2077 installOnlyDeps (\v flags -> flags { installOnlyDeps = v }) 2078 (yesNoOpt showOrParseArgs) 2079 2080 , option [] ["index-state"] 2081 ("Use source package index state as it existed at a previous time. " ++ 2082 "Accepts unix-timestamps (e.g. '@1474732068'), ISO8601 UTC timestamps " ++ 2083 "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD' (default: 'HEAD').") 2084 installIndexState (\v flags -> flags { installIndexState = v }) 2085 (reqArg "STATE" (readP_to_E (const $ "index-state must be a " ++ 2086 "unix-timestamps (e.g. '@1474732068'), " ++ 2087 "a ISO8601 UTC timestamp " ++ 2088 "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD'") 2089 (toFlag `fmap` parse)) 2090 (flagToList . fmap display)) 2091 2092 , option [] ["root-cmd"] 2093 "(No longer supported, do not use.)" 2094 installRootCmd (\v flags -> flags { installRootCmd = v }) 2095 (reqArg' "COMMAND" toFlag flagToList) 2096 2097 , option [] ["symlink-bindir"] 2098 "Add symlinks to installed executables into this directory." 2099 installSymlinkBinDir (\v flags -> flags { installSymlinkBinDir = v }) 2100 (reqArgFlag "DIR") 2101 2102 , option [] ["build-summary"] 2103 "Save build summaries to file (name template can use $pkgid, $compiler, $os, $arch)" 2104 installSummaryFile (\v flags -> flags { installSummaryFile = v }) 2105 (reqArg' "TEMPLATE" (\x -> toNubList [toPathTemplate x]) (map fromPathTemplate . fromNubList)) 2106 2107 , option [] ["build-log"] 2108 "Log all builds to file (name template can use $pkgid, $compiler, $os, $arch)" 2109 installLogFile (\v flags -> flags { installLogFile = v }) 2110 (reqArg' "TEMPLATE" (toFlag.toPathTemplate) 2111 (flagToList . fmap fromPathTemplate)) 2112 2113 , option [] ["remote-build-reporting"] 2114 "Generate build reports to send to a remote server (none, anonymous or detailed)." 2115 installBuildReports (\v flags -> flags { installBuildReports = v }) 2116 (reqArg "LEVEL" (readP_to_E (const $ "report level must be 'none', " 2117 ++ "'anonymous' or 'detailed'") 2118 (toFlag `fmap` parse)) 2119 (flagToList . fmap display)) 2120 2121 , option [] ["report-planning-failure"] 2122 "Generate build reports when the dependency solver fails. This is used by the Hackage build bot." 2123 installReportPlanningFailure (\v flags -> flags { installReportPlanningFailure = v }) 2124 trueArg 2125 2126 , option "" ["per-component"] 2127 "Per-component builds when possible" 2128 installPerComponent (\v flags -> flags { installPerComponent = v }) 2129 (boolOpt [] []) 2130 2131 , option [] ["one-shot"] 2132 "Do not record the packages in the world file." 2133 installOneShot (\v flags -> flags { installOneShot = v }) 2134 (yesNoOpt showOrParseArgs) 2135 2136 , option [] ["run-tests"] 2137 "Run package test suites during installation." 2138 installRunTests (\v flags -> flags { installRunTests = v }) 2139 trueArg 2140 2141 , optionNumJobs 2142 installNumJobs (\v flags -> flags { installNumJobs = v }) 2143 2144 , option [] ["keep-going"] 2145 "After a build failure, continue to build other unaffected packages." 2146 installKeepGoing (\v flags -> flags { installKeepGoing = v }) 2147 trueArg 2148 2149 , option [] ["offline"] 2150 "Don't download packages from the Internet." 2151 installOfflineMode (\v flags -> flags { installOfflineMode = v }) 2152 (yesNoOpt showOrParseArgs) 2153 2154 , option [] ["project-file"] 2155 "Set the name of the cabal.project file to search for in parent directories" 2156 installProjectFileName (\v flags -> flags {installProjectFileName = v}) 2157 (reqArgFlag "FILE") 2158 ] ++ case showOrParseArgs of -- TODO: remove when "cabal install" 2159 -- avoids 2160 ParseArgs -> 2161 [ option [] ["only"] 2162 "Only installs the package in the current directory." 2163 installOnly (\v flags -> flags { installOnly = v }) 2164 trueArg ] 2165 _ -> [] 2166 2167 2168instance Monoid InstallFlags where 2169 mempty = gmempty 2170 mappend = (<>) 2171 2172instance Semigroup InstallFlags where 2173 (<>) = gmappend 2174 2175-- ------------------------------------------------------------ 2176-- * Upload flags 2177-- ------------------------------------------------------------ 2178 2179-- | Is this a candidate package or a package to be published? 2180data IsCandidate = IsCandidate | IsPublished 2181 deriving Eq 2182 2183data UploadFlags = UploadFlags { 2184 uploadCandidate :: Flag IsCandidate, 2185 uploadDoc :: Flag Bool, 2186 uploadUsername :: Flag Username, 2187 uploadPassword :: Flag Password, 2188 uploadPasswordCmd :: Flag [String], 2189 uploadVerbosity :: Flag Verbosity 2190 } deriving Generic 2191 2192defaultUploadFlags :: UploadFlags 2193defaultUploadFlags = UploadFlags { 2194 uploadCandidate = toFlag IsCandidate, 2195 uploadDoc = toFlag False, 2196 uploadUsername = mempty, 2197 uploadPassword = mempty, 2198 uploadPasswordCmd = mempty, 2199 uploadVerbosity = toFlag normal 2200 } 2201 2202uploadCommand :: CommandUI UploadFlags 2203uploadCommand = CommandUI { 2204 commandName = "upload", 2205 commandSynopsis = "Uploads source packages or documentation to Hackage.", 2206 commandDescription = Nothing, 2207 commandNotes = Just $ \_ -> 2208 "You can store your Hackage login in the ~/.cabal/config file\n" 2209 ++ relevantConfigValuesText ["username", "password"], 2210 commandUsage = \pname -> 2211 "Usage: " ++ pname ++ " upload [FLAGS] TARFILES\n", 2212 commandDefaultFlags = defaultUploadFlags, 2213 commandOptions = \_ -> 2214 [optionVerbosity uploadVerbosity 2215 (\v flags -> flags { uploadVerbosity = v }) 2216 2217 ,option [] ["publish"] 2218 "Publish the package instead of uploading it as a candidate." 2219 uploadCandidate (\v flags -> flags { uploadCandidate = v }) 2220 (noArg (Flag IsPublished)) 2221 2222 ,option ['d'] ["documentation"] 2223 ("Upload documentation instead of a source package. " 2224 ++ "By default, this uploads documentation for a package candidate. " 2225 ++ "To upload documentation for " 2226 ++ "a published package, combine with --publish.") 2227 uploadDoc (\v flags -> flags { uploadDoc = v }) 2228 trueArg 2229 2230 ,option ['u'] ["username"] 2231 "Hackage username." 2232 uploadUsername (\v flags -> flags { uploadUsername = v }) 2233 (reqArg' "USERNAME" (toFlag . Username) 2234 (flagToList . fmap unUsername)) 2235 2236 ,option ['p'] ["password"] 2237 "Hackage password." 2238 uploadPassword (\v flags -> flags { uploadPassword = v }) 2239 (reqArg' "PASSWORD" (toFlag . Password) 2240 (flagToList . fmap unPassword)) 2241 2242 ,option ['P'] ["password-command"] 2243 "Command to get Hackage password." 2244 uploadPasswordCmd (\v flags -> flags { uploadPasswordCmd = v }) 2245 (reqArg' "PASSWORD" (Flag . words) (fromMaybe [] . flagToMaybe)) 2246 ] 2247 } 2248 2249instance Monoid UploadFlags where 2250 mempty = gmempty 2251 mappend = (<>) 2252 2253instance Semigroup UploadFlags where 2254 (<>) = gmappend 2255 2256-- ------------------------------------------------------------ 2257-- * Init flags 2258-- ------------------------------------------------------------ 2259 2260emptyInitFlags :: IT.InitFlags 2261emptyInitFlags = mempty 2262 2263defaultInitFlags :: IT.InitFlags 2264defaultInitFlags = emptyInitFlags { IT.initVerbosity = toFlag normal } 2265 2266initCommand :: CommandUI IT.InitFlags 2267initCommand = CommandUI { 2268 commandName = "init", 2269 commandSynopsis = "Create a new .cabal package file.", 2270 commandDescription = Just $ \_ -> wrapText $ 2271 "Create a .cabal, Setup.hs, and optionally a LICENSE file.\n" 2272 ++ "\n" 2273 ++ "Calling init with no arguments creates an executable, " 2274 ++ "guessing as many options as possible. The interactive " 2275 ++ "mode can be invoked by the -i/--interactive flag, which " 2276 ++ "will try to guess as much as possible and prompt you for " 2277 ++ "the rest. You can change init to always be interactive by " 2278 ++ "setting the interactive flag in your configuration file. " 2279 ++ "Command-line arguments are provided for scripting purposes.\n", 2280 commandNotes = Nothing, 2281 commandUsage = \pname -> 2282 "Usage: " ++ pname ++ " init [FLAGS]\n", 2283 commandDefaultFlags = defaultInitFlags, 2284 commandOptions = initOptions 2285 } 2286 2287initOptions :: ShowOrParseArgs -> [OptionField IT.InitFlags] 2288initOptions _ = 2289 [ option ['i'] ["interactive"] 2290 "interactive mode." 2291 IT.interactive (\v flags -> flags { IT.interactive = v }) 2292 (boolOpt' (['i'], ["interactive"]) (['n'], ["non-interactive"])) 2293 2294 , option ['q'] ["quiet"] 2295 "Do not generate log messages to stdout." 2296 IT.quiet (\v flags -> flags { IT.quiet = v }) 2297 trueArg 2298 2299 , option [] ["no-comments"] 2300 "Do not generate explanatory comments in the .cabal file." 2301 IT.noComments (\v flags -> flags { IT.noComments = v }) 2302 trueArg 2303 2304 , option ['m'] ["minimal"] 2305 "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --no-comments." 2306 IT.minimal (\v flags -> flags { IT.minimal = v }) 2307 trueArg 2308 2309 , option [] ["overwrite"] 2310 "Overwrite any existing .cabal, LICENSE, or Setup.hs files without warning." 2311 IT.overwrite (\v flags -> flags { IT.overwrite = v }) 2312 trueArg 2313 2314 , option [] ["package-dir", "packagedir"] 2315 "Root directory of the package (default = current directory)." 2316 IT.packageDir (\v flags -> flags { IT.packageDir = v }) 2317 (reqArgFlag "DIRECTORY") 2318 2319 , option ['p'] ["package-name"] 2320 "Name of the Cabal package to create." 2321 IT.packageName (\v flags -> flags { IT.packageName = v }) 2322 (reqArg "PACKAGE" (readP_to_E ("Cannot parse package name: "++) 2323 (toFlag `fmap` parse)) 2324 (flagToList . fmap display)) 2325 2326 , option [] ["version"] 2327 "Initial version of the package." 2328 IT.version (\v flags -> flags { IT.version = v }) 2329 (reqArg "VERSION" (readP_to_E ("Cannot parse package version: "++) 2330 (toFlag `fmap` parse)) 2331 (flagToList . fmap display)) 2332 2333 , option [] ["cabal-version"] 2334 "Version of the Cabal specification." 2335 IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v }) 2336 (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal specification version: "++) 2337 (toFlag `fmap` parse)) 2338 (flagToList . fmap display)) 2339 2340 , option ['l'] ["license"] 2341 "Project license." 2342 IT.license (\v flags -> flags { IT.license = v }) 2343 (reqArg "LICENSE" (readP_to_E ("Cannot parse license: "++) 2344 (toFlag `fmap` parse)) 2345 (flagToList . fmap display)) 2346 2347 , option ['a'] ["author"] 2348 "Name of the project's author." 2349 IT.author (\v flags -> flags { IT.author = v }) 2350 (reqArgFlag "NAME") 2351 2352 , option ['e'] ["email"] 2353 "Email address of the maintainer." 2354 IT.email (\v flags -> flags { IT.email = v }) 2355 (reqArgFlag "EMAIL") 2356 2357 , option ['u'] ["homepage"] 2358 "Project homepage and/or repository." 2359 IT.homepage (\v flags -> flags { IT.homepage = v }) 2360 (reqArgFlag "URL") 2361 2362 , option ['s'] ["synopsis"] 2363 "Short project synopsis." 2364 IT.synopsis (\v flags -> flags { IT.synopsis = v }) 2365 (reqArgFlag "TEXT") 2366 2367 , option ['c'] ["category"] 2368 "Project category." 2369 IT.category (\v flags -> flags { IT.category = v }) 2370 (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) 2371 (flagToList . fmap (either id show))) 2372 2373 , option ['x'] ["extra-source-file"] 2374 "Extra source file to be distributed with tarball." 2375 IT.extraSrc (\v flags -> flags { IT.extraSrc = v }) 2376 (reqArg' "FILE" (Just . (:[])) 2377 (fromMaybe [])) 2378 2379 , option [] ["lib", "is-library"] 2380 "Build a library." 2381 IT.packageType (\v flags -> flags { IT.packageType = v }) 2382 (noArg (Flag IT.Library)) 2383 2384 , option [] ["exe", "is-executable"] 2385 "Build an executable." 2386 IT.packageType 2387 (\v flags -> flags { IT.packageType = v }) 2388 (noArg (Flag IT.Executable)) 2389 2390 , option [] ["libandexe", "is-libandexe"] 2391 "Build a library and an executable." 2392 IT.packageType 2393 (\v flags -> flags { IT.packageType = v }) 2394 (noArg (Flag IT.LibraryAndExecutable)) 2395 2396 , option [] ["tests"] 2397 "Generate a test suite for the library." 2398 IT.initializeTestSuite 2399 (\v flags -> flags { IT.initializeTestSuite = v }) 2400 trueArg 2401 2402 , option [] ["test-dir"] 2403 "Directory containing tests." 2404 IT.testDirs (\v flags -> flags { IT.testDirs = v }) 2405 (reqArg' "DIR" (Just . (:[])) 2406 (fromMaybe [])) 2407 2408 , option [] ["simple"] 2409 "Create a simple project with sensible defaults." 2410 IT.simpleProject 2411 (\v flags -> flags { IT.simpleProject = v }) 2412 trueArg 2413 2414 , option [] ["main-is"] 2415 "Specify the main module." 2416 IT.mainIs 2417 (\v flags -> flags { IT.mainIs = v }) 2418 (reqArgFlag "FILE") 2419 2420 , option [] ["language"] 2421 "Specify the default language." 2422 IT.language 2423 (\v flags -> flags { IT.language = v }) 2424 (reqArg "LANGUAGE" (readP_to_E ("Cannot parse language: "++) 2425 (toFlag `fmap` parse)) 2426 (flagToList . fmap display)) 2427 2428 , option ['o'] ["expose-module"] 2429 "Export a module from the package." 2430 IT.exposedModules 2431 (\v flags -> flags { IT.exposedModules = v }) 2432 (reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++) 2433 ((Just . (:[])) `fmap` parse)) 2434 (maybe [] (fmap display))) 2435 2436 , option [] ["extension"] 2437 "Use a LANGUAGE extension (in the other-extensions field)." 2438 IT.otherExts 2439 (\v flags -> flags { IT.otherExts = v }) 2440 (reqArg "EXTENSION" (readP_to_E ("Cannot parse extension: "++) 2441 ((Just . (:[])) `fmap` parse)) 2442 (maybe [] (fmap display))) 2443 2444 , option ['d'] ["dependency"] 2445 "Package dependency." 2446 IT.dependencies (\v flags -> flags { IT.dependencies = v }) 2447 (reqArg "PACKAGE" (readP_to_E ("Cannot parse dependency: "++) 2448 ((Just . (:[])) `fmap` parse)) 2449 (maybe [] (fmap display))) 2450 2451 , option [] ["application-dir"] 2452 "Directory containing package application executable." 2453 IT.applicationDirs (\v flags -> flags { IT.applicationDirs = v}) 2454 (reqArg' "DIR" (Just . (:[])) 2455 (fromMaybe [])) 2456 2457 , option [] ["source-dir", "sourcedir"] 2458 "Directory containing package library source." 2459 IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v }) 2460 (reqArg' "DIR" (Just . (:[])) 2461 (fromMaybe [])) 2462 2463 , option [] ["build-tool"] 2464 "Required external build tool." 2465 IT.buildTools (\v flags -> flags { IT.buildTools = v }) 2466 (reqArg' "TOOL" (Just . (:[])) 2467 (fromMaybe [])) 2468 2469 -- NB: this is a bit of a transitional hack and will likely be 2470 -- removed again if `cabal init` is migrated to the v2-* command 2471 -- framework 2472 , option "w" ["with-compiler"] 2473 "give the path to a particular compiler" 2474 IT.initHcPath (\v flags -> flags { IT.initHcPath = v }) 2475 (reqArgFlag "PATH") 2476 2477 , optionVerbosity IT.initVerbosity (\v flags -> flags { IT.initVerbosity = v }) 2478 ] 2479 2480-- ------------------------------------------------------------ 2481-- * SDist flags 2482-- ------------------------------------------------------------ 2483 2484-- | Extra flags to @sdist@ beyond runghc Setup sdist 2485-- 2486sdistCommand :: CommandUI SDistFlags 2487sdistCommand = Cabal.sdistCommand { 2488 commandUsage = \pname -> 2489 "Usage: " ++ pname ++ " v1-sdist [FLAGS]\n", 2490 commandDefaultFlags = (commandDefaultFlags Cabal.sdistCommand) 2491 } 2492 2493 2494-- 2495 2496doctestCommand :: CommandUI DoctestFlags 2497doctestCommand = Cabal.doctestCommand 2498 { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-doctest [FLAGS]\n" } 2499 2500copyCommand :: CommandUI CopyFlags 2501copyCommand = Cabal.copyCommand 2502 { commandNotes = Just $ \pname -> 2503 "Examples:\n" 2504 ++ " " ++ pname ++ " v1-copy " 2505 ++ " All the components in the package\n" 2506 ++ " " ++ pname ++ " v1-copy foo " 2507 ++ " A component (i.e. lib, exe, test suite)" 2508 , commandUsage = usageAlternatives "v1-copy" $ 2509 [ "[FLAGS]" 2510 , "COMPONENTS [FLAGS]" 2511 ] 2512 } 2513 2514registerCommand :: CommandUI RegisterFlags 2515registerCommand = Cabal.registerCommand 2516 { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-register [FLAGS]\n" } 2517 2518-- ------------------------------------------------------------ 2519-- * Win32SelfUpgrade flags 2520-- ------------------------------------------------------------ 2521 2522data Win32SelfUpgradeFlags = Win32SelfUpgradeFlags { 2523 win32SelfUpgradeVerbosity :: Flag Verbosity 2524} deriving Generic 2525 2526defaultWin32SelfUpgradeFlags :: Win32SelfUpgradeFlags 2527defaultWin32SelfUpgradeFlags = Win32SelfUpgradeFlags { 2528 win32SelfUpgradeVerbosity = toFlag normal 2529} 2530 2531win32SelfUpgradeCommand :: CommandUI Win32SelfUpgradeFlags 2532win32SelfUpgradeCommand = CommandUI { 2533 commandName = "win32selfupgrade", 2534 commandSynopsis = "Self-upgrade the executable on Windows", 2535 commandDescription = Nothing, 2536 commandNotes = Nothing, 2537 commandUsage = \pname -> 2538 "Usage: " ++ pname ++ " win32selfupgrade PID PATH\n", 2539 commandDefaultFlags = defaultWin32SelfUpgradeFlags, 2540 commandOptions = \_ -> 2541 [optionVerbosity win32SelfUpgradeVerbosity 2542 (\v flags -> flags { win32SelfUpgradeVerbosity = v}) 2543 ] 2544} 2545 2546instance Monoid Win32SelfUpgradeFlags where 2547 mempty = gmempty 2548 mappend = (<>) 2549 2550instance Semigroup Win32SelfUpgradeFlags where 2551 (<>) = gmappend 2552 2553-- ------------------------------------------------------------ 2554-- * ActAsSetup flags 2555-- ------------------------------------------------------------ 2556 2557data ActAsSetupFlags = ActAsSetupFlags { 2558 actAsSetupBuildType :: Flag BuildType 2559} deriving Generic 2560 2561defaultActAsSetupFlags :: ActAsSetupFlags 2562defaultActAsSetupFlags = ActAsSetupFlags { 2563 actAsSetupBuildType = toFlag Simple 2564} 2565 2566actAsSetupCommand :: CommandUI ActAsSetupFlags 2567actAsSetupCommand = CommandUI { 2568 commandName = "act-as-setup", 2569 commandSynopsis = "Run as-if this was a Setup.hs", 2570 commandDescription = Nothing, 2571 commandNotes = Nothing, 2572 commandUsage = \pname -> 2573 "Usage: " ++ pname ++ " act-as-setup\n", 2574 commandDefaultFlags = defaultActAsSetupFlags, 2575 commandOptions = \_ -> 2576 [option "" ["build-type"] 2577 "Use the given build type." 2578 actAsSetupBuildType (\v flags -> flags { actAsSetupBuildType = v }) 2579 (reqArg "BUILD-TYPE" (readP_to_E ("Cannot parse build type: "++) 2580 (fmap toFlag parse)) 2581 (map display . flagToList)) 2582 ] 2583} 2584 2585instance Monoid ActAsSetupFlags where 2586 mempty = gmempty 2587 mappend = (<>) 2588 2589instance Semigroup ActAsSetupFlags where 2590 (<>) = gmappend 2591 2592-- ------------------------------------------------------------ 2593-- * Sandbox-related flags 2594-- ------------------------------------------------------------ 2595 2596data SandboxFlags = SandboxFlags { 2597 sandboxVerbosity :: Flag Verbosity, 2598 sandboxSnapshot :: Flag Bool, -- FIXME: this should be an 'add-source'-only 2599 -- flag. 2600 sandboxLocation :: Flag FilePath 2601} deriving Generic 2602 2603defaultSandboxLocation :: FilePath 2604defaultSandboxLocation = ".cabal-sandbox" 2605 2606defaultSandboxFlags :: SandboxFlags 2607defaultSandboxFlags = SandboxFlags { 2608 sandboxVerbosity = toFlag normal, 2609 sandboxSnapshot = toFlag False, 2610 sandboxLocation = toFlag defaultSandboxLocation 2611 } 2612 2613sandboxCommand :: CommandUI SandboxFlags 2614sandboxCommand = CommandUI { 2615 commandName = "sandbox", 2616 commandSynopsis = "Create/modify/delete a sandbox.", 2617 commandDescription = Just $ \pname -> concat 2618 [ paragraph $ "Sandboxes are isolated package databases that can be used" 2619 ++ " to prevent dependency conflicts that arise when many different" 2620 ++ " packages are installed in the same database (i.e. the user's" 2621 ++ " database in the home directory)." 2622 , paragraph $ "A sandbox in the current directory (created by" 2623 ++ " `v1-sandbox init`) will be used instead of the user's database for" 2624 ++ " commands such as `v1-install` and `v1-build`. Note that (a directly" 2625 ++ " invoked) GHC will not automatically be aware of sandboxes;" 2626 ++ " only if called via appropriate " ++ pname 2627 ++ " commands, e.g. `v1-repl`, `v1-build`, `v1-exec`." 2628 , paragraph $ "Currently, " ++ pname ++ " will not search for a sandbox" 2629 ++ " in folders above the current one, so cabal will not see the sandbox" 2630 ++ " if you are in a subfolder of a sandbox." 2631 , paragraph "Subcommands:" 2632 , headLine "init:" 2633 , indentParagraph $ "Initialize a sandbox in the current directory." 2634 ++ " An existing package database will not be modified, but settings" 2635 ++ " (such as the location of the database) can be modified this way." 2636 , headLine "delete:" 2637 , indentParagraph $ "Remove the sandbox; deleting all the packages" 2638 ++ " installed inside." 2639 , headLine "add-source:" 2640 , indentParagraph $ "Make one or more local packages available in the" 2641 ++ " sandbox. PATHS may be relative or absolute." 2642 ++ " Typical usecase is when you need" 2643 ++ " to make a (temporary) modification to a dependency: You download" 2644 ++ " the package into a different directory, make the modification," 2645 ++ " and add that directory to the sandbox with `add-source`." 2646 , indentParagraph $ "Unless given `--snapshot`, any add-source'd" 2647 ++ " dependency that was modified since the last build will be" 2648 ++ " re-installed automatically." 2649 , headLine "delete-source:" 2650 , indentParagraph $ "Remove an add-source dependency; however, this will" 2651 ++ " not delete the package(s) that have been installed in the sandbox" 2652 ++ " from this dependency. You can either unregister the package(s) via" 2653 ++ " `" ++ pname ++ " v1-sandbox hc-pkg unregister` or re-create the" 2654 ++ " sandbox (`v1-sandbox delete; v1-sandbox init`)." 2655 , headLine "list-sources:" 2656 , indentParagraph $ "List the directories of local packages made" 2657 ++ " available via `" ++ pname ++ " v1-sandbox add-source`." 2658 , headLine "hc-pkg:" 2659 , indentParagraph $ "Similar to `ghc-pkg`, but for the sandbox package" 2660 ++ " database. Can be used to list specific/all packages that are" 2661 ++ " installed in the sandbox. For subcommands, see the help for" 2662 ++ " ghc-pkg. Affected by the compiler version specified by `v1-configure`." 2663 ], 2664 commandNotes = Just $ \pname -> 2665 relevantConfigValuesText ["require-sandbox" 2666 ,"ignore-sandbox"] 2667 ++ "\n" 2668 ++ "Examples:\n" 2669 ++ " Set up a sandbox with one local dependency, located at ../foo:\n" 2670 ++ " " ++ pname ++ " v1-sandbox init\n" 2671 ++ " " ++ pname ++ " v1-sandbox add-source ../foo\n" 2672 ++ " " ++ pname ++ " v1-install --only-dependencies\n" 2673 ++ " Reset the sandbox:\n" 2674 ++ " " ++ pname ++ " v1-sandbox delete\n" 2675 ++ " " ++ pname ++ " v1-sandbox init\n" 2676 ++ " " ++ pname ++ " v1-install --only-dependencies\n" 2677 ++ " List the packages in the sandbox:\n" 2678 ++ " " ++ pname ++ " v1-sandbox hc-pkg list\n" 2679 ++ " Unregister the `broken` package from the sandbox:\n" 2680 ++ " " ++ pname ++ " v1-sandbox hc-pkg -- --force unregister broken\n", 2681 commandUsage = usageAlternatives "v1-sandbox" 2682 [ "init [FLAGS]" 2683 , "delete [FLAGS]" 2684 , "add-source [FLAGS] PATHS" 2685 , "delete-source [FLAGS] PATHS" 2686 , "list-sources [FLAGS]" 2687 , "hc-pkg [FLAGS] [--] COMMAND [--] [ARGS]" 2688 ], 2689 2690 commandDefaultFlags = defaultSandboxFlags, 2691 commandOptions = \_ -> 2692 [ optionVerbosity sandboxVerbosity 2693 (\v flags -> flags { sandboxVerbosity = v }) 2694 2695 , option [] ["snapshot"] 2696 "Take a snapshot instead of creating a link (only applies to 'add-source')" 2697 sandboxSnapshot (\v flags -> flags { sandboxSnapshot = v }) 2698 trueArg 2699 2700 , option [] ["sandbox"] 2701 "Sandbox location (default: './.cabal-sandbox')." 2702 sandboxLocation (\v flags -> flags { sandboxLocation = v }) 2703 (reqArgFlag "DIR") 2704 ] 2705 } 2706 2707instance Monoid SandboxFlags where 2708 mempty = gmempty 2709 mappend = (<>) 2710 2711instance Semigroup SandboxFlags where 2712 (<>) = gmappend 2713 2714-- ------------------------------------------------------------ 2715-- * Exec Flags 2716-- ------------------------------------------------------------ 2717 2718data ExecFlags = ExecFlags { 2719 execVerbosity :: Flag Verbosity, 2720 execDistPref :: Flag FilePath 2721} deriving Generic 2722 2723defaultExecFlags :: ExecFlags 2724defaultExecFlags = ExecFlags { 2725 execVerbosity = toFlag normal, 2726 execDistPref = NoFlag 2727 } 2728 2729execCommand :: CommandUI ExecFlags 2730execCommand = CommandUI { 2731 commandName = "exec", 2732 commandSynopsis = "Give a command access to the sandbox package repository.", 2733 commandDescription = Just $ \pname -> wrapText $ 2734 -- TODO: this is too GHC-focused for my liking.. 2735 "A directly invoked GHC will not automatically be aware of any" 2736 ++ " sandboxes: the GHC_PACKAGE_PATH environment variable controls what" 2737 ++ " GHC uses. `" ++ pname ++ " v1-exec` can be used to modify this variable:" 2738 ++ " COMMAND will be executed in a modified environment and thereby uses" 2739 ++ " the sandbox package database.\n" 2740 ++ "\n" 2741 ++ "If there is no sandbox, behaves as identity (executing COMMAND).\n" 2742 ++ "\n" 2743 ++ "Note that other " ++ pname ++ " commands change the environment" 2744 ++ " variable appropriately already, so there is no need to wrap those" 2745 ++ " in `" ++ pname ++ " v1-exec`. But with `" ++ pname ++ " v1-exec`, the user" 2746 ++ " has more control and can, for example, execute custom scripts which" 2747 ++ " indirectly execute GHC.\n" 2748 ++ "\n" 2749 ++ "Note that `" ++ pname ++ " v1-repl` is different from `" ++ pname 2750 ++ " v1-exec -- ghci` as the latter will not forward any additional flags" 2751 ++ " being defined in the local package to ghci.\n" 2752 ++ "\n" 2753 ++ "See `" ++ pname ++ " sandbox`.\n", 2754 commandNotes = Just $ \pname -> 2755 "Examples:\n" 2756 ++ " " ++ pname ++ " v1-exec -- ghci -Wall\n" 2757 ++ " Start a repl session with sandbox packages and all warnings;\n" 2758 ++ " " ++ pname ++ " v1-exec gitit -- -f gitit.cnf\n" 2759 ++ " Give gitit access to the sandbox packages, and pass it a flag;\n" 2760 ++ " " ++ pname ++ " v1-exec runghc Foo.hs\n" 2761 ++ " Execute runghc on Foo.hs with runghc configured to use the\n" 2762 ++ " sandbox package database (if a sandbox is being used).\n", 2763 commandUsage = \pname -> 2764 "Usage: " ++ pname ++ " v1-exec [FLAGS] [--] COMMAND [--] [ARGS]\n", 2765 2766 commandDefaultFlags = defaultExecFlags, 2767 commandOptions = \showOrParseArgs -> 2768 [ optionVerbosity execVerbosity 2769 (\v flags -> flags { execVerbosity = v }) 2770 , Cabal.optionDistPref 2771 execDistPref (\d flags -> flags { execDistPref = d }) 2772 showOrParseArgs 2773 ] 2774 } 2775 2776instance Monoid ExecFlags where 2777 mempty = gmempty 2778 mappend = (<>) 2779 2780instance Semigroup ExecFlags where 2781 (<>) = gmappend 2782 2783-- ------------------------------------------------------------ 2784-- * UserConfig flags 2785-- ------------------------------------------------------------ 2786 2787data UserConfigFlags = UserConfigFlags { 2788 userConfigVerbosity :: Flag Verbosity, 2789 userConfigForce :: Flag Bool, 2790 userConfigAppendLines :: Flag [String] 2791 } deriving Generic 2792 2793instance Monoid UserConfigFlags where 2794 mempty = UserConfigFlags { 2795 userConfigVerbosity = toFlag normal, 2796 userConfigForce = toFlag False, 2797 userConfigAppendLines = toFlag [] 2798 } 2799 mappend = (<>) 2800 2801instance Semigroup UserConfigFlags where 2802 (<>) = gmappend 2803 2804userConfigCommand :: CommandUI UserConfigFlags 2805userConfigCommand = CommandUI { 2806 commandName = "user-config", 2807 commandSynopsis = "Display and update the user's global cabal configuration.", 2808 commandDescription = Just $ \_ -> wrapText $ 2809 "When upgrading cabal, the set of configuration keys and their default" 2810 ++ " values may change. This command provides means to merge the existing" 2811 ++ " config in ~/.cabal/config" 2812 ++ " (i.e. all bindings that are actually defined and not commented out)" 2813 ++ " and the default config of the new version.\n" 2814 ++ "\n" 2815 ++ "init: Creates a new config file at either ~/.cabal/config or as" 2816 ++ " specified by --config-file, if given. An existing file won't be " 2817 ++ " overwritten unless -f or --force is given.\n" 2818 ++ "diff: Shows a pseudo-diff of the user's ~/.cabal/config file and" 2819 ++ " the default configuration that would be created by cabal if the" 2820 ++ " config file did not exist.\n" 2821 ++ "update: Applies the pseudo-diff to the configuration that would be" 2822 ++ " created by default, and write the result back to ~/.cabal/config.", 2823 2824 commandNotes = Nothing, 2825 commandUsage = usageAlternatives "user-config" ["init", "diff", "update"], 2826 commandDefaultFlags = mempty, 2827 commandOptions = \ _ -> [ 2828 optionVerbosity userConfigVerbosity (\v flags -> flags { userConfigVerbosity = v }) 2829 , option ['f'] ["force"] 2830 "Overwrite the config file if it already exists." 2831 userConfigForce (\v flags -> flags { userConfigForce = v }) 2832 trueArg 2833 , option ['a'] ["augment"] 2834 "Additional setting to augment the config file (replacing a previous setting if it existed)." 2835 userConfigAppendLines (\v flags -> flags 2836 {userConfigAppendLines = 2837 Flag $ concat (flagToList (userConfigAppendLines flags) ++ flagToList v)}) 2838 (reqArg' "CONFIGLINE" (Flag . (:[])) (fromMaybe [] . flagToMaybe)) 2839 ] 2840 } 2841 2842 2843-- ------------------------------------------------------------ 2844-- * GetOpt Utils 2845-- ------------------------------------------------------------ 2846 2847reqArgFlag :: ArgPlaceHolder -> 2848 MkOptDescr (b -> Flag String) (Flag String -> b -> b) b 2849reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList 2850 2851liftOptions :: (b -> a) -> (a -> b -> b) 2852 -> [OptionField a] -> [OptionField b] 2853liftOptions get set = map (liftOption get set) 2854 2855yesNoOpt :: ShowOrParseArgs -> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b 2856yesNoOpt ShowArgs sf lf = trueArg sf lf 2857yesNoOpt _ sf lf = Command.boolOpt' flagToMaybe Flag (sf, lf) ([], map ("no-" ++) lf) sf lf 2858 2859optionSolver :: (flags -> Flag PreSolver) 2860 -> (Flag PreSolver -> flags -> flags) 2861 -> OptionField flags 2862optionSolver get set = 2863 option [] ["solver"] 2864 ("Select dependency solver to use (default: " ++ display defaultSolver ++ "). Choices: " ++ allSolvers ++ ".") 2865 get set 2866 (reqArg "SOLVER" (readP_to_E (const $ "solver must be one of: " ++ allSolvers) 2867 (toFlag `fmap` parse)) 2868 (flagToList . fmap display)) 2869 2870optionSolverFlags :: ShowOrParseArgs 2871 -> (flags -> Flag Int ) -> (Flag Int -> flags -> flags) 2872 -> (flags -> Flag ReorderGoals) -> (Flag ReorderGoals -> flags -> flags) 2873 -> (flags -> Flag CountConflicts) -> (Flag CountConflicts -> flags -> flags) 2874 -> (flags -> Flag FineGrainedConflicts) -> (Flag FineGrainedConflicts -> flags -> flags) 2875 -> (flags -> Flag MinimizeConflictSet) -> (Flag MinimizeConflictSet -> flags -> flags) 2876 -> (flags -> Flag IndependentGoals) -> (Flag IndependentGoals -> flags -> flags) 2877 -> (flags -> Flag ShadowPkgs) -> (Flag ShadowPkgs -> flags -> flags) 2878 -> (flags -> Flag StrongFlags) -> (Flag StrongFlags -> flags -> flags) 2879 -> (flags -> Flag AllowBootLibInstalls) -> (Flag AllowBootLibInstalls -> flags -> flags) 2880 -> (flags -> Flag OnlyConstrained) -> (Flag OnlyConstrained -> flags -> flags) 2881 -> [OptionField flags] 2882optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc 2883 getfgc setfgc getmc setmc getig setig getsip setsip 2884 getstrfl setstrfl getib setib getoc setoc = 2885 [ option [] ["max-backjumps"] 2886 ("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.") 2887 getmbj setmbj 2888 (reqArg "NUM" (readP_to_E ("Cannot parse number: "++) (fmap toFlag parse)) 2889 (map show . flagToList)) 2890 , option [] ["reorder-goals"] 2891 "Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages." 2892 (fmap asBool . getrg) 2893 (setrg . fmap ReorderGoals) 2894 (yesNoOpt showOrParseArgs) 2895 , option [] ["count-conflicts"] 2896 "Try to speed up solving by preferring goals that are involved in a lot of conflicts (default)." 2897 (fmap asBool . getcc) 2898 (setcc . fmap CountConflicts) 2899 (yesNoOpt showOrParseArgs) 2900 , option [] ["fine-grained-conflicts"] 2901 "Skip a version of a package if it does not resolve the conflicts encountered in the last version, as a solver optimization (default)." 2902 (fmap asBool . getfgc) 2903 (setfgc . fmap FineGrainedConflicts) 2904 (yesNoOpt showOrParseArgs) 2905 , option [] ["minimize-conflict-set"] 2906 ("When there is no solution, try to improve the error message by finding " 2907 ++ "a minimal conflict set (default: false). May increase run time " 2908 ++ "significantly.") 2909 (fmap asBool . getmc) 2910 (setmc . fmap MinimizeConflictSet) 2911 (yesNoOpt showOrParseArgs) 2912 , option [] ["independent-goals"] 2913 "Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen." 2914 (fmap asBool . getig) 2915 (setig . fmap IndependentGoals) 2916 (yesNoOpt showOrParseArgs) 2917 , option [] ["shadow-installed-packages"] 2918 "If multiple package instances of the same version are installed, treat all but one as shadowed." 2919 (fmap asBool . getsip) 2920 (setsip . fmap ShadowPkgs) 2921 (yesNoOpt showOrParseArgs) 2922 , option [] ["strong-flags"] 2923 "Do not defer flag choices (this used to be the default in cabal-install <= 1.20)." 2924 (fmap asBool . getstrfl) 2925 (setstrfl . fmap StrongFlags) 2926 (yesNoOpt showOrParseArgs) 2927 , option [] ["allow-boot-library-installs"] 2928 "Allow cabal to install base, ghc-prim, integer-simple, integer-gmp, and template-haskell." 2929 (fmap asBool . getib) 2930 (setib . fmap AllowBootLibInstalls) 2931 (yesNoOpt showOrParseArgs) 2932 , option [] ["reject-unconstrained-dependencies"] 2933 "Require these packages to have constraints on them if they are to be selected (default: none)." 2934 getoc 2935 setoc 2936 (reqArg "none|all" 2937 (readP_to_E 2938 (const "reject-unconstrained-dependencies must be 'none' or 'all'") 2939 (toFlag `fmap` parse)) 2940 (flagToList . fmap display)) 2941 2942 ] 2943 2944usageFlagsOrPackages :: String -> String -> String 2945usageFlagsOrPackages name pname = 2946 "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n" 2947 ++ " or: " ++ pname ++ " " ++ name ++ " [PACKAGES]\n" 2948 2949usagePackages :: String -> String -> String 2950usagePackages name pname = 2951 "Usage: " ++ pname ++ " " ++ name ++ " [PACKAGES]\n" 2952 2953usageFlags :: String -> String -> String 2954usageFlags name pname = 2955 "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n" 2956 2957--TODO: do we want to allow per-package flags? 2958parsePackageArgs :: [String] -> Either String [Dependency] 2959parsePackageArgs = parsePkgArgs [] 2960 where 2961 parsePkgArgs ds [] = Right (reverse ds) 2962 parsePkgArgs ds (arg:args) = 2963 case readPToMaybe parseDependencyOrPackageId arg of 2964 Just dep -> parsePkgArgs (dep:ds) args 2965 Nothing -> Left $ 2966 show arg ++ " is not valid syntax for a package name or" 2967 ++ " package dependency." 2968 2969parseDependencyOrPackageId :: Parse.ReadP r Dependency 2970parseDependencyOrPackageId = parse Parse.+++ liftM pkgidToDependency parse 2971 where 2972 pkgidToDependency :: PackageIdentifier -> Dependency 2973 pkgidToDependency p = case packageVersion p of 2974 v | v == nullVersion -> Dependency (packageName p) anyVersion (Set.singleton LMainLibName) 2975 | otherwise -> Dependency (packageName p) (thisVersion v) (Set.singleton LMainLibName) 2976 2977showRemoteRepo :: RemoteRepo -> String 2978showRemoteRepo repo = remoteRepoName repo ++ ":" 2979 ++ uriToString id (remoteRepoURI repo) [] 2980 2981readRemoteRepo :: String -> Maybe RemoteRepo 2982readRemoteRepo = readPToMaybe parseRemoteRepo 2983 2984parseRemoteRepo :: Parse.ReadP r RemoteRepo 2985parseRemoteRepo = do 2986 name <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "_-.") 2987 _ <- Parse.char ':' 2988 uriStr <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "+-=._/*()@'$:;&!?~") 2989 uri <- maybe Parse.pfail return (parseAbsoluteURI uriStr) 2990 return RemoteRepo { 2991 remoteRepoName = name, 2992 remoteRepoURI = uri, 2993 remoteRepoSecure = Nothing, 2994 remoteRepoRootKeys = [], 2995 remoteRepoKeyThreshold = 0, 2996 remoteRepoShouldTryHttps = False 2997 } 2998 2999showLocalRepo :: LocalRepo -> String 3000showLocalRepo repo = localRepoName repo ++ ":" ++ localRepoPath repo 3001 3002readLocalRepo :: String -> Maybe LocalRepo 3003readLocalRepo = readPToMaybe parseLocalRepo 3004 3005parseLocalRepo :: Parse.ReadP r LocalRepo 3006parseLocalRepo = do 3007 name <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "_-.") 3008 _ <- Parse.char ':' 3009 path <- Parse.munch1 (const True) 3010 return $ (emptyLocalRepo name) 3011 { localRepoPath = path 3012 } 3013 3014-- ------------------------------------------------------------ 3015-- * Helpers for Documentation 3016-- ------------------------------------------------------------ 3017 3018headLine :: String -> String 3019headLine = unlines 3020 . map unwords 3021 . wrapLine 79 3022 . words 3023 3024paragraph :: String -> String 3025paragraph = (++"\n") 3026 . unlines 3027 . map unwords 3028 . wrapLine 79 3029 . words 3030 3031indentParagraph :: String -> String 3032indentParagraph = unlines 3033 . (flip (++)) [""] 3034 . map ((" "++).unwords) 3035 . wrapLine 77 3036 . words 3037 3038relevantConfigValuesText :: [String] -> String 3039relevantConfigValuesText vs = 3040 "Relevant global configuration keys:\n" 3041 ++ concat [" " ++ v ++ "\n" |v <- vs] 3042