{-# LANGUAGE NoImplicitPrelude #-}
module Stack.Options.ConfigParser
( configOptsParser
) where
import Data.Char ( toUpper )
import Options.Applicative
( Parser, auto, completer, completeWith, eitherReader, help
, long, metavar, option, short, strOption
)
import Options.Applicative.Builder.Extra
( 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
configOptsParser :: FilePath -> GlobalOptsContext -> Parser ConfigMonoid
configOptsParser :: String -> GlobalOptsContext -> Parser ConfigMonoid
configOptsParser String
currentDir GlobalOptsContext
hide0 =
( \First (Path Abs Dir)
stackRoot First (Path Rel Dir)
workDir BuildOptsMonoid
buildOpts DockerOptsMonoid
dockerOpts NixOptsMonoid
nixOpts First Bool
systemGHC FirstTrue
installGHC First String
arch
First GHCVariant
ghcVariant First CompilerBuild
ghcBuild First Int
jobs [String]
includes [String]
libs [Text]
preprocs First (Path Abs File)
overrideGccPath First String
overrideHpack
FirstFalse
skipGHCCheck FirstFalse
skipMsys First String
localBin [String]
setupInfoLocations FirstTrue
modifyCodePage
First Bool
allowDifferentUser First DumpLogs
dumpLogs First ColorWhen
colorWhen First Text
snapLoc FirstFalse
noRunCompile -> forall a. Monoid a => a
mempty
{ configMonoidStackRoot :: First (Path Abs Dir)
configMonoidStackRoot = First (Path Abs Dir)
stackRoot
, configMonoidWorkDir :: First (Path Rel Dir)
configMonoidWorkDir = First (Path Rel Dir)
workDir
, configMonoidBuildOpts :: BuildOptsMonoid
configMonoidBuildOpts = BuildOptsMonoid
buildOpts
, configMonoidDockerOpts :: DockerOptsMonoid
configMonoidDockerOpts = DockerOptsMonoid
dockerOpts
, configMonoidNixOpts :: NixOptsMonoid
configMonoidNixOpts = NixOptsMonoid
nixOpts
, configMonoidSystemGHC :: First Bool
configMonoidSystemGHC = First Bool
systemGHC
, configMonoidInstallGHC :: FirstTrue
configMonoidInstallGHC = FirstTrue
installGHC
, configMonoidSkipGHCCheck :: FirstFalse
configMonoidSkipGHCCheck = FirstFalse
skipGHCCheck
, configMonoidArch :: First String
configMonoidArch = First String
arch
, configMonoidGHCVariant :: First GHCVariant
configMonoidGHCVariant = First GHCVariant
ghcVariant
, configMonoidGHCBuild :: First CompilerBuild
configMonoidGHCBuild = First CompilerBuild
ghcBuild
, configMonoidJobs :: First Int
configMonoidJobs = First Int
jobs
, configMonoidExtraIncludeDirs :: [String]
configMonoidExtraIncludeDirs = [String]
includes
, configMonoidExtraLibDirs :: [String]
configMonoidExtraLibDirs = [String]
libs
, configMonoidCustomPreprocessorExts :: [Text]
configMonoidCustomPreprocessorExts = [Text]
preprocs
, configMonoidOverrideGccPath :: First (Path Abs File)
configMonoidOverrideGccPath = First (Path Abs File)
overrideGccPath
, configMonoidOverrideHpack :: First String
configMonoidOverrideHpack = First String
overrideHpack
, configMonoidSkipMsys :: FirstFalse
configMonoidSkipMsys = FirstFalse
skipMsys
, configMonoidLocalBinPath :: First String
configMonoidLocalBinPath = First String
localBin
, configMonoidSetupInfoLocations :: [String]
configMonoidSetupInfoLocations = [String]
setupInfoLocations
, configMonoidModifyCodePage :: FirstTrue
configMonoidModifyCodePage = FirstTrue
modifyCodePage
, configMonoidAllowDifferentUser :: First Bool
configMonoidAllowDifferentUser = First Bool
allowDifferentUser
, configMonoidDumpLogs :: First DumpLogs
configMonoidDumpLogs = First DumpLogs
dumpLogs
, configMonoidColorWhen :: First ColorWhen
configMonoidColorWhen = First ColorWhen
colorWhen
, configMonoidSnapshotLocation :: First Text
configMonoidSnapshotLocation = First Text
snapLoc
, configMonoidNoRunCompile :: FirstFalse
configMonoidNoRunCompile = FirstFalse
noRunCompile
}
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
absDirOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
stackRootOptionName
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
stackRootOptionName)
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Absolute path to the global Stack root directory (Overrides \
\any STACK_ROOT environment variable)"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (String -> Either String a) -> ReadM a
eitherReader (forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft forall {a}. Show a => a -> String
showWorkDirError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir))
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"work-dir"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WORK-DIR"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
( PathCompleterOpts -> Completer
pathCompleterWith
( PathCompleterOpts
defaultPathCompleterOpts
{ pcoAbsolute :: Bool
pcoAbsolute = Bool
False, pcoFileFilter :: String -> Bool
pcoFileFilter = forall a b. a -> b -> a
const Bool
False }
)
)
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Relative path of work directory (Overrides any STACK_WORK \
\environment variable, default is '.stack-work')"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GlobalOptsContext -> Parser BuildOptsMonoid
buildOptsMonoidParser GlobalOptsContext
hide0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser DockerOptsMonoid
dockerOptsParser Bool
True
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser NixOptsMonoid
nixOptsParser Bool
True
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault
String
"system-ghc"
String
"using the system installed GHC (on the PATH) if it is available and \
\its version matches. Disabled by default."
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstTrue -> Parser FirstTrue
firstBoolFlagsTrue
String
"install-ghc"
String
"downloading and installing GHC if necessary (can be done manually \
\with 'stack setup')"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"arch"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ARCH"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"System architecture, e.g. i386, x86_64"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Bool -> Parser GHCVariant
ghcVariantParser (GlobalOptsContext
hide0 forall a. Eq a => a -> a -> Bool
/= GlobalOptsContext
OuterGlobalOpts))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Bool -> Parser CompilerBuild
ghcBuildParser (GlobalOptsContext
hide0 forall a. Eq a => a -> a -> Bool
/= GlobalOptsContext
OuterGlobalOpts))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"jobs"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"JOBS"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Number of concurrent jobs to run"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((String
currentDir String -> String -> String
FilePath.</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra-include-dirs"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Extra directories to check for C header files"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((String
currentDir String -> String -> String
FilePath.</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra-lib-dirs"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Extra directories to check for libraries"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"custom-preprocessor-extensions"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"EXT"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Extensions used for custom preprocessors"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
absFileOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"with-gcc"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH-TO-GCC"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Use gcc found at PATH-TO-GCC"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"with-hpack"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HPACK"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Use HPACK executable (overrides bundled Hpack)"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse
firstBoolFlagsFalse
String
"skip-ghc-check"
String
"skipping the GHC version and architecture check"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse
firstBoolFlagsFalse
String
"skip-msys"
String
"skipping the local MSYS installation (Windows only)"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst ((String
currentDir String -> String -> String
FilePath.</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"local-bin-path"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Install binaries to DIR"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"setup-info-yaml"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Alternate URL or relative / absolute path for Stack \
\dependencies"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"URL"
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstTrue -> Parser FirstTrue
firstBoolFlagsTrue
String
"modify-code-page"
String
"setting the codepage to support UTF-8 (Windows only)"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault
String
"allow-different-user"
String
"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)"
forall {f :: * -> *} {a}. Mod f a
hide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap First Bool -> First DumpLogs
toDumpLogs (String
-> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlagsNoDefault
String
"dump-logs"
String
"dump the build output logs for local packages to the console \
\(default: dump warning logs)"
forall {f :: * -> *} {a}. Mod f a
hide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ColorWhen
readColorWhen
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"color"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"colour"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WHEN"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
completeWith [String
"always", String
"never", String
"auto"]
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"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"
forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {a}. Mod f a
hide
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"snapshot-location-base"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The base location of LTS/Nightly snapshots"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"URL"
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstFalse -> Parser FirstFalse
firstBoolFlagsFalse
String
"script-no-run-compile"
String
"the use of options `--no-run --compile` with `stack script`"
forall {f :: * -> *} {a}. Mod f a
hide
where
hide :: Mod f a
hide = forall (f :: * -> *) a. Bool -> Mod f a
hideMods (GlobalOptsContext
hide0 forall a. Eq a => a -> a -> Bool
/= GlobalOptsContext
OuterGlobalOpts)
toDumpLogs :: First Bool -> First DumpLogs
toDumpLogs (First (Just Bool
True)) = forall a. Maybe a -> First a
First (forall a. a -> Maybe a
Just DumpLogs
DumpAllLogs)
toDumpLogs (First (Just Bool
False)) = forall a. Maybe a -> First a
First (forall a. a -> Maybe a
Just DumpLogs
DumpNoLogs)
toDumpLogs (First Maybe Bool
Nothing) = forall a. Maybe a -> First a
First forall a. Maybe a
Nothing
showWorkDirError :: a -> String
showWorkDirError a
err = forall {a}. Show a => a -> String
show a
err forall a. [a] -> [a] -> [a]
++
String
"\nNote that --work-dir must be a relative child directory, because \
\work-dirs outside of the package are not supported by Cabal." forall a. [a] -> [a] -> [a]
++
String
"\nSee https://github.com/commercialhaskell/stack/issues/2954"