{-# LANGUAGE NoImplicitPrelude #-}
module Stack.Options.ScriptParser
( scriptOptsParser
) where
import Options.Applicative
( Parser, completer, eitherReader, flag', help, long, metavar
, option, strArgument, strOption
)
import Options.Applicative.Builder.Extra
( boolFlags, fileExtCompleter )
import Stack.Options.Completion ( ghcOptsCompleter )
import Stack.Options.PackagesParser ( packagesParser )
import Stack.Prelude
import Stack.Script
( ScriptExecute (..), ScriptOpts (..), ShouldRun (..) )
scriptOptsParser :: Parser ScriptOpts
scriptOptsParser :: Parser ScriptOpts
scriptOptsParser = [FilePath]
-> FilePath
-> [FilePath]
-> ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts
ScriptOpts
([FilePath]
-> FilePath
-> [FilePath]
-> ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
-> Parser [FilePath]
-> Parser
(FilePath
-> [FilePath]
-> ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [FilePath]
packagesParser
Parser
(FilePath
-> [FilePath]
-> ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
-> Parser FilePath
-> Parser
([FilePath]
-> ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
( FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE"
Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([FilePath] -> Completer
fileExtCompleter [FilePath
".hs", FilePath
".lhs"])
)
Parser
([FilePath]
-> ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
-> Parser [FilePath]
-> Parser
(ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
( FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to \
\program)."
))
Parser
(ScriptExecute
-> Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
-> Parser ScriptExecute
-> Parser
(Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ScriptExecute
-> Mod FlagFields ScriptExecute -> Parser ScriptExecute
forall a. a -> Mod FlagFields a -> Parser a
flag' ScriptExecute
SECompile
( FilePath -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"compile"
Mod FlagFields ScriptExecute
-> Mod FlagFields ScriptExecute -> Mod FlagFields ScriptExecute
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Compile the script without optimization and run the \
\executable."
)
Parser ScriptExecute
-> Parser ScriptExecute -> Parser ScriptExecute
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScriptExecute
-> Mod FlagFields ScriptExecute -> Parser ScriptExecute
forall a. a -> Mod FlagFields a -> Parser a
flag' ScriptExecute
SEOptimize
( FilePath -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"optimize"
Mod FlagFields ScriptExecute
-> Mod FlagFields ScriptExecute -> Mod FlagFields ScriptExecute
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Compile the script with optimization and run the \
\executable."
)
Parser ScriptExecute
-> Parser ScriptExecute -> Parser ScriptExecute
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScriptExecute -> Parser ScriptExecute
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptExecute
SEInterpret
)
Parser
(Bool
-> [FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
-> Parser Bool
-> Parser
([FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> FilePath -> FilePath -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
False
FilePath
"use-root"
FilePath
"writing of all compilation outputs to a script-specific location in \
\the scripts directory of the Stack root."
Mod FlagFields Bool
forall a. Monoid a => a
mempty
Parser
([FilePath]
-> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun
-> ScriptOpts)
-> Parser [FilePath]
-> Parser
([Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun -> ScriptOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ghc-options"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"OPTIONS"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
ghcOptsCompleter
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Additional options passed to GHC (can be specified multiple \
\times)."
))
Parser
([Unresolved (NonEmpty RawPackageLocationImmutable)]
-> ShouldRun -> ScriptOpts)
-> Parser [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> Parser (ShouldRun -> ScriptOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser [Unresolved (NonEmpty RawPackageLocationImmutable)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Unresolved (NonEmpty RawPackageLocationImmutable))
extraDepRead
( FilePath
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"extra-dep"
Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. Semigroup a => a -> a -> a
<> FilePath
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"EXTRA-DEP"
Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. Semigroup a => a -> a -> a
<> FilePath
-> Mod
OptionFields (Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"An immutable extra dependency to be added to the snapshot \
\(can be specified multiple times)."
))
Parser (ShouldRun -> ScriptOpts)
-> Parser ShouldRun -> Parser ScriptOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ShouldRun -> Mod FlagFields ShouldRun -> Parser ShouldRun
forall a. a -> Mod FlagFields a -> Parser a
flag' ShouldRun
NoRun
( FilePath -> Mod FlagFields ShouldRun
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-run"
Mod FlagFields ShouldRun
-> Mod FlagFields ShouldRun -> Mod FlagFields ShouldRun
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields ShouldRun
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Do not run, just compile."
)
Parser ShouldRun -> Parser ShouldRun -> Parser ShouldRun
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ShouldRun -> Parser ShouldRun
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShouldRun
YesRun
)
where
extraDepRead :: ReadM (Unresolved (NonEmpty RawPackageLocationImmutable))
extraDepRead = (FilePath
-> Either
FilePath (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> ReadM (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((FilePath
-> Either
FilePath (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> ReadM (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> (FilePath
-> Either
FilePath (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> ReadM (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$
(PantryException -> FilePath)
-> Either
PantryException (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Either
FilePath (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft PantryException -> FilePath
forall a. Show a => a -> FilePath
show (Either
PantryException (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Either
FilePath (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> (FilePath
-> Either
PantryException
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> FilePath
-> Either
FilePath (Unresolved (NonEmpty RawPackageLocationImmutable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either
PantryException (Unresolved (NonEmpty RawPackageLocationImmutable))
parseRawPackageLocationImmutables (Text
-> Either
PantryException
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> (FilePath -> Text)
-> FilePath
-> Either
PantryException (Unresolved (NonEmpty RawPackageLocationImmutable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. IsString a => FilePath -> a
fromString