{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DuplicateRecordFields #-}

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 hiding ( snapshotLocation )
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]
extraIncludeDirs [String]
extraLibDirs
     [Text]
customPreprocessorExts First (Path Abs File)
overrideGccPath First String
overrideHpack FirstFalse
skipGHCCheck FirstFalse
skipMsys
     First String
localBinPath [String]
setupInfoLocations FirstTrue
modifyCodePage First Bool
allowDifferentUser First DumpLogs
dumpLogs
     First ColorWhen
colorWhen First Text
snapshotLocation FirstFalse
noRunCompile -> ConfigMonoid
forall a. Monoid a => a
mempty
       { stackRoot
       , workDir
       , buildOpts
       , dockerOpts
       , nixOpts
       , systemGHC
       , installGHC
       , skipGHCCheck
       , arch
       , ghcVariant
       , ghcBuild
       , jobs
       , extraIncludeDirs
       , extraLibDirs
       , customPreprocessorExts
       , overrideGccPath
       , overrideHpack
       , skipMsys
       , localBinPath
       , setupInfoLocations
       , modifyCodePage
       , allowDifferentUser
       , dumpLogs
       , colorWhen
       , snapshotLocation
       , noRunCompile
       }
  )
  (First (Path Abs Dir)
 -> First (Path Rel Dir)
 -> BuildOptsMonoid
 -> DockerOptsMonoid
 -> NixOptsMonoid
 -> First Bool
 -> FirstTrue
 -> First String
 -> First GHCVariant
 -> First CompilerBuild
 -> First Int
 -> [String]
 -> [String]
 -> [Text]
 -> First (Path Abs File)
 -> First String
 -> FirstFalse
 -> FirstFalse
 -> First String
 -> [String]
 -> FirstTrue
 -> First Bool
 -> First DumpLogs
 -> First ColorWhen
 -> First Text
 -> FirstFalse
 -> ConfigMonoid)
-> Parser (First (Path Abs Dir))
-> Parser
     (First (Path Rel Dir)
      -> BuildOptsMonoid
      -> DockerOptsMonoid
      -> NixOptsMonoid
      -> First Bool
      -> FirstTrue
      -> First String
      -> First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Path Abs Dir) -> Parser (First (Path Abs Dir))
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
absDirOption
        ( String -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
stackRootOptionName
        Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
stackRootOptionName)
        Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. String -> Mod f a
help String
"Absolute path to the global Stack root directory. Overrides \
                \any STACK_ROOT environment variable."
        Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Path Abs Dir)
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  (First (Path Rel Dir)
   -> BuildOptsMonoid
   -> DockerOptsMonoid
   -> NixOptsMonoid
   -> First Bool
   -> FirstTrue
   -> First String
   -> First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First (Path Rel Dir))
