    {-# 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]
      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
    ""
      return . lines . either (const []) id $ 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 []
              = []