diff --git a/src/Stack/Options/BuildMonoidParser.hs b/src/Stack/Options/BuildMonoidParser.hs index df357bc993..56782346ef 100644 --- a/src/Stack/Options/BuildMonoidParser.hs +++ b/src/Stack/Options/BuildMonoidParser.hs @@ -1,193 +1,206 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.BuildMonoidParser where +module Stack.Options.BuildMonoidParser + ( buildOptsMonoidParser + , cabalVerboseParser + , cabalVerbosityOptsParser + , cabalVerbosityParser + ) where import qualified Data.Text as T import Distribution.Parsec ( eitherParsec ) import Options.Applicative + ( Parser, eitherReader, flag, help, long, metavar, option + , strOption + ) import Options.Applicative.Builder.Extra + ( firstBoolFlagsFalse, firstBoolFlagsNoDefault + , firstBoolFlagsTrue, optionalFirst + ) import Stack.Build ( splitObjsWarning ) import Stack.Prelude -import Stack.Options.BenchParser -import Stack.Options.TestParser -import Stack.Options.HaddockParser -import Stack.Options.Utils +import Stack.Options.BenchParser ( benchOptsParser ) +import Stack.Options.TestParser ( testOptsParser ) +import Stack.Options.HaddockParser ( haddockOptsParser ) +import Stack.Options.Utils ( GlobalOptsContext (..), hideMods ) import Stack.Types.Config.Build + ( BuildOptsMonoid (..), CabalVerbosity + , toFirstCabalVerbosity + ) buildOptsMonoidParser :: GlobalOptsContext -> Parser BuildOptsMonoid -buildOptsMonoidParser hide0 = - BuildOptsMonoid <$> trace' <*> profile <*> noStrip <*> libProfiling <*> - exeProfiling <*> libStripping <*> exeStripping <*> haddock <*> - haddockOptsParser hideBool <*> openHaddocks <*> haddockDeps <*> - haddockInternal <*> haddockHyperlinkSource <*> copyBins <*> - copyCompilerTool <*> preFetch <*> keepGoing <*> keepTmpFiles <*> - forceDirty <*> tests <*> testOptsParser hideBool <*> benches <*> - benchOptsParser hideBool <*> reconfigure <*> cabalVerbose <*> splitObjs <*> - skipComponents <*> interleavedOutput <*> ddumpDir - where - hideBool = hide0 /= BuildCmdGlobalOpts - hide = - hideMods hideBool - hideExceptGhci = - hideMods (hide0 `notElem` [BuildCmdGlobalOpts, GhciCmdGlobalOpts]) +buildOptsMonoidParser hide0 = BuildOptsMonoid + <$> trace' + <*> profile + <*> noStrip + <*> libProfiling + <*> exeProfiling + <*> libStripping + <*> exeStripping + <*> haddock + <*> haddockOptsParser hideBool + <*> openHaddocks + <*> haddockDeps + <*> haddockInternal + <*> haddockHyperlinkSource + <*> copyBins + <*> copyCompilerTool + <*> preFetch + <*> keepGoing + <*> keepTmpFiles + <*> forceDirty + <*> tests + <*> testOptsParser hideBool + <*> benches + <*> benchOptsParser hideBool + <*> reconfigure + <*> cabalVerbose + <*> splitObjs + <*> skipComponents + <*> interleavedOutput + <*> ddumpDir + where + hideBool = hide0 /= BuildCmdGlobalOpts + hide = hideMods hideBool + hideExceptGhci = + hideMods (hide0 `notElem` [BuildCmdGlobalOpts, GhciCmdGlobalOpts]) - -- These use 'Any' because they are not settable in stack.yaml, so - -- there is no need for options like --no-profile. - trace' = Any <$> - flag - False - True - ( long "trace" - <> help - "Enable profiling in libraries, executables, etc. for all \ - \expressions and generate a backtrace on exception" - <> hideExceptGhci) - profile = Any <$> - flag - False - True - ( long "profile" - <> help - "Enable profiling in libraries, executables, etc. for all \ - \expressions and generate a profiling report in tests or \ - \benchmarks" - <> hideExceptGhci) - noStrip = Any <$> - flag - False - True - ( long "no-strip" - <> help - "Disable DWARF debugging symbol stripping in libraries, \ - \executables, etc. for all expressions, producing larger \ - \executables but allowing the use of standard \ - \debuggers/profiling tools/other utilities that use \ - \debugging symbols." - <> hideExceptGhci) - libProfiling = - firstBoolFlagsFalse - "library-profiling" - "library profiling for TARGETs and all its dependencies" - hide - exeProfiling = - firstBoolFlagsFalse - "executable-profiling" - "executable profiling for TARGETs and all its dependencies" - hide - libStripping = - firstBoolFlagsTrue - "library-stripping" - "library stripping for TARGETs and all its dependencies" - hide - exeStripping = - firstBoolFlagsTrue - "executable-stripping" - "executable stripping for TARGETs and all its dependencies" - hide - haddock = - firstBoolFlagsFalse - "haddock" - "generating Haddocks the package(s) in this directory/configuration" - hide - openHaddocks = - firstBoolFlagsFalse - "open" - "opening the local Haddock documentation in the browser" - hide - haddockDeps = - firstBoolFlagsNoDefault - "haddock-deps" - "building Haddocks for dependencies (default: true if building \ - \Haddocks, false otherwise)" - hide - haddockInternal = - firstBoolFlagsFalse - "haddock-internal" - "building Haddocks for internal modules (like cabal haddock \ - \--internal)" - hide - haddockHyperlinkSource = - firstBoolFlagsTrue - "haddock-hyperlink-source" - "building hyperlinked source for Haddock (like haddock \ - \--hyperlinked-source)" - hide - copyBins = - firstBoolFlagsFalse - "copy-bins" - "copying binaries to local-bin (see 'stack path')" - hide - copyCompilerTool = - firstBoolFlagsFalse - "copy-compiler-tool" - "copying binaries of targets to compiler-tools-bin (see 'stack \ - \path')" - hide - keepGoing = - firstBoolFlagsNoDefault - "keep-going" - "continue running after a step fails (default: false for build, \ - \true for test/bench)" - hide - keepTmpFiles = - firstBoolFlagsFalse - "keep-tmp-files" - "keep intermediate files and build directories" - hide - preFetch = - firstBoolFlagsFalse - "prefetch" - "fetching packages necessary for the build immediately, useful \ - \with --dry-run" - hide - forceDirty = - firstBoolFlagsFalse - "force-dirty" - "forcing the treatment of all local packages as having dirty \ - \files, useful for cases where Stack can't detect a file change" - hide - tests = - firstBoolFlagsFalse - "test" - "testing the package(s) in this directory/configuration" - hideExceptGhci - benches = - firstBoolFlagsFalse - "bench" - "benchmarking the package(s) in this directory/configuration" - hideExceptGhci - reconfigure = - firstBoolFlagsFalse - "reconfigure" - "performing the configure step, even if unnecessary. Useful in \ - \some corner cases with custom Setup.hs files" - hide - cabalVerbose = cabalVerbosityOptsParser hideBool - splitObjs = - firstBoolFlagsFalse - "split-objs" - ( "split-objs, to reduce output size (at the cost of build time). " - ++ splitObjsWarning) - hide - skipComponents = many - (fmap - T.pack - (strOption - ( long "skip" - <> help "Skip given component (can be specified multiple times)" - <> hide))) - interleavedOutput = - firstBoolFlagsTrue - "interleaved-output" - "printing concurrent GHC output to the console with a prefix for \ - \the package name" - hide - ddumpDir = - optionalFirst - (strOption - ( long "ddump-dir" - <> help "Specify output ddump-files" - <> hide)) + -- These use 'Any' because they are not settable in stack.yaml, so + -- there is no need for options like --no-profile. + trace' = Any <$> + flag + False + True + ( long "trace" + <> help + "Enable profiling in libraries, executables, etc. for all \ + \expressions and generate a backtrace on exception" + <> hideExceptGhci + ) + profile = Any <$> + flag + False + True + ( long "profile" + <> help + "Enable profiling in libraries, executables, etc. for all \ + \expressions and generate a profiling report in tests or \ + \benchmarks" + <> hideExceptGhci + ) + noStrip = Any <$> + flag + False + True + ( long "no-strip" + <> help + "Disable DWARF debugging symbol stripping in libraries, \ + \executables, etc. for all expressions, producing larger \ + \executables but allowing the use of standard \ + \debuggers/profiling tools/other utilities that use \ + \debugging symbols." + <> hideExceptGhci + ) + libProfiling = firstBoolFlagsFalse + "library-profiling" + "library profiling for TARGETs and all its dependencies" + hide + exeProfiling = firstBoolFlagsFalse + "executable-profiling" + "executable profiling for TARGETs and all its dependencies" + hide + libStripping = firstBoolFlagsTrue + "library-stripping" + "library stripping for TARGETs and all its dependencies" + hide + exeStripping = firstBoolFlagsTrue + "executable-stripping" + "executable stripping for TARGETs and all its dependencies" + hide + haddock = firstBoolFlagsFalse + "haddock" + "generating Haddocks the package(s) in this directory/configuration" + hide + openHaddocks = firstBoolFlagsFalse + "open" + "opening the local Haddock documentation in the browser" + hide + haddockDeps = firstBoolFlagsNoDefault + "haddock-deps" + "building Haddocks for dependencies (default: true if building Haddocks, \ + \false otherwise)" + hide + haddockInternal = firstBoolFlagsFalse + "haddock-internal" + "building Haddocks for internal modules (like cabal haddock --internal)" + hide + haddockHyperlinkSource = firstBoolFlagsTrue + "haddock-hyperlink-source" + "building hyperlinked source for Haddock (like haddock \ + \--hyperlinked-source)" + hide + copyBins = firstBoolFlagsFalse + "copy-bins" + "copying binaries to local-bin (see 'stack path')" + hide + copyCompilerTool = firstBoolFlagsFalse + "copy-compiler-tool" + "copying binaries of targets to compiler-tools-bin (see 'stack path')" + hide + keepGoing = firstBoolFlagsNoDefault + "keep-going" + "continue running after a step fails (default: false for build, true for \ + \test/bench)" + hide + keepTmpFiles = firstBoolFlagsFalse + "keep-tmp-files" + "keep intermediate files and build directories" + hide + preFetch = firstBoolFlagsFalse + "prefetch" + "fetching packages necessary for the build immediately, useful with \ + \--dry-run" + hide + forceDirty = firstBoolFlagsFalse + "force-dirty" + "forcing the treatment of all local packages as having dirty files, \ + \useful for cases where Stack can't detect a file change" + hide + tests = firstBoolFlagsFalse + "test" + "testing the package(s) in this directory/configuration" + hideExceptGhci + benches = firstBoolFlagsFalse + "bench" + "benchmarking the package(s) in this directory/configuration" + hideExceptGhci + reconfigure = firstBoolFlagsFalse + "reconfigure" + "performing the configure step, even if unnecessary. Useful in some \ + \corner cases with custom Setup.hs files" + hide + cabalVerbose = cabalVerbosityOptsParser hideBool + splitObjs = firstBoolFlagsFalse + "split-objs" + ( "split-objs, to reduce output size (at the cost of build time). " + ++ splitObjsWarning + ) + hide + skipComponents = many (fmap T.pack (strOption + ( long "skip" + <> help "Skip given component (can be specified multiple times)" + <> hide + ))) + interleavedOutput = firstBoolFlagsTrue + "interleaved-output" + "printing concurrent GHC output to the console with a prefix for the \ + \package name" + hide + ddumpDir = optionalFirst (strOption + ( long "ddump-dir" + <> help "Specify output ddump-files" + <> hide + )) -- | Parser for Cabal verbosity options cabalVerbosityOptsParser :: Bool -> Parser (First CabalVerbosity) @@ -198,10 +211,10 @@ cabalVerbosityOptsParser hide = cabalVerbosityParser :: Bool -> Parser (First CabalVerbosity) cabalVerbosityParser hide = let pCabalVerbosity = option (eitherReader eitherParsec) - ( long "cabal-verbosity" - <> metavar "VERBOSITY" - <> help "Cabal verbosity (accepts Cabal's numerical and extended syntax)" - <> hideMods hide) + ( long "cabal-verbosity" + <> metavar "VERBOSITY" + <> help "Cabal verbosity (accepts Cabal's numerical and extended syntax)" + <> hideMods hide) in First . Just <$> pCabalVerbosity -- | Parser for the Cabal verbose flag, retained for backward compatibility diff --git a/src/Stack/Options/ConfigParser.hs b/src/Stack/Options/ConfigParser.hs index 52d4ca1291..6efd27f82d 100644 --- a/src/Stack/Options/ConfigParser.hs +++ b/src/Stack/Options/ConfigParser.hs @@ -1,192 +1,211 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.ConfigParser where +module Stack.Options.ConfigParser + ( configOptsParser + ) where -import Data.Char +import Data.Char ( toUpper ) import Options.Applicative + ( Parser, auto, completer, completeWith, eitherReader, help + , long, metavar, option, short, strOption + ) import Options.Applicative.Builder.Extra -import Path -import Stack.Constants -import Stack.Options.BuildMonoidParser -import Stack.Options.DockerParser -import Stack.Options.GhcBuildParser -import Stack.Options.GhcVariantParser -import Stack.Options.NixParser -import Stack.Options.Utils + ( PathCompleterOpts (..), absDirOption, absFileOption + , defaultPathCompleterOpts, dirCompleter, firstBoolFlagsFalse + , firstBoolFlagsNoDefault, firstBoolFlagsTrue, optionalFirst + , pathCompleterWith + ) +import Path ( parseRelDir ) +import Stack.Constants ( stackRootOptionName ) +import Stack.Options.BuildMonoidParser ( buildOptsMonoidParser ) +import Stack.Options.DockerParser ( dockerOptsParser ) +import Stack.Options.GhcBuildParser ( ghcBuildParser ) +import Stack.Options.GhcVariantParser ( ghcVariantParser ) +import Stack.Options.NixParser ( nixOptsParser ) +import Stack.Options.Utils ( GlobalOptsContext (..), hideMods ) import Stack.Prelude import Stack.Types.Config + ( ConfigMonoid (..), DumpLogs (..), readColorWhen ) import qualified System.FilePath as FilePath -- | Command-line arguments parser for configuration. configOptsParser :: FilePath -> GlobalOptsContext -> Parser ConfigMonoid configOptsParser currentDir hide0 = - (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch - ghcVariant ghcBuild jobs includes libs preprocs overrideGccPath overrideHpack - skipGHCCheck skipMsys localBin setupInfoLocations modifyCodePage - allowDifferentUser dumpLogs colorWhen snapLoc noRunCompile -> mempty - { configMonoidStackRoot = stackRoot - , configMonoidWorkDir = workDir - , configMonoidBuildOpts = buildOpts - , configMonoidDockerOpts = dockerOpts - , configMonoidNixOpts = nixOpts - , configMonoidSystemGHC = systemGHC - , configMonoidInstallGHC = installGHC - , configMonoidSkipGHCCheck = skipGHCCheck - , configMonoidArch = arch - , configMonoidGHCVariant = ghcVariant - , configMonoidGHCBuild = ghcBuild - , configMonoidJobs = jobs - , configMonoidExtraIncludeDirs = includes - , configMonoidExtraLibDirs = libs - , configMonoidCustomPreprocessorExts = preprocs - , configMonoidOverrideGccPath = overrideGccPath - , configMonoidOverrideHpack = overrideHpack - , configMonoidSkipMsys = skipMsys - , configMonoidLocalBinPath = localBin - , configMonoidSetupInfoLocations = setupInfoLocations - , configMonoidModifyCodePage = modifyCodePage - , configMonoidAllowDifferentUser = allowDifferentUser - , configMonoidDumpLogs = dumpLogs - , configMonoidColorWhen = colorWhen - , configMonoidSnapshotLocation = snapLoc - , configMonoidNoRunCompile = noRunCompile - }) - <$> optionalFirst (absDirOption - ( long stackRootOptionName - <> metavar (map toUpper stackRootOptionName) - <> help ("Absolute path to the global Stack root directory " ++ - "(Overrides any STACK_ROOT environment variable)") - <> hide - )) - <*> optionalFirst (option (eitherReader (mapLeft showWorkDirError . parseRelDir)) - ( long "work-dir" - <> metavar "WORK-DIR" - <> completer (pathCompleterWith (defaultPathCompleterOpts { pcoAbsolute = False, pcoFileFilter = const False })) - <> help ("Relative path of work directory " ++ - "(Overrides any STACK_WORK environment variable, default is '.stack-work')") - <> hide - )) - <*> buildOptsMonoidParser hide0 - <*> dockerOptsParser True - <*> nixOptsParser True - <*> firstBoolFlagsNoDefault - "system-ghc" - "using the system installed GHC (on the PATH) if it is available and its version matches. Disabled by default." - hide - <*> firstBoolFlagsTrue - "install-ghc" - "downloading and installing GHC if necessary (can be done manually \ - \with 'stack setup')" - hide - <*> optionalFirst (strOption - ( long "arch" - <> metavar "ARCH" - <> help "System architecture, e.g. i386, x86_64" - <> hide - )) - <*> optionalFirst (ghcVariantParser (hide0 /= OuterGlobalOpts)) - <*> optionalFirst (ghcBuildParser (hide0 /= OuterGlobalOpts)) - <*> optionalFirst (option auto - ( long "jobs" - <> short 'j' - <> metavar "JOBS" - <> help "Number of concurrent jobs to run" - <> hide - )) - <*> many ((currentDir FilePath.) <$> strOption - ( long "extra-include-dirs" - <> metavar "DIR" - <> completer dirCompleter - <> help "Extra directories to check for C header files" - <> hide - )) - <*> many ((currentDir FilePath.) <$> strOption - ( long "extra-lib-dirs" - <> metavar "DIR" - <> completer dirCompleter - <> help "Extra directories to check for libraries" - <> hide - )) - <*> many (strOption - ( long "custom-preprocessor-extensions" - <> metavar "EXT" - <> help "Extensions used for custom preprocessors" - <> hide - )) - <*> optionalFirst (absFileOption - ( long "with-gcc" - <> metavar "PATH-TO-GCC" - <> help "Use gcc found at PATH-TO-GCC" - <> hide - )) - <*> optionalFirst (strOption - ( long "with-hpack" - <> metavar "HPACK" - <> help "Use HPACK executable (overrides bundled Hpack)" - <> hide - )) - <*> firstBoolFlagsFalse - "skip-ghc-check" - "skipping the GHC version and architecture check" - hide - <*> firstBoolFlagsFalse - "skip-msys" - "skipping the local MSYS installation (Windows only)" - hide - <*> optionalFirst ((currentDir FilePath.) <$> strOption - ( long "local-bin-path" - <> metavar "DIR" - <> completer dirCompleter - <> help "Install binaries to DIR" - <> hide - )) - <*> many ( - strOption - ( long "setup-info-yaml" - <> help "Alternate URL or relative / absolute path for Stack dependencies" - <> metavar "URL" )) - <*> firstBoolFlagsTrue - "modify-code-page" - "setting the codepage to support UTF-8 (Windows only)" - hide - <*> firstBoolFlagsNoDefault - "allow-different-user" - ("permission for users other than the owner of the Stack root " ++ - "directory to use a Stack installation (POSIX only) " ++ - "(default: true inside Docker, otherwise false)") - hide - <*> fmap toDumpLogs - (firstBoolFlagsNoDefault - "dump-logs" - "dump the build output logs for local packages to the console \ - \(default: dump warning logs)" - hide) - <*> optionalFirst (option readColorWhen - ( long "color" - <> long "colour" - <> metavar "WHEN" - <> completeWith ["always", "never", "auto"] - <> help "Specify when to use color in output; WHEN is 'always', \ - \'never', or 'auto'. On Windows versions before Windows \ - \10, for terminals that do not support color codes, the \ - \default is 'never'; color may work on terminals that \ - \support color codes" - <> hide - )) - <*> optionalFirst (strOption - ( long "snapshot-location-base" - <> help "The base location of LTS/Nightly snapshots" - <> metavar "URL" - )) - <*> firstBoolFlagsFalse - "script-no-run-compile" - "the use of options `--no-run --compile` with `stack script`" - hide - where - hide = hideMods (hide0 /= OuterGlobalOpts) - toDumpLogs (First (Just True)) = First (Just DumpAllLogs) - toDumpLogs (First (Just False)) = First (Just DumpNoLogs) - toDumpLogs (First Nothing) = First Nothing - showWorkDirError err = show err ++ - "\nNote that --work-dir must be a relative child directory, because work-dirs outside of the package are not supported by Cabal." ++ - "\nSee https://github.com/commercialhaskell/stack/issues/2954" + ( \stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch + ghcVariant ghcBuild jobs includes libs preprocs overrideGccPath overrideHpack + skipGHCCheck skipMsys localBin setupInfoLocations modifyCodePage + allowDifferentUser dumpLogs colorWhen snapLoc noRunCompile -> mempty + { configMonoidStackRoot = stackRoot + , configMonoidWorkDir = workDir + , configMonoidBuildOpts = buildOpts + , configMonoidDockerOpts = dockerOpts + , configMonoidNixOpts = nixOpts + , configMonoidSystemGHC = systemGHC + , configMonoidInstallGHC = installGHC + , configMonoidSkipGHCCheck = skipGHCCheck + , configMonoidArch = arch + , configMonoidGHCVariant = ghcVariant + , configMonoidGHCBuild = ghcBuild + , configMonoidJobs = jobs + , configMonoidExtraIncludeDirs = includes + , configMonoidExtraLibDirs = libs + , configMonoidCustomPreprocessorExts = preprocs + , configMonoidOverrideGccPath = overrideGccPath + , configMonoidOverrideHpack = overrideHpack + , configMonoidSkipMsys = skipMsys + , configMonoidLocalBinPath = localBin + , configMonoidSetupInfoLocations = setupInfoLocations + , configMonoidModifyCodePage = modifyCodePage + , configMonoidAllowDifferentUser = allowDifferentUser + , configMonoidDumpLogs = dumpLogs + , configMonoidColorWhen = colorWhen + , configMonoidSnapshotLocation = snapLoc + , configMonoidNoRunCompile = noRunCompile + } + ) + <$> optionalFirst (absDirOption + ( long stackRootOptionName + <> metavar (map toUpper stackRootOptionName) + <> help "Absolute path to the global Stack root directory (Overrides \ + \any STACK_ROOT environment variable)" + <> hide + )) + <*> optionalFirst (option (eitherReader (mapLeft showWorkDirError . parseRelDir)) + ( long "work-dir" + <> metavar "WORK-DIR" + <> completer + ( pathCompleterWith + ( defaultPathCompleterOpts + { pcoAbsolute = False, pcoFileFilter = const False } + ) + ) + <> help "Relative path of work directory (Overrides any STACK_WORK \ + \environment variable, default is '.stack-work')" + <> hide + )) + <*> buildOptsMonoidParser hide0 + <*> dockerOptsParser True + <*> nixOptsParser True + <*> firstBoolFlagsNoDefault + "system-ghc" + "using the system installed GHC (on the PATH) if it is available and \ + \its version matches. Disabled by default." + hide + <*> firstBoolFlagsTrue + "install-ghc" + "downloading and installing GHC if necessary (can be done manually \ + \with 'stack setup')" + hide + <*> optionalFirst (strOption + ( long "arch" + <> metavar "ARCH" + <> help "System architecture, e.g. i386, x86_64" + <> hide + )) + <*> optionalFirst (ghcVariantParser (hide0 /= OuterGlobalOpts)) + <*> optionalFirst (ghcBuildParser (hide0 /= OuterGlobalOpts)) + <*> optionalFirst (option auto + ( long "jobs" + <> short 'j' + <> metavar "JOBS" + <> help "Number of concurrent jobs to run" + <> hide + )) + <*> many ((currentDir FilePath.) <$> strOption + ( long "extra-include-dirs" + <> metavar "DIR" + <> completer dirCompleter + <> help "Extra directories to check for C header files" + <> hide + )) + <*> many ((currentDir FilePath.) <$> strOption + ( long "extra-lib-dirs" + <> metavar "DIR" + <> completer dirCompleter + <> help "Extra directories to check for libraries" + <> hide + )) + <*> many (strOption + ( long "custom-preprocessor-extensions" + <> metavar "EXT" + <> help "Extensions used for custom preprocessors" + <> hide + )) + <*> optionalFirst (absFileOption + ( long "with-gcc" + <> metavar "PATH-TO-GCC" + <> help "Use gcc found at PATH-TO-GCC" + <> hide + )) + <*> optionalFirst (strOption + ( long "with-hpack" + <> metavar "HPACK" + <> help "Use HPACK executable (overrides bundled Hpack)" + <> hide + )) + <*> firstBoolFlagsFalse + "skip-ghc-check" + "skipping the GHC version and architecture check" + hide + <*> firstBoolFlagsFalse + "skip-msys" + "skipping the local MSYS installation (Windows only)" + hide + <*> optionalFirst ((currentDir FilePath.) <$> strOption + ( long "local-bin-path" + <> metavar "DIR" + <> completer dirCompleter + <> help "Install binaries to DIR" + <> hide + )) + <*> many (strOption + ( long "setup-info-yaml" + <> help "Alternate URL or relative / absolute path for Stack \ + \dependencies" + <> metavar "URL" + )) + <*> firstBoolFlagsTrue + "modify-code-page" + "setting the codepage to support UTF-8 (Windows only)" + hide + <*> firstBoolFlagsNoDefault + "allow-different-user" + "permission for users other than the owner of the Stack root directory \ + \to use a Stack installation (POSIX only) (default: true inside \ + \Docker, otherwise false)" + hide + <*> fmap toDumpLogs (firstBoolFlagsNoDefault + "dump-logs" + "dump the build output logs for local packages to the console \ + \(default: dump warning logs)" + hide) + <*> optionalFirst (option readColorWhen + ( long "color" + <> long "colour" + <> metavar "WHEN" + <> completeWith ["always", "never", "auto"] + <> help "Specify when to use color in output; WHEN is 'always', \ + \'never', or 'auto'. On Windows versions before Windows \ + \10, for terminals that do not support color codes, the \ + \default is 'never'; color may work on terminals that \ + \support color codes" + <> hide + )) + <*> optionalFirst (strOption + ( long "snapshot-location-base" + <> help "The base location of LTS/Nightly snapshots" + <> metavar "URL" + )) + <*> firstBoolFlagsFalse + "script-no-run-compile" + "the use of options `--no-run --compile` with `stack script`" + hide + where + hide = hideMods (hide0 /= OuterGlobalOpts) + toDumpLogs (First (Just True)) = First (Just DumpAllLogs) + toDumpLogs (First (Just False)) = First (Just DumpNoLogs) + toDumpLogs (First Nothing) = First Nothing + showWorkDirError err = show err ++ + "\nNote that --work-dir must be a relative child directory, because \ + \work-dirs outside of the package are not supported by Cabal." ++ + "\nSee https://github.com/commercialhaskell/stack/issues/2954" diff --git a/src/Stack/Options/DockerParser.hs b/src/Stack/Options/DockerParser.hs index f13a49d4d6..1f90a69529 100644 --- a/src/Stack/Options/DockerParser.hs +++ b/src/Stack/Options/DockerParser.hs @@ -1,108 +1,151 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.DockerParser where +module Stack.Options.DockerParser + ( dockerOptsParser + ) where import Data.List ( intercalate ) import qualified Data.Text as T import Distribution.Version ( anyVersion ) import Options.Applicative -import Options.Applicative.Args + ( Parser, auto, completer, help, listCompleter, long, metavar + , option, str, value + ) +import Options.Applicative.Args ( argsOption ) import Options.Applicative.Builder.Extra -import Stack.Docker + ( dirCompleter, eitherReader', fileCompleter + , firstBoolFlagsFalse, firstBoolFlagsNoDefault + , firstBoolFlagsTrue, optionalFirst + ) +import Stack.Docker ( dockerCmdName ) import Stack.Prelude -import Stack.Options.Utils -import Stack.Types.Version +import Stack.Options.Utils ( hideMods ) +import Stack.Types.Version ( IntersectingVersionRange (..) ) import Stack.Types.Docker + ( DockerMonoidRepoOrImage (..), DockerOptsMonoid (..) + , dockerAutoPullArgName, dockerImageArgName + , dockerContainerNameArgName, dockerDetachArgName + , dockerEnvArgName, dockerPersistArgName + , dockerRegistryLoginArgName, dockerRegistryPasswordArgName + , dockerRegistryUsernameArgName, dockerRepoArgName + , dockerRunArgsArgName, dockerMountArgName + , dockerMountModeArgName, dockerNetworkArgName + , dockerSetUserArgName, dockerStackExeArgName + , dockerStackExeDownloadVal, dockerStackExeHostVal + , dockerStackExeImageVal, parseDockerStackExe + ) -- | Options parser configuration for Docker. dockerOptsParser :: Bool -> Parser DockerOptsMonoid -dockerOptsParser hide0 = - DockerOptsMonoid (Any False) - <$> firstBoolFlagsNoDefault - dockerCmdName - "using a Docker container. --docker implies 'system-ghc: true'" - hide - <*> fmap First - (Just . DockerMonoidRepo <$> option str (long (dockerOptName dockerRepoArgName) <> - hide <> - metavar "NAME" <> - help "Docker repository name") <|> - Just . DockerMonoidImage <$> option str (long (dockerOptName dockerImageArgName) <> - hide <> - metavar "IMAGE" <> - help "Exact Docker image ID (overrides docker-repo)") <|> - pure Nothing) - <*> firstBoolFlagsNoDefault - (dockerOptName dockerRegistryLoginArgName) - "registry requires login" - hide - <*> firstStrOption (long (dockerOptName dockerRegistryUsernameArgName) <> - hide <> - metavar "USERNAME" <> - help "Docker registry username") - <*> firstStrOption (long (dockerOptName dockerRegistryPasswordArgName) <> - hide <> - metavar "PASSWORD" <> - help "Docker registry password") - <*> firstBoolFlagsTrue - (dockerOptName dockerAutoPullArgName) - "automatic pulling latest version of image" - hide - <*> firstBoolFlagsFalse - (dockerOptName dockerDetachArgName) - "running a detached Docker container" - hide - <*> firstBoolFlagsFalse - (dockerOptName dockerPersistArgName) - "not deleting container after it exits" - hide - <*> firstStrOption (long (dockerOptName dockerContainerNameArgName) <> - hide <> - metavar "NAME" <> - help "Docker container name") - <*> firstStrOption (long (dockerOptName dockerNetworkArgName) <> - hide <> - metavar "NETWORK" <> - help "Docker network") - <*> argsOption (long (dockerOptName dockerRunArgsArgName) <> - hide <> - value [] <> - metavar "'ARG1 [ARG2 ...]'" <> - help "Additional options to pass to 'docker run'") - <*> many (option auto (long (dockerOptName dockerMountArgName) <> - hide <> - metavar "(PATH | HOST-PATH:CONTAINER-PATH)" <> - completer dirCompleter <> - help ("Mount volumes from host in container " ++ - "(can be specified multiple times)"))) - <*> firstStrOption (long (dockerOptName dockerMountModeArgName) <> - hide <> - metavar "SUFFIX" <> - help "Volume mount mode suffix") - <*> many (option str (long (dockerOptName dockerEnvArgName) <> - hide <> - metavar "NAME=VALUE" <> - help ("Set environment variable in container " ++ - "(can be specified multiple times)"))) - <*> optionalFirst (option (eitherReader' parseDockerStackExe) - (let specialOpts = - [ dockerStackExeDownloadVal - , dockerStackExeHostVal - , dockerStackExeImageVal - ] in - long(dockerOptName dockerStackExeArgName) <> - hide <> - metavar (intercalate "|" (specialOpts ++ ["PATH"])) <> - completer (listCompleter specialOpts <> fileCompleter) <> - help (concat [ "Location of " +dockerOptsParser hide0 = DockerOptsMonoid (Any False) + <$> firstBoolFlagsNoDefault + dockerCmdName + "using a Docker container. --docker implies 'system-ghc: true'" + hide + <*> fmap First + ( Just . DockerMonoidRepo <$> option str + ( long (dockerOptName dockerRepoArgName) + <> hide + <> metavar "NAME" + <> help "Docker repository name" + ) + <|> Just . DockerMonoidImage <$> option str + ( long (dockerOptName dockerImageArgName) + <> hide + <> metavar "IMAGE" + <> help "Exact Docker image ID (overrides docker-repo)" + ) + <|> pure Nothing + ) + <*> firstBoolFlagsNoDefault + (dockerOptName dockerRegistryLoginArgName) + "registry requires login" + hide + <*> firstStrOption + ( long (dockerOptName dockerRegistryUsernameArgName) + <> hide + <> metavar "USERNAME" + <> help "Docker registry username" + ) + <*> firstStrOption + ( long (dockerOptName dockerRegistryPasswordArgName) + <> hide + <> metavar "PASSWORD" + <> help "Docker registry password" + ) + <*> firstBoolFlagsTrue + (dockerOptName dockerAutoPullArgName) + "automatic pulling latest version of image" + hide + <*> firstBoolFlagsFalse + (dockerOptName dockerDetachArgName) + "running a detached Docker container" + hide + <*> firstBoolFlagsFalse + (dockerOptName dockerPersistArgName) + "not deleting container after it exits" + hide + <*> firstStrOption + ( long (dockerOptName dockerContainerNameArgName) + <> hide + <> metavar "NAME" + <> help "Docker container name" + ) + <*> firstStrOption + ( long (dockerOptName dockerNetworkArgName) + <> hide + <> metavar "NETWORK" + <> help "Docker network" + ) + <*> argsOption + ( long (dockerOptName dockerRunArgsArgName) + <> hide + <> value [] + <> metavar "'ARG1 [ARG2 ...]'" + <> help "Additional options to pass to 'docker run'") + <*> many (option auto + ( long (dockerOptName dockerMountArgName) + <> hide + <> metavar "(PATH | HOST-PATH:CONTAINER-PATH)" + <> completer dirCompleter + <> help "Mount volumes from host in container (can be specified \ + \multiple times)" + )) + <*> firstStrOption + ( long (dockerOptName dockerMountModeArgName) + <> hide + <> metavar "SUFFIX" + <> help "Volume mount mode suffix" + ) + <*> many (option str + ( long (dockerOptName dockerEnvArgName) + <> hide + <> metavar "NAME=VALUE" + <> help "Set environment variable in container (can be specified \ + \multiple times)" + )) + <*> optionalFirst (option (eitherReader' parseDockerStackExe) + ( let specialOpts = [ dockerStackExeDownloadVal + , dockerStackExeHostVal + , dockerStackExeImageVal + ] + in long (dockerOptName dockerStackExeArgName) + <> hide + <> metavar (intercalate "|" (specialOpts ++ ["PATH"])) + <> completer (listCompleter specialOpts <> fileCompleter) + <> help ( concat + [ "Location of " , stackProgName - , " executable used in container" ]))) - <*> firstBoolFlagsNoDefault - (dockerOptName dockerSetUserArgName) - "setting user in container to match host" - hide - <*> pure (IntersectingVersionRange anyVersion) - where - dockerOptName optName = dockerCmdName ++ "-" ++ T.unpack optName - firstStrOption = optionalFirst . option str - hide = hideMods hide0 + , " executable used in container" + ] + ) + )) + <*> firstBoolFlagsNoDefault + (dockerOptName dockerSetUserArgName) + "setting user in container to match host" + hide + <*> pure (IntersectingVersionRange anyVersion) + where + dockerOptName optName = dockerCmdName ++ "-" ++ T.unpack optName + firstStrOption = optionalFirst . option str + hide = hideMods hide0 diff --git a/src/Stack/Options/GhcBuildParser.hs b/src/Stack/Options/GhcBuildParser.hs index 21ccd3f60a..5364025cad 100644 --- a/src/Stack/Options/GhcBuildParser.hs +++ b/src/Stack/Options/GhcBuildParser.hs @@ -1,34 +1,38 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.GhcBuildParser where +module Stack.Options.GhcBuildParser +( ghcBuildParser +) where import Options.Applicative -import Options.Applicative.Types -import Stack.Options.Utils + ( Parser, completeWith, help, long, metavar, option ) +import Options.Applicative.Types ( readerAsk, readerError ) +import Stack.Options.Utils ( hideMods ) import Stack.Prelude -import Stack.Types.CompilerBuild +import Stack.Types.CompilerBuild ( CompilerBuild, parseCompilerBuild ) -- | GHC build parser ghcBuildParser :: Bool -> Parser CompilerBuild -ghcBuildParser hide = - option - readGHCBuild - (long "ghc-build" <> metavar "BUILD" <> - completeWith [ "standard" - , "gmp4" - , "nopie" - , "tinfo6" - , "tinfo6-nopie" - , "ncurses6" - , "int-native" - , "integersimple"] <> - help - "Specialized GHC build, e.g. 'gmp4' or 'standard' (usually auto-detected)" <> - hideMods hide - ) - where - readGHCBuild = do - s <- readerAsk - case parseCompilerBuild s of - Left e -> readerError (displayException e) - Right v -> pure v +ghcBuildParser hide = option readGHCBuild + ( long "ghc-build" + <> metavar "BUILD" + <> completeWith + [ "standard" + , "gmp4" + , "nopie" + , "tinfo6" + , "tinfo6-nopie" + , "ncurses6" + , "int-native" + , "integersimple" + ] + <> help "Specialized GHC build, e.g. 'gmp4' or 'standard' (usually \ + \auto-detected)" + <> hideMods hide + ) + where + readGHCBuild = do + s <- readerAsk + case parseCompilerBuild s of + Left e -> readerError (displayException e) + Right v -> pure v diff --git a/src/Stack/Options/GhcVariantParser.hs b/src/Stack/Options/GhcVariantParser.hs index 20e466c8cd..0e574fdf76 100644 --- a/src/Stack/Options/GhcVariantParser.hs +++ b/src/Stack/Options/GhcVariantParser.hs @@ -1,22 +1,25 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.GhcVariantParser where +module Stack.Options.GhcVariantParser + ( ghcVariantParser + ) where import Options.Applicative + ( Parser, help, long, metavar, option, readerError ) import Options.Applicative.Types ( readerAsk ) import Stack.Prelude -import Stack.Options.Utils -import Stack.Types.Config +import Stack.Options.Utils ( hideMods ) +import Stack.Types.Config ( GHCVariant, parseGHCVariant ) -- | GHC variant parser ghcVariantParser :: Bool -> Parser GHCVariant ghcVariantParser hide = option readGHCVariant - ( long "ghc-variant" + ( long "ghc-variant" <> metavar "VARIANT" <> help "Specialized GHC variant, e.g. int-native or integersimple \ \(incompatible with --system-ghc)" <> hideMods hide - ) + ) where readGHCVariant = do s <- readerAsk diff --git a/src/Stack/Options/GlobalParser.hs b/src/Stack/Options/GlobalParser.hs index aafbe1ede5..6e14d74d99 100644 --- a/src/Stack/Options/GlobalParser.hs +++ b/src/Stack/Options/GlobalParser.hs @@ -1,20 +1,36 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} -module Stack.Options.GlobalParser where +module Stack.Options.GlobalParser + ( globalOptsFromMonoid + , globalOptsParser + , initOptsParser + ) where import Options.Applicative + ( Parser, auto, completer, help, hidden, internal, long + , metavar, option, strOption, switch, value + ) import Options.Applicative.Builder.Extra + ( dirCompleter, fileExtCompleter, firstBoolFlagsFalse + , firstBoolFlagsNoDefault, firstBoolFlagsTrue, optionalFirst + , textArgument + ) import Path.IO ( getCurrentDir, resolveDir', resolveFile' ) import qualified Stack.Docker as Docker -import Stack.Init +import Stack.Init ( InitOpts (..) ) import Stack.Prelude -import Stack.Options.ConfigParser -import Stack.Options.LogLevelParser +import Stack.Options.ConfigParser ( configOptsParser ) +import Stack.Options.LogLevelParser ( logLevelOptsParser ) import Stack.Options.ResolverParser -import Stack.Options.Utils + ( abstractResolverOptsParser, compilerOptsParser ) +import Stack.Options.Utils ( GlobalOptsContext (..), hideMods ) import Stack.Types.Config -import Stack.Types.Docker + ( GlobalOpts (..), GlobalOptsMonoid (..) + , LockFileBehavior (..), StackYamlLoc (..), defaultLogLevel + , readLockFileBehavior, readStyles + ) +import Stack.Types.Docker ( dockerEntrypointArgName ) -- | Parser for global command-line options. globalOptsParser :: diff --git a/src/Stack/Options/HpcReportParser.hs b/src/Stack/Options/HpcReportParser.hs index 2d19a24dc1..6766dd2902 100644 --- a/src/Stack/Options/HpcReportParser.hs +++ b/src/Stack/Options/HpcReportParser.hs @@ -1,42 +1,57 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.HpcReportParser where +module Stack.Options.HpcReportParser + ( hpcReportOptsParser + , pvpBoundsOption + ) where import qualified Data.Text as T import Options.Applicative + ( Parser, completer, completeWith, help, long, metavar + , option, readerError, strOption, switch + ) import Options.Applicative.Builder.Extra + ( dirCompleter, fileExtCompleter, textArgument ) import Options.Applicative.Types ( readerAsk ) import Stack.Coverage ( HpcReportOpts (..) ) import Stack.Options.Completion ( targetCompleter ) import Stack.Prelude -import Stack.Types.Config +import Stack.Types.Config ( PvpBounds, parsePvpBounds ) -- | Parser for @stack hpc report@. hpcReportOptsParser :: Parser HpcReportOpts hpcReportOptsParser = HpcReportOpts - <$> many (textArgument $ metavar "TARGET_OR_TIX" <> - completer (targetCompleter <> fileExtCompleter [".tix"])) - <*> switch (long "all" <> help "Use results from all packages and components involved in previous --coverage run") - <*> optional (strOption (long "destdir" <> - metavar "DIR" <> - completer dirCompleter <> - help "Output directory for HTML report")) - <*> switch (long "open" <> help "Open the report in the browser") + <$> many (textArgument + ( metavar "TARGET_OR_TIX" + <> completer (targetCompleter <> fileExtCompleter [".tix"]) + )) + <*> switch + ( long "all" + <> help "Use results from all packages and components involved in \ + \previous --coverage run" + ) + <*> optional (strOption + ( long "destdir" + <> metavar "DIR" + <> completer dirCompleter + <> help "Output directory for HTML report" + )) + <*> switch + ( long "open" + <> help "Open the report in the browser" + ) pvpBoundsOption :: Parser PvpBounds -pvpBoundsOption = - option - readPvpBounds - (long "pvp-bounds" <> - metavar "PVP-BOUNDS" <> - completeWith ["none", "lower", "upper", "both"] <> - help - "How PVP version bounds should be added to Cabal file: none, lower, upper, both") - where - readPvpBounds = do - s <- readerAsk - case parsePvpBounds $ T.pack s of - Left e -> - readerError e - Right v -> - pure v +pvpBoundsOption = option readPvpBounds + ( long "pvp-bounds" + <> metavar "PVP-BOUNDS" + <> completeWith ["none", "lower", "upper", "both"] + <> help "How PVP version bounds should be added to Cabal file: none, lower, \ + \upper, both" + ) + where + readPvpBounds = do + s <- readerAsk + case parsePvpBounds $ T.pack s of + Left e -> readerError e + Right v -> pure v diff --git a/src/Stack/Options/LogLevelParser.hs b/src/Stack/Options/LogLevelParser.hs index d7bc46d98a..b81e2d6762 100644 --- a/src/Stack/Options/LogLevelParser.hs +++ b/src/Stack/Options/LogLevelParser.hs @@ -1,44 +1,59 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Stack.Options.LogLevelParser where +module Stack.Options.LogLevelParser + ( logLevelOptsParser + ) where import qualified Data.Text as T import Options.Applicative -import Stack.Options.Utils + ( Parser, completeWith, flag', help, long, metavar, short + , strOption + ) +import Stack.Options.Utils ( hideMods ) import Stack.Prelude -- | Parser for a logging level. logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel) -logLevelOptsParser hide defLogLevel = - fmap (Just . parse) - (strOption (long "verbosity" <> - metavar "VERBOSITY" <> - completeWith ["silent", "error", "warn", "info", "debug"] <> - help "Verbosity: silent, error, warn, info, debug" <> - hideMods hide)) <|> - flag' (Just verboseLevel) - (short 'v' <> long "verbose" <> - help ("Enable verbose mode: verbosity level \"" <> showLevel verboseLevel <> "\"") <> - hideMods hide) <|> - flag' (Just silentLevel) - (long "silent" <> - help ("Enable silent mode: verbosity level \"" <> showLevel silentLevel <> "\"") <> - hideMods hide) <|> - pure defLogLevel - where verboseLevel = LevelDebug - silentLevel = LevelOther "silent" - showLevel l = - case l of - LevelDebug -> "debug" - LevelInfo -> "info" - LevelWarn -> "warn" - LevelError -> "error" - LevelOther x -> T.unpack x - parse s = - case s of - "debug" -> LevelDebug - "info" -> LevelInfo - "warn" -> LevelWarn - "error" -> LevelError - _ -> LevelOther (T.pack s) +logLevelOptsParser hide defLogLevel = fmap (Just . parse) + (strOption + ( long "verbosity" + <> metavar "VERBOSITY" + <> completeWith ["silent", "error", "warn", "info", "debug"] + <> help "Verbosity: silent, error, warn, info, debug" + <> hideMods hide + )) + <|> flag' (Just verboseLevel) + ( short 'v' + <> long "verbose" + <> help + ( "Enable verbose mode: verbosity level \"" + <> showLevel verboseLevel + <> "\"" + ) + <> hideMods hide + ) + <|> flag' (Just silentLevel) + ( long "silent" + <> help ( "Enable silent mode: verbosity level \"" + <> showLevel silentLevel + <> "\"" + ) + <> hideMods hide + ) + <|> pure defLogLevel + where + verboseLevel = LevelDebug + silentLevel = LevelOther "silent" + showLevel l = case l of + LevelDebug -> "debug" + LevelInfo -> "info" + LevelWarn -> "warn" + LevelError -> "error" + LevelOther x -> T.unpack x + parse s = case s of + "debug" -> LevelDebug + "info" -> LevelInfo + "warn" -> LevelWarn + "error" -> LevelError + _ -> LevelOther (T.pack s) diff --git a/src/Stack/Options/PackageParser.hs b/src/Stack/Options/PackageParser.hs index d13a849829..492f75ac9b 100644 --- a/src/Stack/Options/PackageParser.hs +++ b/src/Stack/Options/PackageParser.hs @@ -1,9 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.PackageParser where +module Stack.Options.PackageParser + ( readFlag + ) where import qualified Data.Map as Map -import Options.Applicative +import Options.Applicative ( ReadM, readerError ) import Options.Applicative.Types ( readerAsk ) import Stack.Prelude import Stack.Types.Config.Build ( ApplyCLIFlag (..) ) @@ -11,22 +13,19 @@ import Stack.Types.Config.Build ( ApplyCLIFlag (..) ) -- | Parser for package:[-]flag readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool)) readFlag = do - s <- readerAsk - case break (== ':') s of - (pn, ':':mflag) -> do - pn' <- - case parsePackageName pn of - Nothing - | pn == "*" -> pure ACFAllProjectPackages - | otherwise -> readerError $ "Invalid package name: " ++ pn - Just x -> pure $ ACFByName x - let (b, flagS) = - case mflag of - '-':x -> (False, x) - _ -> (True, mflag) - flagN <- - case parseFlagName flagS of - Nothing -> readerError $ "Invalid flag name: " ++ flagS - Just x -> pure x - pure $ Map.singleton pn' $ Map.singleton flagN b - _ -> readerError "Must have a colon" + s <- readerAsk + case break (== ':') s of + (pn, ':':mflag) -> do + pn' <- case parsePackageName pn of + Nothing + | pn == "*" -> pure ACFAllProjectPackages + | otherwise -> readerError $ "Invalid package name: " ++ pn + Just x -> pure $ ACFByName x + let (b, flagS) = case mflag of + '-':x -> (False, x) + _ -> (True, mflag) + flagN <- case parseFlagName flagS of + Nothing -> readerError $ "Invalid flag name: " ++ flagS + Just x -> pure x + pure $ Map.singleton pn' $ Map.singleton flagN b + _ -> readerError "Must have a colon" diff --git a/src/Stack/Options/ResolverParser.hs b/src/Stack/Options/ResolverParser.hs index baa3a1863a..8ed1823f10 100644 --- a/src/Stack/Options/ResolverParser.hs +++ b/src/Stack/Options/ResolverParser.hs @@ -1,35 +1,40 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DataKinds #-} -module Stack.Options.ResolverParser where +module Stack.Options.ResolverParser + ( abstractResolverOptsParser + , compilerOptsParser + , readCompilerVersion + ) where import qualified Data.Text as T import Options.Applicative + ( Parser, ReadM, help, long, metavar, option, readerError ) import Options.Applicative.Types ( readerAsk ) -import Stack.Options.Utils +import Stack.Options.Utils ( hideMods ) import Stack.Prelude -import Stack.Types.Resolver +import Stack.Types.Resolver ( AbstractResolver, readAbstractResolver ) -- | Parser for the resolver abstractResolverOptsParser :: Bool -> Parser (Unresolved AbstractResolver) -abstractResolverOptsParser hide = - option readAbstractResolver - (long "resolver" <> - metavar "RESOLVER" <> - help "Override resolver in project file" <> - hideMods hide) +abstractResolverOptsParser hide = option readAbstractResolver + ( long "resolver" + <> metavar "RESOLVER" + <> help "Override resolver in project file" + <> hideMods hide + ) compilerOptsParser :: Bool -> Parser WantedCompiler -compilerOptsParser hide = - option readCompilerVersion - (long "compiler" <> - metavar "COMPILER" <> - help "Use the specified compiler" <> - hideMods hide) +compilerOptsParser hide = option readCompilerVersion + ( long "compiler" + <> metavar "COMPILER" + <> help "Use the specified compiler" + <> hideMods hide + ) readCompilerVersion :: ReadM WantedCompiler readCompilerVersion = do - s <- readerAsk - case parseWantedCompiler (T.pack s) of - Left{} -> readerError $ "Failed to parse compiler: " ++ s - Right x -> pure x + s <- readerAsk + case parseWantedCompiler (T.pack s) of + Left{} -> readerError $ "Failed to parse compiler: " ++ s + Right x -> pure x diff --git a/src/Stack/Options/ScriptParser.hs b/src/Stack/Options/ScriptParser.hs index 59d89b8429..71fd98a6a6 100644 --- a/src/Stack/Options/ScriptParser.hs +++ b/src/Stack/Options/ScriptParser.hs @@ -1,10 +1,18 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Stack.Options.ScriptParser where +module Stack.Options.ScriptParser + ( ScriptExecute (..) + , ScriptOpts (..) + , ShouldRun (..) + , scriptOptsParser + ) where import Options.Applicative -import Options.Applicative.Builder.Extra -import Stack.Options.Completion + ( Parser, completer, eitherReader, flag', help, long + , metavar, option, strArgument, strOption + ) +import Options.Applicative.Builder.Extra ( fileExtCompleter ) +import Stack.Options.Completion ( ghcOptsCompleter ) import Stack.Prelude data ScriptOpts = ScriptOpts @@ -29,30 +37,46 @@ data ShouldRun = YesRun | NoRun scriptOptsParser :: Parser ScriptOpts scriptOptsParser = ScriptOpts - <$> many (strOption - (long "package" <> - metavar "PACKAGE" <> - help "Add a package (can be specified multiple times)")) - <*> strArgument (metavar "FILE" <> completer (fileExtCompleter [".hs", ".lhs"])) - <*> many (strArgument (metavar "-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to program)")) - <*> (flag' SECompile - ( long "compile" - <> help "Compile the script without optimization and run the executable" - ) <|> - flag' SEOptimize - ( long "optimize" - <> help "Compile the script with optimization and run the executable" - ) <|> - pure SEInterpret) - <*> many (strOption - (long "ghc-options" <> - metavar "OPTIONS" <> - completer ghcOptsCompleter <> - help "Additional options passed to GHC")) - <*> many (option extraDepRead - (long "extra-dep" <> - metavar "PACKAGE-VERSION" <> - help "Extra dependencies to be added to the snapshot")) - <*> (flag' NoRun (long "no-run" <> help "Don't run, just compile.") <|> pure YesRun) - where - extraDepRead = eitherReader $ mapLeft show . parsePackageIdentifierRevision . fromString + <$> many (strOption + ( long "package" + <> metavar "PACKAGE" + <> help "Add a package (can be specified multiple times)" + )) + <*> strArgument + ( metavar "FILE" + <> completer (fileExtCompleter [".hs", ".lhs"]) + ) + <*> many (strArgument + ( metavar "-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to \ + \program)" + )) + <*> ( flag' SECompile + ( long "compile" + <> help "Compile the script without optimization and run the executable" + ) + <|> flag' SEOptimize + ( long "optimize" + <> help "Compile the script with optimization and run the executable" + ) + <|> pure SEInterpret + ) + <*> many (strOption + ( long "ghc-options" + <> metavar "OPTIONS" + <> completer ghcOptsCompleter + <> help "Additional options passed to GHC" + )) + <*> many (option extraDepRead + ( long "extra-dep" + <> metavar "PACKAGE-VERSION" + <> help "Extra dependencies to be added to the snapshot" + )) + <*> ( flag' NoRun + ( long "no-run" + <> help "Don't run, just compile." + ) + <|> pure YesRun + ) + where + extraDepRead = eitherReader $ + mapLeft show . parsePackageIdentifierRevision . fromString