{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.ExecParser
  ( evalOptsParser
  , execOptsExtraParser
  , execOptsParser
  ) where

import           Options.Applicative
import           Options.Applicative.Builder.Extra
import           Options.Applicative.Args
import           Stack.Options.Completion
import           Stack.Prelude
import           Stack.Types.Config

-- | Parser for exec command

execOptsParser :: Maybe SpecialExecCmd -> Parser ExecOpts
execOptsParser :: Maybe SpecialExecCmd -> Parser ExecOpts
execOptsParser Maybe SpecialExecCmd
mcmd = SpecialExecCmd -> [FilePath] -> ExecOptsExtra -> ExecOpts
ExecOpts
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser SpecialExecCmd
eoCmdParser forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SpecialExecCmd
mcmd
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
eoArgsParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecOptsExtra
execOptsExtraParser
 where
  eoCmdParser :: Parser SpecialExecCmd
eoCmdParser = FilePath -> SpecialExecCmd
ExecCmd
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
          (  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"COMMAND"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
projectExeCompleter
          )
  eoArgsParser :: Parser [FilePath]
eoArgsParser = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
txt))
   where
    txt :: FilePath
txt = case Maybe SpecialExecCmd
mcmd of
      Maybe SpecialExecCmd
Nothing -> FilePath
normalTxt
      Just ExecCmd{} -> FilePath
normalTxt
      Just SpecialExecCmd
ExecRun -> FilePath
"-- ARGUMENT(S) (e.g. stack run -- file.txt)"
      Just SpecialExecCmd
ExecGhc -> FilePath
"-- ARGUMENT(S) (e.g. stack ghc -- X.hs -o x)"
      Just SpecialExecCmd
ExecRunGhc -> FilePath
"-- ARGUMENT(S) (e.g. stack runghc -- X.hs)"
    normalTxt :: FilePath
normalTxt = FilePath
"-- ARGUMENT(S) (e.g. stack exec ghc-pkg -- describe base)"

evalOptsParser :: String -- ^ metavar

               -> Parser EvalOpts
evalOptsParser :: FilePath -> Parser EvalOpts
evalOptsParser FilePath
meta = FilePath -> ExecOptsExtra -> EvalOpts
EvalOpts
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
eoArgsParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecOptsExtra
execOptsExtraParser
 where
  eoArgsParser :: Parser String
  eoArgsParser :: Parser FilePath
eoArgsParser = forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
meta)

-- | Parser for extra options to exec command

execOptsExtraParser :: Parser ExecOptsExtra
execOptsExtraParser :: Parser ExecOptsExtra
execOptsExtraParser = EnvSettings
-> [FilePath] -> [FilePath] -> Maybe FilePath -> ExecOptsExtra
ExecOptsExtra
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser EnvSettings
eoEnvSettingsParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
eoPackagesParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
eoRtsOptionsParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
eoCwdParser
 where
  eoEnvSettingsParser :: Parser EnvSettings
  eoEnvSettingsParser :: Parser EnvSettings
eoEnvSettingsParser = Bool -> Bool -> Bool -> Bool -> Bool -> EnvSettings
EnvSettings Bool
True
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> FilePath -> FilePath -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
          FilePath
"ghc-package-path"
          FilePath
"setting the GHC_PACKAGE_PATH variable for the subprocess"
          forall m. Monoid m => m
idm
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> FilePath -> FilePath -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
          FilePath
"stack-exe"
          FilePath
"setting the STACK_EXE environment variable to the path for the \
          \stack executable"
          forall m. Monoid m => m
idm
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

  eoPackagesParser :: Parser [String]
  eoPackagesParser :: Parser [FilePath]
eoPackagesParser = 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 => FilePath -> Mod f a
long FilePath
"package"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PACKAGE"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Add a package (can be specified multiple times)"
    ))

  eoRtsOptionsParser :: Parser [String]
  eoRtsOptionsParser :: Parser [FilePath]
eoRtsOptionsParser = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields [FilePath] -> Parser [FilePath]
argsOption
    ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"rts-options"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Explicit RTS options to pass to application"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RTSFLAG"
    ))

  eoCwdParser :: Parser (Maybe FilePath)
  eoCwdParser :: Parser (Maybe FilePath)
eoCwdParser = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (  forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"cwd"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Sets the working directory before executing"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
    ))