{-# LANGUAGE NoImplicitPrelude #-}
module Stack.Options.ScriptParser
( ScriptExecute (..)
, ScriptOpts (..)
, ShouldRun (..)
, scriptOptsParser
) where
import Options.Applicative
( Parser, completer, eitherReader, flag', help, long
, metavar, option, strArgument, strOption
)
import Options.Applicative.Builder.Extra ( fileExtCompleter )
import Stack.Options.Completion ( ghcOptsCompleter )
import Stack.Prelude
data ScriptOpts = ScriptOpts
{ ScriptOpts -> [String]
soPackages :: ![String]
, ScriptOpts -> String
soFile :: !FilePath
, ScriptOpts -> [String]
soArgs :: ![String]
, ScriptOpts -> ScriptExecute
soCompile :: !ScriptExecute
, ScriptOpts -> [String]
soGhcOptions :: ![String]
, :: ![PackageIdentifierRevision]
, ScriptOpts -> ShouldRun
soShouldRun :: !ShouldRun
}
deriving Int -> ScriptOpts -> ShowS
[ScriptOpts] -> ShowS
ScriptOpts -> String
(Int -> ScriptOpts -> ShowS)
-> (ScriptOpts -> String)
-> ([ScriptOpts] -> ShowS)
-> Show ScriptOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptOpts -> ShowS
showsPrec :: Int -> ScriptOpts -> ShowS
$cshow :: ScriptOpts -> String
show :: ScriptOpts -> String
$cshowList :: [ScriptOpts] -> ShowS
showList :: [ScriptOpts] -> ShowS
Show
data ScriptExecute
= SEInterpret
| SECompile
| SEOptimize
deriving Int -> ScriptExecute -> ShowS
[ScriptExecute] -> ShowS
ScriptExecute -> String
(Int -> ScriptExecute -> ShowS)
-> (ScriptExecute -> String)
-> ([ScriptExecute] -> ShowS)
-> Show ScriptExecute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptExecute -> ShowS
showsPrec :: Int -> ScriptExecute -> ShowS
$cshow :: ScriptExecute -> String
show :: ScriptExecute -> String
$cshowList :: [ScriptExecute] -> ShowS
showList :: [ScriptExecute] -> ShowS
Show
data ShouldRun = YesRun | NoRun
deriving Int -> ShouldRun -> ShowS
[ShouldRun] -> ShowS
ShouldRun -> String
(Int -> ShouldRun -> ShowS)
-> (ShouldRun -> String)
-> ([ShouldRun] -> ShowS)
-> Show ShouldRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShouldRun -> ShowS
showsPrec :: Int -> ShouldRun -> ShowS
$cshow :: ShouldRun -> String
show :: ShouldRun -> String
$cshowList :: [ShouldRun] -> ShowS
showList :: [ShouldRun] -> ShowS
Show
scriptOptsParser :: Parser ScriptOpts
scriptOptsParser :: Parser ScriptOpts
scriptOptsParser = [String]
-> String
-> [String]
-> ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> ShouldRun
-> ScriptOpts
ScriptOpts
([String]
-> String
-> [String]
-> ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> ShouldRun
-> ScriptOpts)
-> Parser [String]
-> Parser
(String
-> [String]
-> ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> ShouldRun
-> ScriptOpts)
forall (f :: * -> *) a b. Functor 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
"package"
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
"PACKAGE"
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
"Add a package (can be specified multiple times)"
))
Parser
(String
-> [String]
-> ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> ShouldRun
-> ScriptOpts)
-> Parser String
-> Parser
([String]
-> ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> 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 String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
( String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod ArgumentFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
fileExtCompleter [String
".hs", String
".lhs"])
)
Parser
([String]
-> ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> ShouldRun
-> ScriptOpts)
-> Parser [String]
-> Parser
(ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> 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 String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
( String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to \
\program)"
))
Parser
(ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> ShouldRun
-> ScriptOpts)
-> Parser ScriptExecute
-> Parser
([String]
-> [PackageIdentifierRevision] -> 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
( String -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"compile"
Mod FlagFields ScriptExecute
-> Mod FlagFields ScriptExecute -> Mod FlagFields ScriptExecute
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. String -> Mod f a
help String
"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
( String -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"optimize"
Mod FlagFields ScriptExecute
-> Mod FlagFields ScriptExecute -> Mod FlagFields ScriptExecute
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ScriptExecute
forall (f :: * -> *) a. String -> Mod f a
help String
"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
([String]
-> [PackageIdentifierRevision] -> ShouldRun -> ScriptOpts)
-> Parser [String]
-> Parser ([PackageIdentifierRevision] -> 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 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
"ghc-options"
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
"OPTIONS"
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
ghcOptsCompleter
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
"Additional options passed to GHC"
))
Parser ([PackageIdentifierRevision] -> ShouldRun -> ScriptOpts)
-> Parser [PackageIdentifierRevision]
-> 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 PackageIdentifierRevision
-> Parser [PackageIdentifierRevision]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM PackageIdentifierRevision
-> Mod OptionFields PackageIdentifierRevision
-> Parser PackageIdentifierRevision
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM PackageIdentifierRevision
extraDepRead
( String -> Mod OptionFields PackageIdentifierRevision
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra-dep"
Mod OptionFields PackageIdentifierRevision
-> Mod OptionFields PackageIdentifierRevision
-> Mod OptionFields PackageIdentifierRevision
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PackageIdentifierRevision
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGE-VERSION"
Mod OptionFields PackageIdentifierRevision
-> Mod OptionFields PackageIdentifierRevision
-> Mod OptionFields PackageIdentifierRevision
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PackageIdentifierRevision
forall (f :: * -> *) a. String -> Mod f a
help String
"Extra dependencies to be added to the snapshot"
))
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
( String -> Mod FlagFields ShouldRun
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-run"
Mod FlagFields ShouldRun
-> Mod FlagFields ShouldRun -> Mod FlagFields ShouldRun
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ShouldRun
forall (f :: * -> *) a. String -> Mod f a
help String
"Don't 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 PackageIdentifierRevision
extraDepRead = (String -> Either String PackageIdentifierRevision)
-> ReadM PackageIdentifierRevision
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String PackageIdentifierRevision)
-> ReadM PackageIdentifierRevision)
-> (String -> Either String PackageIdentifierRevision)
-> ReadM PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$
(PantryException -> String)
-> Either PantryException PackageIdentifierRevision
-> Either String PackageIdentifierRevision
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft PantryException -> String
forall a. Show a => a -> String
show (Either PantryException PackageIdentifierRevision
-> Either String PackageIdentifierRevision)
-> (String -> Either PantryException PackageIdentifierRevision)
-> String
-> Either String PackageIdentifierRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision (Text -> Either PantryException PackageIdentifierRevision)
-> (String -> Text)
-> String
-> Either PantryException PackageIdentifierRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString