From ee208d3488ef62b6993d6b2d1b352d9c04b5baba Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <p.capriotti@gmail.com>
Date: Thu, 2 Aug 2012 18:13:50 +0100
Subject: [PATCH] Add more completers.

---
 Options/Applicative.hs                   |  4 ++++
 Options/Applicative/Builder.hs           | 12 ++++------
 Options/Applicative/Builder/Completer.hs | 28 ++++++++++++++++++++++++
 optparse-applicative.cabal               |  3 ++-
 4 files changed, 38 insertions(+), 9 deletions(-)
 create mode 100644 Options/Applicative/Builder/Completer.hs

diff --git a/Options/Applicative.hs b/Options/Applicative.hs
index 75f1c9a..f412062 100644
--- a/Options/Applicative.hs
+++ b/Options/Applicative.hs
@@ -20,6 +20,9 @@ module Options.Applicative (
   -- | Utilities to build parsers out of basic primitives.
   module Options.Applicative.Builder,
 
+  -- | Common completion functions.
+  module Options.Applicative.Builder.Completer,
+
   -- | Utilities to run parsers and display a help text.
   module Options.Applicative.Extra,
   ) where
@@ -29,4 +32,5 @@ import Control.Applicative
 
 import Options.Applicative.Common
 import Options.Applicative.Builder
+import Options.Applicative.Builder.Completer
 import Options.Applicative.Extra
diff --git a/Options/Applicative/Builder.hs b/Options/Applicative/Builder.hs
index 6a6155e..592a057 100644
--- a/Options/Applicative/Builder.hs
+++ b/Options/Applicative/Builder.hs
@@ -76,10 +76,10 @@ module Options.Applicative.Builder (
 
 import Control.Applicative
 import Control.Monad
-import Data.List
 import Data.Maybe
 import Data.Monoid
 
+import Options.Applicative.Builder.Completer
 import Options.Applicative.Common
 import Options.Applicative.Types
 
@@ -212,14 +212,14 @@ command cmd pinfo = fieldMod $ \p ->
 
 -- | Add a list of possible values for an argument
 argValues :: HasCompleter f => [String] -> Mod f a
-argValues xs = fieldMod $ modCompleter (<> listCompleter xs)
+argValues xs = completer (listCompleter xs)
 
 -- | Add a completer to an argument.
 --
 -- A completer is a function String -> IO String which, given a partial
 -- argument, returns all possible completions for that argument.
-completer :: (String -> IO [String]) -> Mod ArgumentFields a
-completer f = fieldMod $ modCompleter (<> Completer f)
+completer :: HasCompleter f => Completer -> Mod f a
+completer f = fieldMod $ modCompleter (<> f)
 
 -- parsers --
 
@@ -263,10 +263,6 @@ 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, s `isPrefixOf` x ]
-
 -- | Builder for an argument parser.
 argument :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser a
 argument p (Mod f d g) = mkParser d g (ArgReader rdr)
diff --git a/Options/Applicative/Builder/Completer.hs b/Options/Applicative/Builder/Completer.hs
new file mode 100644
index 0000000..717d6ec
--- /dev/null
+++ b/Options/Applicative/Builder/Completer.hs
@@ -0,0 +1,28 @@
+module Options.Applicative.Builder.Completer
+  ( listIOCompleter
+  , listCompleter
+  , fileCompleter
+  , dirCompleter
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.List
+import Options.Applicative.Types
+import System.Directory
+
+listIOCompleter :: IO [String] -> Completer
+listIOCompleter ss = Completer $ \s ->
+  filter (isPrefixOf s) <$> ss
+
+listCompleter :: [String] -> Completer
+listCompleter = listIOCompleter . pure
+
+fileCompleter :: Completer
+fileCompleter = listIOCompleter $
+  getDirectoryContents "."
+
+dirCompleter :: Completer
+dirCompleter = listIOCompleter $ do
+  files <- getDirectoryContents "."
+  filterM doesDirectoryExist files
diff --git a/optparse-applicative.cabal b/optparse-applicative.cabal
index a6cc95f..125d96b 100644
--- a/optparse-applicative.cabal
+++ b/optparse-applicative.cabal
@@ -85,7 +85,8 @@ library
                        Options.Applicative.Utils
   other-modules:       Options.Applicative.Internal
   build-depends:       base == 4.*,
-                       transformers >= 0.2 && < 0.4
+                       transformers >= 0.2 && < 0.4,
+                       directory == 1.1.*
 test-suite tests
   type:                exitcode-stdio-1.0
   hs-source-dirs:      tests