{-# LANGUAGE CPP #-}

module Options.Applicative.Builder.Completer
  ( Completer
  , mkCompleter
  , listIOCompleter
  , listCompleter
  , bashCompleter

  , requote
  ) where

import Control.Applicative
import Prelude
import Control.Exception (IOException, try)
import Data.List (isPrefixOf)
#ifdef MIN_VERSION_process
import System.Process (readProcess)
#endif

import Options.Applicative.Types

-- | Create a 'Completer' from an IO action
listIOCompleter :: IO [String] -> Completer
listIOCompleter :: IO [String] -> Completer
listIOCompleter IO [String]
ss = (String -> IO [String]) -> Completer
Completer ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \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

-- | Create a 'Completer' from a constant
-- list of strings.
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Run a compgen completion action.
--
-- Common actions include @file@ and
-- @directory@. See
-- <http://www.gnu.org/software/bash/manual/html_node/Programmable-Completion-Builtins.html#Programmable-Completion-Builtins>
-- for a complete list.
bashCompleter :: String -> Completer
#ifdef MIN_VERSION_process
bashCompleter :: String -> Completer
bashCompleter String
action = (String -> IO [String]) -> Completer
Completer ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \String
word -> do
  let cmd :: String
cmd = [String] -> String
unwords [String
"compgen", String
"-A", String
action, String
"--", 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 String
"bash" [String
"-c", String
cmd] String
""
  [String] -> IO [String]
forall a. a -> IO a
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
#else
bashCompleter = const $ Completer $ const $ return []
#endif

tryIO :: IO a -> IO (Either IOException a)
tryIO :: forall a. 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

-- | Strongly quote the string we pass to compgen.
--
-- We need to do this so bash doesn't expand out any ~ or other
-- chars we want to complete on, or emit an end of line error
-- when seeking the close to the quote.
requote :: String -> String
requote :: String -> String
requote String
s =
  let
    -- Bash doesn't appear to allow "mixed" escaping
    -- in bash completions. So we don't have to really
    -- worry about people swapping between strong and
    -- weak quotes.
    unescaped :: String
unescaped =
      case String
s of
        -- It's already strongly quoted, so we
        -- can use it mostly as is, but we must
        -- ensure it's closed off at the end and
        -- there's no single quotes in the
        -- middle which might confuse bash.
        (Char
'\'': String
rs) -> String -> String
unescapeN String
rs

        -- We're weakly quoted.
        (Char
'"': String
rs)  -> String -> String
unescapeD String
rs

        -- We're not quoted at all.
        -- We need to unescape some characters like
        -- spaces and quotation marks.
        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 t Char
ss = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String -> String) -> String -> t Char -> String
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
go String
"'" t Char
ss
      where
        -- If there's a single quote inside the
        -- command: exit from the strong quote and
        -- emit it the quote escaped, then resume.
        go :: Char -> String -> String
go Char
'\'' String
t = String
"'\\''" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
        go Char
h String
t    = Char
h Char -> String -> String
forall a. a -> [a] -> [a]
: String
t

    -- Unescape a strongly quoted string
    -- We have two recursive functions, as we
    -- can enter and exit the strong escaping.
    unescapeN :: String -> String
unescapeN = String -> String
goX
      where
        goX :: String -> String
goX (Char
'\'' : String
xs) = String -> String
goN String
xs
        goX (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
        goX [] = []

        goN :: String -> String
goN (Char
'\\' : Char
'\'' : String
xs) = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goN String
xs
        goN (Char
'\'' : String
xs) = String -> String
goX String
xs
        goN (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goN String
xs
        goN [] = []

    -- Unescape an unquoted string
    unescapeU :: String -> String
unescapeU = String -> String
goX
      where
        goX :: String -> String
goX [] = []
        goX (Char
'\\' : Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
        goX (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs

    -- Unescape a weakly quoted string
    unescapeD :: String -> String
unescapeD = String -> String
goX
      where
        -- Reached an escape character
        goX :: String -> String
goX (Char
'\\' : Char
x : String
xs)
          -- If it's true escapable, strip the
          -- slashes, as we're going to strong
          -- escape instead.
          | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"$`\"\\\n" = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
          | Bool
otherwise = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
        -- We've ended quoted section, so we
        -- don't recurse on goX, it's done.
        goX (Char
'"' : String
xs)
          = String
xs
        -- Not done, but not a special character
        -- just continue the fold.
        goX (Char
x : String
xs)
          = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
        goX []
          = []