Put inline behind an option to keep old behaviour by default

Options/Applicative/Builder.hs

@@ -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

Options/Applicative/Common.hs

@@ -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

Options/Applicative/Types.hs

@@ -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

tests/test.hs

@@ -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")