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