{-# 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

-- | Command-line arguments parser for configuration.

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"