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