Copyright | Isaac Jones 2003-2004 Duncan Coutts 2007 |
---|---|
License | BSD3 |
Maintainer | cabal-devel@haskell.org |
Portability | portable |
Safe Haskell | None |
Language | Haskell98 |
Distribution.Simple.Setup
Description
This is a big module, but not very complicated. The code is very regular
and repetitive. It defines the command line interface for all the Cabal
commands. For each command (like configure
, build
etc) it defines a type
that holds all the flags, the default set of flags and a CommandUI
that
maps command line flags to and from the corresponding flags type.
All the flags types are instances of Monoid
, see
http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html
for an explanation.
The types defined here get used in the front end and especially in
cabal-install
which has to do quite a bit of manipulating sets of command
line flags.
This is actually relatively nice, it works quite well. The main change it needs is to unify it with the code for managing sets of fields that can be read and written from files. This would allow us to save configure flags in config files.
- data GlobalFlags = GlobalFlags {}
- emptyGlobalFlags :: GlobalFlags
- defaultGlobalFlags :: GlobalFlags
- globalCommand :: [Command action] -> CommandUI GlobalFlags
- data ConfigFlags = ConfigFlags {
- configPrograms_ :: Last' ProgramConfiguration
- configProgramPaths :: [(String, FilePath)]
- configProgramArgs :: [(String, [String])]
- configProgramPathExtra :: NubList FilePath
- configHcFlavor :: Flag CompilerFlavor
- configHcPath :: Flag FilePath
- configHcPkg :: Flag FilePath
- configVanillaLib :: Flag Bool
- configProfLib :: Flag Bool
- configSharedLib :: Flag Bool
- configDynExe :: Flag Bool
- configProfExe :: Flag Bool
- configProf :: Flag Bool
- configProfDetail :: Flag ProfDetailLevel
- configProfLibDetail :: Flag ProfDetailLevel
- configConfigureArgs :: [String]
- configOptimization :: Flag OptimisationLevel
- configProgPrefix :: Flag PathTemplate
- configProgSuffix :: Flag PathTemplate
- configInstallDirs :: InstallDirs (Flag PathTemplate)
- configScratchDir :: Flag FilePath
- configExtraLibDirs :: [FilePath]
- configExtraFrameworkDirs :: [FilePath]
- configExtraIncludeDirs :: [FilePath]
- configIPID :: Flag String
- configDistPref :: Flag FilePath
- configVerbosity :: Flag Verbosity
- configUserInstall :: Flag Bool
- configPackageDBs :: [Maybe PackageDB]
- configGHCiLib :: Flag Bool
- configSplitObjs :: Flag Bool
- configStripExes :: Flag Bool
- configStripLibs :: Flag Bool
- configConstraints :: [Dependency]
- configDependencies :: [(PackageName, UnitId)]
- configConfigurationsFlags :: FlagAssignment
- configTests :: Flag Bool
- configBenchmarks :: Flag Bool
- configCoverage :: Flag Bool
- configLibCoverage :: Flag Bool
- configExactConfiguration :: Flag Bool
- configFlagError :: Flag String
- configRelocatable :: Flag Bool
- configDebugInfo :: Flag DebugInfoLevel
- configAllowNewer :: Maybe AllowNewer
- emptyConfigFlags :: ConfigFlags
- defaultConfigFlags :: ProgramConfiguration -> ConfigFlags
- configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags
- configPrograms :: ConfigFlags -> ProgramConfiguration
- data AllowNewer
- data AllowNewerDep
- isAllowNewer :: AllowNewer -> Bool
- configAbsolutePaths :: ConfigFlags -> IO ConfigFlags
- readPackageDbList :: String -> [Maybe PackageDB]
- showPackageDbList :: [Maybe PackageDB] -> [String]
- data CopyFlags = CopyFlags {}
- emptyCopyFlags :: CopyFlags
- defaultCopyFlags :: CopyFlags
- copyCommand :: CommandUI CopyFlags
- data InstallFlags = InstallFlags {}
- emptyInstallFlags :: InstallFlags
- defaultInstallFlags :: InstallFlags
- installCommand :: CommandUI InstallFlags
- data HaddockFlags = HaddockFlags {
- haddockProgramPaths :: [(String, FilePath)]
- haddockProgramArgs :: [(String, [String])]
- haddockHoogle :: Flag Bool
- haddockHtml :: Flag Bool
- haddockHtmlLocation :: Flag String
- haddockForHackage :: Flag Bool
- haddockExecutables :: Flag Bool
- haddockTestSuites :: Flag Bool
- haddockBenchmarks :: Flag Bool
- haddockInternal :: Flag Bool
- haddockCss :: Flag FilePath
- haddockHscolour :: Flag Bool
- haddockHscolourCss :: Flag FilePath
- haddockContents :: Flag PathTemplate
- haddockDistPref :: Flag FilePath
- haddockKeepTempFiles :: Flag Bool
- haddockVerbosity :: Flag Verbosity
- emptyHaddockFlags :: HaddockFlags
- defaultHaddockFlags :: HaddockFlags
- haddockCommand :: CommandUI HaddockFlags
- data HscolourFlags = HscolourFlags {}
- emptyHscolourFlags :: HscolourFlags
- defaultHscolourFlags :: HscolourFlags
- hscolourCommand :: CommandUI HscolourFlags
- data BuildFlags = BuildFlags {
- buildProgramPaths :: [(String, FilePath)]
- buildProgramArgs :: [(String, [String])]
- buildDistPref :: Flag FilePath
- buildVerbosity :: Flag Verbosity
- buildNumJobs :: Flag (Maybe Int)
- buildArgs :: [String]
- emptyBuildFlags :: BuildFlags
- defaultBuildFlags :: BuildFlags
- buildCommand :: ProgramConfiguration -> CommandUI BuildFlags
- buildVerbose :: BuildFlags -> Verbosity
- data ReplFlags = ReplFlags {
- replProgramPaths :: [(String, FilePath)]
- replProgramArgs :: [(String, [String])]
- replDistPref :: Flag FilePath
- replVerbosity :: Flag Verbosity
- replReload :: Flag Bool
- defaultReplFlags :: ReplFlags
- replCommand :: ProgramConfiguration -> CommandUI ReplFlags
- data CleanFlags = CleanFlags {}
- emptyCleanFlags :: CleanFlags
- defaultCleanFlags :: CleanFlags
- cleanCommand :: CommandUI CleanFlags
- data RegisterFlags = RegisterFlags {}
- emptyRegisterFlags :: RegisterFlags
- defaultRegisterFlags :: RegisterFlags
- registerCommand :: CommandUI RegisterFlags
- unregisterCommand :: CommandUI RegisterFlags
- data SDistFlags = SDistFlags {}
- emptySDistFlags :: SDistFlags
- defaultSDistFlags :: SDistFlags
- sdistCommand :: CommandUI SDistFlags
- data TestFlags = TestFlags {}
- emptyTestFlags :: TestFlags
- defaultTestFlags :: TestFlags
- testCommand :: CommandUI TestFlags
- data TestShowDetails
- data BenchmarkFlags = BenchmarkFlags {}
- emptyBenchmarkFlags :: BenchmarkFlags
- defaultBenchmarkFlags :: BenchmarkFlags
- benchmarkCommand :: CommandUI BenchmarkFlags
- data CopyDest
- configureArgs :: Bool -> ConfigFlags -> [String]
- configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags]
- configureCCompiler :: Verbosity -> ProgramConfiguration -> IO (FilePath, [String])
- configureLinker :: Verbosity -> ProgramConfiguration -> IO (FilePath, [String])
- buildOptions :: ProgramConfiguration -> ShowOrParseArgs -> [OptionField BuildFlags]
- haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
- installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))]
- programConfigurationOptions :: ProgramConfiguration -> ShowOrParseArgs -> (flags -> [(String, [String])]) -> ([(String, [String])] -> flags -> flags) -> [OptionField flags]
- programConfigurationPaths' :: (String -> String) -> ProgramConfiguration -> ShowOrParseArgs -> (flags -> [(String, FilePath)]) -> ([(String, FilePath)] -> flags -> flags) -> [OptionField flags]
- splitArgs :: String -> [String]
- defaultDistPref :: FilePath
- optionDistPref :: (flags -> Flag FilePath) -> (Flag FilePath -> flags -> flags) -> ShowOrParseArgs -> OptionField flags
- data Flag a
- toFlag :: a -> Flag a
- fromFlag :: Flag a -> a
- fromFlagOrDefault :: a -> Flag a -> a
- flagToMaybe :: Flag a -> Maybe a
- flagToList :: Flag a -> [a]
- boolOpt :: SFlags -> SFlags -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
- boolOpt' :: OptFlags -> OptFlags -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
- trueArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
- falseArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
- optionVerbosity :: (flags -> Flag Verbosity) -> (Flag Verbosity -> flags -> flags) -> OptionField flags
- optionNumJobs :: (flags -> Flag (Maybe Int)) -> (Flag (Maybe Int) -> flags -> flags) -> OptionField flags
- readPToMaybe :: ReadP a a -> String -> Maybe a
Documentation
data GlobalFlags Source #
Flags that apply at the top level, not to any sub-command.
Constructors
GlobalFlags | |
Fields |
Instances
Generic GlobalFlags # | |
Semigroup GlobalFlags # | |
Monoid GlobalFlags # | |
type Rep GlobalFlags = D1 (MetaData "GlobalFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "GlobalFlags" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "globalVersion") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Bool))) (S1 (MetaSel (Just Symbol "globalNumericVersion") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Bool))))) # |
globalCommand :: [Command action] -> CommandUI GlobalFlags Source #
data ConfigFlags Source #
Flags to configure
command.
IMPORTANT: every time a new flag is added, filterConfigureFlags
should be updated.
Constructors
ConfigFlags | |
Fields
|
Instances
configPrograms :: ConfigFlags -> ProgramConfiguration Source #
More convenient version of configPrograms
. Results in an
error
if internal invariant is violated.
data AllowNewer Source #
Policy for relaxing upper bounds in dependencies. For example, given
'build-depends: array >= 0.3 && < 0.5', are we allowed to relax the upper
bound and choose a version of array
that is greater or equal to 0.5? By
default the upper bounds are always strictly honored.
Constructors
AllowNewerNone | Default: honor the upper bounds in all dependencies, never choose versions newer than allowed. |
AllowNewerSome [AllowNewerDep] | Ignore upper bounds in dependencies on the given packages. |
AllowNewerAll | Ignore upper bounds in dependencies on all packages. |
Instances
Eq AllowNewer # | |
Read AllowNewer # | |
Show AllowNewer # | |
Generic AllowNewer # | |
Semigroup AllowNewer # | |
Monoid AllowNewer # | |
Binary AllowNewer # | |
type Rep AllowNewer = D1 (MetaData "AllowNewer" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) ((:+:) (C1 (MetaCons "AllowNewerNone" PrefixI False) U1) ((:+:) (C1 (MetaCons "AllowNewerSome" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [AllowNewerDep]))) (C1 (MetaCons "AllowNewerAll" PrefixI False) U1))) # |
data AllowNewerDep Source #
Dependencies can be relaxed either for all packages in the install plan, or only for some packages.
Instances
Eq AllowNewerDep # | |
Read AllowNewerDep # | |
Show AllowNewerDep # | |
Generic AllowNewerDep # | |
Binary AllowNewerDep # | |
Text AllowNewerDep # | |
type Rep AllowNewerDep = D1 (MetaData "AllowNewerDep" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) ((:+:) (C1 (MetaCons "AllowNewerDep" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 PackageName))) (C1 (MetaCons "AllowNewerDepScoped" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 PackageName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 PackageName))))) # |
isAllowNewer :: AllowNewer -> Bool Source #
Convert AllowNewer
to a boolean.
Flags to copy
: (destdir, copy-prefix (backwards compat), verbosity)
Constructors
CopyFlags | |
Fields |
Instances
Show CopyFlags # | |
Generic CopyFlags # | |
Semigroup CopyFlags # | |
Monoid CopyFlags # | |
type Rep CopyFlags = D1 (MetaData "CopyFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "CopyFlags" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "copyDest") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag CopyDest))) ((:*:) (S1 (MetaSel (Just Symbol "copyDistPref") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath))) (S1 (MetaSel (Just Symbol "copyVerbosity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Verbosity)))))) # |
data InstallFlags Source #
Flags to install
: (package db, verbosity)
Constructors
InstallFlags | |
Fields |
Instances
Show InstallFlags # | |
Generic InstallFlags # | |
Semigroup InstallFlags # | |
Monoid InstallFlags # | |
type Rep InstallFlags = D1 (MetaData "InstallFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "InstallFlags" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "installPackageDB") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag PackageDB))) (S1 (MetaSel (Just Symbol "installDistPref") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath)))) ((:*:) (S1 (MetaSel (Just Symbol "installUseWrapper") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Bool))) ((:*:) (S1 (MetaSel (Just Symbol "installInPlace") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Bool))) (S1 (MetaSel (Just Symbol "installVerbosity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Verbosity))))))) # |
data HaddockFlags Source #
Constructors
HaddockFlags | |
Fields
|
Instances
data HscolourFlags Source #
Constructors
HscolourFlags | |
Fields |
Instances
data BuildFlags Source #
Constructors
BuildFlags | |
Fields
|
Instances
Show BuildFlags # | |
Generic BuildFlags # | |
Semigroup BuildFlags # | |
Monoid BuildFlags # | |
type Rep BuildFlags = D1 (MetaData "BuildFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "BuildFlags" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "buildProgramPaths") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(String, FilePath)])) ((:*:) (S1 (MetaSel (Just Symbol "buildProgramArgs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(String, [String])])) (S1 (MetaSel (Just Symbol "buildDistPref") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath))))) ((:*:) (S1 (MetaSel (Just Symbol "buildVerbosity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Verbosity))) ((:*:) (S1 (MetaSel (Just Symbol "buildNumJobs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag (Maybe Int)))) (S1 (MetaSel (Just Symbol "buildArgs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String])))))) # |
buildVerbose :: BuildFlags -> Verbosity Source #
Deprecated: Use buildVerbosity instead
Constructors
ReplFlags | |
Fields
|
Instances
Show ReplFlags # | |
Generic ReplFlags # | |
Semigroup ReplFlags # | |
Monoid ReplFlags # | |
type Rep ReplFlags = D1 (MetaData "ReplFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "ReplFlags" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "replProgramPaths") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(String, FilePath)])) (S1 (MetaSel (Just Symbol "replProgramArgs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(String, [String])]))) ((:*:) (S1 (MetaSel (Just Symbol "replDistPref") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath))) ((:*:) (S1 (MetaSel (Just Symbol "replVerbosity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Verbosity))) (S1 (MetaSel (Just Symbol "replReload") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Bool))))))) # |
data CleanFlags Source #
Constructors
CleanFlags | |
Fields |
Instances
Show CleanFlags # | |
Generic CleanFlags # | |
Semigroup CleanFlags # | |
Monoid CleanFlags # | |
type Rep CleanFlags = D1 (MetaData "CleanFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "CleanFlags" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "cleanSaveConf") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Bool))) ((:*:) (S1 (MetaSel (Just Symbol "cleanDistPref") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath))) (S1 (MetaSel (Just Symbol "cleanVerbosity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Verbosity)))))) # |
data RegisterFlags Source #
Flags to register
and unregister
: (user package, gen-script,
in-place, verbosity)
Constructors
RegisterFlags | |
Fields
|
Instances
data SDistFlags Source #
Flags to sdist
: (snapshot, verbosity)
Constructors
SDistFlags | |
Fields |
Instances
Show SDistFlags # | |
Generic SDistFlags # | |
Semigroup SDistFlags # | |
Monoid SDistFlags # | |
type Rep SDistFlags = D1 (MetaData "SDistFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "SDistFlags" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "sDistSnapshot") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Bool))) (S1 (MetaSel (Just Symbol "sDistDirectory") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath)))) ((:*:) (S1 (MetaSel (Just Symbol "sDistDistPref") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath))) ((:*:) (S1 (MetaSel (Just Symbol "sDistListSources") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath))) (S1 (MetaSel (Just Symbol "sDistVerbosity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Verbosity))))))) # |
Constructors
TestFlags | |
Fields |
Instances
data TestShowDetails Source #
data BenchmarkFlags Source #
Constructors
BenchmarkFlags | |
Fields |
Instances
Generic BenchmarkFlags # | |
Semigroup BenchmarkFlags # | |
Monoid BenchmarkFlags # | |
type Rep BenchmarkFlags = D1 (MetaData "BenchmarkFlags" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) (C1 (MetaCons "BenchmarkFlags" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "benchmarkDistPref") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag FilePath))) ((:*:) (S1 (MetaSel (Just Symbol "benchmarkVerbosity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Flag Verbosity))) (S1 (MetaSel (Just Symbol "benchmarkOptions") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [PathTemplate]))))) # |
The location prefix for the copy command.
Constructors
NoCopyDest | |
CopyTo FilePath |
configureArgs :: Bool -> ConfigFlags -> [String] Source #
Arguments to pass to a configure
script, e.g. generated by
autoconf
.
configureCCompiler :: Verbosity -> ProgramConfiguration -> IO (FilePath, [String]) Source #
configureLinker :: Verbosity -> ProgramConfiguration -> IO (FilePath, [String]) Source #
programConfigurationOptions :: ProgramConfiguration -> ShowOrParseArgs -> (flags -> [(String, [String])]) -> ([(String, [String])] -> flags -> flags) -> [OptionField flags] Source #
For each known program PROG
in progConf
, produce a PROG-options
OptionField
.
programConfigurationPaths' :: (String -> String) -> ProgramConfiguration -> ShowOrParseArgs -> (flags -> [(String, FilePath)]) -> ([(String, FilePath)] -> flags -> flags) -> [OptionField flags] Source #
Like programConfigurationPaths
, but allows to customise the option name.
splitArgs :: String -> [String] Source #
Helper function to split a string into a list of arguments. It's supposed to handle quoted things sensibly, eg:
splitArgs "--foo=\"C:\Program Files\Bar\" --baz" = ["--foo=C:\Program Files\Bar", "--baz"]
optionDistPref :: (flags -> Flag FilePath) -> (Flag FilePath -> flags -> flags) -> ShowOrParseArgs -> OptionField flags Source #
All flags are monoids, they come in two flavours:
- list flags eg
--ghc-option=foo --ghc-option=bar
gives us all the values ["foo", "bar"]
- singular value flags, eg:
--enable-foo --disable-foo
gives us Just False
So this Flag type is for the latter singular kind of flag.
Its monoid instance gives us the behaviour where it starts out as
NoFlag
and later flags override earlier ones.
Instances
Functor Flag # | |
Bounded a => Bounded (Flag a) # | |
Enum a => Enum (Flag a) # | |
Eq a => Eq (Flag a) # | |
Read a => Read (Flag a) # | |
Show a => Show (Flag a) # | |
Generic (Flag a) # | |
Semigroup (Flag a) # | |
Monoid (Flag a) # | |
Binary a => Binary (Flag a) # | |
type Rep (Flag a) = D1 (MetaData "Flag" "Distribution.Simple.Setup" "Cabal-1.24.0.0" False) ((:+:) (C1 (MetaCons "Flag" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a))) (C1 (MetaCons "NoFlag" PrefixI False) U1)) # |
fromFlagOrDefault :: a -> Flag a -> a Source #
flagToMaybe :: Flag a -> Maybe a Source #
flagToList :: Flag a -> [a] Source #
optionVerbosity :: (flags -> Flag Verbosity) -> (Flag Verbosity -> flags -> flags) -> OptionField flags Source #
optionNumJobs :: (flags -> Flag (Maybe Int)) -> (Flag (Maybe Int) -> flags -> flags) -> OptionField flags Source #