{-# 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 ( PathException (..), 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.ColorWhen ( readColorWhen )
import           Stack.Types.ConfigMonoid ( ConfigMonoid (..) )
import           Stack.Types.DumpLogs ( DumpLogs (..) )
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 SomeException -> 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 to Stack's work directory. Overrides any \
                \STACK_WORK environment variable. (default: '.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. (default: disabled)"
        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 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 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 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
"Override the target directory for 'stack build --copy-bins' \
                \and 'stack install'. DIR can be an absolute path or one \
                \relative to the current directory."
        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 path (relative or absolute) 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: inside Docker, \
        \ true; 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 :: SomeException -> String
showWorkDirError SomeException
err = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err of
    Just (InvalidRelDir String
x) ->
      String
"Stack failed to interpret the value of the option as a valid\n\
      \relative path to a directory. Stack will not accept an absolute path. A \
      \path\n\
      \containing a .. (parent directory) component is not valid.\n\n\
      \If set, Stack expects the value to identify the location of Stack's \
      \work\n\
      \directory, relative to the root directory of the project or package. \
      \Stack\n\
      \encountered the value:\n"
      forall a. [a] -> [a] -> [a]
++ String
x
    Maybe PathException
_ -> forall e. Exception e => e -> String
displayException SomeException
err