{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Options.BuildParser
( buildOptsParser
, flagsParser
, targetsParser
) where
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Text as T
import Options.Applicative
( Parser, completer, flag, flag', help, internal, long
, metavar, option, strOption, switch, value
)
import Options.Applicative.Args ( cmdOption )
import Options.Applicative.Builder.Extra ( textArgument, textOption )
import Stack.Options.Completion
( flagCompleter, ghcOptsCompleter, targetCompleter )
import Stack.Options.PackageParser ( readFlag )
import Stack.Prelude
import Stack.Types.BuildOpts
( ApplyCLIFlag, BuildCommand, BuildOptsCLI (..)
, BuildSubset (..), FileWatchOpts (..)
)
buildOptsParser :: BuildCommand -> Parser BuildOptsCLI
buildOptsParser :: BuildCommand -> Parser BuildOptsCLI
buildOptsParser BuildCommand
cmd = [Text]
-> Bool
-> [Text]
-> [(Text, [Text])]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> BuildSubset
-> FileWatchOpts
-> Bool
-> [(String, [String])]
-> Bool
-> BuildCommand
-> Bool
-> BuildOptsCLI
BuildOptsCLI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Text]
targetsParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dry-run"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Don't build anything, just prepare to."
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (\[Text]
x [Text]
y [Text]
z -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]
x, [Text]
y, [Text]
z])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> a -> Mod FlagFields a -> Parser a
flag
[]
[Text
"-Wall", Text
"-Werror"]
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pedantic"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Turn on -Wall and -Werror."
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a -> Mod FlagFields a -> Parser a
flag
[]
[Text
"-O0"]
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fast"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Turn off optimizations (-O0)."
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields Text -> Parser Text
textOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghc-options"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"OPTIONS"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
ghcOptsCompleter
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Additional options passed to GHC (can be specified \
\multiple times)."
))
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Text, [Text])]
progsOptionsParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map ApplyCLIFlag (Map FlagName Bool))
flagsParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall a. a -> Mod FlagFields a -> Parser a
flag' BuildSubset
BSOnlyDependencies
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dependencies-only"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"A synonym for --only-dependencies."
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' BuildSubset
BSOnlySnapshot
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"only-snapshot"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only build packages for the snapshot database, not the \
\local database."
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' BuildSubset
BSOnlyDependencies
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"only-dependencies"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only build packages that are dependencies of targets on \
\the command line."
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' BuildSubset
BSOnlyLocals
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"only-locals"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only build packages in the local database. Fail if the \
\build plan includes the snapshot database."
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildSubset
BSAll
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall a. a -> Mod FlagFields a -> Parser a
flag' FileWatchOpts
FileWatch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"file-watch"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Watch for changes in local files and automatically \
\rebuild."
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' FileWatchOpts
FileWatchPoll
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"file-watch-poll"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Like --file-watch, but polling the filesystem instead of \
\using events."
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileWatchOpts
NoFileWatch
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"watch-all"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Watch all local files not taking targets into account."
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields (String, [String]) -> Parser (String, [String])
cmdOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"exec"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"COMMAND [ARGUMENT(S)]"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Command and argument(s) to run after a successful build."
))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"only-configure"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only perform the configure step, not any builds. Intended for \
\tool usage. May break when used on multiple packages at once!"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildCommand
cmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"initial-build-steps"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"For target packages, only run initial build steps needed for \
\GHCi."
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
)
targetsParser :: Parser [Text]
targetsParser :: Parser [Text]
targetsParser =
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields Text -> Parser Text
textArgument
( forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TARGET"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
targetCompleter
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"If none specified, use all local packages. See \
\https://docs.haskellstack.org/en/stable/build_command/#target-syntax \
\for details."
))
flagsParser :: Parser (Map.Map ApplyCLIFlag (Map.Map FlagName Bool))
flagsParser :: Parser (Map ApplyCLIFlag (Map FlagName Bool))
flagsParser = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Map ApplyCLIFlag (Map FlagName Bool))
readFlag
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"flag"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
flagCompleter
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGE:[-]FLAG"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Override flags set in stack.yaml (applies to local packages \
\and extra-deps)."
))
progsOptionsParser :: Parser [(Text, [Text])]
progsOptionsParser :: Parser [(Text, [Text])]
progsOptionsParser =
Parser String
dummyProgOptionsParser
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Text, [Text])]
progsOptionsParser')
where
dummyProgOptionsParser :: Parser String
dummyProgOptionsParser :: Parser String
dummyProgOptionsParser = forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"PROG-option"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help
( String
"Pass an argument to PROG (can be specified multiple times). PROG \
\must be a program recognised by the Cabal library and one of "
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Text -> [Text] -> Text
T.intercalate Text
" " [Text]
progs) forall a. Semigroup a => a -> a -> a
<> String
"."
)
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ARG"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
""
)
progs :: [Text]
progs :: [Text]
progs = forall a. Ord a => [a] -> [a]
L.sort
[
Text
"pkg-config"
, Text
"alex"
, Text
"c2hs"
, Text
"cpphs"
, Text
"greencard"
, Text
"happy"
, Text
"hsc2hs"
, Text
"hscolour"
, Text
"ar"
, Text
"gcc"
, Text
"ld"
, Text
"strip"
, Text
"tar"
]
progsOptionsParser' :: Parser [(Text, [Text])]
progsOptionsParser' :: Parser [(Text, [Text])]
progsOptionsParser' = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Parser (Text, [Text])
mkProgOptionsParser [Text]
progs
mkProgOptionsParser :: Text -> Parser (Text, [Text])
mkProgOptionsParser :: Text -> Parser (Text, [Text])
mkProgOptionsParser Text
prog = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
prog,) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ Mod OptionFields Text -> Parser Text
textOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
T.unpack Text
prog forall a. Semigroup a => a -> a -> a
<> String
"-option")
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
)