diff --git a/ChangeLog.md b/ChangeLog.md index a0dea9a610..bc48e56428 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -136,6 +136,9 @@ Other enhancements: expiration verification just like `cabal --ignore-expiry` does. The flag is not enabled by default so that the default functionality is not changed. +* Include default values for most command line flags in the `--help` + output. See + [#893](https://github.com/commercialhaskell/stack/issues/893). Bug fixes: diff --git a/src/Options/Applicative/Builder/Extra.hs b/src/Options/Applicative/Builder/Extra.hs index f5b8e7e811..1d44b0c8d7 100644 --- a/src/Options/Applicative/Builder/Extra.hs +++ b/src/Options/Applicative/Builder/Extra.hs @@ -7,8 +7,9 @@ module Options.Applicative.Builder.Extra (boolFlags ,boolFlagsNoDefault - ,maybeBoolFlags - ,firstBoolFlags + ,firstBoolFlagsNoDefault + ,firstBoolFlagsTrue + ,firstBoolFlagsFalse ,enableDisableFlags ,enableDisableFlagsNoDefault ,extraHelpOption @@ -16,6 +17,8 @@ module Options.Applicative.Builder.Extra ,textOption ,textArgument ,optionalFirst + ,optionalFirstTrue + ,optionalFirstFalse ,absFileOption ,relFileOption ,absDirOption @@ -48,7 +51,13 @@ boolFlags :: Bool -- ^ Default value -> String -- ^ Help suffix -> Mod FlagFields Bool -> Parser Bool -boolFlags defaultValue = enableDisableFlags defaultValue True False +boolFlags defaultValue name helpSuffix = + enableDisableFlags defaultValue True False name $ concat + [ helpSuffix + , " (default: " + , if defaultValue then "enabled" else "disabled" + , ")" + ] -- | Enable/disable flags for a 'Bool', without a default case (to allow chaining with '<|>'). boolFlagsNoDefault :: String -- ^ Flag name @@ -57,16 +66,24 @@ boolFlagsNoDefault :: String -- ^ Flag name -> Parser Bool boolFlagsNoDefault = enableDisableFlagsNoDefault True False --- | Enable/disable flags for a @('Maybe' 'Bool')@. -maybeBoolFlags :: String -- ^ Flag name - -> String -- ^ Help suffix - -> Mod FlagFields (Maybe Bool) - -> Parser (Maybe Bool) -maybeBoolFlags = enableDisableFlags Nothing (Just True) (Just False) +-- | Flag with no default of True or False +firstBoolFlagsNoDefault :: String -> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool) +firstBoolFlagsNoDefault name helpSuffix mod' = + First <$> + enableDisableFlags Nothing (Just True) (Just False) + name helpSuffix mod' --- | Like 'maybeBoolFlags', but parsing a 'First'. -firstBoolFlags :: String -> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool) -firstBoolFlags long0 help0 mod0 = First <$> maybeBoolFlags long0 help0 mod0 +-- | Flag with a Semigroup instance and a default of True +firstBoolFlagsTrue :: String -> String -> Mod FlagFields FirstTrue -> Parser FirstTrue +firstBoolFlagsTrue name helpSuffix = + enableDisableFlags mempty (FirstTrue (Just True)) (FirstTrue (Just False)) + name $ helpSuffix ++ " (default: enabled)" + +-- | Flag with a Semigroup instance and a default of False +firstBoolFlagsFalse :: String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse +firstBoolFlagsFalse name helpSuffix = + enableDisableFlags mempty (FirstFalse (Just False)) (FirstFalse (Just False)) + name $ helpSuffix ++ " (default: disabled)" -- | Enable/disable flags for any type. enableDisableFlags :: a -- ^ Default value @@ -161,6 +178,14 @@ textArgument = argument (T.pack <$> readerAsk) optionalFirst :: Alternative f => f a -> f (First a) optionalFirst = fmap First . optional +-- | Like 'optional', but returning a 'FirstTrue'. +optionalFirstTrue :: Alternative f => f Bool -> f FirstTrue +optionalFirstTrue = fmap FirstTrue . optional + +-- | Like 'optional', but returning a 'FirstFalse'. +optionalFirstFalse :: Alternative f => f Bool -> f FirstFalse +optionalFirstFalse = fmap FirstFalse . optional + absFileOption :: Mod OptionFields (Path Abs File) -> Parser (Path Abs File) absFileOption mods = option (eitherReader' parseAbsFile) $ completer (pathCompleterWith defaultPathCompleterOpts { pcoRelative = False }) <> mods diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index eefc5e9b6e..8b13c3df69 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -373,7 +373,7 @@ withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPacka toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp)) createTempDirFunction - | Just True <- boptsKeepTmpFiles bopts = withKeepSystemTempDir + | boptsKeepTmpFiles bopts = withKeepSystemTempDir | otherwise = withSystemTempDir dumpLogs :: TChan (Path Abs Dir, Path Abs File) -> Int -> RIO env () diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index f5199744a3..690ba5510d 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -223,13 +223,13 @@ configFromConfigMonoid "https://s3.amazonaws.com/haddock.stackage.org/snapshots.json" configMonoidLatestSnapshot clConnectionCount = fromFirst 8 configMonoidConnectionCount - configHideTHLoading = fromFirst True configMonoidHideTHLoading + configHideTHLoading = fromFirstTrue configMonoidHideTHLoading configGHCVariant = getFirst configMonoidGHCVariant configGHCBuild = getFirst configMonoidGHCBuild - configInstallGHC = fromFirst True configMonoidInstallGHC - configSkipGHCCheck = fromFirst False configMonoidSkipGHCCheck - configSkipMsys = fromFirst False configMonoidSkipMsys + configInstallGHC = fromFirstTrue configMonoidInstallGHC + configSkipGHCCheck = fromFirstFalse configMonoidSkipGHCCheck + configSkipMsys = fromFirstFalse configMonoidSkipMsys configExtraIncludeDirs = configMonoidExtraIncludeDirs configExtraLibDirs = configMonoidExtraLibDirs @@ -315,9 +315,9 @@ configFromConfigMonoid configGhcOptionsByCat = coerce configMonoidGhcOptionsByCat configSetupInfoLocations = configMonoidSetupInfoLocations configPvpBounds = fromFirst (PvpBounds PvpBoundsNone False) configMonoidPvpBounds - configModifyCodePage = fromFirst True configMonoidModifyCodePage + configModifyCodePage = fromFirstTrue configMonoidModifyCodePage configExplicitSetupDeps = configMonoidExplicitSetupDeps - configRebuildGhcOptions = fromFirst False configMonoidRebuildGhcOptions + configRebuildGhcOptions = fromFirstFalse configMonoidRebuildGhcOptions configApplyGhcOptions = fromFirst AGOLocals configMonoidApplyGhcOptions configAllowNewer = fromFirst False configMonoidAllowNewer configDefaultTemplate = getFirst configMonoidDefaultTemplate diff --git a/src/Stack/Config/Build.hs b/src/Stack/Config/Build.hs index 6d29d27b7b..6b4a095dc5 100644 --- a/src/Stack/Config/Build.hs +++ b/src/Stack/Config/Build.hs @@ -10,71 +10,41 @@ import Stack.Types.Config -- | Interprets BuildOptsMonoid options. buildOptsFromMonoid :: BuildOptsMonoid -> BuildOpts buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts - { boptsLibProfile = fromFirst - (boptsLibProfile defaultBuildOpts) + { boptsLibProfile = fromFirstFalse (buildMonoidLibProfile <> - First (if tracing || profiling then Just True else Nothing)) - , boptsExeProfile = fromFirst - (boptsExeProfile defaultBuildOpts) + FirstFalse (if tracing || profiling then Just True else Nothing)) + , boptsExeProfile = fromFirstFalse (buildMonoidExeProfile <> - First (if tracing || profiling then Just True else Nothing)) - , boptsLibStrip = fromFirst - (boptsLibStrip defaultBuildOpts) + FirstFalse (if tracing || profiling then Just True else Nothing)) + , boptsLibStrip = fromFirstTrue (buildMonoidLibStrip <> - First (if noStripping then Just False else Nothing)) - , boptsExeStrip = fromFirst - (boptsExeStrip defaultBuildOpts) + FirstTrue (if noStripping then Just False else Nothing)) + , boptsExeStrip = fromFirstTrue (buildMonoidExeStrip <> - First (if noStripping then Just False else Nothing)) - , boptsHaddock = fromFirst - (boptsHaddock defaultBuildOpts) - buildMonoidHaddock + FirstTrue (if noStripping then Just False else Nothing)) + , boptsHaddock = fromFirstFalse buildMonoidHaddock , boptsHaddockOpts = haddockOptsFromMonoid buildMonoidHaddockOpts - , boptsOpenHaddocks = fromFirst - (boptsOpenHaddocks defaultBuildOpts) - buildMonoidOpenHaddocks + , boptsOpenHaddocks = fromFirstFalse buildMonoidOpenHaddocks , boptsHaddockDeps = getFirst buildMonoidHaddockDeps - , boptsHaddockInternal = fromFirst - (boptsHaddockInternal defaultBuildOpts) - buildMonoidHaddockInternal - , boptsHaddockHyperlinkSource = fromFirst - (boptsHaddockHyperlinkSource defaultBuildOpts) - buildMonoidHaddockHyperlinkSource - , boptsInstallExes = fromFirst - (boptsInstallExes defaultBuildOpts) - buildMonoidInstallExes - , boptsInstallCompilerTool = fromFirst - (boptsInstallCompilerTool defaultBuildOpts) - buildMonoidInstallCompilerTool - , boptsPreFetch = fromFirst - (boptsPreFetch defaultBuildOpts) - buildMonoidPreFetch + , boptsHaddockInternal = fromFirstFalse buildMonoidHaddockInternal + , boptsHaddockHyperlinkSource = fromFirstTrue buildMonoidHaddockHyperlinkSource + , boptsInstallExes = fromFirstFalse buildMonoidInstallExes + , boptsInstallCompilerTool = fromFirstFalse buildMonoidInstallCompilerTool + , boptsPreFetch = fromFirstFalse buildMonoidPreFetch , boptsKeepGoing = getFirst buildMonoidKeepGoing - , boptsKeepTmpFiles = getFirst buildMonoidKeepTmpFiles - , boptsForceDirty = fromFirst - (boptsForceDirty defaultBuildOpts) - buildMonoidForceDirty - , boptsTests = fromFirst (boptsTests defaultBuildOpts) buildMonoidTests + , boptsKeepTmpFiles = fromFirstFalse buildMonoidKeepTmpFiles + , boptsForceDirty = fromFirstFalse buildMonoidForceDirty + , boptsTests = fromFirstFalse buildMonoidTests , boptsTestOpts = testOptsFromMonoid buildMonoidTestOpts additionalArgs - , boptsBenchmarks = fromFirst - (boptsBenchmarks defaultBuildOpts) - buildMonoidBenchmarks + , boptsBenchmarks = fromFirstFalse buildMonoidBenchmarks , boptsBenchmarkOpts = benchmarkOptsFromMonoid buildMonoidBenchmarkOpts additionalArgs - , boptsReconfigure = fromFirst - (boptsReconfigure defaultBuildOpts) - buildMonoidReconfigure - , boptsCabalVerbose = fromFirst - (boptsCabalVerbose defaultBuildOpts) - buildMonoidCabalVerbose - , boptsSplitObjs = fromFirst - (boptsSplitObjs defaultBuildOpts) - buildMonoidSplitObjs + , boptsReconfigure = fromFirstFalse buildMonoidReconfigure + , boptsCabalVerbose = fromFirstFalse buildMonoidCabalVerbose + , boptsSplitObjs = fromFirstFalse buildMonoidSplitObjs , boptsSkipComponents = buildMonoidSkipComponents - , boptsInterleavedOutput = fromFirst - (boptsInterleavedOutput defaultBuildOpts) - buildMonoidInterleavedOutput + , boptsInterleavedOutput = fromFirstFalse buildMonoidInterleavedOutput , boptsDdumpDir = getFirst buildMonoidDdumpDir } where @@ -105,10 +75,10 @@ haddockOptsFromMonoid HaddockOptsMonoid{..} = testOptsFromMonoid :: TestOptsMonoid -> Maybe [String] -> TestOpts testOptsFromMonoid TestOptsMonoid{..} madditional = defaultTestOpts - { toRerunTests = fromFirst (toRerunTests defaultTestOpts) toMonoidRerunTests + { toRerunTests = fromFirstTrue toMonoidRerunTests , toAdditionalArgs = fromMaybe [] madditional <> toMonoidAdditionalArgs - , toCoverage = fromFirst (toCoverage defaultTestOpts) toMonoidCoverage - , toDisableRun = fromFirst (toDisableRun defaultTestOpts) toMonoidDisableRun + , toCoverage = fromFirstFalse toMonoidCoverage + , toDisableRun = fromFirstFalse toMonoidDisableRun , toMaximumTimeSeconds = fromFirst (toMaximumTimeSeconds defaultTestOpts) toMonoidMaximumTimeSeconds } diff --git a/src/Stack/Config/Docker.hs b/src/Stack/Config/Docker.hs index 944d3753aa..03df2de90b 100644 --- a/src/Stack/Config/Docker.hs +++ b/src/Stack/Config/Docker.hs @@ -69,9 +69,9 @@ dockerOptsFromMonoid mproject stackRoot maresolver DockerOptsMonoid{..} = do dockerMonoidRegistryLogin dockerRegistryUsername = emptyToNothing (getFirst dockerMonoidRegistryUsername) dockerRegistryPassword = emptyToNothing (getFirst dockerMonoidRegistryPassword) - dockerAutoPull = fromFirst False dockerMonoidAutoPull - dockerDetach = fromFirst False dockerMonoidDetach - dockerPersist = fromFirst False dockerMonoidPersist + dockerAutoPull = fromFirstFalse dockerMonoidAutoPull + dockerDetach = fromFirstFalse dockerMonoidDetach + dockerPersist = fromFirstFalse dockerMonoidPersist dockerContainerName = emptyToNothing (getFirst dockerMonoidContainerName) dockerRunArgs = dockerMonoidRunArgs dockerMount = dockerMonoidMount diff --git a/src/Stack/Config/Nix.hs b/src/Stack/Config/Nix.hs index 963c537f24..faafe84894 100644 --- a/src/Stack/Config/Nix.hs +++ b/src/Stack/Config/Nix.hs @@ -33,7 +33,7 @@ nixOptsFromMonoid NixOptsMonoid{..} os = do nixInitFile = getFirst nixMonoidInitFile nixShellOptions = fromFirst [] nixMonoidShellOptions ++ prefixAll (T.pack "-I") (fromFirst [] nixMonoidPath) - nixAddGCRoots = fromFirst False nixMonoidAddGCRoots + nixAddGCRoots = fromFirstFalse nixMonoidAddGCRoots -- Enable Nix-mode by default on NixOS, unless Docker-mode was specified osIsNixOS <- isNixOS diff --git a/src/Stack/Options/BuildMonoidParser.hs b/src/Stack/Options/BuildMonoidParser.hs index ac47f21a0c..402dd111ad 100644 --- a/src/Stack/Options/BuildMonoidParser.hs +++ b/src/Stack/Options/BuildMonoidParser.hs @@ -65,99 +65,102 @@ buildOptsMonoidParser hide0 = \debugging symbols." <> hideExceptGhci) libProfiling = - firstBoolFlags + firstBoolFlagsFalse "library-profiling" "library profiling for TARGETs and all its dependencies" hide exeProfiling = - firstBoolFlags + firstBoolFlagsFalse "executable-profiling" "executable profiling for TARGETs and all its dependencies" hide libStripping = - firstBoolFlags + firstBoolFlagsTrue "library-stripping" "library stripping for TARGETs and all its dependencies" hide exeStripping = - firstBoolFlags + firstBoolFlagsTrue "executable-stripping" "executable stripping for TARGETs and all its dependencies" hide haddock = - firstBoolFlags + firstBoolFlagsFalse "haddock" "generating Haddocks the package(s) in this directory/configuration" hide openHaddocks = - firstBoolFlags + firstBoolFlagsFalse "open" "opening the local Haddock documentation in the browser" hide haddockDeps = - firstBoolFlags "haddock-deps" "building Haddocks for dependencies" hide + firstBoolFlagsNoDefault + "haddock-deps" + "building Haddocks for dependencies (default: true if building Haddocks, false otherwise)" + hide haddockInternal = - firstBoolFlags + firstBoolFlagsFalse "haddock-internal" "building Haddocks for internal modules (like cabal haddock --internal)" hide haddockHyperlinkSource = - firstBoolFlags + firstBoolFlagsTrue "haddock-hyperlink-source" "building hyperlinked source for Haddock (like haddock --hyperlinked-source)" hide copyBins = - firstBoolFlags + firstBoolFlagsFalse "copy-bins" "copying binaries to the local-bin-path (see 'stack path')" hide copyCompilerTool = - firstBoolFlags + firstBoolFlagsFalse "copy-compiler-tool" "copying binaries of targets to compiler-tools-bin (see 'stack path')" hide keepGoing = - firstBoolFlags + firstBoolFlagsNoDefault "keep-going" "continue running after a step fails (default: false for build, true for test/bench)" hide keepTmpFiles = - firstBoolFlags + firstBoolFlagsFalse "keep-tmp-files" - "keep intermediate files and build directories (default: false)" + "keep intermediate files and build directories" hide preFetch = - firstBoolFlags + firstBoolFlagsFalse "prefetch" "Fetch packages necessary for the build immediately, useful with --dry-run" hide forceDirty = - firstBoolFlags + firstBoolFlagsFalse "force-dirty" "Force treating all local packages as having dirty files (useful for cases where stack can't detect a file change" hide tests = - firstBoolFlags + firstBoolFlagsFalse "test" "testing the package(s) in this directory/configuration" hideExceptGhci benches = - firstBoolFlags + firstBoolFlagsFalse "bench" "benchmarking the package(s) in this directory/configuration" hideExceptGhci reconfigure = - firstBoolFlags + firstBoolFlagsFalse "reconfigure" "Perform the configure step even if unnecessary. Useful in some corner cases with custom Setup.hs files" hide cabalVerbose = - firstBoolFlags + firstBoolFlagsFalse "cabal-verbose" "Ask Cabal to be verbose in its output" hide splitObjs = - firstBoolFlags + firstBoolFlagsFalse "split-objs" ("Enable split-objs, to reduce output size (at the cost of build time). " ++ splitObjsWarning) hide @@ -169,7 +172,7 @@ buildOptsMonoidParser hide0 = help "Skip given component, can be specified multiple times" <> hide))) interleavedOutput = - firstBoolFlags + firstBoolFlagsFalse "interleaved-output" "Print concurrent GHC output to the console with a prefix for the package name" hide diff --git a/src/Stack/Options/ConfigParser.hs b/src/Stack/Options/ConfigParser.hs index 74432ce05e..7d5f5509f6 100644 --- a/src/Stack/Options/ConfigParser.hs +++ b/src/Stack/Options/ConfigParser.hs @@ -64,11 +64,11 @@ configOptsParser currentDir hide0 = <*> buildOptsMonoidParser hide0 <*> dockerOptsParser True <*> nixOptsParser True - <*> firstBoolFlags + <*> firstBoolFlagsNoDefault "system-ghc" "using the system installed GHC (on the PATH) if it is available and its version matches. Disabled by default." hide - <*> firstBoolFlags + <*> firstBoolFlagsTrue "install-ghc" "downloading and installing GHC if necessary (can be done manually with stack setup)" hide @@ -113,11 +113,11 @@ configOptsParser currentDir hide0 = <> help "Use HPACK executable (overrides bundled Hpack)" <> hide )) - <*> firstBoolFlags + <*> firstBoolFlagsFalse "skip-ghc-check" "skipping the GHC version and architecture check" hide - <*> firstBoolFlags + <*> firstBoolFlagsFalse "skip-msys" "skipping the local MSYS installation (Windows only)" hide @@ -128,19 +128,20 @@ configOptsParser currentDir hide0 = <> help "Install binaries to DIR" <> hide )) - <*> firstBoolFlags + <*> firstBoolFlagsTrue "modify-code-page" "setting the codepage to support UTF-8 (Windows only)" hide - <*> firstBoolFlags + <*> firstBoolFlagsNoDefault "allow-different-user" ("permission for users other than the owner of the stack root " ++ - "directory to use a stack installation (POSIX only)") + "directory to use a stack installation (POSIX only) " ++ + "(default: true inside Docker, otherwise false)") hide <*> fmap toDumpLogs - (firstBoolFlags + (firstBoolFlagsNoDefault "dump-logs" - "dump the build output logs for local packages to the console" + "dump the build output logs for local packages to the console (default: dump warning logs)" hide) <*> optionalFirst (option readColorWhen ( long "color" diff --git a/src/Stack/Options/DockerParser.hs b/src/Stack/Options/DockerParser.hs index c8b9ab7ba6..dd4e2584b3 100644 --- a/src/Stack/Options/DockerParser.hs +++ b/src/Stack/Options/DockerParser.hs @@ -20,7 +20,8 @@ dockerOptsParser :: Bool -> Parser DockerOptsMonoid dockerOptsParser hide0 = DockerOptsMonoid <$> pure (Any False) - <*> firstBoolFlags dockerCmdName + <*> firstBoolFlagsNoDefault + dockerCmdName "using a Docker container. --docker implies 'system-ghc: true'" hide <*> fmap First @@ -33,7 +34,8 @@ dockerOptsParser hide0 = metavar "IMAGE" <> help "Exact Docker image ID (overrides docker-repo)") <|> pure Nothing) - <*> firstBoolFlags (dockerOptName dockerRegistryLoginArgName) + <*> firstBoolFlagsNoDefault + (dockerOptName dockerRegistryLoginArgName) "registry requires login" hide <*> firstStrOption (long (dockerOptName dockerRegistryUsernameArgName) <> @@ -44,13 +46,16 @@ dockerOptsParser hide0 = hide <> metavar "PASSWORD" <> help "Docker registry password") - <*> firstBoolFlags (dockerOptName dockerAutoPullArgName) + <*> firstBoolFlagsFalse + (dockerOptName dockerAutoPullArgName) "automatic pulling latest version of image" hide - <*> firstBoolFlags (dockerOptName dockerDetachArgName) + <*> firstBoolFlagsFalse + (dockerOptName dockerDetachArgName) "running a detached Docker container" hide - <*> firstBoolFlags (dockerOptName dockerPersistArgName) + <*> firstBoolFlagsFalse + (dockerOptName dockerPersistArgName) "not deleting container after it exits" hide <*> firstStrOption (long (dockerOptName dockerContainerNameArgName) <> @@ -91,7 +96,8 @@ dockerOptsParser hide0 = help (concat [ "Location of " , stackProgName , " executable used in container" ]))) - <*> firstBoolFlags (dockerOptName dockerSetUserArgName) + <*> firstBoolFlagsNoDefault + (dockerOptName dockerSetUserArgName) "setting user in container to match host" hide <*> pure (IntersectingVersionRange anyVersion) diff --git a/src/Stack/Options/GlobalParser.hs b/src/Stack/Options/GlobalParser.hs index 30a3bbcfb0..c65485bca2 100644 --- a/src/Stack/Options/GlobalParser.hs +++ b/src/Stack/Options/GlobalParser.hs @@ -23,7 +23,7 @@ globalOptsParser currentDir kind defLogLevel = optionalFirst (strOption (long Docker.reExecArgName <> hidden <> internal)) <*> optionalFirst (option auto (long dockerEntrypointArgName <> hidden <> internal)) <*> (First <$> logLevelOptsParser hide0 defLogLevel) <*> - firstBoolFlags + firstBoolFlagsTrue "time-in-log" "inclusion of timings in logs, for the purposes of using diff with logs" hide <*> @@ -31,7 +31,7 @@ globalOptsParser currentDir kind defLogLevel = optionalFirst (abstractResolverOptsParser hide0) <*> pure (First Nothing) <*> -- resolver root is only set via the script command optionalFirst (compilerOptsParser hide0) <*> - firstBoolFlags + firstBoolFlagsNoDefault "terminal" "overriding terminal detection in the case of running in a false terminal" hide <*> @@ -82,7 +82,7 @@ globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = do { globalReExecVersion = getFirst globalMonoidReExecVersion , globalDockerEntrypoint = getFirst globalMonoidDockerEntrypoint , globalLogLevel = fromFirst defaultLogLevel globalMonoidLogLevel - , globalTimeInLog = fromFirst True globalMonoidTimeInLog + , globalTimeInLog = fromFirstTrue globalMonoidTimeInLog , globalConfigMonoid = globalMonoidConfigMonoid , globalResolver = resolver , globalCompiler = getFirst globalMonoidCompiler diff --git a/src/Stack/Options/NixParser.hs b/src/Stack/Options/NixParser.hs index 4d1b6879b8..614fccbd4c 100644 --- a/src/Stack/Options/NixParser.hs +++ b/src/Stack/Options/NixParser.hs @@ -13,10 +13,12 @@ import Stack.Types.Nix nixOptsParser :: Bool -> Parser NixOptsMonoid nixOptsParser hide0 = overrideActivation <$> (NixOptsMonoid - <$> firstBoolFlags nixCmdName + <$> firstBoolFlagsNoDefault + nixCmdName "use of a Nix-shell. Implies 'system-ghc: true'" hide - <*> firstBoolFlags "nix-pure" + <*> firstBoolFlagsNoDefault + "nix-pure" "use of a pure Nix-shell. Implies '--nix' and 'system-ghc: true'" hide <*> optionalFirst @@ -45,7 +47,8 @@ nixOptsParser hide0 = overrideActivation <$> metavar "PATH_OPTIONS" <> help "Additional options to override NIX_PATH parts (notably 'nixpkgs')" <> hide)) - <*> firstBoolFlags "nix-add-gc-roots" + <*> firstBoolFlagsFalse + "nix-add-gc-roots" "addition of packages to the nix GC roots so nix-collect-garbage doesn't remove them" hide ) diff --git a/src/Stack/Options/TestParser.hs b/src/Stack/Options/TestParser.hs index a852190231..20e8cf9ad9 100644 --- a/src/Stack/Options/TestParser.hs +++ b/src/Stack/Options/TestParser.hs @@ -13,7 +13,7 @@ import Stack.Types.Config testOptsParser :: Bool -> Parser TestOptsMonoid testOptsParser hide0 = TestOptsMonoid - <$> firstBoolFlags + <$> firstBoolFlagsTrue "rerun-tests" "running already successful tests" hide @@ -26,12 +26,12 @@ testOptsParser hide0 = metavar "TEST_ARGS" <> help "Arguments passed in to the test suite program" <> hide))) - <*> optionalFirst + <*> optionalFirstFalse (flag' True (long "coverage" <> help "Generate a code coverage report" <> hide)) - <*> optionalFirst + <*> optionalFirstFalse (flag' True (long "no-run-tests" <> help "Disable running of tests. (Tests will still be built.)" <> diff --git a/src/Stack/Prelude.hs b/src/Stack/Prelude.hs index 30724f539a..6779bb8c0c 100644 --- a/src/Stack/Prelude.hs +++ b/src/Stack/Prelude.hs @@ -14,6 +14,12 @@ module Stack.Prelude , promptPassword , promptBool , stackProgName + , FirstTrue (..) + , fromFirstTrue + , defaultFirstTrue + , FirstFalse (..) + , fromFirstFalse + , defaultFirstFalse , module X ) where @@ -165,3 +171,39 @@ promptBool txt = liftIO $ do -- GHC stage restrictions. stackProgName :: String stackProgName = "stack" + +-- | Like @First Bool@, but the default is @True@. +newtype FirstTrue = FirstTrue { getFirstTrue :: Maybe Bool } + deriving (Show, Eq, Ord) +instance Semigroup FirstTrue where + FirstTrue (Just x) <> _ = FirstTrue (Just x) + FirstTrue Nothing <> x = x +instance Monoid FirstTrue where + mempty = FirstTrue Nothing + mappend = (<>) + +-- | Get the 'Bool', defaulting to 'True' +fromFirstTrue :: FirstTrue -> Bool +fromFirstTrue = fromMaybe True . getFirstTrue + +-- | Helper for filling in default values +defaultFirstTrue :: (a -> FirstTrue) -> Bool +defaultFirstTrue _ = True + +-- | Like @First Bool@, but the default is @False@. +newtype FirstFalse = FirstFalse { getFirstFalse :: Maybe Bool } + deriving (Show, Eq, Ord) +instance Semigroup FirstFalse where + FirstFalse (Just x) <> _ = FirstFalse (Just x) + FirstFalse Nothing <> x = x +instance Monoid FirstFalse where + mempty = FirstFalse Nothing + mappend = (<>) + +-- | Get the 'Bool', defaulting to 'False' +fromFirstFalse :: FirstFalse -> Bool +fromFirstFalse = fromMaybe False . getFirstFalse + +-- | Helper for filling in default values +defaultFirstFalse :: (a -> FirstFalse) -> Bool +defaultFirstFalse _ = False diff --git a/src/Stack/Script.hs b/src/Stack/Script.hs index 815665991b..c1fb009a40 100644 --- a/src/Stack/Script.hs +++ b/src/Stack/Script.hs @@ -62,7 +62,7 @@ scriptCmd opts = do let scriptDir = parent file modifyGO go = go { globalConfigMonoid = (globalConfigMonoid go) - { configMonoidInstallGHC = First $ Just True + { configMonoidInstallGHC = FirstTrue $ Just True } , globalStackYaml = SYLNoConfig $ soScriptExtraDeps opts } diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index 56cb414ddb..39fe4c8fba 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -1363,7 +1363,7 @@ loadGhcjsEnvConfig stackYaml binPath inner = where modifyGO go = go { globalConfigMonoid = mempty - { configMonoidInstallGHC = First (Just True) + { configMonoidInstallGHC = FirstTrue (Just True) , configMonoidLocalBinPath = First (Just (toFilePath binPath)) } , globalResolver = Nothing diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index ed246c8973..7e4b51d4a4 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -489,7 +489,7 @@ data GlobalOptsMonoid = GlobalOptsMonoid , globalMonoidDockerEntrypoint :: !(First DockerEntrypoint) -- ^ Data used when stack is acting as a Docker entrypoint (internal use only) , globalMonoidLogLevel :: !(First LogLevel) -- ^ Log level - , globalMonoidTimeInLog :: !(First Bool) -- ^ Whether to include timings in logs. + , globalMonoidTimeInLog :: !FirstTrue -- ^ Whether to include timings in logs. , globalMonoidConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig' , globalMonoidResolver :: !(First (Unresolved AbstractResolver)) -- ^ Resolver override , globalMonoidResolverRoot :: !(First FilePath) -- ^ root directory for resolver relative path @@ -677,7 +677,7 @@ data ConfigMonoid = -- ^ Options for the execution environment (nix-shell or container) , configMonoidConnectionCount :: !(First Int) -- ^ See: 'configConnectionCount' - , configMonoidHideTHLoading :: !(First Bool) + , configMonoidHideTHLoading :: !FirstTrue -- ^ See: 'configHideTHLoading' , configMonoidLatestSnapshot :: !(First Text) -- ^ See: 'configLatestSnapshot' @@ -685,11 +685,11 @@ data ConfigMonoid = -- ^ See: @picIndices@ , configMonoidSystemGHC :: !(First Bool) -- ^ See: 'configSystemGHC' - ,configMonoidInstallGHC :: !(First Bool) + ,configMonoidInstallGHC :: !FirstTrue -- ^ See: 'configInstallGHC' - ,configMonoidSkipGHCCheck :: !(First Bool) + ,configMonoidSkipGHCCheck :: !FirstFalse -- ^ See: 'configSkipGHCCheck' - ,configMonoidSkipMsys :: !(First Bool) + ,configMonoidSkipMsys :: !FirstFalse -- ^ See: 'configSkipMsys' ,configMonoidCompilerCheck :: !(First VersionCheck) -- ^ See: 'configCompilerCheck' @@ -735,11 +735,11 @@ data ConfigMonoid = -- ^ Override the default local programs dir, where e.g. GHC is installed. ,configMonoidPvpBounds :: !(First PvpBounds) -- ^ See 'configPvpBounds' - ,configMonoidModifyCodePage :: !(First Bool) + ,configMonoidModifyCodePage :: !FirstTrue -- ^ See 'configModifyCodePage' ,configMonoidExplicitSetupDeps :: !(Map (Maybe PackageName) Bool) -- ^ See 'configExplicitSetupDeps' - ,configMonoidRebuildGhcOptions :: !(First Bool) + ,configMonoidRebuildGhcOptions :: !FirstFalse -- ^ See 'configMonoidRebuildGhcOptions' ,configMonoidApplyGhcOptions :: !(First ApplyGhcOptions) -- ^ See 'configApplyGhcOptions' @@ -785,7 +785,7 @@ parseConfigMonoidObject rootDir obj = do configMonoidDockerOpts <- jsonSubWarnings (obj ..:? configMonoidDockerOptsName ..!= mempty) configMonoidNixOpts <- jsonSubWarnings (obj ..:? configMonoidNixOptsName ..!= mempty) configMonoidConnectionCount <- First <$> obj ..:? configMonoidConnectionCountName - configMonoidHideTHLoading <- First <$> obj ..:? configMonoidHideTHLoadingName + configMonoidHideTHLoading <- FirstTrue <$> obj ..:? configMonoidHideTHLoadingName murls :: Maybe Value <- obj ..:? configMonoidUrlsName configMonoidLatestSnapshot <- @@ -798,9 +798,9 @@ parseConfigMonoidObject rootDir obj = do configMonoidPackageIndices <- First <$> jsonSubWarningsTT (obj ..:? configMonoidPackageIndicesName) configMonoidSystemGHC <- First <$> obj ..:? configMonoidSystemGHCName - configMonoidInstallGHC <- First <$> obj ..:? configMonoidInstallGHCName - configMonoidSkipGHCCheck <- First <$> obj ..:? configMonoidSkipGHCCheckName - configMonoidSkipMsys <- First <$> obj ..:? configMonoidSkipMsysName + configMonoidInstallGHC <- FirstTrue <$> obj ..:? configMonoidInstallGHCName + configMonoidSkipGHCCheck <- FirstFalse <$> obj ..:? configMonoidSkipGHCCheckName + configMonoidSkipMsys <- FirstFalse <$> obj ..:? configMonoidSkipMsysName configMonoidRequireStackVersion <- IntersectingVersionRange . unVersionRangeJSON <$> ( obj ..:? configMonoidRequireStackVersionName ..!= VersionRangeJSON anyVersion) @@ -851,11 +851,11 @@ parseConfigMonoidObject rootDir obj = do maybeToList <$> jsonSubWarningsT (obj ..:? configMonoidSetupInfoLocationsName) configMonoidLocalProgramsBase <- First <$> obj ..:? configMonoidLocalProgramsBaseName configMonoidPvpBounds <- First <$> obj ..:? configMonoidPvpBoundsName - configMonoidModifyCodePage <- First <$> obj ..:? configMonoidModifyCodePageName + configMonoidModifyCodePage <- FirstTrue <$> obj ..:? configMonoidModifyCodePageName configMonoidExplicitSetupDeps <- (obj ..:? configMonoidExplicitSetupDepsName ..!= mempty) >>= fmap Map.fromList . mapM handleExplicitSetupDep . Map.toList - configMonoidRebuildGhcOptions <- First <$> obj ..:? configMonoidRebuildGhcOptionsName + configMonoidRebuildGhcOptions <- FirstFalse <$> obj ..:? configMonoidRebuildGhcOptionsName configMonoidApplyGhcOptions <- First <$> obj ..:? configMonoidApplyGhcOptionsName configMonoidAllowNewer <- First <$> obj ..:? configMonoidAllowNewerName configMonoidDefaultTemplate <- First <$> obj ..:? configMonoidDefaultTemplateName @@ -1939,21 +1939,21 @@ buildOptsL = configL.lens (\x y -> x { configBuild = y }) buildOptsMonoidHaddockL :: Lens' BuildOptsMonoid (Maybe Bool) -buildOptsMonoidHaddockL = lens (getFirst . buildMonoidHaddock) - (\buildMonoid t -> buildMonoid {buildMonoidHaddock = First t}) +buildOptsMonoidHaddockL = lens (getFirstFalse . buildMonoidHaddock) + (\buildMonoid t -> buildMonoid {buildMonoidHaddock = FirstFalse t}) buildOptsMonoidTestsL :: Lens' BuildOptsMonoid (Maybe Bool) -buildOptsMonoidTestsL = lens (getFirst . buildMonoidTests) - (\buildMonoid t -> buildMonoid {buildMonoidTests = First t}) +buildOptsMonoidTestsL = lens (getFirstFalse . buildMonoidTests) + (\buildMonoid t -> buildMonoid {buildMonoidTests = FirstFalse t}) buildOptsMonoidBenchmarksL :: Lens' BuildOptsMonoid (Maybe Bool) -buildOptsMonoidBenchmarksL = lens (getFirst . buildMonoidBenchmarks) - (\buildMonoid t -> buildMonoid {buildMonoidBenchmarks = First t}) +buildOptsMonoidBenchmarksL = lens (getFirstFalse . buildMonoidBenchmarks) + (\buildMonoid t -> buildMonoid {buildMonoidBenchmarks = FirstFalse t}) buildOptsMonoidInstallExesL :: Lens' BuildOptsMonoid (Maybe Bool) buildOptsMonoidInstallExesL = - lens (getFirst . buildMonoidInstallExes) - (\buildMonoid t -> buildMonoid {buildMonoidInstallExes = First t}) + lens (getFirstFalse . buildMonoidInstallExes) + (\buildMonoid t -> buildMonoid {buildMonoidInstallExes = FirstFalse t}) buildOptsInstallExesL :: Lens' BuildOpts Bool buildOptsInstallExesL = diff --git a/src/Stack/Types/Config/Build.hs b/src/Stack/Types/Config/Build.hs index 6e0d412194..4595268885 100644 --- a/src/Stack/Types/Config/Build.hs +++ b/src/Stack/Types/Config/Build.hs @@ -64,7 +64,7 @@ data BuildOpts = -- ^ Watch files for changes and automatically rebuild ,boptsKeepGoing :: !(Maybe Bool) -- ^ Keep building/running after failure - ,boptsKeepTmpFiles :: !(Maybe Bool) + ,boptsKeepTmpFiles :: !Bool -- ^ Keep intermediate files and build directories ,boptsForceDirty :: !Bool -- ^ Force treating all local packages as having dirty files @@ -97,31 +97,31 @@ data BuildOpts = defaultBuildOpts :: BuildOpts defaultBuildOpts = BuildOpts - { boptsLibProfile = False - , boptsExeProfile = False - , boptsLibStrip = True - , boptsExeStrip = True + { boptsLibProfile = defaultFirstFalse buildMonoidLibProfile + , boptsExeProfile = defaultFirstFalse buildMonoidExeProfile + , boptsLibStrip = defaultFirstTrue buildMonoidLibStrip + , boptsExeStrip = defaultFirstTrue buildMonoidExeStrip , boptsHaddock = False , boptsHaddockOpts = defaultHaddockOpts - , boptsOpenHaddocks = False + , boptsOpenHaddocks = defaultFirstFalse buildMonoidOpenHaddocks , boptsHaddockDeps = Nothing - , boptsHaddockInternal = False - , boptsHaddockHyperlinkSource = True - , boptsInstallExes = False - , boptsInstallCompilerTool = False - , boptsPreFetch = False + , boptsHaddockInternal = defaultFirstFalse buildMonoidHaddockInternal + , boptsHaddockHyperlinkSource = defaultFirstTrue buildMonoidHaddockHyperlinkSource + , boptsInstallExes = defaultFirstFalse buildMonoidInstallExes + , boptsInstallCompilerTool = defaultFirstFalse buildMonoidInstallCompilerTool + , boptsPreFetch = defaultFirstFalse buildMonoidPreFetch , boptsKeepGoing = Nothing - , boptsKeepTmpFiles = Nothing - , boptsForceDirty = False - , boptsTests = False + , boptsKeepTmpFiles = defaultFirstFalse buildMonoidKeepTmpFiles + , boptsForceDirty = defaultFirstFalse buildMonoidForceDirty + , boptsTests = defaultFirstFalse buildMonoidTests , boptsTestOpts = defaultTestOpts - , boptsBenchmarks = False + , boptsBenchmarks = defaultFirstFalse buildMonoidBenchmarks , boptsBenchmarkOpts = defaultBenchmarkOpts - , boptsReconfigure = False - , boptsCabalVerbose = False - , boptsSplitObjs = False + , boptsReconfigure = defaultFirstFalse buildMonoidReconfigure + , boptsCabalVerbose = defaultFirstFalse buildMonoidCabalVerbose + , boptsSplitObjs = defaultFirstFalse buildMonoidSplitObjs , boptsSkipComponents = [] - , boptsInterleavedOutput = False + , boptsInterleavedOutput = defaultFirstFalse buildMonoidInterleavedOutput , boptsDdumpDir = Nothing } @@ -186,31 +186,31 @@ data BuildOptsMonoid = BuildOptsMonoid { buildMonoidTrace :: !Any , buildMonoidProfile :: !Any , buildMonoidNoStrip :: !Any - , buildMonoidLibProfile :: !(First Bool) - , buildMonoidExeProfile :: !(First Bool) - , buildMonoidLibStrip :: !(First Bool) - , buildMonoidExeStrip :: !(First Bool) - , buildMonoidHaddock :: !(First Bool) + , buildMonoidLibProfile :: !FirstFalse + , buildMonoidExeProfile :: !FirstFalse + , buildMonoidLibStrip :: !FirstTrue + , buildMonoidExeStrip :: !FirstTrue + , buildMonoidHaddock :: !FirstFalse , buildMonoidHaddockOpts :: !HaddockOptsMonoid - , buildMonoidOpenHaddocks :: !(First Bool) + , buildMonoidOpenHaddocks :: !FirstFalse , buildMonoidHaddockDeps :: !(First Bool) - , buildMonoidHaddockInternal :: !(First Bool) - , buildMonoidHaddockHyperlinkSource :: !(First Bool) - , buildMonoidInstallExes :: !(First Bool) - , buildMonoidInstallCompilerTool :: !(First Bool) - , buildMonoidPreFetch :: !(First Bool) + , buildMonoidHaddockInternal :: !FirstFalse + , buildMonoidHaddockHyperlinkSource :: !FirstTrue + , buildMonoidInstallExes :: !FirstFalse + , buildMonoidInstallCompilerTool :: !FirstFalse + , buildMonoidPreFetch :: !FirstFalse , buildMonoidKeepGoing :: !(First Bool) - , buildMonoidKeepTmpFiles :: !(First Bool) - , buildMonoidForceDirty :: !(First Bool) - , buildMonoidTests :: !(First Bool) + , buildMonoidKeepTmpFiles :: !FirstFalse + , buildMonoidForceDirty :: !FirstFalse + , buildMonoidTests :: !FirstFalse , buildMonoidTestOpts :: !TestOptsMonoid - , buildMonoidBenchmarks :: !(First Bool) + , buildMonoidBenchmarks :: !FirstFalse , buildMonoidBenchmarkOpts :: !BenchmarkOptsMonoid - , buildMonoidReconfigure :: !(First Bool) - , buildMonoidCabalVerbose :: !(First Bool) - , buildMonoidSplitObjs :: !(First Bool) + , buildMonoidReconfigure :: !FirstFalse + , buildMonoidCabalVerbose :: !FirstFalse + , buildMonoidSplitObjs :: !FirstFalse , buildMonoidSkipComponents :: ![Text] - , buildMonoidInterleavedOutput :: !(First Bool) + , buildMonoidInterleavedOutput :: !FirstFalse , buildMonoidDdumpDir :: !(First Text) } deriving (Show, Generic) @@ -219,31 +219,31 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where (\o -> do let buildMonoidTrace = Any False buildMonoidProfile = Any False buildMonoidNoStrip = Any False - buildMonoidLibProfile <- First <$> o ..:? buildMonoidLibProfileArgName - buildMonoidExeProfile <-First <$> o ..:? buildMonoidExeProfileArgName - buildMonoidLibStrip <- First <$> o ..:? buildMonoidLibStripArgName - buildMonoidExeStrip <-First <$> o ..:? buildMonoidExeStripArgName - buildMonoidHaddock <- First <$> o ..:? buildMonoidHaddockArgName + buildMonoidLibProfile <- FirstFalse <$> o ..:? buildMonoidLibProfileArgName + buildMonoidExeProfile <-FirstFalse <$> o ..:? buildMonoidExeProfileArgName + buildMonoidLibStrip <- FirstTrue <$> o ..:? buildMonoidLibStripArgName + buildMonoidExeStrip <-FirstTrue <$> o ..:? buildMonoidExeStripArgName + buildMonoidHaddock <- FirstFalse <$> o ..:? buildMonoidHaddockArgName buildMonoidHaddockOpts <- jsonSubWarnings (o ..:? buildMonoidHaddockOptsArgName ..!= mempty) - buildMonoidOpenHaddocks <- First <$> o ..:? buildMonoidOpenHaddocksArgName + buildMonoidOpenHaddocks <- FirstFalse <$> o ..:? buildMonoidOpenHaddocksArgName buildMonoidHaddockDeps <- First <$> o ..:? buildMonoidHaddockDepsArgName - buildMonoidHaddockInternal <- First <$> o ..:? buildMonoidHaddockInternalArgName - buildMonoidHaddockHyperlinkSource <- First <$> o ..:? buildMonoidHaddockHyperlinkSourceArgName - buildMonoidInstallExes <- First <$> o ..:? buildMonoidInstallExesArgName - buildMonoidInstallCompilerTool <- First <$> o ..:? buildMonoidInstallCompilerToolArgName - buildMonoidPreFetch <- First <$> o ..:? buildMonoidPreFetchArgName + buildMonoidHaddockInternal <- FirstFalse <$> o ..:? buildMonoidHaddockInternalArgName + buildMonoidHaddockHyperlinkSource <- FirstTrue <$> o ..:? buildMonoidHaddockHyperlinkSourceArgName + buildMonoidInstallExes <- FirstFalse <$> o ..:? buildMonoidInstallExesArgName + buildMonoidInstallCompilerTool <- FirstFalse <$> o ..:? buildMonoidInstallCompilerToolArgName + buildMonoidPreFetch <- FirstFalse <$> o ..:? buildMonoidPreFetchArgName buildMonoidKeepGoing <- First <$> o ..:? buildMonoidKeepGoingArgName - buildMonoidKeepTmpFiles <- First <$> o ..:? buildMonoidKeepTmpFilesArgName - buildMonoidForceDirty <- First <$> o ..:? buildMonoidForceDirtyArgName - buildMonoidTests <- First <$> o ..:? buildMonoidTestsArgName + buildMonoidKeepTmpFiles <- FirstFalse <$> o ..:? buildMonoidKeepTmpFilesArgName + buildMonoidForceDirty <- FirstFalse <$> o ..:? buildMonoidForceDirtyArgName + buildMonoidTests <- FirstFalse <$> o ..:? buildMonoidTestsArgName buildMonoidTestOpts <- jsonSubWarnings (o ..:? buildMonoidTestOptsArgName ..!= mempty) - buildMonoidBenchmarks <- First <$> o ..:? buildMonoidBenchmarksArgName + buildMonoidBenchmarks <- FirstFalse <$> o ..:? buildMonoidBenchmarksArgName buildMonoidBenchmarkOpts <- jsonSubWarnings (o ..:? buildMonoidBenchmarkOptsArgName ..!= mempty) - buildMonoidReconfigure <- First <$> o ..:? buildMonoidReconfigureArgName - buildMonoidCabalVerbose <- First <$> o ..:? buildMonoidCabalVerboseArgName - buildMonoidSplitObjs <- First <$> o ..:? buildMonoidSplitObjsName + buildMonoidReconfigure <- FirstFalse <$> o ..:? buildMonoidReconfigureArgName + buildMonoidCabalVerbose <- FirstFalse <$> o ..:? buildMonoidCabalVerboseArgName + buildMonoidSplitObjs <- FirstFalse <$> o ..:? buildMonoidSplitObjsName buildMonoidSkipComponents <- o ..:? buildMonoidSkipComponentsName ..!= mempty - buildMonoidInterleavedOutput <- First <$> o ..:? buildMonoidInterleavedOutputName + buildMonoidInterleavedOutput <- FirstFalse <$> o ..:? buildMonoidInterleavedOutputName buildMonoidDdumpDir <- o ..:? buildMonoidDdumpDirName ..!= mempty return BuildOptsMonoid{..}) @@ -352,28 +352,28 @@ data TestOpts = defaultTestOpts :: TestOpts defaultTestOpts = TestOpts - { toRerunTests = True + { toRerunTests = defaultFirstTrue toMonoidRerunTests , toAdditionalArgs = [] - , toCoverage = False - , toDisableRun = False + , toCoverage = defaultFirstFalse toMonoidCoverage + , toDisableRun = defaultFirstFalse toMonoidDisableRun , toMaximumTimeSeconds = Nothing } data TestOptsMonoid = TestOptsMonoid - { toMonoidRerunTests :: !(First Bool) + { toMonoidRerunTests :: !FirstTrue , toMonoidAdditionalArgs :: ![String] - , toMonoidCoverage :: !(First Bool) - , toMonoidDisableRun :: !(First Bool) + , toMonoidCoverage :: !FirstFalse + , toMonoidDisableRun :: !FirstFalse , toMonoidMaximumTimeSeconds :: !(First (Maybe Int)) } deriving (Show, Generic) instance FromJSON (WithJSONWarnings TestOptsMonoid) where parseJSON = withObjectWarnings "TestOptsMonoid" - (\o -> do toMonoidRerunTests <- First <$> o ..:? toMonoidRerunTestsArgName + (\o -> do toMonoidRerunTests <- FirstTrue <$> o ..:? toMonoidRerunTestsArgName toMonoidAdditionalArgs <- o ..:? toMonoidAdditionalArgsName ..!= [] - toMonoidCoverage <- First <$> o ..:? toMonoidCoverageArgName - toMonoidDisableRun <- First <$> o ..:? toMonoidDisableRunArgName + toMonoidCoverage <- FirstFalse <$> o ..:? toMonoidCoverageArgName + toMonoidDisableRun <- FirstFalse <$> o ..:? toMonoidDisableRunArgName toMonoidMaximumTimeSeconds <- First <$> o ..:? toMonoidMaximumTimeSecondsArgName return TestOptsMonoid{..}) diff --git a/src/Stack/Types/Docker.hs b/src/Stack/Types/Docker.hs index 49a7ddcb72..010f4dae6a 100644 --- a/src/Stack/Types/Docker.hs +++ b/src/Stack/Types/Docker.hs @@ -75,11 +75,11 @@ data DockerOptsMonoid = DockerOptsMonoid -- ^ Optional username for Docker registry. ,dockerMonoidRegistryPassword :: !(First String) -- ^ Optional password for Docker registry. - ,dockerMonoidAutoPull :: !(First Bool) + ,dockerMonoidAutoPull :: !FirstFalse -- ^ Automatically pull new images. - ,dockerMonoidDetach :: !(First Bool) + ,dockerMonoidDetach :: !FirstFalse -- ^ Whether to run a detached container - ,dockerMonoidPersist :: !(First Bool) + ,dockerMonoidPersist :: !FirstFalse -- ^ Create a persistent container (don't remove it when finished). Implied by -- `dockerDetach`. ,dockerMonoidContainerName :: !(First String) @@ -114,9 +114,9 @@ instance FromJSON (WithJSONWarnings DockerOptsMonoid) where dockerMonoidRegistryLogin <- First <$> o ..:? dockerRegistryLoginArgName dockerMonoidRegistryUsername <- First <$> o ..:? dockerRegistryUsernameArgName dockerMonoidRegistryPassword <- First <$> o ..:? dockerRegistryPasswordArgName - dockerMonoidAutoPull <- First <$> o ..:? dockerAutoPullArgName - dockerMonoidDetach <- First <$> o ..:? dockerDetachArgName - dockerMonoidPersist <- First <$> o ..:? dockerPersistArgName + dockerMonoidAutoPull <- FirstFalse <$> o ..:? dockerAutoPullArgName + dockerMonoidDetach <- FirstFalse <$> o ..:? dockerDetachArgName + dockerMonoidPersist <- FirstFalse <$> o ..:? dockerPersistArgName dockerMonoidContainerName <- First <$> o ..:? dockerContainerNameArgName dockerMonoidRunArgs <- o ..:? dockerRunArgsArgName ..!= [] dockerMonoidMount <- o ..:? dockerMountArgName ..!= [] diff --git a/src/Stack/Types/Nix.hs b/src/Stack/Types/Nix.hs index 81d2e04fe6..6728edbd8f 100644 --- a/src/Stack/Types/Nix.hs +++ b/src/Stack/Types/Nix.hs @@ -43,7 +43,7 @@ data NixOptsMonoid = NixOptsMonoid -- ^ Options to be given to the nix-shell command line ,nixMonoidPath :: !(First [Text]) -- ^ Override parts of NIX_PATH (notably 'nixpkgs') - ,nixMonoidAddGCRoots :: !(First Bool) + ,nixMonoidAddGCRoots :: !FirstFalse -- ^ Should we register gc roots so running nix-collect-garbage doesn't remove nix dependencies } deriving (Eq, Show, Generic) @@ -57,7 +57,7 @@ instance FromJSON (WithJSONWarnings NixOptsMonoid) where nixMonoidInitFile <- First <$> o ..:? nixInitFileArgName nixMonoidShellOptions <- First <$> o ..:? nixShellOptsArgName nixMonoidPath <- First <$> o ..:? nixPathArgName - nixMonoidAddGCRoots <- First <$> o ..:? nixAddGCRootsArgName + nixMonoidAddGCRoots <- FirstFalse <$> o ..:? nixAddGCRootsArgName return NixOptsMonoid{..}) -- | Left-biased combine Nix options diff --git a/src/test/Stack/ConfigSpec.hs b/src/test/Stack/ConfigSpec.hs index deae516958..9894ba7d9c 100644 --- a/src/test/Stack/ConfigSpec.hs +++ b/src/test/Stack/ConfigSpec.hs @@ -168,7 +168,7 @@ spec = beforeAll setup $ do boptsInstallExes `shouldBe` True boptsPreFetch `shouldBe` True boptsKeepGoing `shouldBe` Just True - boptsKeepTmpFiles `shouldBe` Just True + boptsKeepTmpFiles `shouldBe` True boptsForceDirty `shouldBe` True boptsTests `shouldBe` True boptsTestOpts `shouldBe` TestOpts {toRerunTests = True