Fix completion for successful parses.

Options/Applicative/Common.hs

@@ -150,7 +150,7 @@ stepParser prefs (BindP p k) arg args =
 -- if any options are missing and don't have a default value.
 runParser :: MonadP m => Parser a -> [String] -> m (a, [String])
 runParser p args = case args of
-  [] -> maybe (exitP p) return result
+  [] -> exitP p result
   (arg : argt) -> do
     prefs <- getPrefs
     x <- tryP $ do_step prefs arg argt

Options/Applicative/Internal.hs

@@ -34,7 +34,7 @@ class (Alternative m, MonadPlus m) => MonadP m where
   missingArgP :: Completer -> m a
   tryP :: m a -> m (Either String a)
   errorP :: String -> m a
-  exitP :: Parser b -> m a
+  exitP :: Parser b -> Maybe a -> m a
 
 type P = ErrorT String (WriterT Context (Reader ParserPrefs))
 
@@ -58,7 +58,7 @@ instance MonadP P where
 
   missingArgP _ = empty
   tryP p = lift $ runErrorT p
-  exitP _ = mzero
+  exitP _ = maybe mzero return
   errorP = throwError
 
 liftMaybe :: MonadPlus m => Maybe a -> m a
@@ -109,7 +109,7 @@ instance MonadP Completion where
 
   missingArgP = lift . lift . ComplOption
   tryP p = catchError (Right <$> p) (return . Left)
-  exitP = lift . lift . ComplParser . SomeParser
+  exitP p _ = lift . lift . ComplParser $ SomeParser p
   errorP = throwError
 
 runCompletion :: Completion r -> ParserPrefs -> Maybe (Either SomeParser Completer)

tests/Tests.hs

@@ -164,5 +164,20 @@ case_ambiguous = do
     Left _ -> return ()
     Right val -> assertFailure $ "unexpected result " ++ show val
 
+case_completion :: Assertion
+case_completion = do
+  let p = (,)
+        <$> strOption (long "foo" & value "")
+        <*> strOption (long "bar" & value "")
+      i = info p idm
+      result = run i ["--bash-completion-index", "0"]
+  case result of
+    Left (ParserFailure err code) -> do
+      ExitSuccess @=? code
+      completions <- lines <$> err "test"
+      ["--foo", "--bar"] @=? completions
+    Right val ->
+      assertFailure $ "unexpected result " ++ show val
+
 main :: IO ()
 main = $(defaultMainGenerator)