Add support for completers in ArgReader.

Options/Applicative/BashCompletion.hs

@@ -42,7 +42,7 @@ bashCompletionQuery parser ws i = case runCompletion compl parser of
     opt_names opt = case optMain opt of
       OptReader ns _  -> map show_name ns
       FlagReader ns _ -> map show_name ns
-      ArgReader _     -> []
+      ArgReader _ _   -> []
       CmdReader ns _  -> ns
 
     show_name (OptShort c) = '-':[c]

Options/Applicative/Builder.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor, EmptyDataDecls #-}
+{-# LANGUAGE DeriveFunctor #-}
 module Options.Applicative.Builder (
   -- * Parser builders
   --
@@ -74,6 +74,7 @@ module Options.Applicative.Builder (
 
 import Control.Applicative
 import Control.Monad
+import Data.List
 import Data.Maybe
 import Data.Monoid
 
@@ -94,7 +95,9 @@ data CommandFields a = CommandFields
   { cmdCommands :: [(String, ParserInfo a)] }
   deriving Functor
 
-data ArgumentFields a
+data ArgumentFields a = ArgumentFields
+  { argCompleter :: Completer
+  , argAdmissible :: [String] }
   deriving Functor
 
 class HasName f where
@@ -238,9 +241,16 @@ subparser m = mkParser d g rdr
     CommandFields cmds = f (CommandFields [])
     rdr = CmdReader (map fst cmds) (`lookup` cmds)
 
+listCompleter :: [String] -> Completer
+listCompleter ss = Completer $ \s -> return
+  [ x | x <- ss, x `isPrefixOf` s ]
+
 -- | Builder for an argument parser.
 argument :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser a
-argument p (Mod _ d g) = mkParser d g (ArgReader p)
+argument p (Mod f d g) = mkParser d g (ArgReader completer p)
+  where
+    fields = f (ArgumentFields mempty [])
+    completer = argCompleter fields <> listCompleter (argAdmissible fields)
 
 -- | Builder for an argument list parser. All arguments are collected and
 -- returned as a list.
@@ -253,7 +263,7 @@ argument p (Mod _ d g) = mkParser d g (ArgReader p)
 arguments :: (String -> Maybe a) -> Mod ArgumentFields [a] -> Parser [a]
 arguments p m = args1 <|> pure (fromMaybe [] def)
   where
-    Mod _ (DefaultProp def sdef) g = m
+    Mod f (DefaultProp def sdef) g = m
     show_def = sdef <*> def
 
     p' ('-':_) = Nothing
@@ -267,11 +277,14 @@ arguments p m = args1 <|> pure (fromMaybe [] def)
       Just a -> fmap (a:) args
     args = args1 <|> pure []
 
-    arg = liftOpt (Option (ArgReader p) props)
-    arg' = liftOpt (Option (ArgReader p') props')
+    arg = liftOpt (Option (ArgReader completer p) props)
+    arg' = liftOpt (Option (ArgReader completer p') props')
 
     ddash = argument (guard . (== "--")) internal
 
+    fields = f (ArgumentFields mempty [])
+    completer = argCompleter fields <> listCompleter (argAdmissible fields)
+
 -- | Builder for a flag parser.
 --
 -- A flag that switches from a \"default value\" to an \"active value\" when

Options/Applicative/Common.hs

@@ -87,7 +87,7 @@ optMatches rdr arg = case rdr of
     | Just (arg1, Nothing) <- parsed
     , arg1 `elem` names
     -> Just $ \args -> return (x, args)
-  ArgReader f
+  ArgReader _ f
     | Just result <- f arg
     -> Just $ \args -> return (result, args)
   CmdReader _ f

Options/Applicative/Types.hs

@@ -9,6 +9,7 @@ module Options.Applicative.Types (
   OptProperties(..),
   OptVisibility(..),
   Parser(..),
+  Completer(..),
   ParserFailure(..),
   OptHelpInfo(..),
 
@@ -20,6 +21,7 @@ module Options.Applicative.Types (
 
 import Control.Applicative
 import Control.Monad.Trans.Error
+import Data.Monoid
 import System.Exit
 
 -- | A full description for a runnable 'Parser' for a program.
@@ -66,7 +68,7 @@ data Option a = Option
 data OptReader a
   = OptReader [OptName] (String -> Maybe a)             -- ^ option reader
   | FlagReader [OptName] !a                             -- ^ flag reader
-  | ArgReader (String -> Maybe a)                       -- ^ argument reader
+  | ArgReader Completer (String -> Maybe a)             -- ^ argument reader
   | CmdReader [String] (String -> Maybe (ParserInfo a)) -- ^ command reader
   deriving Functor
 
@@ -95,6 +97,14 @@ instance Alternative Parser where
   many p = some p <|> pure []
   some p = p `BindP` (\r -> (r:) <$> many p)
 
+newtype Completer = Completer
+  { runCompleter :: String -> IO [String] }
+
+instance Monoid Completer where
+  mempty = Completer $ \_ -> return []
+  mappend (Completer c1) (Completer c2) =
+    Completer $ \s -> (++) <$> c1 s <*> c2 s
+
 -- | Result after a parse error.
 data ParserFailure = ParserFailure
   { errMessage :: String -> String -- ^ Function which takes the program name