mirror of
https://github.com/ilyakooo0/optparse-applicative.git
synced 2024-09-11 10:45:25 +03:00
Put inline behind an option to keep old behaviour by default
This commit is contained in:
parent
9108ccd1f6
commit
48f4d7a743
@ -83,6 +83,7 @@ module Options.Applicative.Builder (
|
||||
showHelpOnError,
|
||||
showHelpOnEmpty,
|
||||
noBacktrack,
|
||||
subparserInline,
|
||||
columns,
|
||||
prefs,
|
||||
defaultPrefs,
|
||||
@ -485,7 +486,15 @@ showHelpOnEmpty = PrefsMod $ \p -> p { prefShowHelpOnEmpty = True }
|
||||
|
||||
-- | Turn off backtracking after subcommand is parsed.
|
||||
noBacktrack :: PrefsMod
|
||||
noBacktrack = PrefsMod $ \p -> p { prefBacktrack = False }
|
||||
noBacktrack = PrefsMod $ \p -> p { prefBacktrack = NoBacktrack }
|
||||
|
||||
-- | Allow full mixing of subcommand and parent arguments by inlining
|
||||
-- selected subparsers into the parent parser.
|
||||
--
|
||||
-- /NOTE:/ When this option is used, preferences for the subparser which
|
||||
-- effect the parser behaviour (such as noIntersperse) are ignored.
|
||||
subparserInline :: PrefsMod
|
||||
subparserInline = PrefsMod $ \p -> p { prefBacktrack = SubparserInline }
|
||||
|
||||
-- | Set the maximum width of the generated help text.
|
||||
columns :: Int -> PrefsMod
|
||||
@ -500,7 +509,7 @@ prefs m = applyPrefsMod m base
|
||||
, prefDisambiguate = False
|
||||
, prefShowHelpOnError = False
|
||||
, prefShowHelpOnEmpty = False
|
||||
, prefBacktrack = True
|
||||
, prefBacktrack = Backtrack
|
||||
, prefColumns = 80 }
|
||||
|
||||
-- Convenience shortcuts
|
||||
|
@ -162,31 +162,39 @@ searchOpt pprefs w = searchParser $ \opt -> do
|
||||
Just matcher -> lift $ fmap pure matcher
|
||||
Nothing -> mzero
|
||||
|
||||
searchArg :: MonadP m => String -> Parser a
|
||||
searchArg :: MonadP m => ParserPrefs -> String -> Parser a
|
||||
-> NondetT (StateT Args m) (Parser a)
|
||||
searchArg arg = searchParser $ \opt -> do
|
||||
searchArg prefs arg = searchParser $ \opt -> do
|
||||
when (isArg (optMain opt)) cut
|
||||
case optMain opt of
|
||||
CmdReader _ _ f ->
|
||||
case f arg of
|
||||
Just subp -> do
|
||||
lift . lift $ enterContext arg subp
|
||||
case (f arg, prefBacktrack prefs) of
|
||||
(Just subp, NoBacktrack) -> lift $ do
|
||||
args <- get <* put []
|
||||
fmap pure . lift $ enterContext arg subp *> runParserInfo subp args <* exitContext
|
||||
|
||||
(Just subp, Backtrack) -> fmap pure . lift . StateT $ \args -> do
|
||||
enterContext arg subp *> runParser (infoPolicy subp) CmdStart (infoParser subp) args <* exitContext
|
||||
|
||||
(Just subp, SubparserInline) -> lift $ do
|
||||
lift $ enterContext arg subp
|
||||
return $ infoParser subp
|
||||
Nothing -> mzero
|
||||
|
||||
(Nothing, _) -> mzero
|
||||
ArgReader rdr ->
|
||||
fmap pure . lift . lift $ runReadM (crReader rdr) arg
|
||||
_ -> mzero
|
||||
|
||||
stepParser :: MonadP m => ParserPrefs -> ArgPolicy -> String
|
||||
-> Parser a -> NondetT (StateT Args m) (Parser a)
|
||||
stepParser _ AllPositionals arg p =
|
||||
searchArg arg p
|
||||
stepParser pprefs AllPositionals arg p =
|
||||
searchArg pprefs arg p
|
||||
stepParser pprefs ForwardOptions arg p = case parseWord arg of
|
||||
Just w -> searchOpt pprefs w p <|> searchArg arg p
|
||||
Nothing -> searchArg arg p
|
||||
Just w -> searchOpt pprefs w p <|> searchArg pprefs arg p
|
||||
Nothing -> searchArg pprefs arg p
|
||||
stepParser pprefs _ arg p = case parseWord arg of
|
||||
Just w -> searchOpt pprefs w p
|
||||
Nothing -> searchArg arg p
|
||||
Nothing -> searchArg pprefs arg p
|
||||
|
||||
|
||||
-- | Apply a 'Parser' to a command line, and return a result and leftover
|
||||
|
@ -9,6 +9,7 @@ module Options.Applicative.Types (
|
||||
OptReader(..),
|
||||
OptProperties(..),
|
||||
OptVisibility(..),
|
||||
Backtracking(..),
|
||||
ReadM(..),
|
||||
readerAsk,
|
||||
readerAbort,
|
||||
@ -95,19 +96,25 @@ data ParserInfo a = ParserInfo
|
||||
instance Functor ParserInfo where
|
||||
fmap f i = i { infoParser = fmap f (infoParser i) }
|
||||
|
||||
data Backtracking
|
||||
= Backtrack
|
||||
| NoBacktrack
|
||||
| SubparserInline
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Global preferences for a top-level 'Parser'.
|
||||
data ParserPrefs = ParserPrefs
|
||||
{ prefMultiSuffix :: String -- ^ metavar suffix for multiple options
|
||||
, prefDisambiguate :: Bool -- ^ automatically disambiguate abbreviations
|
||||
-- (default: False)
|
||||
, prefShowHelpOnError :: Bool -- ^ always show help text on parse errors
|
||||
-- (default: False)
|
||||
, prefShowHelpOnEmpty :: Bool -- ^ show the help text for a command or subcommand
|
||||
-- if it fails with no input (default: False)
|
||||
, prefBacktrack :: Bool -- ^ backtrack to parent parser when a
|
||||
-- subcommand fails (default: True)
|
||||
, prefColumns :: Int -- ^ number of columns in the terminal, used to
|
||||
-- format the help page (default: 80)
|
||||
{ prefMultiSuffix :: String -- ^ metavar suffix for multiple options
|
||||
, prefDisambiguate :: Bool -- ^ automatically disambiguate abbreviations
|
||||
-- (default: False)
|
||||
, prefShowHelpOnError :: Bool -- ^ always show help text on parse errors
|
||||
-- (default: False)
|
||||
, prefShowHelpOnEmpty :: Bool -- ^ show the help text for a command or subcommand
|
||||
-- if it fails with no input (default: False)
|
||||
, prefBacktrack :: Backtracking -- ^ backtrack to parent parser when a
|
||||
-- subcommand fails (default: Backtrack)
|
||||
, prefColumns :: Int -- ^ number of columns in the terminal, used to
|
||||
-- format the help page (default: 80)
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data OptName = OptShort !Char
|
||||
|
@ -393,6 +393,16 @@ prop_backtracking = once $
|
||||
result = execParserPure (prefs noBacktrack) i ["c", "-b"]
|
||||
in assertError result $ \_ -> property succeeded
|
||||
|
||||
prop_subparser_inline :: Property
|
||||
prop_subparser_inline = once $
|
||||
let p2 = switch (short 'a')
|
||||
p1 = (,)
|
||||
<$> subparser (command "c" (info p2 idm))
|
||||
<*> switch (short 'b')
|
||||
i = info (p1 <**> helper) idm
|
||||
result = execParserPure (prefs subparserInline) i ["c", "-b", "-a" ]
|
||||
in assertResult result ((True, True) ===)
|
||||
|
||||
prop_error_context :: Property
|
||||
prop_error_context = once $
|
||||
let p = pk <$> option auto (long "port")
|
||||
|
Loading…
Reference in New Issue
Block a user