1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveGeneric #-} 3{-# LANGUAGE FlexibleContexts #-} 4{-# LANGUAGE RankNTypes #-} 5 6----------------------------------------------------------------------------- 7-- | 8-- Module : Distribution.Simple.Setup 9-- Copyright : Isaac Jones 2003-2004 10-- Duncan Coutts 2007 11-- License : BSD3 12-- 13-- Maintainer : cabal-devel@haskell.org 14-- Portability : portable 15-- 16-- This is a big module, but not very complicated. The code is very regular 17-- and repetitive. It defines the command line interface for all the Cabal 18-- commands. For each command (like @configure@, @build@ etc) it defines a type 19-- that holds all the flags, the default set of flags and a 'CommandUI' that 20-- maps command line flags to and from the corresponding flags type. 21-- 22-- All the flags types are instances of 'Monoid', see 23-- <http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html> 24-- for an explanation. 25-- 26-- The types defined here get used in the front end and especially in 27-- @cabal-install@ which has to do quite a bit of manipulating sets of command 28-- line flags. 29-- 30-- This is actually relatively nice, it works quite well. The main change it 31-- needs is to unify it with the code for managing sets of fields that can be 32-- read and written from files. This would allow us to save configure flags in 33-- config files. 34 35module Distribution.Simple.Setup ( 36 37 GlobalFlags(..), emptyGlobalFlags, defaultGlobalFlags, globalCommand, 38 ConfigFlags(..), emptyConfigFlags, defaultConfigFlags, configureCommand, 39 configPrograms, 40 configAbsolutePaths, readPackageDbList, showPackageDbList, 41 CopyFlags(..), emptyCopyFlags, defaultCopyFlags, copyCommand, 42 InstallFlags(..), emptyInstallFlags, defaultInstallFlags, installCommand, 43 DoctestFlags(..), emptyDoctestFlags, defaultDoctestFlags, doctestCommand, 44 HaddockTarget(..), 45 HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand, 46 HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand, 47 BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand, 48 ShowBuildInfoFlags(..), defaultShowBuildFlags, showBuildInfoCommand, 49 ReplFlags(..), defaultReplFlags, replCommand, 50 CleanFlags(..), emptyCleanFlags, defaultCleanFlags, cleanCommand, 51 RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand, 52 unregisterCommand, 53 SDistFlags(..), emptySDistFlags, defaultSDistFlags, sdistCommand, 54 TestFlags(..), emptyTestFlags, defaultTestFlags, testCommand, 55 TestShowDetails(..), 56 BenchmarkFlags(..), emptyBenchmarkFlags, 57 defaultBenchmarkFlags, benchmarkCommand, 58 CopyDest(..), 59 configureArgs, configureOptions, configureCCompiler, configureLinker, 60 buildOptions, haddockOptions, installDirsOptions, testOptions', 61 programDbOptions, programDbPaths', 62 programFlagsDescription, 63 replOptions, 64 splitArgs, 65 66 defaultDistPref, optionDistPref, 67 68 Flag(..), 69 toFlag, 70 fromFlag, 71 fromFlagOrDefault, 72 flagToMaybe, 73 flagToList, 74 maybeToFlag, 75 BooleanFlag(..), 76 boolOpt, boolOpt', trueArg, falseArg, 77 optionVerbosity, optionNumJobs) where 78 79import Prelude () 80import Distribution.Compat.Prelude hiding (get) 81 82import Distribution.Compiler 83import Distribution.ReadE 84import Distribution.Parsec 85import Distribution.Pretty 86import qualified Distribution.Compat.CharParsing as P 87import qualified Text.PrettyPrint as Disp 88import Distribution.ModuleName 89import Distribution.PackageDescription hiding (Flag) 90import Distribution.Simple.Command hiding (boolOpt, boolOpt') 91import qualified Distribution.Simple.Command as Command 92import Distribution.Simple.Compiler hiding (Flag) 93import Distribution.Simple.Flag 94import Distribution.Simple.Utils 95import Distribution.Simple.Program 96import Distribution.Simple.InstallDirs 97import Distribution.Verbosity 98import Distribution.Utils.NubList 99import Distribution.Types.Dependency 100import Distribution.Types.ComponentId 101import Distribution.Types.GivenComponent 102import Distribution.Types.Module 103import Distribution.Types.PackageName 104import Distribution.Types.UnqualComponentName (unUnqualComponentName) 105 106import Distribution.Compat.Stack 107import Distribution.Compat.Semigroup (Last' (..), Option' (..)) 108 109import Data.Function (on) 110 111-- FIXME Not sure where this should live 112defaultDistPref :: FilePath 113defaultDistPref = "dist" 114 115-- ------------------------------------------------------------ 116-- * Global flags 117-- ------------------------------------------------------------ 118 119-- In fact since individual flags types are monoids and these are just sets of 120-- flags then they are also monoids pointwise. This turns out to be really 121-- useful. The mempty is the set of empty flags and mappend allows us to 122-- override specific flags. For example we can start with default flags and 123-- override with the ones we get from a file or the command line, or both. 124 125-- | Flags that apply at the top level, not to any sub-command. 126data GlobalFlags = GlobalFlags { 127 globalVersion :: Flag Bool, 128 globalNumericVersion :: Flag Bool 129 } deriving (Generic) 130 131defaultGlobalFlags :: GlobalFlags 132defaultGlobalFlags = GlobalFlags { 133 globalVersion = Flag False, 134 globalNumericVersion = Flag False 135 } 136 137globalCommand :: [Command action] -> CommandUI GlobalFlags 138globalCommand commands = CommandUI 139 { commandName = "" 140 , commandSynopsis = "" 141 , commandUsage = \pname -> 142 "This Setup program uses the Haskell Cabal Infrastructure.\n" 143 ++ "See http://www.haskell.org/cabal/ for more information.\n" 144 ++ "\n" 145 ++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n" 146 , commandDescription = Just $ \pname -> 147 let 148 commands' = commands ++ [commandAddAction helpCommandUI undefined] 149 cmdDescs = getNormalCommandDescriptions commands' 150 maxlen = maximum $ [length name | (name, _) <- cmdDescs] 151 align str = str ++ replicate (maxlen - length str) ' ' 152 in 153 "Commands:\n" 154 ++ unlines [ " " ++ align name ++ " " ++ descr 155 | (name, descr) <- cmdDescs ] 156 ++ "\n" 157 ++ "For more information about a command use\n" 158 ++ " " ++ pname ++ " COMMAND --help\n\n" 159 ++ "Typical steps for installing Cabal packages:\n" 160 ++ concat [ " " ++ pname ++ " " ++ x ++ "\n" 161 | x <- ["configure", "build", "install"]] 162 , commandNotes = Nothing 163 , commandDefaultFlags = defaultGlobalFlags 164 , commandOptions = \_ -> 165 [option ['V'] ["version"] 166 "Print version information" 167 globalVersion (\v flags -> flags { globalVersion = v }) 168 trueArg 169 ,option [] ["numeric-version"] 170 "Print just the version number" 171 globalNumericVersion (\v flags -> flags { globalNumericVersion = v }) 172 trueArg 173 ] 174 } 175 176emptyGlobalFlags :: GlobalFlags 177emptyGlobalFlags = mempty 178 179instance Monoid GlobalFlags where 180 mempty = gmempty 181 mappend = (<>) 182 183instance Semigroup GlobalFlags where 184 (<>) = gmappend 185 186-- ------------------------------------------------------------ 187-- * Config flags 188-- ------------------------------------------------------------ 189 190-- | Flags to @configure@ command. 191-- 192-- IMPORTANT: every time a new flag is added, 'D.C.Setup.filterConfigureFlags' 193-- should be updated. 194-- IMPORTANT: every time a new flag is added, it should be added to the Eq instance 195data ConfigFlags = ConfigFlags { 196 -- This is the same hack as in 'buildArgs' and 'copyArgs'. 197 -- TODO: Stop using this eventually when 'UserHooks' gets changed 198 configArgs :: [String], 199 200 --FIXME: the configPrograms is only here to pass info through to configure 201 -- because the type of configure is constrained by the UserHooks. 202 -- when we change UserHooks next we should pass the initial 203 -- ProgramDb directly and not via ConfigFlags 204 configPrograms_ :: Option' (Last' ProgramDb), -- ^All programs that 205 -- @cabal@ may run 206 207 configProgramPaths :: [(String, FilePath)], -- ^user specified programs paths 208 configProgramArgs :: [(String, [String])], -- ^user specified programs args 209 configProgramPathExtra :: NubList FilePath, -- ^Extend the $PATH 210 configHcFlavor :: Flag CompilerFlavor, -- ^The \"flavor\" of the 211 -- compiler, e.g. GHC. 212 configHcPath :: Flag FilePath, -- ^given compiler location 213 configHcPkg :: Flag FilePath, -- ^given hc-pkg location 214 configVanillaLib :: Flag Bool, -- ^Enable vanilla library 215 configProfLib :: Flag Bool, -- ^Enable profiling in the library 216 configSharedLib :: Flag Bool, -- ^Build shared library 217 configStaticLib :: Flag Bool, -- ^Build static library 218 configDynExe :: Flag Bool, -- ^Enable dynamic linking of the 219 -- executables. 220 configFullyStaticExe :: Flag Bool, -- ^Enable fully static linking of the 221 -- executables. 222 configProfExe :: Flag Bool, -- ^Enable profiling in the 223 -- executables. 224 configProf :: Flag Bool, -- ^Enable profiling in the library 225 -- and executables. 226 configProfDetail :: Flag ProfDetailLevel, -- ^Profiling detail level 227 -- in the library and executables. 228 configProfLibDetail :: Flag ProfDetailLevel, -- ^Profiling detail level 229 -- in the library 230 configConfigureArgs :: [String], -- ^Extra arguments to @configure@ 231 configOptimization :: Flag OptimisationLevel, -- ^Enable optimization. 232 configProgPrefix :: Flag PathTemplate, -- ^Installed executable prefix. 233 configProgSuffix :: Flag PathTemplate, -- ^Installed executable suffix. 234 configInstallDirs :: InstallDirs (Flag PathTemplate), -- ^Installation 235 -- paths 236 configScratchDir :: Flag FilePath, 237 configExtraLibDirs :: [FilePath], -- ^ path to search for extra libraries 238 configExtraFrameworkDirs :: [FilePath], -- ^ path to search for extra 239 -- frameworks (OS X only) 240 configExtraIncludeDirs :: [FilePath], -- ^ path to search for header files 241 configIPID :: Flag String, -- ^ explicit IPID to be used 242 configCID :: Flag ComponentId, -- ^ explicit CID to be used 243 configDeterministic :: Flag Bool, -- ^ be as deterministic as possible 244 -- (e.g., invariant over GHC, database, 245 -- etc). Used by the test suite 246 247 configDistPref :: Flag FilePath, -- ^"dist" prefix 248 configCabalFilePath :: Flag FilePath, -- ^ Cabal file to use 249 configVerbosity :: Flag Verbosity, -- ^verbosity level 250 configUserInstall :: Flag Bool, -- ^The --user\/--global flag 251 configPackageDBs :: [Maybe PackageDB], -- ^Which package DBs to use 252 configGHCiLib :: Flag Bool, -- ^Enable compiling library for GHCi 253 configSplitSections :: Flag Bool, -- ^Enable -split-sections with GHC 254 configSplitObjs :: Flag Bool, -- ^Enable -split-objs with GHC 255 configStripExes :: Flag Bool, -- ^Enable executable stripping 256 configStripLibs :: Flag Bool, -- ^Enable library stripping 257 configConstraints :: [Dependency], -- ^Additional constraints for 258 -- dependencies. 259 configDependencies :: [GivenComponent], 260 -- ^The packages depended on. 261 configInstantiateWith :: [(ModuleName, Module)], 262 -- ^ The requested Backpack instantiation. If empty, either this 263 -- package does not use Backpack, or we just want to typecheck 264 -- the indefinite package. 265 configConfigurationsFlags :: FlagAssignment, 266 configTests :: Flag Bool, -- ^Enable test suite compilation 267 configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation 268 configCoverage :: Flag Bool, -- ^Enable program coverage 269 configLibCoverage :: Flag Bool, -- ^Enable program coverage (deprecated) 270 configExactConfiguration :: Flag Bool, 271 -- ^All direct dependencies and flags are provided on the command line by 272 -- the user via the '--dependency' and '--flags' options. 273 configFlagError :: Flag String, 274 -- ^Halt and show an error message indicating an error in flag assignment 275 configRelocatable :: Flag Bool, -- ^ Enable relocatable package built 276 configDebugInfo :: Flag DebugInfoLevel, -- ^ Emit debug info. 277 configUseResponseFiles :: Flag Bool, 278 -- ^ Whether to use response files at all. They're used for such tools 279 -- as haddock, or or ld. 280 configAllowDependingOnPrivateLibs :: Flag Bool 281 -- ^ Allow depending on private sublibraries. This is used by external 282 -- tools (like cabal-install) so they can add multiple-public-libraries 283 -- compatibility to older ghcs by checking visibility externally. 284 } 285 deriving (Generic, Read, Show) 286 287instance Binary ConfigFlags 288 289-- | More convenient version of 'configPrograms'. Results in an 290-- 'error' if internal invariant is violated. 291configPrograms :: WithCallStack (ConfigFlags -> ProgramDb) 292configPrograms = fromMaybe (error "FIXME: remove configPrograms") . fmap getLast' 293 . getOption' . configPrograms_ 294 295instance Eq ConfigFlags where 296 (==) a b = 297 -- configPrograms skipped: not user specified, has no Eq instance 298 equal configProgramPaths 299 && equal configProgramArgs 300 && equal configProgramPathExtra 301 && equal configHcFlavor 302 && equal configHcPath 303 && equal configHcPkg 304 && equal configVanillaLib 305 && equal configProfLib 306 && equal configSharedLib 307 && equal configStaticLib 308 && equal configDynExe 309 && equal configFullyStaticExe 310 && equal configProfExe 311 && equal configProf 312 && equal configProfDetail 313 && equal configProfLibDetail 314 && equal configConfigureArgs 315 && equal configOptimization 316 && equal configProgPrefix 317 && equal configProgSuffix 318 && equal configInstallDirs 319 && equal configScratchDir 320 && equal configExtraLibDirs 321 && equal configExtraIncludeDirs 322 && equal configIPID 323 && equal configDeterministic 324 && equal configDistPref 325 && equal configVerbosity 326 && equal configUserInstall 327 && equal configPackageDBs 328 && equal configGHCiLib 329 && equal configSplitSections 330 && equal configSplitObjs 331 && equal configStripExes 332 && equal configStripLibs 333 && equal configConstraints 334 && equal configDependencies 335 && equal configConfigurationsFlags 336 && equal configTests 337 && equal configBenchmarks 338 && equal configCoverage 339 && equal configLibCoverage 340 && equal configExactConfiguration 341 && equal configFlagError 342 && equal configRelocatable 343 && equal configDebugInfo 344 && equal configUseResponseFiles 345 where 346 equal f = on (==) f a b 347 348configAbsolutePaths :: ConfigFlags -> NoCallStackIO ConfigFlags 349configAbsolutePaths f = 350 (\v -> f { configPackageDBs = v }) 351 `liftM` traverse (maybe (return Nothing) (liftM Just . absolutePackageDBPath)) 352 (configPackageDBs f) 353 354defaultConfigFlags :: ProgramDb -> ConfigFlags 355defaultConfigFlags progDb = emptyConfigFlags { 356 configArgs = [], 357 configPrograms_ = Option' (Just (Last' progDb)), 358 configHcFlavor = maybe NoFlag Flag defaultCompilerFlavor, 359 configVanillaLib = Flag True, 360 configProfLib = NoFlag, 361 configSharedLib = NoFlag, 362 configStaticLib = NoFlag, 363 configDynExe = Flag False, 364 configFullyStaticExe = Flag False, 365 configProfExe = NoFlag, 366 configProf = NoFlag, 367 configProfDetail = NoFlag, 368 configProfLibDetail= NoFlag, 369 configOptimization = Flag NormalOptimisation, 370 configProgPrefix = Flag (toPathTemplate ""), 371 configProgSuffix = Flag (toPathTemplate ""), 372 configDistPref = NoFlag, 373 configCabalFilePath = NoFlag, 374 configVerbosity = Flag normal, 375 configUserInstall = Flag False, --TODO: reverse this 376#if defined(mingw32_HOST_OS) 377 -- See #1589. 378 configGHCiLib = Flag True, 379#else 380 configGHCiLib = NoFlag, 381#endif 382 configSplitSections = Flag False, 383 configSplitObjs = Flag False, -- takes longer, so turn off by default 384 configStripExes = NoFlag, 385 configStripLibs = NoFlag, 386 configTests = Flag False, 387 configBenchmarks = Flag False, 388 configCoverage = Flag False, 389 configLibCoverage = NoFlag, 390 configExactConfiguration = Flag False, 391 configFlagError = NoFlag, 392 configRelocatable = Flag False, 393 configDebugInfo = Flag NoDebugInfo, 394 configUseResponseFiles = NoFlag 395 } 396 397configureCommand :: ProgramDb -> CommandUI ConfigFlags 398configureCommand progDb = CommandUI 399 { commandName = "configure" 400 , commandSynopsis = "Prepare to build the package." 401 , commandDescription = Just $ \_ -> wrapText $ 402 "Configure how the package is built by setting " 403 ++ "package (and other) flags.\n" 404 ++ "\n" 405 ++ "The configuration affects several other commands, " 406 ++ "including build, test, bench, run, repl.\n" 407 , commandNotes = Just $ \_pname -> programFlagsDescription progDb 408 , commandUsage = \pname -> 409 "Usage: " ++ pname ++ " configure [FLAGS]\n" 410 , commandDefaultFlags = defaultConfigFlags progDb 411 , commandOptions = \showOrParseArgs -> 412 configureOptions showOrParseArgs 413 ++ programDbPaths progDb showOrParseArgs 414 configProgramPaths (\v fs -> fs { configProgramPaths = v }) 415 ++ programDbOption progDb showOrParseArgs 416 configProgramArgs (\v fs -> fs { configProgramArgs = v }) 417 ++ programDbOptions progDb showOrParseArgs 418 configProgramArgs (\v fs -> fs { configProgramArgs = v }) 419 } 420 421-- | Inverse to 'dispModSubstEntry'. 422parsecModSubstEntry :: ParsecParser (ModuleName, Module) 423parsecModSubstEntry = do 424 k <- parsec 425 _ <- P.char '=' 426 v <- parsec 427 return (k, v) 428 429-- | Pretty-print a single entry of a module substitution. 430dispModSubstEntry :: (ModuleName, Module) -> Disp.Doc 431dispModSubstEntry (k, v) = pretty k <<>> Disp.char '=' <<>> pretty v 432 433configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags] 434configureOptions showOrParseArgs = 435 [optionVerbosity configVerbosity 436 (\v flags -> flags { configVerbosity = v }) 437 ,optionDistPref 438 configDistPref (\d flags -> flags { configDistPref = d }) 439 showOrParseArgs 440 441 ,option [] ["compiler"] "compiler" 442 configHcFlavor (\v flags -> flags { configHcFlavor = v }) 443 (choiceOpt [ (Flag GHC, ("g", ["ghc"]), "compile with GHC") 444 , (Flag GHCJS, ([] , ["ghcjs"]), "compile with GHCJS") 445 , (Flag UHC, ([] , ["uhc"]), "compile with UHC") 446 -- "haskell-suite" compiler id string will be replaced 447 -- by a more specific one during the configure stage 448 , (Flag (HaskellSuite "haskell-suite"), ([] , ["haskell-suite"]), 449 "compile with a haskell-suite compiler")]) 450 451 ,option "" ["cabal-file"] 452 "use this Cabal file" 453 configCabalFilePath (\v flags -> flags { configCabalFilePath = v }) 454 (reqArgFlag "PATH") 455 456 ,option "w" ["with-compiler"] 457 "give the path to a particular compiler" 458 configHcPath (\v flags -> flags { configHcPath = v }) 459 (reqArgFlag "PATH") 460 461 ,option "" ["with-hc-pkg"] 462 "give the path to the package tool" 463 configHcPkg (\v flags -> flags { configHcPkg = v }) 464 (reqArgFlag "PATH") 465 ] 466 ++ map liftInstallDirs installDirsOptions 467 ++ [option "" ["program-prefix"] 468 "prefix to be applied to installed executables" 469 configProgPrefix 470 (\v flags -> flags { configProgPrefix = v }) 471 (reqPathTemplateArgFlag "PREFIX") 472 473 ,option "" ["program-suffix"] 474 "suffix to be applied to installed executables" 475 configProgSuffix (\v flags -> flags { configProgSuffix = v } ) 476 (reqPathTemplateArgFlag "SUFFIX") 477 478 ,option "" ["library-vanilla"] 479 "Vanilla libraries" 480 configVanillaLib (\v flags -> flags { configVanillaLib = v }) 481 (boolOpt [] []) 482 483 ,option "p" ["library-profiling"] 484 "Library profiling" 485 configProfLib (\v flags -> flags { configProfLib = v }) 486 (boolOpt "p" []) 487 488 ,option "" ["shared"] 489 "Shared library" 490 configSharedLib (\v flags -> flags { configSharedLib = v }) 491 (boolOpt [] []) 492 493 ,option "" ["static"] 494 "Static library" 495 configStaticLib (\v flags -> flags { configStaticLib = v }) 496 (boolOpt [] []) 497 498 ,option "" ["executable-dynamic"] 499 "Executable dynamic linking" 500 configDynExe (\v flags -> flags { configDynExe = v }) 501 (boolOpt [] []) 502 503 ,option "" ["executable-static"] 504 "Executable fully static linking" 505 configFullyStaticExe (\v flags -> flags { configFullyStaticExe = v }) 506 (boolOpt [] []) 507 508 ,option "" ["profiling"] 509 "Executable and library profiling" 510 configProf (\v flags -> flags { configProf = v }) 511 (boolOpt [] []) 512 513 ,option "" ["executable-profiling"] 514 "Executable profiling (DEPRECATED)" 515 configProfExe (\v flags -> flags { configProfExe = v }) 516 (boolOpt [] []) 517 518 ,option "" ["profiling-detail"] 519 ("Profiling detail level for executable and library (default, " ++ 520 "none, exported-functions, toplevel-functions, all-functions).") 521 configProfDetail (\v flags -> flags { configProfDetail = v }) 522 (reqArg' "level" (Flag . flagToProfDetailLevel) 523 showProfDetailLevelFlag) 524 525 ,option "" ["library-profiling-detail"] 526 "Profiling detail level for libraries only." 527 configProfLibDetail (\v flags -> flags { configProfLibDetail = v }) 528 (reqArg' "level" (Flag . flagToProfDetailLevel) 529 showProfDetailLevelFlag) 530 531 ,multiOption "optimization" 532 configOptimization (\v flags -> flags { configOptimization = v }) 533 [optArg' "n" (Flag . flagToOptimisationLevel) 534 (\f -> case f of 535 Flag NoOptimisation -> [] 536 Flag NormalOptimisation -> [Nothing] 537 Flag MaximumOptimisation -> [Just "2"] 538 _ -> []) 539 "O" ["enable-optimization","enable-optimisation"] 540 "Build with optimization (n is 0--2, default is 1)", 541 noArg (Flag NoOptimisation) [] 542 ["disable-optimization","disable-optimisation"] 543 "Build without optimization" 544 ] 545 546 ,multiOption "debug-info" 547 configDebugInfo (\v flags -> flags { configDebugInfo = v }) 548 [optArg' "n" (Flag . flagToDebugInfoLevel) 549 (\f -> case f of 550 Flag NoDebugInfo -> [] 551 Flag MinimalDebugInfo -> [Just "1"] 552 Flag NormalDebugInfo -> [Nothing] 553 Flag MaximalDebugInfo -> [Just "3"] 554 _ -> []) 555 "" ["enable-debug-info"] 556 "Emit debug info (n is 0--3, default is 0)", 557 noArg (Flag NoDebugInfo) [] 558 ["disable-debug-info"] 559 "Don't emit debug info" 560 ] 561 562 ,option "" ["library-for-ghci"] 563 "compile library for use with GHCi" 564 configGHCiLib (\v flags -> flags { configGHCiLib = v }) 565 (boolOpt [] []) 566 567 ,option "" ["split-sections"] 568 "compile library code such that unneeded definitions can be dropped from the final executable (GHC 7.8+)" 569 configSplitSections (\v flags -> flags { configSplitSections = v }) 570 (boolOpt [] []) 571 572 ,option "" ["split-objs"] 573 "split library into smaller objects to reduce binary sizes (GHC 6.6+)" 574 configSplitObjs (\v flags -> flags { configSplitObjs = v }) 575 (boolOpt [] []) 576 577 ,option "" ["executable-stripping"] 578 "strip executables upon installation to reduce binary sizes" 579 configStripExes (\v flags -> flags { configStripExes = v }) 580 (boolOpt [] []) 581 582 ,option "" ["library-stripping"] 583 "strip libraries upon installation to reduce binary sizes" 584 configStripLibs (\v flags -> flags { configStripLibs = v }) 585 (boolOpt [] []) 586 587 ,option "" ["configure-option"] 588 "Extra option for configure" 589 configConfigureArgs (\v flags -> flags { configConfigureArgs = v }) 590 (reqArg' "OPT" (\x -> [x]) id) 591 592 ,option "" ["user-install"] 593 "doing a per-user installation" 594 configUserInstall (\v flags -> flags { configUserInstall = v }) 595 (boolOpt' ([],["user"]) ([], ["global"])) 596 597 ,option "" ["package-db"] 598 ( "Append the given package database to the list of package" 599 ++ " databases used (to satisfy dependencies and register into)." 600 ++ " May be a specific file, 'global' or 'user'. The initial list" 601 ++ " is ['global'], ['global', 'user'], or ['global', $sandbox]," 602 ++ " depending on context. Use 'clear' to reset the list to empty." 603 ++ " See the user guide for details.") 604 configPackageDBs (\v flags -> flags { configPackageDBs = v }) 605 (reqArg' "DB" readPackageDbList showPackageDbList) 606 607 ,option "f" ["flags"] 608 "Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false." 609 configConfigurationsFlags (\v flags -> flags { configConfigurationsFlags = v }) 610 (reqArg "FLAGS" 611 (parsecToReadE (\err -> "Invalid flag assignment: " ++ err) parsecFlagAssignment) 612 showFlagAssignment) 613 614 ,option "" ["extra-include-dirs"] 615 "A list of directories to search for header files" 616 configExtraIncludeDirs (\v flags -> flags {configExtraIncludeDirs = v}) 617 (reqArg' "PATH" (\x -> [x]) id) 618 619 ,option "" ["deterministic"] 620 "Try to be as deterministic as possible (used by the test suite)" 621 configDeterministic (\v flags -> flags {configDeterministic = v}) 622 (boolOpt [] []) 623 624 ,option "" ["ipid"] 625 "Installed package ID to compile this package as" 626 configIPID (\v flags -> flags {configIPID = v}) 627 (reqArgFlag "IPID") 628 629 ,option "" ["cid"] 630 "Installed component ID to compile this component as" 631 (fmap prettyShow . configCID) (\v flags -> flags {configCID = fmap mkComponentId v}) 632 (reqArgFlag "CID") 633 634 ,option "" ["extra-lib-dirs"] 635 "A list of directories to search for external libraries" 636 configExtraLibDirs (\v flags -> flags {configExtraLibDirs = v}) 637 (reqArg' "PATH" (\x -> [x]) id) 638 639 ,option "" ["extra-framework-dirs"] 640 "A list of directories to search for external frameworks (OS X only)" 641 configExtraFrameworkDirs 642 (\v flags -> flags {configExtraFrameworkDirs = v}) 643 (reqArg' "PATH" (\x -> [x]) id) 644 645 ,option "" ["extra-prog-path"] 646 "A list of directories to search for required programs (in addition to the normal search locations)" 647 configProgramPathExtra (\v flags -> flags {configProgramPathExtra = v}) 648 (reqArg' "PATH" (\x -> toNubList [x]) fromNubList) 649 650 ,option "" ["constraint"] 651 "A list of additional constraints on the dependencies." 652 configConstraints (\v flags -> flags { configConstraints = v}) 653 (reqArg "DEPENDENCY" 654 (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsec)) 655 (map prettyShow)) 656 657 ,option "" ["dependency"] 658 "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" 659 configDependencies (\v flags -> flags { configDependencies = v}) 660 (reqArg "NAME[:COMPONENT_NAME]=CID" 661 (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent)) 662 (map (\(GivenComponent pn cn cid) -> 663 prettyShow pn 664 ++ case cn of LMainLibName -> "" 665 LSubLibName n -> ":" ++ prettyShow n 666 ++ "=" ++ prettyShow cid))) 667 668 ,option "" ["instantiate-with"] 669 "A mapping of signature names to concrete module instantiations." 670 configInstantiateWith (\v flags -> flags { configInstantiateWith = v }) 671 (reqArg "NAME=MOD" 672 (parsecToReadE ("Cannot parse module substitution: " ++) (fmap (:[]) parsecModSubstEntry)) 673 (map (Disp.renderStyle defaultStyle . dispModSubstEntry))) 674 675 ,option "" ["tests"] 676 "dependency checking and compilation for test suites listed in the package description file." 677 configTests (\v flags -> flags { configTests = v }) 678 (boolOpt [] []) 679 680 ,option "" ["coverage"] 681 "build package with Haskell Program Coverage. (GHC only)" 682 configCoverage (\v flags -> flags { configCoverage = v }) 683 (boolOpt [] []) 684 685 ,option "" ["library-coverage"] 686 "build package with Haskell Program Coverage. (GHC only) (DEPRECATED)" 687 configLibCoverage (\v flags -> flags { configLibCoverage = v }) 688 (boolOpt [] []) 689 690 ,option "" ["exact-configuration"] 691 "All direct dependencies and flags are provided on the command line." 692 configExactConfiguration 693 (\v flags -> flags { configExactConfiguration = v }) 694 trueArg 695 696 ,option "" ["benchmarks"] 697 "dependency checking and compilation for benchmarks listed in the package description file." 698 configBenchmarks (\v flags -> flags { configBenchmarks = v }) 699 (boolOpt [] []) 700 701 ,option "" ["relocatable"] 702 "building a package that is relocatable. (GHC only)" 703 configRelocatable (\v flags -> flags { configRelocatable = v}) 704 (boolOpt [] []) 705 706 ,option "" ["response-files"] 707 "enable workaround for old versions of programs like \"ar\" that do not support @file arguments" 708 configUseResponseFiles 709 (\v flags -> flags { configUseResponseFiles = v }) 710 (boolOpt' ([], ["disable-response-files"]) ([], [])) 711 712 ,option "" ["allow-depending-on-private-libs"] 713 ( "Allow depending on private libraries. " 714 ++ "If set, the library visibility check MUST be done externally." ) 715 configAllowDependingOnPrivateLibs 716 (\v flags -> flags { configAllowDependingOnPrivateLibs = v }) 717 trueArg 718 ] 719 where 720 liftInstallDirs = 721 liftOption configInstallDirs (\v flags -> flags { configInstallDirs = v }) 722 723 reqPathTemplateArgFlag title _sf _lf d get set = 724 reqArgFlag title _sf _lf d 725 (fmap fromPathTemplate . get) (set . fmap toPathTemplate) 726 727showFlagAssignment :: FlagAssignment -> [String] 728showFlagAssignment = map showFlagValue' . unFlagAssignment 729 where 730 -- We can't use 'showFlagValue' because legacy custom-setups don't 731 -- support the '+' prefix in --flags; so we omit the (redundant) + prefix; 732 -- NB: we assume that we never have to set/enable '-'-prefixed flags here. 733 showFlagValue' :: (FlagName, Bool) -> String 734 showFlagValue' (f, True) = unFlagName f 735 showFlagValue' (f, False) = '-' : unFlagName f 736 737readPackageDbList :: String -> [Maybe PackageDB] 738readPackageDbList "clear" = [Nothing] 739readPackageDbList "global" = [Just GlobalPackageDB] 740readPackageDbList "user" = [Just UserPackageDB] 741readPackageDbList other = [Just (SpecificPackageDB other)] 742 743showPackageDbList :: [Maybe PackageDB] -> [String] 744showPackageDbList = map showPackageDb 745 where 746 showPackageDb Nothing = "clear" 747 showPackageDb (Just GlobalPackageDB) = "global" 748 showPackageDb (Just UserPackageDB) = "user" 749 showPackageDb (Just (SpecificPackageDB db)) = db 750 751showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String] 752showProfDetailLevelFlag NoFlag = [] 753showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] 754 755parsecGivenComponent :: ParsecParser GivenComponent 756parsecGivenComponent = do 757 pn <- parsec 758 ln <- P.option LMainLibName $ do 759 _ <- P.char ':' 760 ucn <- parsec 761 return $ if unUnqualComponentName ucn == unPackageName pn 762 then LMainLibName 763 else LSubLibName ucn 764 _ <- P.char '=' 765 cid <- parsec 766 return $ GivenComponent pn ln cid 767 768installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] 769installDirsOptions = 770 [ option "" ["prefix"] 771 "bake this prefix in preparation of installation" 772 prefix (\v flags -> flags { prefix = v }) 773 installDirArg 774 775 , option "" ["bindir"] 776 "installation directory for executables" 777 bindir (\v flags -> flags { bindir = v }) 778 installDirArg 779 780 , option "" ["libdir"] 781 "installation directory for libraries" 782 libdir (\v flags -> flags { libdir = v }) 783 installDirArg 784 785 , option "" ["libsubdir"] 786 "subdirectory of libdir in which libs are installed" 787 libsubdir (\v flags -> flags { libsubdir = v }) 788 installDirArg 789 790 , option "" ["dynlibdir"] 791 "installation directory for dynamic libraries" 792 dynlibdir (\v flags -> flags { dynlibdir = v }) 793 installDirArg 794 795 , option "" ["libexecdir"] 796 "installation directory for program executables" 797 libexecdir (\v flags -> flags { libexecdir = v }) 798 installDirArg 799 800 , option "" ["libexecsubdir"] 801 "subdirectory of libexecdir in which private executables are installed" 802 libexecsubdir (\v flags -> flags { libexecsubdir = v }) 803 installDirArg 804 805 , option "" ["datadir"] 806 "installation directory for read-only data" 807 datadir (\v flags -> flags { datadir = v }) 808 installDirArg 809 810 , option "" ["datasubdir"] 811 "subdirectory of datadir in which data files are installed" 812 datasubdir (\v flags -> flags { datasubdir = v }) 813 installDirArg 814 815 , option "" ["docdir"] 816 "installation directory for documentation" 817 docdir (\v flags -> flags { docdir = v }) 818 installDirArg 819 820 , option "" ["htmldir"] 821 "installation directory for HTML documentation" 822 htmldir (\v flags -> flags { htmldir = v }) 823 installDirArg 824 825 , option "" ["haddockdir"] 826 "installation directory for haddock interfaces" 827 haddockdir (\v flags -> flags { haddockdir = v }) 828 installDirArg 829 830 , option "" ["sysconfdir"] 831 "installation directory for configuration files" 832 sysconfdir (\v flags -> flags { sysconfdir = v }) 833 installDirArg 834 ] 835 where 836 installDirArg _sf _lf d get set = 837 reqArgFlag "DIR" _sf _lf d 838 (fmap fromPathTemplate . get) (set . fmap toPathTemplate) 839 840emptyConfigFlags :: ConfigFlags 841emptyConfigFlags = mempty 842 843instance Monoid ConfigFlags where 844 mempty = gmempty 845 mappend = (<>) 846 847instance Semigroup ConfigFlags where 848 (<>) = gmappend 849 850-- ------------------------------------------------------------ 851-- * Copy flags 852-- ------------------------------------------------------------ 853 854-- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbosity) 855data CopyFlags = CopyFlags { 856 copyDest :: Flag CopyDest, 857 copyDistPref :: Flag FilePath, 858 copyVerbosity :: Flag Verbosity, 859 -- This is the same hack as in 'buildArgs'. But I (ezyang) don't 860 -- think it's a hack, it's the right way to make hooks more robust 861 -- TODO: Stop using this eventually when 'UserHooks' gets changed 862 copyArgs :: [String], 863 copyCabalFilePath :: Flag FilePath 864 } 865 deriving (Show, Generic) 866 867defaultCopyFlags :: CopyFlags 868defaultCopyFlags = CopyFlags { 869 copyDest = Flag NoCopyDest, 870 copyDistPref = NoFlag, 871 copyVerbosity = Flag normal, 872 copyArgs = [], 873 copyCabalFilePath = mempty 874 } 875 876copyCommand :: CommandUI CopyFlags 877copyCommand = CommandUI 878 { commandName = "copy" 879 , commandSynopsis = "Copy the files of all/specific components to install locations." 880 , commandDescription = Just $ \_ -> wrapText $ 881 "Components encompass executables and libraries. " 882 ++ "Does not call register, and allows a prefix at install time. " 883 ++ "Without the --destdir flag, configure determines location.\n" 884 , commandNotes = Just $ \pname -> 885 "Examples:\n" 886 ++ " " ++ pname ++ " copy " 887 ++ " All the components in the package\n" 888 ++ " " ++ pname ++ " copy foo " 889 ++ " A component (i.e. lib, exe, test suite)" 890 , commandUsage = usageAlternatives "copy" $ 891 [ "[FLAGS]" 892 , "COMPONENTS [FLAGS]" 893 ] 894 , commandDefaultFlags = defaultCopyFlags 895 , commandOptions = \showOrParseArgs -> case showOrParseArgs of 896 ShowArgs -> filter ((`notElem` ["target-package-db"]) 897 . optionName) $ copyOptions ShowArgs 898 ParseArgs -> copyOptions ParseArgs 899} 900 901copyOptions :: ShowOrParseArgs -> [OptionField CopyFlags] 902copyOptions showOrParseArgs = 903 [optionVerbosity copyVerbosity (\v flags -> flags { copyVerbosity = v }) 904 905 ,optionDistPref 906 copyDistPref (\d flags -> flags { copyDistPref = d }) 907 showOrParseArgs 908 909 ,option "" ["destdir"] 910 "directory to copy files to, prepended to installation directories" 911 copyDest (\v flags -> case copyDest flags of 912 Flag (CopyToDb _) -> error "Use either 'destdir' or 'target-package-db'." 913 _ -> flags { copyDest = v }) 914 (reqArg "DIR" (succeedReadE (Flag . CopyTo)) 915 (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])) 916 917 ,option "" ["target-package-db"] 918 "package database to copy files into. Required when using ${pkgroot} prefix." 919 copyDest (\v flags -> case copyDest flags of 920 NoFlag -> flags { copyDest = v } 921 Flag NoCopyDest -> flags { copyDest = v } 922 _ -> error "Use either 'destdir' or 'target-package-db'.") 923 (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb)) 924 (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])) 925 ] 926 927emptyCopyFlags :: CopyFlags 928emptyCopyFlags = mempty 929 930instance Monoid CopyFlags where 931 mempty = gmempty 932 mappend = (<>) 933 934instance Semigroup CopyFlags where 935 (<>) = gmappend 936 937-- ------------------------------------------------------------ 938-- * Install flags 939-- ------------------------------------------------------------ 940 941-- | Flags to @install@: (package db, verbosity) 942data InstallFlags = InstallFlags { 943 installPackageDB :: Flag PackageDB, 944 installDest :: Flag CopyDest, 945 installDistPref :: Flag FilePath, 946 installUseWrapper :: Flag Bool, 947 installInPlace :: Flag Bool, 948 installVerbosity :: Flag Verbosity, 949 -- this is only here, because we can not 950 -- change the hooks API. 951 installCabalFilePath :: Flag FilePath 952 } 953 deriving (Show, Generic) 954 955defaultInstallFlags :: InstallFlags 956defaultInstallFlags = InstallFlags { 957 installPackageDB = NoFlag, 958 installDest = Flag NoCopyDest, 959 installDistPref = NoFlag, 960 installUseWrapper = Flag False, 961 installInPlace = Flag False, 962 installVerbosity = Flag normal, 963 installCabalFilePath = mempty 964 } 965 966installCommand :: CommandUI InstallFlags 967installCommand = CommandUI 968 { commandName = "install" 969 , commandSynopsis = 970 "Copy the files into the install locations. Run register." 971 , commandDescription = Just $ \_ -> wrapText $ 972 "Unlike the copy command, install calls the register command." 973 ++ "If you want to install into a location that is not what was" 974 ++ "specified in the configure step, use the copy command.\n" 975 , commandNotes = Nothing 976 , commandUsage = \pname -> 977 "Usage: " ++ pname ++ " install [FLAGS]\n" 978 , commandDefaultFlags = defaultInstallFlags 979 , commandOptions = \showOrParseArgs -> case showOrParseArgs of 980 ShowArgs -> filter ((`notElem` ["target-package-db"]) 981 . optionName) $ installOptions ShowArgs 982 ParseArgs -> installOptions ParseArgs 983 } 984 985installOptions :: ShowOrParseArgs -> [OptionField InstallFlags] 986installOptions showOrParseArgs = 987 [optionVerbosity installVerbosity (\v flags -> flags { installVerbosity = v }) 988 ,optionDistPref 989 installDistPref (\d flags -> flags { installDistPref = d }) 990 showOrParseArgs 991 992 ,option "" ["inplace"] 993 "install the package in the install subdirectory of the dist prefix, so it can be used without being installed" 994 installInPlace (\v flags -> flags { installInPlace = v }) 995 trueArg 996 997 ,option "" ["shell-wrappers"] 998 "using shell script wrappers around executables" 999 installUseWrapper (\v flags -> flags { installUseWrapper = v }) 1000 (boolOpt [] []) 1001 1002 ,option "" ["package-db"] "" 1003 installPackageDB (\v flags -> flags { installPackageDB = v }) 1004 (choiceOpt [ (Flag UserPackageDB, ([],["user"]), 1005 "upon configuration register this package in the user's local package database") 1006 , (Flag GlobalPackageDB, ([],["global"]), 1007 "(default) upon configuration register this package in the system-wide package database")]) 1008 ,option "" ["target-package-db"] 1009 "package database to install into. Required when using ${pkgroot} prefix." 1010 installDest (\v flags -> flags { installDest = v }) 1011 (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb)) 1012 (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])) 1013 ] 1014 1015emptyInstallFlags :: InstallFlags 1016emptyInstallFlags = mempty 1017 1018instance Monoid InstallFlags where 1019 mempty = gmempty 1020 mappend = (<>) 1021 1022instance Semigroup InstallFlags where 1023 (<>) = gmappend 1024 1025-- ------------------------------------------------------------ 1026-- * SDist flags 1027-- ------------------------------------------------------------ 1028 1029-- | Flags to @sdist@: (snapshot, verbosity) 1030data SDistFlags = SDistFlags { 1031 sDistSnapshot :: Flag Bool, 1032 sDistDirectory :: Flag FilePath, 1033 sDistDistPref :: Flag FilePath, 1034 sDistListSources :: Flag FilePath, 1035 sDistVerbosity :: Flag Verbosity 1036 } 1037 deriving (Show, Generic) 1038 1039defaultSDistFlags :: SDistFlags 1040defaultSDistFlags = SDistFlags { 1041 sDistSnapshot = Flag False, 1042 sDistDirectory = mempty, 1043 sDistDistPref = NoFlag, 1044 sDistListSources = mempty, 1045 sDistVerbosity = Flag normal 1046 } 1047 1048sdistCommand :: CommandUI SDistFlags 1049sdistCommand = CommandUI 1050 { commandName = "sdist" 1051 , commandSynopsis = 1052 "Generate a source distribution file (.tar.gz)." 1053 , commandDescription = Nothing 1054 , commandNotes = Nothing 1055 , commandUsage = \pname -> 1056 "Usage: " ++ pname ++ " sdist [FLAGS]\n" 1057 , commandDefaultFlags = defaultSDistFlags 1058 , commandOptions = \showOrParseArgs -> 1059 [optionVerbosity sDistVerbosity (\v flags -> flags { sDistVerbosity = v }) 1060 ,optionDistPref 1061 sDistDistPref (\d flags -> flags { sDistDistPref = d }) 1062 showOrParseArgs 1063 1064 ,option "" ["list-sources"] 1065 "Just write a list of the package's sources to a file" 1066 sDistListSources (\v flags -> flags { sDistListSources = v }) 1067 (reqArgFlag "FILE") 1068 1069 ,option "" ["snapshot"] 1070 "Produce a snapshot source distribution" 1071 sDistSnapshot (\v flags -> flags { sDistSnapshot = v }) 1072 trueArg 1073 1074 ,option "" ["output-directory"] 1075 ("Generate a source distribution in the given directory, " 1076 ++ "without creating a tarball") 1077 sDistDirectory (\v flags -> flags { sDistDirectory = v }) 1078 (reqArgFlag "DIR") 1079 ] 1080 } 1081 1082emptySDistFlags :: SDistFlags 1083emptySDistFlags = mempty 1084 1085instance Monoid SDistFlags where 1086 mempty = gmempty 1087 mappend = (<>) 1088 1089instance Semigroup SDistFlags where 1090 (<>) = gmappend 1091 1092-- ------------------------------------------------------------ 1093-- * Register flags 1094-- ------------------------------------------------------------ 1095 1096-- | Flags to @register@ and @unregister@: (user package, gen-script, 1097-- in-place, verbosity) 1098data RegisterFlags = RegisterFlags { 1099 regPackageDB :: Flag PackageDB, 1100 regGenScript :: Flag Bool, 1101 regGenPkgConf :: Flag (Maybe FilePath), 1102 regInPlace :: Flag Bool, 1103 regDistPref :: Flag FilePath, 1104 regPrintId :: Flag Bool, 1105 regVerbosity :: Flag Verbosity, 1106 -- Same as in 'buildArgs' and 'copyArgs' 1107 regArgs :: [String], 1108 regCabalFilePath :: Flag FilePath 1109 } 1110 deriving (Show, Generic) 1111 1112defaultRegisterFlags :: RegisterFlags 1113defaultRegisterFlags = RegisterFlags { 1114 regPackageDB = NoFlag, 1115 regGenScript = Flag False, 1116 regGenPkgConf = NoFlag, 1117 regInPlace = Flag False, 1118 regDistPref = NoFlag, 1119 regPrintId = Flag False, 1120 regArgs = [], 1121 regCabalFilePath = mempty, 1122 regVerbosity = Flag normal 1123 } 1124 1125registerCommand :: CommandUI RegisterFlags 1126registerCommand = CommandUI 1127 { commandName = "register" 1128 , commandSynopsis = 1129 "Register this package with the compiler." 1130 , commandDescription = Nothing 1131 , commandNotes = Nothing 1132 , commandUsage = \pname -> 1133 "Usage: " ++ pname ++ " register [FLAGS]\n" 1134 , commandDefaultFlags = defaultRegisterFlags 1135 , commandOptions = \showOrParseArgs -> 1136 [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) 1137 ,optionDistPref 1138 regDistPref (\d flags -> flags { regDistPref = d }) 1139 showOrParseArgs 1140 1141 ,option "" ["packageDB"] "" 1142 regPackageDB (\v flags -> flags { regPackageDB = v }) 1143 (choiceOpt [ (Flag UserPackageDB, ([],["user"]), 1144 "upon registration, register this package in the user's local package database") 1145 , (Flag GlobalPackageDB, ([],["global"]), 1146 "(default)upon registration, register this package in the system-wide package database")]) 1147 1148 ,option "" ["inplace"] 1149 "register the package in the build location, so it can be used without being installed" 1150 regInPlace (\v flags -> flags { regInPlace = v }) 1151 trueArg 1152 1153 ,option "" ["gen-script"] 1154 "instead of registering, generate a script to register later" 1155 regGenScript (\v flags -> flags { regGenScript = v }) 1156 trueArg 1157 1158 ,option "" ["gen-pkg-config"] 1159 "instead of registering, generate a package registration file/directory" 1160 regGenPkgConf (\v flags -> flags { regGenPkgConf = v }) 1161 (optArg' "PKG" Flag flagToList) 1162 1163 ,option "" ["print-ipid"] 1164 "print the installed package ID calculated for this package" 1165 regPrintId (\v flags -> flags { regPrintId = v }) 1166 trueArg 1167 ] 1168 } 1169 1170unregisterCommand :: CommandUI RegisterFlags 1171unregisterCommand = CommandUI 1172 { commandName = "unregister" 1173 , commandSynopsis = 1174 "Unregister this package with the compiler." 1175 , commandDescription = Nothing 1176 , commandNotes = Nothing 1177 , commandUsage = \pname -> 1178 "Usage: " ++ pname ++ " unregister [FLAGS]\n" 1179 , commandDefaultFlags = defaultRegisterFlags 1180 , commandOptions = \showOrParseArgs -> 1181 [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) 1182 ,optionDistPref 1183 regDistPref (\d flags -> flags { regDistPref = d }) 1184 showOrParseArgs 1185 1186 ,option "" ["user"] "" 1187 regPackageDB (\v flags -> flags { regPackageDB = v }) 1188 (choiceOpt [ (Flag UserPackageDB, ([],["user"]), 1189 "unregister this package in the user's local package database") 1190 , (Flag GlobalPackageDB, ([],["global"]), 1191 "(default) unregister this package in the system-wide package database")]) 1192 1193 ,option "" ["gen-script"] 1194 "Instead of performing the unregister command, generate a script to unregister later" 1195 regGenScript (\v flags -> flags { regGenScript = v }) 1196 trueArg 1197 ] 1198 } 1199 1200emptyRegisterFlags :: RegisterFlags 1201emptyRegisterFlags = mempty 1202 1203instance Monoid RegisterFlags where 1204 mempty = gmempty 1205 mappend = (<>) 1206 1207instance Semigroup RegisterFlags where 1208 (<>) = gmappend 1209 1210-- ------------------------------------------------------------ 1211-- * HsColour flags 1212-- ------------------------------------------------------------ 1213 1214data HscolourFlags = HscolourFlags { 1215 hscolourCSS :: Flag FilePath, 1216 hscolourExecutables :: Flag Bool, 1217 hscolourTestSuites :: Flag Bool, 1218 hscolourBenchmarks :: Flag Bool, 1219 hscolourForeignLibs :: Flag Bool, 1220 hscolourDistPref :: Flag FilePath, 1221 hscolourVerbosity :: Flag Verbosity, 1222 hscolourCabalFilePath :: Flag FilePath 1223 } 1224 deriving (Show, Generic) 1225 1226emptyHscolourFlags :: HscolourFlags 1227emptyHscolourFlags = mempty 1228 1229defaultHscolourFlags :: HscolourFlags 1230defaultHscolourFlags = HscolourFlags { 1231 hscolourCSS = NoFlag, 1232 hscolourExecutables = Flag False, 1233 hscolourTestSuites = Flag False, 1234 hscolourBenchmarks = Flag False, 1235 hscolourDistPref = NoFlag, 1236 hscolourForeignLibs = Flag False, 1237 hscolourVerbosity = Flag normal, 1238 hscolourCabalFilePath = mempty 1239 } 1240 1241instance Monoid HscolourFlags where 1242 mempty = gmempty 1243 mappend = (<>) 1244 1245instance Semigroup HscolourFlags where 1246 (<>) = gmappend 1247 1248hscolourCommand :: CommandUI HscolourFlags 1249hscolourCommand = CommandUI 1250 { commandName = "hscolour" 1251 , commandSynopsis = 1252 "Generate HsColour colourised code, in HTML format." 1253 , commandDescription = Just (\_ -> "Requires the hscolour program.\n") 1254 , commandNotes = Just $ \_ -> 1255 "Deprecated in favour of 'cabal haddock --hyperlink-source'." 1256 , commandUsage = \pname -> 1257 "Usage: " ++ pname ++ " hscolour [FLAGS]\n" 1258 , commandDefaultFlags = defaultHscolourFlags 1259 , commandOptions = \showOrParseArgs -> 1260 [optionVerbosity hscolourVerbosity 1261 (\v flags -> flags { hscolourVerbosity = v }) 1262 ,optionDistPref 1263 hscolourDistPref (\d flags -> flags { hscolourDistPref = d }) 1264 showOrParseArgs 1265 1266 ,option "" ["executables"] 1267 "Run hscolour for Executables targets" 1268 hscolourExecutables (\v flags -> flags { hscolourExecutables = v }) 1269 trueArg 1270 1271 ,option "" ["tests"] 1272 "Run hscolour for Test Suite targets" 1273 hscolourTestSuites (\v flags -> flags { hscolourTestSuites = v }) 1274 trueArg 1275 1276 ,option "" ["benchmarks"] 1277 "Run hscolour for Benchmark targets" 1278 hscolourBenchmarks (\v flags -> flags { hscolourBenchmarks = v }) 1279 trueArg 1280 1281 ,option "" ["foreign-libraries"] 1282 "Run hscolour for Foreign Library targets" 1283 hscolourForeignLibs (\v flags -> flags { hscolourForeignLibs = v }) 1284 trueArg 1285 1286 ,option "" ["all"] 1287 "Run hscolour for all targets" 1288 (\f -> allFlags [ hscolourExecutables f 1289 , hscolourTestSuites f 1290 , hscolourBenchmarks f 1291 , hscolourForeignLibs f 1292 ]) 1293 (\v flags -> flags { hscolourExecutables = v 1294 , hscolourTestSuites = v 1295 , hscolourBenchmarks = v 1296 , hscolourForeignLibs = v 1297 }) 1298 trueArg 1299 1300 ,option "" ["css"] 1301 "Use a cascading style sheet" 1302 hscolourCSS (\v flags -> flags { hscolourCSS = v }) 1303 (reqArgFlag "PATH") 1304 ] 1305 } 1306 1307-- ------------------------------------------------------------ 1308-- * Doctest flags 1309-- ------------------------------------------------------------ 1310 1311data DoctestFlags = DoctestFlags { 1312 doctestProgramPaths :: [(String, FilePath)], 1313 doctestProgramArgs :: [(String, [String])], 1314 doctestDistPref :: Flag FilePath, 1315 doctestVerbosity :: Flag Verbosity 1316 } 1317 deriving (Show, Generic) 1318 1319defaultDoctestFlags :: DoctestFlags 1320defaultDoctestFlags = DoctestFlags { 1321 doctestProgramPaths = mempty, 1322 doctestProgramArgs = [], 1323 doctestDistPref = NoFlag, 1324 doctestVerbosity = Flag normal 1325 } 1326 1327doctestCommand :: CommandUI DoctestFlags 1328doctestCommand = CommandUI 1329 { commandName = "doctest" 1330 , commandSynopsis = "Run doctest tests." 1331 , commandDescription = Just $ \_ -> 1332 "Requires the program doctest, version 0.12.\n" 1333 , commandNotes = Nothing 1334 , commandUsage = \pname -> 1335 "Usage: " ++ pname ++ " doctest [FLAGS]\n" 1336 , commandDefaultFlags = defaultDoctestFlags 1337 , commandOptions = \showOrParseArgs -> 1338 doctestOptions showOrParseArgs 1339 ++ programDbPaths progDb ParseArgs 1340 doctestProgramPaths (\v flags -> flags { doctestProgramPaths = v }) 1341 ++ programDbOption progDb showOrParseArgs 1342 doctestProgramArgs (\v fs -> fs { doctestProgramArgs = v }) 1343 ++ programDbOptions progDb ParseArgs 1344 doctestProgramArgs (\v flags -> flags { doctestProgramArgs = v }) 1345 } 1346 where 1347 progDb = addKnownProgram doctestProgram 1348 emptyProgramDb 1349 1350doctestOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] 1351doctestOptions showOrParseArgs = 1352 [optionVerbosity doctestVerbosity 1353 (\v flags -> flags { doctestVerbosity = v }) 1354 ,optionDistPref 1355 doctestDistPref (\d flags -> flags { doctestDistPref = d }) 1356 showOrParseArgs 1357 ] 1358 1359emptyDoctestFlags :: DoctestFlags 1360emptyDoctestFlags = mempty 1361 1362instance Monoid DoctestFlags where 1363 mempty = gmempty 1364 mappend = (<>) 1365 1366instance Semigroup DoctestFlags where 1367 (<>) = gmappend 1368 1369-- ------------------------------------------------------------ 1370-- * Haddock flags 1371-- ------------------------------------------------------------ 1372 1373 1374-- | When we build haddock documentation, there are two cases: 1375-- 1376-- 1. We build haddocks only for the current development version, 1377-- intended for local use and not for distribution. In this case, 1378-- we store the generated documentation in @<dist>/doc/html/<package name>@. 1379-- 1380-- 2. We build haddocks for intended for uploading them to hackage. 1381-- In this case, we need to follow the layout that hackage expects 1382-- from documentation tarballs, and we might also want to use different 1383-- flags than for development builds, so in this case we store the generated 1384-- documentation in @<dist>/doc/html/<package id>-docs@. 1385data HaddockTarget = ForHackage | ForDevelopment deriving (Eq, Show, Generic) 1386 1387instance Binary HaddockTarget 1388 1389instance Pretty HaddockTarget where 1390 pretty ForHackage = Disp.text "for-hackage" 1391 pretty ForDevelopment = Disp.text "for-development" 1392 1393instance Parsec HaddockTarget where 1394 parsec = P.choice [ P.try $ P.string "for-hackage" >> return ForHackage 1395 , P.string "for-development" >> return ForDevelopment] 1396 1397data HaddockFlags = HaddockFlags { 1398 haddockProgramPaths :: [(String, FilePath)], 1399 haddockProgramArgs :: [(String, [String])], 1400 haddockHoogle :: Flag Bool, 1401 haddockHtml :: Flag Bool, 1402 haddockHtmlLocation :: Flag String, 1403 haddockForHackage :: Flag HaddockTarget, 1404 haddockExecutables :: Flag Bool, 1405 haddockTestSuites :: Flag Bool, 1406 haddockBenchmarks :: Flag Bool, 1407 haddockForeignLibs :: Flag Bool, 1408 haddockInternal :: Flag Bool, 1409 haddockCss :: Flag FilePath, 1410 haddockLinkedSource :: Flag Bool, 1411 haddockQuickJump :: Flag Bool, 1412 haddockHscolourCss :: Flag FilePath, 1413 haddockContents :: Flag PathTemplate, 1414 haddockDistPref :: Flag FilePath, 1415 haddockKeepTempFiles:: Flag Bool, 1416 haddockVerbosity :: Flag Verbosity, 1417 haddockCabalFilePath :: Flag FilePath, 1418 haddockArgs :: [String] 1419 } 1420 deriving (Show, Generic) 1421 1422defaultHaddockFlags :: HaddockFlags 1423defaultHaddockFlags = HaddockFlags { 1424 haddockProgramPaths = mempty, 1425 haddockProgramArgs = [], 1426 haddockHoogle = Flag False, 1427 haddockHtml = Flag False, 1428 haddockHtmlLocation = NoFlag, 1429 haddockForHackage = NoFlag, 1430 haddockExecutables = Flag False, 1431 haddockTestSuites = Flag False, 1432 haddockBenchmarks = Flag False, 1433 haddockForeignLibs = Flag False, 1434 haddockInternal = Flag False, 1435 haddockCss = NoFlag, 1436 haddockLinkedSource = Flag False, 1437 haddockQuickJump = Flag False, 1438 haddockHscolourCss = NoFlag, 1439 haddockContents = NoFlag, 1440 haddockDistPref = NoFlag, 1441 haddockKeepTempFiles= Flag False, 1442 haddockVerbosity = Flag normal, 1443 haddockCabalFilePath = mempty, 1444 haddockArgs = mempty 1445 } 1446 1447haddockCommand :: CommandUI HaddockFlags 1448haddockCommand = CommandUI 1449 { commandName = "haddock" 1450 , commandSynopsis = "Generate Haddock HTML documentation." 1451 , commandDescription = Just $ \_ -> 1452 "Requires the program haddock, version 2.x.\n" 1453 , commandNotes = Nothing 1454 , commandUsage = usageAlternatives "haddock" $ 1455 [ "[FLAGS]" 1456 , "COMPONENTS [FLAGS]" 1457 ] 1458 , commandDefaultFlags = defaultHaddockFlags 1459 , commandOptions = \showOrParseArgs -> 1460 haddockOptions showOrParseArgs 1461 ++ programDbPaths progDb ParseArgs 1462 haddockProgramPaths (\v flags -> flags { haddockProgramPaths = v}) 1463 ++ programDbOption progDb showOrParseArgs 1464 haddockProgramArgs (\v fs -> fs { haddockProgramArgs = v }) 1465 ++ programDbOptions progDb ParseArgs 1466 haddockProgramArgs (\v flags -> flags { haddockProgramArgs = v}) 1467 } 1468 where 1469 progDb = addKnownProgram haddockProgram 1470 $ addKnownProgram ghcProgram 1471 $ emptyProgramDb 1472 1473haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags] 1474haddockOptions showOrParseArgs = 1475 [optionVerbosity haddockVerbosity 1476 (\v flags -> flags { haddockVerbosity = v }) 1477 ,optionDistPref 1478 haddockDistPref (\d flags -> flags { haddockDistPref = d }) 1479 showOrParseArgs 1480 1481 ,option "" ["keep-temp-files"] 1482 "Keep temporary files" 1483 haddockKeepTempFiles (\b flags -> flags { haddockKeepTempFiles = b }) 1484 trueArg 1485 1486 ,option "" ["hoogle"] 1487 "Generate a hoogle database" 1488 haddockHoogle (\v flags -> flags { haddockHoogle = v }) 1489 trueArg 1490 1491 ,option "" ["html"] 1492 "Generate HTML documentation (the default)" 1493 haddockHtml (\v flags -> flags { haddockHtml = v }) 1494 trueArg 1495 1496 ,option "" ["html-location"] 1497 "Location of HTML documentation for pre-requisite packages" 1498 haddockHtmlLocation (\v flags -> flags { haddockHtmlLocation = v }) 1499 (reqArgFlag "URL") 1500 1501 ,option "" ["for-hackage"] 1502 "Collection of flags to generate documentation suitable for upload to hackage" 1503 haddockForHackage (\v flags -> flags { haddockForHackage = v }) 1504 (noArg (Flag ForHackage)) 1505 1506 ,option "" ["executables"] 1507 "Run haddock for Executables targets" 1508 haddockExecutables (\v flags -> flags { haddockExecutables = v }) 1509 trueArg 1510 1511 ,option "" ["tests"] 1512 "Run haddock for Test Suite targets" 1513 haddockTestSuites (\v flags -> flags { haddockTestSuites = v }) 1514 trueArg 1515 1516 ,option "" ["benchmarks"] 1517 "Run haddock for Benchmark targets" 1518 haddockBenchmarks (\v flags -> flags { haddockBenchmarks = v }) 1519 trueArg 1520 1521 ,option "" ["foreign-libraries"] 1522 "Run haddock for Foreign Library targets" 1523 haddockForeignLibs (\v flags -> flags { haddockForeignLibs = v }) 1524 trueArg 1525 1526 ,option "" ["all"] 1527 "Run haddock for all targets" 1528 (\f -> allFlags [ haddockExecutables f 1529 , haddockTestSuites f 1530 , haddockBenchmarks f 1531 , haddockForeignLibs f 1532 ]) 1533 (\v flags -> flags { haddockExecutables = v 1534 , haddockTestSuites = v 1535 , haddockBenchmarks = v 1536 , haddockForeignLibs = v 1537 }) 1538 trueArg 1539 1540 ,option "" ["internal"] 1541 "Run haddock for internal modules and include all symbols" 1542 haddockInternal (\v flags -> flags { haddockInternal = v }) 1543 trueArg 1544 1545 ,option "" ["css"] 1546 "Use PATH as the haddock stylesheet" 1547 haddockCss (\v flags -> flags { haddockCss = v }) 1548 (reqArgFlag "PATH") 1549 1550 ,option "" ["hyperlink-source","hyperlink-sources","hyperlinked-source"] 1551 "Hyperlink the documentation to the source code" 1552 haddockLinkedSource (\v flags -> flags { haddockLinkedSource = v }) 1553 trueArg 1554 1555 ,option "" ["quickjump"] 1556 "Generate an index for interactive documentation navigation" 1557 haddockQuickJump (\v flags -> flags { haddockQuickJump = v }) 1558 trueArg 1559 1560 ,option "" ["hscolour-css"] 1561 "Use PATH as the HsColour stylesheet" 1562 haddockHscolourCss (\v flags -> flags { haddockHscolourCss = v }) 1563 (reqArgFlag "PATH") 1564 1565 ,option "" ["contents-location"] 1566 "Bake URL in as the location for the contents page" 1567 haddockContents (\v flags -> flags { haddockContents = v }) 1568 (reqArg' "URL" 1569 (toFlag . toPathTemplate) 1570 (flagToList . fmap fromPathTemplate)) 1571 ] 1572 1573emptyHaddockFlags :: HaddockFlags 1574emptyHaddockFlags = mempty 1575 1576instance Monoid HaddockFlags where 1577 mempty = gmempty 1578 mappend = (<>) 1579 1580instance Semigroup HaddockFlags where 1581 (<>) = gmappend 1582 1583-- ------------------------------------------------------------ 1584-- * Clean flags 1585-- ------------------------------------------------------------ 1586 1587data CleanFlags = CleanFlags { 1588 cleanSaveConf :: Flag Bool, 1589 cleanDistPref :: Flag FilePath, 1590 cleanVerbosity :: Flag Verbosity, 1591 cleanCabalFilePath :: Flag FilePath 1592 } 1593 deriving (Show, Generic) 1594 1595defaultCleanFlags :: CleanFlags 1596defaultCleanFlags = CleanFlags { 1597 cleanSaveConf = Flag False, 1598 cleanDistPref = NoFlag, 1599 cleanVerbosity = Flag normal, 1600 cleanCabalFilePath = mempty 1601 } 1602 1603cleanCommand :: CommandUI CleanFlags 1604cleanCommand = CommandUI 1605 { commandName = "clean" 1606 , commandSynopsis = "Clean up after a build." 1607 , commandDescription = Just $ \_ -> 1608 "Removes .hi, .o, preprocessed sources, etc.\n" 1609 , commandNotes = Nothing 1610 , commandUsage = \pname -> 1611 "Usage: " ++ pname ++ " clean [FLAGS]\n" 1612 , commandDefaultFlags = defaultCleanFlags 1613 , commandOptions = \showOrParseArgs -> 1614 [optionVerbosity cleanVerbosity (\v flags -> flags { cleanVerbosity = v }) 1615 ,optionDistPref 1616 cleanDistPref (\d flags -> flags { cleanDistPref = d }) 1617 showOrParseArgs 1618 1619 ,option "s" ["save-configure"] 1620 "Do not remove the configuration file (dist/setup-config) during cleaning. Saves need to reconfigure." 1621 cleanSaveConf (\v flags -> flags { cleanSaveConf = v }) 1622 trueArg 1623 ] 1624 } 1625 1626emptyCleanFlags :: CleanFlags 1627emptyCleanFlags = mempty 1628 1629instance Monoid CleanFlags where 1630 mempty = gmempty 1631 mappend = (<>) 1632 1633instance Semigroup CleanFlags where 1634 (<>) = gmappend 1635 1636-- ------------------------------------------------------------ 1637-- * Build flags 1638-- ------------------------------------------------------------ 1639 1640data BuildFlags = BuildFlags { 1641 buildProgramPaths :: [(String, FilePath)], 1642 buildProgramArgs :: [(String, [String])], 1643 buildDistPref :: Flag FilePath, 1644 buildVerbosity :: Flag Verbosity, 1645 buildNumJobs :: Flag (Maybe Int), 1646 -- TODO: this one should not be here, it's just that the silly 1647 -- UserHooks stop us from passing extra info in other ways 1648 buildArgs :: [String], 1649 buildCabalFilePath :: Flag FilePath 1650 } 1651 deriving (Read, Show, Generic) 1652 1653defaultBuildFlags :: BuildFlags 1654defaultBuildFlags = BuildFlags { 1655 buildProgramPaths = mempty, 1656 buildProgramArgs = [], 1657 buildDistPref = mempty, 1658 buildVerbosity = Flag normal, 1659 buildNumJobs = mempty, 1660 buildArgs = [], 1661 buildCabalFilePath = mempty 1662 } 1663 1664buildCommand :: ProgramDb -> CommandUI BuildFlags 1665buildCommand progDb = CommandUI 1666 { commandName = "build" 1667 , commandSynopsis = "Compile all/specific components." 1668 , commandDescription = Just $ \_ -> wrapText $ 1669 "Components encompass executables, tests, and benchmarks.\n" 1670 ++ "\n" 1671 ++ "Affected by configuration options, see `configure`.\n" 1672 , commandNotes = Just $ \pname -> 1673 "Examples:\n" 1674 ++ " " ++ pname ++ " build " 1675 ++ " All the components in the package\n" 1676 ++ " " ++ pname ++ " build foo " 1677 ++ " A component (i.e. lib, exe, test suite)\n\n" 1678 ++ programFlagsDescription progDb 1679--TODO: re-enable once we have support for module/file targets 1680-- ++ " " ++ pname ++ " build Foo.Bar " 1681-- ++ " A module\n" 1682-- ++ " " ++ pname ++ " build Foo/Bar.hs" 1683-- ++ " A file\n\n" 1684-- ++ "If a target is ambiguous it can be qualified with the component " 1685-- ++ "name, e.g.\n" 1686-- ++ " " ++ pname ++ " build foo:Foo.Bar\n" 1687-- ++ " " ++ pname ++ " build testsuite1:Foo/Bar.hs\n" 1688 , commandUsage = usageAlternatives "build" $ 1689 [ "[FLAGS]" 1690 , "COMPONENTS [FLAGS]" 1691 ] 1692 , commandDefaultFlags = defaultBuildFlags 1693 , commandOptions = \showOrParseArgs -> 1694 [ optionVerbosity 1695 buildVerbosity (\v flags -> flags { buildVerbosity = v }) 1696 1697 , optionDistPref 1698 buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs 1699 ] 1700 ++ buildOptions progDb showOrParseArgs 1701 } 1702 1703buildOptions :: ProgramDb -> ShowOrParseArgs 1704 -> [OptionField BuildFlags] 1705buildOptions progDb showOrParseArgs = 1706 [ optionNumJobs 1707 buildNumJobs (\v flags -> flags { buildNumJobs = v }) 1708 ] 1709 1710 ++ programDbPaths progDb showOrParseArgs 1711 buildProgramPaths (\v flags -> flags { buildProgramPaths = v}) 1712 1713 ++ programDbOption progDb showOrParseArgs 1714 buildProgramArgs (\v fs -> fs { buildProgramArgs = v }) 1715 1716 ++ programDbOptions progDb showOrParseArgs 1717 buildProgramArgs (\v flags -> flags { buildProgramArgs = v}) 1718 1719emptyBuildFlags :: BuildFlags 1720emptyBuildFlags = mempty 1721 1722instance Monoid BuildFlags where 1723 mempty = gmempty 1724 mappend = (<>) 1725 1726instance Semigroup BuildFlags where 1727 (<>) = gmappend 1728 1729-- ------------------------------------------------------------ 1730-- * REPL Flags 1731-- ------------------------------------------------------------ 1732 1733data ReplFlags = ReplFlags { 1734 replProgramPaths :: [(String, FilePath)], 1735 replProgramArgs :: [(String, [String])], 1736 replDistPref :: Flag FilePath, 1737 replVerbosity :: Flag Verbosity, 1738 replReload :: Flag Bool, 1739 replReplOptions :: [String] 1740 } 1741 deriving (Show, Generic) 1742 1743defaultReplFlags :: ReplFlags 1744defaultReplFlags = ReplFlags { 1745 replProgramPaths = mempty, 1746 replProgramArgs = [], 1747 replDistPref = NoFlag, 1748 replVerbosity = Flag normal, 1749 replReload = Flag False, 1750 replReplOptions = [] 1751 } 1752 1753instance Monoid ReplFlags where 1754 mempty = gmempty 1755 mappend = (<>) 1756 1757instance Semigroup ReplFlags where 1758 (<>) = gmappend 1759 1760replCommand :: ProgramDb -> CommandUI ReplFlags 1761replCommand progDb = CommandUI 1762 { commandName = "repl" 1763 , commandSynopsis = 1764 "Open an interpreter session for the given component." 1765 , commandDescription = Just $ \pname -> wrapText $ 1766 "If the current directory contains no package, ignores COMPONENT " 1767 ++ "parameters and opens an interactive interpreter session; if a " 1768 ++ "sandbox is present, its package database will be used.\n" 1769 ++ "\n" 1770 ++ "Otherwise, (re)configures with the given or default flags, and " 1771 ++ "loads the interpreter with the relevant modules. For executables, " 1772 ++ "tests and benchmarks, loads the main module (and its " 1773 ++ "dependencies); for libraries all exposed/other modules.\n" 1774 ++ "\n" 1775 ++ "The default component is the library itself, or the executable " 1776 ++ "if that is the only component.\n" 1777 ++ "\n" 1778 ++ "Support for loading specific modules is planned but not " 1779 ++ "implemented yet. For certain scenarios, `" ++ pname 1780 ++ " exec -- ghci :l Foo` may be used instead. Note that `exec` will " 1781 ++ "not (re)configure and you will have to specify the location of " 1782 ++ "other modules, if required.\n" 1783 1784 , commandNotes = Just $ \pname -> 1785 "Examples:\n" 1786 ++ " " ++ pname ++ " repl " 1787 ++ " The first component in the package\n" 1788 ++ " " ++ pname ++ " repl foo " 1789 ++ " A named component (i.e. lib, exe, test suite)\n" 1790 ++ " " ++ pname ++ " repl --repl-options=\"-lstdc++\"" 1791 ++ " Specifying flags for interpreter\n" 1792--TODO: re-enable once we have support for module/file targets 1793-- ++ " " ++ pname ++ " repl Foo.Bar " 1794-- ++ " A module\n" 1795-- ++ " " ++ pname ++ " repl Foo/Bar.hs" 1796-- ++ " A file\n\n" 1797-- ++ "If a target is ambiguous it can be qualified with the component " 1798-- ++ "name, e.g.\n" 1799-- ++ " " ++ pname ++ " repl foo:Foo.Bar\n" 1800-- ++ " " ++ pname ++ " repl testsuite1:Foo/Bar.hs\n" 1801 , commandUsage = \pname -> "Usage: " ++ pname ++ " repl [COMPONENT] [FLAGS]\n" 1802 , commandDefaultFlags = defaultReplFlags 1803 , commandOptions = \showOrParseArgs -> 1804 optionVerbosity replVerbosity (\v flags -> flags { replVerbosity = v }) 1805 : optionDistPref 1806 replDistPref (\d flags -> flags { replDistPref = d }) 1807 showOrParseArgs 1808 1809 : programDbPaths progDb showOrParseArgs 1810 replProgramPaths (\v flags -> flags { replProgramPaths = v}) 1811 1812 ++ programDbOption progDb showOrParseArgs 1813 replProgramArgs (\v flags -> flags { replProgramArgs = v}) 1814 1815 ++ programDbOptions progDb showOrParseArgs 1816 replProgramArgs (\v flags -> flags { replProgramArgs = v}) 1817 1818 ++ case showOrParseArgs of 1819 ParseArgs -> 1820 [ option "" ["reload"] 1821 "Used from within an interpreter to update files." 1822 replReload (\v flags -> flags { replReload = v }) 1823 trueArg 1824 ] 1825 _ -> [] 1826 ++ map liftReplOption (replOptions showOrParseArgs) 1827 } 1828 where 1829 liftReplOption = liftOption replReplOptions (\v flags -> flags { replReplOptions = v }) 1830 1831replOptions :: ShowOrParseArgs -> [OptionField [String]] 1832replOptions _ = [ option [] ["repl-options"] "use this option for the repl" id 1833 const (reqArg "FLAG" (succeedReadE (:[])) id) ] 1834 1835-- ------------------------------------------------------------ 1836-- * Test flags 1837-- ------------------------------------------------------------ 1838 1839data TestShowDetails = Never | Failures | Always | Streaming | Direct 1840 deriving (Eq, Ord, Enum, Bounded, Generic, Show) 1841 1842instance Binary TestShowDetails 1843 1844knownTestShowDetails :: [TestShowDetails] 1845knownTestShowDetails = [minBound..maxBound] 1846 1847instance Pretty TestShowDetails where 1848 pretty = Disp.text . lowercase . show 1849 1850instance Parsec TestShowDetails where 1851 parsec = maybe (fail "invalid TestShowDetails") return . classify =<< ident 1852 where 1853 ident = P.munch1 (\c -> isAlpha c || c == '_' || c == '-') 1854 classify str = lookup (lowercase str) enumMap 1855 enumMap :: [(String, TestShowDetails)] 1856 enumMap = [ (prettyShow x, x) 1857 | x <- knownTestShowDetails ] 1858 1859--TODO: do we need this instance? 1860instance Monoid TestShowDetails where 1861 mempty = Never 1862 mappend = (<>) 1863 1864instance Semigroup TestShowDetails where 1865 a <> b = if a < b then b else a 1866 1867data TestFlags = TestFlags { 1868 testDistPref :: Flag FilePath, 1869 testVerbosity :: Flag Verbosity, 1870 testHumanLog :: Flag PathTemplate, 1871 testMachineLog :: Flag PathTemplate, 1872 testShowDetails :: Flag TestShowDetails, 1873 testKeepTix :: Flag Bool, 1874 testWrapper :: Flag FilePath, 1875 testFailWhenNoTestSuites :: Flag Bool, 1876 -- TODO: think about if/how options are passed to test exes 1877 testOptions :: [PathTemplate] 1878 } deriving (Generic) 1879 1880defaultTestFlags :: TestFlags 1881defaultTestFlags = TestFlags { 1882 testDistPref = NoFlag, 1883 testVerbosity = Flag normal, 1884 testHumanLog = toFlag $ toPathTemplate $ "$pkgid-$test-suite.log", 1885 testMachineLog = toFlag $ toPathTemplate $ "$pkgid.log", 1886 testShowDetails = toFlag Failures, 1887 testKeepTix = toFlag False, 1888 testWrapper = NoFlag, 1889 testFailWhenNoTestSuites = toFlag False, 1890 testOptions = [] 1891 } 1892 1893testCommand :: CommandUI TestFlags 1894testCommand = CommandUI 1895 { commandName = "test" 1896 , commandSynopsis = 1897 "Run all/specific tests in the test suite." 1898 , commandDescription = Just $ \pname -> wrapText $ 1899 "If necessary (re)configures with `--enable-tests` flag and builds" 1900 ++ " the test suite.\n" 1901 ++ "\n" 1902 ++ "Remember that the tests' dependencies must be installed if there" 1903 ++ " are additional ones; e.g. with `" ++ pname 1904 ++ " install --only-dependencies --enable-tests`.\n" 1905 ++ "\n" 1906 ++ "By defining UserHooks in a custom Setup.hs, the package can" 1907 ++ " define actions to be executed before and after running tests.\n" 1908 , commandNotes = Nothing 1909 , commandUsage = usageAlternatives "test" 1910 [ "[FLAGS]" 1911 , "TESTCOMPONENTS [FLAGS]" 1912 ] 1913 , commandDefaultFlags = defaultTestFlags 1914 , commandOptions = testOptions' 1915 } 1916 1917testOptions' :: ShowOrParseArgs -> [OptionField TestFlags] 1918testOptions' showOrParseArgs = 1919 [ optionVerbosity testVerbosity (\v flags -> flags { testVerbosity = v }) 1920 , optionDistPref 1921 testDistPref (\d flags -> flags { testDistPref = d }) 1922 showOrParseArgs 1923 , option [] ["log"] 1924 ("Log all test suite results to file (name template can use " 1925 ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)") 1926 testHumanLog (\v flags -> flags { testHumanLog = v }) 1927 (reqArg' "TEMPLATE" 1928 (toFlag . toPathTemplate) 1929 (flagToList . fmap fromPathTemplate)) 1930 , option [] ["machine-log"] 1931 ("Produce a machine-readable log file (name template can use " 1932 ++ "$pkgid, $compiler, $os, $arch, $result)") 1933 testMachineLog (\v flags -> flags { testMachineLog = v }) 1934 (reqArg' "TEMPLATE" 1935 (toFlag . toPathTemplate) 1936 (flagToList . fmap fromPathTemplate)) 1937 , option [] ["show-details"] 1938 ("'always': always show results of individual test cases. " 1939 ++ "'never': never show results of individual test cases. " 1940 ++ "'failures': show results of failing test cases. " 1941 ++ "'streaming': show results of test cases in real time." 1942 ++ "'direct': send results of test cases in real time; no log file.") 1943 testShowDetails (\v flags -> flags { testShowDetails = v }) 1944 (reqArg "FILTER" 1945 (parsecToReadE (\_ -> "--show-details flag expects one of " 1946 ++ intercalate ", " 1947 (map prettyShow knownTestShowDetails)) 1948 (fmap toFlag parsec)) 1949 (flagToList . fmap prettyShow)) 1950 , option [] ["keep-tix-files"] 1951 "keep .tix files for HPC between test runs" 1952 testKeepTix (\v flags -> flags { testKeepTix = v}) 1953 trueArg 1954 , option [] ["test-wrapper"] 1955 "Run test through a wrapper." 1956 testWrapper (\v flags -> flags { testWrapper = v }) 1957 (reqArg' "FILE" (toFlag :: FilePath -> Flag FilePath) 1958 (flagToList :: Flag FilePath -> [FilePath])) 1959 , option [] ["fail-when-no-test-suites"] 1960 ("Exit with failure when no test suites are found.") 1961 testFailWhenNoTestSuites (\v flags -> flags { testFailWhenNoTestSuites = v}) 1962 trueArg 1963 , option [] ["test-options"] 1964 ("give extra options to test executables " 1965 ++ "(name templates can use $pkgid, $compiler, " 1966 ++ "$os, $arch, $test-suite)") 1967 testOptions (\v flags -> flags { testOptions = v }) 1968 (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) 1969 (const [])) 1970 , option [] ["test-option"] 1971 ("give extra option to test executables " 1972 ++ "(no need to quote options containing spaces, " 1973 ++ "name template can use $pkgid, $compiler, " 1974 ++ "$os, $arch, $test-suite)") 1975 testOptions (\v flags -> flags { testOptions = v }) 1976 (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) 1977 (map fromPathTemplate)) 1978 ] 1979 1980emptyTestFlags :: TestFlags 1981emptyTestFlags = mempty 1982 1983instance Monoid TestFlags where 1984 mempty = gmempty 1985 mappend = (<>) 1986 1987instance Semigroup TestFlags where 1988 (<>) = gmappend 1989 1990-- ------------------------------------------------------------ 1991-- * Benchmark flags 1992-- ------------------------------------------------------------ 1993 1994data BenchmarkFlags = BenchmarkFlags { 1995 benchmarkDistPref :: Flag FilePath, 1996 benchmarkVerbosity :: Flag Verbosity, 1997 benchmarkOptions :: [PathTemplate] 1998 } deriving (Generic) 1999 2000defaultBenchmarkFlags :: BenchmarkFlags 2001defaultBenchmarkFlags = BenchmarkFlags { 2002 benchmarkDistPref = NoFlag, 2003 benchmarkVerbosity = Flag normal, 2004 benchmarkOptions = [] 2005 } 2006 2007benchmarkCommand :: CommandUI BenchmarkFlags 2008benchmarkCommand = CommandUI 2009 { commandName = "bench" 2010 , commandSynopsis = 2011 "Run all/specific benchmarks." 2012 , commandDescription = Just $ \pname -> wrapText $ 2013 "If necessary (re)configures with `--enable-benchmarks` flag and" 2014 ++ " builds the benchmarks.\n" 2015 ++ "\n" 2016 ++ "Remember that the benchmarks' dependencies must be installed if" 2017 ++ " there are additional ones; e.g. with `" ++ pname 2018 ++ " install --only-dependencies --enable-benchmarks`.\n" 2019 ++ "\n" 2020 ++ "By defining UserHooks in a custom Setup.hs, the package can" 2021 ++ " define actions to be executed before and after running" 2022 ++ " benchmarks.\n" 2023 , commandNotes = Nothing 2024 , commandUsage = usageAlternatives "bench" 2025 [ "[FLAGS]" 2026 , "BENCHCOMPONENTS [FLAGS]" 2027 ] 2028 , commandDefaultFlags = defaultBenchmarkFlags 2029 , commandOptions = \showOrParseArgs -> 2030 [ optionVerbosity benchmarkVerbosity 2031 (\v flags -> flags { benchmarkVerbosity = v }) 2032 , optionDistPref 2033 benchmarkDistPref (\d flags -> flags { benchmarkDistPref = d }) 2034 showOrParseArgs 2035 , option [] ["benchmark-options"] 2036 ("give extra options to benchmark executables " 2037 ++ "(name templates can use $pkgid, $compiler, " 2038 ++ "$os, $arch, $benchmark)") 2039 benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) 2040 (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) 2041 (const [])) 2042 , option [] ["benchmark-option"] 2043 ("give extra option to benchmark executables " 2044 ++ "(no need to quote options containing spaces, " 2045 ++ "name template can use $pkgid, $compiler, " 2046 ++ "$os, $arch, $benchmark)") 2047 benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) 2048 (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) 2049 (map fromPathTemplate)) 2050 ] 2051 } 2052 2053emptyBenchmarkFlags :: BenchmarkFlags 2054emptyBenchmarkFlags = mempty 2055 2056instance Monoid BenchmarkFlags where 2057 mempty = gmempty 2058 mappend = (<>) 2059 2060instance Semigroup BenchmarkFlags where 2061 (<>) = gmappend 2062 2063-- ------------------------------------------------------------ 2064-- * Shared options utils 2065-- ------------------------------------------------------------ 2066 2067programFlagsDescription :: ProgramDb -> String 2068programFlagsDescription progDb = 2069 "The flags --with-PROG and --PROG-option(s) can be used with" 2070 ++ " the following programs:" 2071 ++ (concatMap (\line -> "\n " ++ unwords line) . wrapLine 77 . sort) 2072 [ programName prog | (prog, _) <- knownPrograms progDb ] 2073 ++ "\n" 2074 2075-- | For each known program @PROG@ in 'progDb', produce a @with-PROG@ 2076-- 'OptionField'. 2077programDbPaths 2078 :: ProgramDb 2079 -> ShowOrParseArgs 2080 -> (flags -> [(String, FilePath)]) 2081 -> ([(String, FilePath)] -> (flags -> flags)) 2082 -> [OptionField flags] 2083programDbPaths progDb showOrParseArgs get set = 2084 programDbPaths' ("with-" ++) progDb showOrParseArgs get set 2085 2086-- | Like 'programDbPaths', but allows to customise the option name. 2087programDbPaths' 2088 :: (String -> String) 2089 -> ProgramDb 2090 -> ShowOrParseArgs 2091 -> (flags -> [(String, FilePath)]) 2092 -> ([(String, FilePath)] -> (flags -> flags)) 2093 -> [OptionField flags] 2094programDbPaths' mkName progDb showOrParseArgs get set = 2095 case showOrParseArgs of 2096 -- we don't want a verbose help text list so we just show a generic one: 2097 ShowArgs -> [withProgramPath "PROG"] 2098 ParseArgs -> map (withProgramPath . programName . fst) 2099 (knownPrograms progDb) 2100 where 2101 withProgramPath prog = 2102 option "" [mkName prog] 2103 ("give the path to " ++ prog) 2104 get set 2105 (reqArg' "PATH" (\path -> [(prog, path)]) 2106 (\progPaths -> [ path | (prog', path) <- progPaths, prog==prog' ])) 2107 2108-- | For each known program @PROG@ in 'progDb', produce a @PROG-option@ 2109-- 'OptionField'. 2110programDbOption 2111 :: ProgramDb 2112 -> ShowOrParseArgs 2113 -> (flags -> [(String, [String])]) 2114 -> ([(String, [String])] -> (flags -> flags)) 2115 -> [OptionField flags] 2116programDbOption progDb showOrParseArgs get set = 2117 case showOrParseArgs of 2118 -- we don't want a verbose help text list so we just show a generic one: 2119 ShowArgs -> [programOption "PROG"] 2120 ParseArgs -> map (programOption . programName . fst) 2121 (knownPrograms progDb) 2122 where 2123 programOption prog = 2124 option "" [prog ++ "-option"] 2125 ("give an extra option to " ++ prog ++ 2126 " (no need to quote options containing spaces)") 2127 get set 2128 (reqArg' "OPT" (\arg -> [(prog, [arg])]) 2129 (\progArgs -> concat [ args 2130 | (prog', args) <- progArgs, prog==prog' ])) 2131 2132 2133-- | For each known program @PROG@ in 'progDb', produce a @PROG-options@ 2134-- 'OptionField'. 2135programDbOptions 2136 :: ProgramDb 2137 -> ShowOrParseArgs 2138 -> (flags -> [(String, [String])]) 2139 -> ([(String, [String])] -> (flags -> flags)) 2140 -> [OptionField flags] 2141programDbOptions progDb showOrParseArgs get set = 2142 case showOrParseArgs of 2143 -- we don't want a verbose help text list so we just show a generic one: 2144 ShowArgs -> [programOptions "PROG"] 2145 ParseArgs -> map (programOptions . programName . fst) 2146 (knownPrograms progDb) 2147 where 2148 programOptions prog = 2149 option "" [prog ++ "-options"] 2150 ("give extra options to " ++ prog) 2151 get set 2152 (reqArg' "OPTS" (\args -> [(prog, splitArgs args)]) (const [])) 2153 2154-- ------------------------------------------------------------ 2155-- * GetOpt Utils 2156-- ------------------------------------------------------------ 2157 2158boolOpt :: SFlags -> SFlags 2159 -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a 2160boolOpt = Command.boolOpt flagToMaybe Flag 2161 2162boolOpt' :: OptFlags -> OptFlags 2163 -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a 2164boolOpt' = Command.boolOpt' flagToMaybe Flag 2165 2166trueArg, falseArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a 2167trueArg sfT lfT = boolOpt' (sfT, lfT) ([], []) sfT lfT 2168falseArg sfF lfF = boolOpt' ([], []) (sfF, lfF) sfF lfF 2169 2170reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description -> 2171 (b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b 2172reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList 2173 2174optionDistPref :: (flags -> Flag FilePath) 2175 -> (Flag FilePath -> flags -> flags) 2176 -> ShowOrParseArgs 2177 -> OptionField flags 2178optionDistPref get set = \showOrParseArgs -> 2179 option "" (distPrefFlagName showOrParseArgs) 2180 ( "The directory where Cabal puts generated build files " 2181 ++ "(default " ++ defaultDistPref ++ ")") 2182 get set 2183 (reqArgFlag "DIR") 2184 where 2185 distPrefFlagName ShowArgs = ["builddir"] 2186 distPrefFlagName ParseArgs = ["builddir", "distdir", "distpref"] 2187 2188optionVerbosity :: (flags -> Flag Verbosity) 2189 -> (Flag Verbosity -> flags -> flags) 2190 -> OptionField flags 2191optionVerbosity get set = 2192 option "v" ["verbose"] 2193 "Control verbosity (n is 0--3, default verbosity level is 1)" 2194 get set 2195 (optArg "n" (fmap Flag flagToVerbosity) 2196 (Flag verbose) -- default Value if no n is given 2197 (fmap (Just . showForCabal) . flagToList)) 2198 2199optionNumJobs :: (flags -> Flag (Maybe Int)) 2200 -> (Flag (Maybe Int) -> flags -> flags) 2201 -> OptionField flags 2202optionNumJobs get set = 2203 option "j" ["jobs"] 2204 "Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)." 2205 get set 2206 (optArg "NUM" (fmap Flag numJobsParser) 2207 (Flag Nothing) 2208 (map (Just . maybe "$ncpus" show) . flagToList)) 2209 where 2210 numJobsParser :: ReadE (Maybe Int) 2211 numJobsParser = ReadE $ \s -> 2212 case s of 2213 "$ncpus" -> Right Nothing 2214 _ -> case reads s of 2215 [(n, "")] 2216 | n < 1 -> Left "The number of jobs should be 1 or more." 2217 | otherwise -> Right (Just n) 2218 _ -> Left "The jobs value should be a number or '$ncpus'" 2219 2220 2221-- ------------------------------------------------------------ 2222-- * show-build-info command flags 2223-- ------------------------------------------------------------ 2224 2225data ShowBuildInfoFlags = ShowBuildInfoFlags 2226 { buildInfoBuildFlags :: BuildFlags 2227 , buildInfoOutputFile :: Maybe FilePath 2228 } deriving Show 2229 2230defaultShowBuildFlags :: ShowBuildInfoFlags 2231defaultShowBuildFlags = 2232 ShowBuildInfoFlags 2233 { buildInfoBuildFlags = defaultBuildFlags 2234 , buildInfoOutputFile = Nothing 2235 } 2236 2237showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags 2238showBuildInfoCommand progDb = CommandUI 2239 { commandName = "show-build-info" 2240 , commandSynopsis = "Emit details about how a package would be built." 2241 , commandDescription = Just $ \_ -> wrapText $ 2242 "Components encompass executables, tests, and benchmarks.\n" 2243 ++ "\n" 2244 ++ "Affected by configuration options, see `configure`.\n" 2245 , commandNotes = Just $ \pname -> 2246 "Examples:\n" 2247 ++ " " ++ pname ++ " show-build-info " 2248 ++ " All the components in the package\n" 2249 ++ " " ++ pname ++ " show-build-info foo " 2250 ++ " A component (i.e. lib, exe, test suite)\n\n" 2251 ++ programFlagsDescription progDb 2252--TODO: re-enable once we have support for module/file targets 2253-- ++ " " ++ pname ++ " show-build-info Foo.Bar " 2254-- ++ " A module\n" 2255-- ++ " " ++ pname ++ " show-build-info Foo/Bar.hs" 2256-- ++ " A file\n\n" 2257-- ++ "If a target is ambiguous it can be qualified with the component " 2258-- ++ "name, e.g.\n" 2259-- ++ " " ++ pname ++ " show-build-info foo:Foo.Bar\n" 2260-- ++ " " ++ pname ++ " show-build-info testsuite1:Foo/Bar.hs\n" 2261 , commandUsage = usageAlternatives "show-build-info" $ 2262 [ "[FLAGS]" 2263 , "COMPONENTS [FLAGS]" 2264 ] 2265 , commandDefaultFlags = defaultShowBuildFlags 2266 , commandOptions = \showOrParseArgs -> 2267 parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb 2268 ++ 2269 [ option [] ["buildinfo-json-output"] 2270 "Write the result to the given file instead of stdout" 2271 buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) 2272 (reqArg' "FILE" Just (maybe [] pure)) 2273 ] 2274 2275 } 2276 2277parseBuildFlagsForShowBuildInfoFlags :: ShowOrParseArgs -> ProgramDb -> [OptionField ShowBuildInfoFlags] 2278parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb = 2279 map 2280 (liftOption 2281 buildInfoBuildFlags 2282 (\bf flags -> flags { buildInfoBuildFlags = bf } ) 2283 ) 2284 buildFlags 2285 where 2286 buildFlags = buildOptions progDb showOrParseArgs 2287 ++ 2288 [ optionVerbosity 2289 buildVerbosity (\v flags -> flags { buildVerbosity = v }) 2290 2291 , optionDistPref 2292 buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs 2293 ] 2294 2295-- ------------------------------------------------------------ 2296-- * Other Utils 2297-- ------------------------------------------------------------ 2298 2299-- | Arguments to pass to a @configure@ script, e.g. generated by 2300-- @autoconf@. 2301configureArgs :: Bool -> ConfigFlags -> [String] 2302configureArgs bcHack flags 2303 = hc_flag 2304 ++ optFlag "with-hc-pkg" configHcPkg 2305 ++ optFlag' "prefix" prefix 2306 ++ optFlag' "bindir" bindir 2307 ++ optFlag' "libdir" libdir 2308 ++ optFlag' "libexecdir" libexecdir 2309 ++ optFlag' "datadir" datadir 2310 ++ optFlag' "sysconfdir" sysconfdir 2311 ++ configConfigureArgs flags 2312 where 2313 hc_flag = case (configHcFlavor flags, configHcPath flags) of 2314 (_, Flag hc_path) -> [hc_flag_name ++ hc_path] 2315 (Flag hc, NoFlag) -> [hc_flag_name ++ prettyShow hc] 2316 (NoFlag,NoFlag) -> [] 2317 hc_flag_name 2318 --TODO kill off thic bc hack when defaultUserHooks is removed. 2319 | bcHack = "--with-hc=" 2320 | otherwise = "--with-compiler=" 2321 optFlag name config_field = case config_field flags of 2322 Flag p -> ["--" ++ name ++ "=" ++ p] 2323 NoFlag -> [] 2324 optFlag' name config_field = optFlag name (fmap fromPathTemplate 2325 . config_field 2326 . configInstallDirs) 2327 2328configureCCompiler :: Verbosity -> ProgramDb 2329 -> IO (FilePath, [String]) 2330configureCCompiler verbosity progdb = configureProg verbosity progdb gccProgram 2331 2332configureLinker :: Verbosity -> ProgramDb -> IO (FilePath, [String]) 2333configureLinker verbosity progdb = configureProg verbosity progdb ldProgram 2334 2335configureProg :: Verbosity -> ProgramDb -> Program 2336 -> IO (FilePath, [String]) 2337configureProg verbosity programDb prog = do 2338 (p, _) <- requireProgram verbosity prog programDb 2339 let pInv = programInvocation p [] 2340 return (progInvokePath pInv, progInvokeArgs pInv) 2341 2342-- | Helper function to split a string into a list of arguments. 2343-- It's supposed to handle quoted things sensibly, eg: 2344-- 2345-- > splitArgs "--foo=\"C:/Program Files/Bar/" --baz" 2346-- > = ["--foo=C:/Program Files/Bar", "--baz"] 2347-- 2348-- > splitArgs "\"-DMSGSTR=\\\"foo bar\\\"\" --baz" 2349-- > = ["-DMSGSTR=\"foo bar\"","--baz"] 2350-- 2351splitArgs :: String -> [String] 2352splitArgs = space [] 2353 where 2354 space :: String -> String -> [String] 2355 space w [] = word w [] 2356 space w ( c :s) 2357 | isSpace c = word w (space [] s) 2358 space w ('"':s) = string w s 2359 space w s = nonstring w s 2360 2361 string :: String -> String -> [String] 2362 string w [] = word w [] 2363 string w ('"':s) = space w s 2364 string w ('\\':'"':s) = string ('"':w) s 2365 string w ( c :s) = string (c:w) s 2366 2367 nonstring :: String -> String -> [String] 2368 nonstring w [] = word w [] 2369 nonstring w ('"':s) = string w s 2370 nonstring w ( c :s) = space (c:w) s 2371 2372 word [] s = s 2373 word w s = reverse w : s 2374 2375-- The test cases kinda have to be rewritten from the ground up... :/ 2376--hunitTests :: [Test] 2377--hunitTests = 2378-- let m = [("ghc", GHC), ("nhc98", NHC), ("hugs", Hugs)] 2379-- (flags, commands', unkFlags, ers) 2380-- = getOpt Permute options ["configure", "foobar", "--prefix=/foo", "--ghc", "--nhc98", "--hugs", "--with-compiler=/comp", "--unknown1", "--unknown2", "--install-prefix=/foo", "--user", "--global"] 2381-- in [TestLabel "very basic option parsing" $ TestList [ 2382-- "getOpt flags" ~: "failed" ~: 2383-- [Prefix "/foo", GhcFlag, NhcFlag, HugsFlag, 2384-- WithCompiler "/comp", InstPrefix "/foo", UserFlag, GlobalFlag] 2385-- ~=? flags, 2386-- "getOpt commands" ~: "failed" ~: ["configure", "foobar"] ~=? commands', 2387-- "getOpt unknown opts" ~: "failed" ~: 2388-- ["--unknown1", "--unknown2"] ~=? unkFlags, 2389-- "getOpt errors" ~: "failed" ~: [] ~=? ers], 2390-- 2391-- TestLabel "test location of various compilers" $ TestList 2392-- ["configure parsing for prefix and compiler flag" ~: "failed" ~: 2393-- (Right (ConfigCmd (Just comp, Nothing, Just "/usr/local"), [])) 2394-- ~=? (parseArgs ["--prefix=/usr/local", "--"++name, "configure"]) 2395-- | (name, comp) <- m], 2396-- 2397-- TestLabel "find the package tool" $ TestList 2398-- ["configure parsing for prefix comp flag, withcompiler" ~: "failed" ~: 2399-- (Right (ConfigCmd (Just comp, Just "/foo/comp", Just "/usr/local"), [])) 2400-- ~=? (parseArgs ["--prefix=/usr/local", "--"++name, 2401-- "--with-compiler=/foo/comp", "configure"]) 2402-- | (name, comp) <- m], 2403-- 2404-- TestLabel "simpler commands" $ TestList 2405-- [flag ~: "failed" ~: (Right (flagCmd, [])) ~=? (parseArgs [flag]) 2406-- | (flag, flagCmd) <- [("build", BuildCmd), 2407-- ("install", InstallCmd Nothing False), 2408-- ("sdist", SDistCmd), 2409-- ("register", RegisterCmd False)] 2410-- ] 2411-- ] 2412 2413{- Testing ideas: 2414 * IO to look for hugs and hugs-pkg (which hugs, etc) 2415 * quickCheck to test permutations of arguments 2416 * what other options can we over-ride with a command-line flag? 2417-} 2418