-> Parser
     (BuildOptsMonoid
      -> DockerOptsMonoid
      -> NixOptsMonoid
      -> First Bool
      -> FirstTrue
      -> First String
      -> First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Path Rel Dir) -> Parser (First (Path Rel Dir))
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (ReadM (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String (Path Rel Dir)) -> ReadM (Path Rel Dir)
forall a. (String -> Either String a) -> ReadM a
eitherReader ((SomeException -> String)
-> Either SomeException (Path Rel Dir)
-> Either String (Path Rel Dir)
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft SomeException -> String
showWorkDirError (Either SomeException (Path Rel Dir)
 -> Either String (Path Rel Dir))
-> (String -> Either SomeException (Path Rel Dir))
-> String
-> Either String (Path Rel Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either SomeException (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir))
        ( String -> Mod OptionFields (Path Rel Dir)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"work-dir"
        Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Path Rel Dir)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WORK-DIR"
        Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields (Path Rel Dir)
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer
             ( PathCompleterOpts -> Completer
pathCompleterWith
               ( PathCompleterOpts
defaultPathCompleterOpts
                   { absolute = False, fileFilter = const False }
               )
             )
        Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Path Rel Dir)
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')"
        Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
-> Mod OptionFields (Path Rel Dir)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Path Rel Dir)
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  (BuildOptsMonoid
   -> DockerOptsMonoid
   -> NixOptsMonoid
   -> First Bool
   -> FirstTrue
   -> First String
   -> First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser BuildOptsMonoid
-> Parser
     (DockerOptsMonoid
      -> NixOptsMonoid
      -> First Bool
      -> FirstTrue
      -> First String
      -> First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GlobalOptsContext -> Parser BuildOptsMonoid
buildOptsMonoidParser GlobalOptsContext
hide0
  Parser
  (DockerOptsMonoid
   -> NixOptsMonoid
   -> First Bool
   -> FirstTrue
   -> First String
   -> First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser DockerOptsMonoid
-> Parser
     (NixOptsMonoid
      -> First Bool
      -> FirstTrue
      -> First String
      -> First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser DockerOptsMonoid
dockerOptsParser Bool
True
  Parser
  (NixOptsMonoid
   -> First Bool
   -> FirstTrue
   -> First String
   -> First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser NixOptsMonoid
-> Parser
     (First Bool
      -> FirstTrue
      -> First String
      -> First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser NixOptsMonoid
nixOptsParser Bool
True
  Parser
  (First Bool
   -> FirstTrue
   -> First String
   -> First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First Bool)
-> Parser
     (FirstTrue
      -> First String
      -> First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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)"
        Mod FlagFields (Maybe Bool)
forall {f :: * -> *} {a}. Mod f a
hide
  Parser
  (FirstTrue
   -> First String
   -> First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser FirstTrue
-> Parser
     (First String
      -> First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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'.)"
        Mod FlagFields FirstTrue
forall {f :: * -> *} {a}. Mod f a
hide
  Parser
  (First String
   -> First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First String)
-> Parser
     (First GHCVariant
      -> First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (First String)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"arch"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ARCH"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"System architecture, e.g. i386, x86_64, aarch64."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  (First GHCVariant
   -> First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First GHCVariant)
-> Parser
     (First CompilerBuild
      -> First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser GHCVariant -> Parser (First GHCVariant)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Bool -> Parser GHCVariant
ghcVariantParser (GlobalOptsContext
hide0 GlobalOptsContext -> GlobalOptsContext -> Bool
forall a. Eq a => a -> a -> Bool
/= GlobalOptsContext
OuterGlobalOpts))
  Parser
  (First CompilerBuild
   -> First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First CompilerBuild)
-> Parser
     (First Int
      -> [String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CompilerBuild -> Parser (First CompilerBuild)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Bool -> Parser CompilerBuild
ghcBuildParser (GlobalOptsContext
hide0 GlobalOptsContext -> GlobalOptsContext -> Bool
forall a. Eq a => a -> a -> Bool
/= GlobalOptsContext
OuterGlobalOpts))
  Parser
  (First Int
   -> [String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First Int)
-> Parser
     ([String]
      -> [String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (First Int)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
        (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"jobs"
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j'
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"JOBS"
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of concurrent jobs to run."
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  ([String]
   -> [String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser [String]
-> Parser
     ([String]
      -> [Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((String
currentDir FilePath.</>) (String -> String) -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra-include-dirs"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Extra directories to check for C header files."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  ([String]
   -> [Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser [String]
-> Parser
     ([Text]
      -> First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((String
currentDir FilePath.</>) (String -> String) -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra-lib-dirs"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Extra directories to check for libraries."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  ([Text]
   -> First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser [Text]
-> Parser
     (First (Path Abs File)
      -> First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser [Text]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"custom-preprocessor-extensions"
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"EXT"
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Extensions used for custom preprocessors."
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Text
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  (First (Path Abs File)
   -> First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First (Path Abs File))
-> Parser
     (First String
      -> FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Path Abs File) -> Parser (First (Path Abs File))
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
absFileOption
        (  String -> Mod OptionFields (Path Abs File)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"with-gcc"
        Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Path Abs File)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH-TO-GCC"
        Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Path Abs File)
forall (f :: * -> *) a. String -> Mod f a
help String
"Use gcc found at PATH-TO-GCC."
        Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
-> Mod OptionFields (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Path Abs File)
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  (First String
   -> FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First String)
-> Parser
     (FirstFalse
      -> FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (First String)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"with-hpack"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HPACK"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Use HPACK executable (overrides bundled Hpack)."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  (FirstFalse
   -> FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser FirstFalse
-> Parser
     (FirstFalse
      -> First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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."
        Mod FlagFields FirstFalse
forall {f :: * -> *} {a}. Mod f a
hide
  Parser
  (FirstFalse
   -> First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser FirstFalse
-> Parser
     (First String
      -> [String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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)."
        Mod FlagFields FirstFalse
forall {f :: * -> *} {a}. Mod f a
hide
  Parser
  (First String
   -> [String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First String)
-> Parser
     ([String]
      -> FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (First String)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst ((String
currentDir FilePath.</>) (String -> String) -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"local-bin-path"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
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."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  ([String]
   -> FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser [String]
-> Parser
     (FirstTrue
      -> First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"setup-info-yaml"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Alternate URL or path (relative or absolute) for Stack \
                \dependencies."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"URL"
        ))
  Parser
  (FirstTrue
   -> First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser FirstTrue
-> Parser
     (First Bool
      -> First DumpLogs
      -> First ColorWhen
      -> First Text
      -> FirstFalse
      -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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)."
        Mod FlagFields FirstTrue
forall {f :: * -> *} {a}. Mod f a
hide
  Parser
  (First Bool
   -> First DumpLogs
   -> First ColorWhen
   -> First Text
   -> FirstFalse
   -> ConfigMonoid)
-> Parser (First Bool)
-> Parser
     (First DumpLogs
      -> First ColorWhen -> First Text -> FirstFalse -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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)"
        Mod FlagFields (Maybe Bool)
forall {f :: * -> *} {a}. Mod f a
hide
  Parser
  (First DumpLogs
   -> First ColorWhen -> First Text -> FirstFalse -> ConfigMonoid)
-> Parser (First DumpLogs)
-> Parser
     (First ColorWhen -> First Text -> FirstFalse -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (First Bool -> First DumpLogs)
-> Parser (First Bool) -> Parser (First DumpLogs)
forall a b. (a -> b) -> Parser a -> Parser 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)"
        Mod FlagFields (Maybe Bool)
forall {f :: * -> *} {a}. Mod f a
hide)
  Parser
  (First ColorWhen -> First Text -> FirstFalse -> ConfigMonoid)
-> Parser (First ColorWhen)
-> Parser (First Text -> FirstFalse -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ColorWhen -> Parser (First ColorWhen)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (ReadM ColorWhen -> Mod OptionFields ColorWhen -> Parser ColorWhen
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ColorWhen
readColorWhen
        (  String -> Mod OptionFields ColorWhen
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"color"
        Mod OptionFields ColorWhen
-> Mod OptionFields ColorWhen -> Mod OptionFields ColorWhen
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ColorWhen
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"colour"
        Mod OptionFields ColorWhen
-> Mod OptionFields ColorWhen -> Mod OptionFields ColorWhen
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ColorWhen
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WHEN"
        Mod OptionFields ColorWhen
-> Mod OptionFields ColorWhen -> Mod OptionFields ColorWhen
forall a. Semigroup a => a -> a -> a
<> [String] -> Mod OptionFields ColorWhen
forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
completeWith [String
"always", String
"never", String
"auto"]
        Mod OptionFields ColorWhen
-> Mod OptionFields ColorWhen -> Mod OptionFields ColorWhen
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ColorWhen
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."
        Mod OptionFields ColorWhen
-> Mod OptionFields ColorWhen -> Mod OptionFields ColorWhen
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields ColorWhen
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser (First Text -> FirstFalse -> ConfigMonoid)
-> Parser (First Text) -> Parser (FirstFalse -> ConfigMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (First Text)
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"snapshot-location-base"
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"The base location of LTS/Nightly snapshots."
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"URL"
        ))
  Parser (FirstFalse -> ConfigMonoid)
-> Parser FirstFalse -> Parser ConfigMonoid
forall a b. Parser (a -> b) -> Parser a -> Parser b
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`."
        Mod FlagFields FirstFalse
forall {f :: * -> *} {a}. Mod f a
hide
 where
  hide :: Mod f a
hide = Bool -> Mod f a
forall (f :: * -> *) a. Bool -> Mod f a
hideMods (GlobalOptsContext
hide0 GlobalOptsContext -> GlobalOptsContext -> Bool
forall a. Eq a => a -> a -> Bool
/= GlobalOptsContext
OuterGlobalOpts)
  toDumpLogs :: First Bool -> First DumpLogs
toDumpLogs (First (Just Bool
True)) = Maybe DumpLogs -> First DumpLogs
forall a. Maybe a -> First a
First (DumpLogs -> Maybe DumpLogs
forall a. a -> Maybe a
Just DumpLogs
DumpAllLogs)
  toDumpLogs (First (Just Bool
False)) = Maybe DumpLogs -> First DumpLogs
forall a. Maybe a -> First a
First (DumpLogs -> Maybe DumpLogs
forall a. a -> Maybe a
Just DumpLogs
DumpNoLogs)
  toDumpLogs (First Maybe Bool
Nothing) = Maybe DumpLogs -> First DumpLogs
forall a. Maybe a -> First a
First Maybe DumpLogs
forall a. Maybe a
Nothing
  showWorkDirError :: SomeException -> String
showWorkDirError SomeException
err = case SomeException -> Maybe PathException
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"
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
    Maybe PathException
_ -> SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
err