module Options.Applicative.Builder.Completer
( Completer
, mkCompleter
, listIOCompleter
, listCompleter
, bashCompleter
) where
import Control.Applicative
import Prelude
import Control.Exception (IOException, try)
import Data.List (isPrefixOf)
import System.Process (readProcess)
import Options.Applicative.Types
listIOCompleter :: IO [String] -> Completer
listIOCompleter :: IO [String] -> Completer
listIOCompleter ss :: IO [String]
ss = (String -> IO [String]) -> Completer
Completer ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \s :: String
s ->
(String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
s) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
ss
listCompleter :: [String] -> Completer
listCompleter :: [String] -> Completer
listCompleter = IO [String] -> Completer
listIOCompleter (IO [String] -> Completer)
-> ([String] -> IO [String]) -> [String] -> Completer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
bashCompleter :: String -> Completer
bashCompleter :: String -> Completer
bashCompleter action :: String
action = (String -> IO [String]) -> Completer
Completer ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \word :: String
word -> do
let cmd :: String
cmd = [String] -> String
unwords ["compgen", "-A", String
action, "--", String -> String
requote String
word]
Either IOException String
result <- IO String -> IO (Either IOException String)
forall a. IO a -> IO (Either IOException a)
tryIO (IO String -> IO (Either IOException String))
-> IO String -> IO (Either IOException String)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO String
readProcess "bash" ["-c", String
cmd] ""
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> (Either IOException String -> [String])
-> Either IOException String
-> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> (Either IOException String -> String)
-> Either IOException String
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOException -> String)
-> (String -> String) -> Either IOException String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IOException -> String
forall a b. a -> b -> a
const []) String -> String
forall a. a -> a
id (Either IOException String -> IO [String])
-> Either IOException String -> IO [String]
forall a b. (a -> b) -> a -> b
$ Either IOException String
result
tryIO :: IO a -> IO (Either IOException a)
tryIO :: IO a -> IO (Either IOException a)
tryIO = IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try
requote :: String -> String
requote :: String -> String
requote s :: String
s =
let
unescaped :: String
unescaped =
case String
s of
('\'': rs :: String
rs) -> String -> String
unescapeN String
rs
('"': rs :: String
rs) -> String -> String
unescapeD String
rs
elsewise :: String
elsewise -> String -> String
unescapeU String
elsewise
in
String -> String
forall (t :: * -> *). Foldable t => t Char -> String
strong String
unescaped
where
strong :: t Char -> String
strong ss :: t Char
ss = '\'' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String -> String) -> String -> t Char -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
go "'" t Char
ss
where
go :: Char -> String -> String
go '\'' t :: String
t = "'\\''" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
go h :: Char
h t :: String
t = Char
h Char -> String -> String
forall a. a -> [a] -> [a]
: String
t
unescapeN :: String -> String
unescapeN = String -> String
goX
where
goX :: String -> String
goX ('\'' : xs :: String
xs) = String -> String
goN String
xs
goX (x :: Char
x : xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
goX [] = []
goN :: String -> String
goN ('\\' : '\'' : xs :: String
xs) = '\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goN String
xs
goN ('\'' : xs :: String
xs) = String -> String
goX String
xs
goN (x :: Char
x : xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goN String
xs
goN [] = []
unescapeU :: String -> String
unescapeU = String -> String
goX
where
goX :: String -> String
goX [] = []
goX ('\\' : x :: Char
x : xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
goX (x :: Char
x : xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
unescapeD :: String -> String
unescapeD = String -> String
goX
where
goX :: String -> String
goX ('\\' : x :: Char
x : xs :: String
xs)
| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "$`\"\\\n" = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
| Bool
otherwise = '\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
goX ('"' : xs :: String
xs)
= String
xs
goX (x :: Char
x : xs :: String
xs)
= Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
goX []
= []