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