opt-env-conf-0.11.0.0: src/OptEnvConf/Completion.hs
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module OptEnvConf.Completion
( generateBashCompletionScript,
bashCompletionScript,
generateZshCompletionScript,
zshCompletionScript,
generateFishCompletionScript,
fishCompletionScript,
runCompletionQuery,
pureCompletionQuery,
Completion (..),
evalCompletions,
evalCompletion,
Suggestion (..),
evalSuggestion,
)
where
import Control.Monad
import Control.Monad.State
import Data.List
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.String
import OptEnvConf.Args as Args
import OptEnvConf.Casing
import OptEnvConf.Completer
import OptEnvConf.Parser
import OptEnvConf.Setting
import Path
generateBashCompletionScript :: Path Abs File -> String -> IO ()
generateBashCompletionScript progPath progname = putStrLn $ bashCompletionScript progPath progname
-- | Generated bash shell completion script
bashCompletionScript :: Path Abs File -> String -> String
bashCompletionScript progPath progname =
let functionName = progNameToFunctionName progname
in unlines
[ functionName ++ "()",
"{",
" local CMDLINE",
" local IFS=$'\\n'",
" CMDLINE=(--query-opt-env-conf-completion)",
" CMDLINE+=(--completion-index $COMP_CWORD)",
"",
" for arg in ${COMP_WORDS[@]}; do",
" CMDLINE=(${CMDLINE[@]} --completion-word $arg)",
" done",
"",
" COMPREPLY=( $(" ++ fromAbsFile progPath ++ " \"${CMDLINE[@]}\") )",
"}",
"",
"complete -o filenames -F " ++ functionName ++ " " ++ progname
]
generateZshCompletionScript :: Path Abs File -> String -> IO ()
generateZshCompletionScript progPath progname = putStrLn $ zshCompletionScript progPath progname
-- | Generated zsh shell completion script
zshCompletionScript :: Path Abs File -> String -> String
zshCompletionScript progPath progname =
unlines
[ "#compdef " ++ progname,
"",
"local request",
"local completions",
"local word",
"local index=$((CURRENT - 1))",
"",
"request=(--query-opt-env-conf-completion --completion-enriched --completion-index $index)",
"for arg in ${words[@]}; do",
" request=(${request[@]} --completion-word $arg)",
"done",
"",
"IFS=$'\\n' completions=($( " ++ fromAbsFile progPath ++ " \"${request[@]}\" ))",
"",
"for word in $completions; do",
" local -a parts",
"",
" # Split the line at a tab if there is one.",
" IFS=$'\\t' parts=($( echo $word ))",
"",
" if [[ -n $parts[2] ]]; then",
" if [[ $word[1] == \"-\" ]]; then",
" local desc=(\"$parts[1] ($parts[2])\")",
" compadd -d desc -- $parts[1]",
" else",
" local desc=($(print -f \"%-019s -- %s\" $parts[1] $parts[2]))",
" compadd -l -d desc -- $parts[1]",
" fi",
" else",
" compadd -f -- $word",
" fi",
"done"
]
generateFishCompletionScript :: Path Abs File -> String -> IO ()
generateFishCompletionScript progPath progname = putStrLn $ fishCompletionScript progPath progname
-- | Generated fish shell completion script
fishCompletionScript :: Path Abs File -> String -> String
fishCompletionScript progPath progname =
let functionName = progNameToFunctionName progname
in unlines
[ " function " ++ functionName,
" set -l cl (commandline --tokenize --current-process)",
" # Hack around fish issue #3934",
" set -l cn (commandline --tokenize --cut-at-cursor --current-process)",
" set -l cn (count $cn)",
" set -l tmpline --query-opt-env-conf-completion --completion-enriched --completion-index $cn",
" for arg in $cl",
" set tmpline $tmpline --completion-word $arg",
" end",
" for opt in (" ++ fromAbsFile progPath ++ " $tmpline)",
" if test -d $opt",
" echo -E \"$opt/\"",
" else",
" echo -E \"$opt\"",
" end",
" end",
"end",
"",
"complete --no-files --command " ++ fromAbsFile progPath ++ " --arguments '(" ++ functionName ++ ")'"
]
-- This should be a name that a normal user would never want to define themselves.
progNameToFunctionName :: String -> String
progNameToFunctionName progname = "_opt_env_conf_completion_" ++ toShellFunctionCase progname
runCompletionQuery ::
Parser a ->
-- | Enriched
Bool ->
-- | Where completion is invoked (inbetween arguments)
Int ->
-- Provider arguments
[String] ->
IO ()
runCompletionQuery parser enriched index' ws' = do
-- Which index and args are passed here is a bit tricky.
-- Some examples:
--
-- progname <tab> -> (1, ["progname"])
-- progname <tab>- -> (1, ["progname", "-"])
-- progname -<tab> -> (1, ["progname", "-"])
-- progname -<tab>- -> (1, ["progname", "--"])
-- progname - <tab> -> (2, ["progname", "-"])
--
-- We use 'drop 1' here because we don't care about the progname anymore.
let index = pred index'
let ws = drop 1 ws'
let arg = fromMaybe "" $ listToMaybe $ drop index ws
let completions = pureCompletionQuery parser index ws
evaluatedCompletions <- evalCompletions arg completions
-- You can use this for debugging inputs:
-- import System.IO
-- hPutStrLn stderr $ show (enriched, index, ws)
-- hPutStrLn stderr $ show evaluatedCompletions
if enriched
then
putStr $
unlines $
map
( \Completion {..} -> case completionDescription of
Nothing -> completionSuggestion
Just d -> completionSuggestion <> "\t" <> d
)
evaluatedCompletions
else putStr $ unlines $ map completionSuggestion evaluatedCompletions
pure ()
-- Because the first arg has already been skipped we get input like this here:
--
-- progname <tab> -> (0, [])
-- progname <tab>- -> (0, ["-"])
-- progname -<tab> -> (0, ["-"])
-- progname -<tab>- -> (0, ["--"])
-- progname - <tab> -> (1, ["-"])
selectArgs :: Int -> [String] -> (Args, Maybe String)
selectArgs ix args =
( parseArgs $ take ix args,
NE.head <$> NE.nonEmpty (drop ix args)
)
data Completion a = Completion
{ -- | Completion
completionSuggestion :: !a,
-- | Description
completionDescription :: !(Maybe String)
}
deriving (Show, Eq, Ord)
instance (IsString str) => IsString (Completion str) where
fromString s =
Completion
{ completionSuggestion = fromString s,
completionDescription = Nothing
}
evalCompletions :: String -> [Completion Suggestion] -> IO [Completion String]
evalCompletions arg = fmap concat . mapM (evalCompletion arg)
evalCompletion :: String -> Completion Suggestion -> IO [Completion String]
evalCompletion arg c = do
ss <- evalSuggestion arg (completionSuggestion c)
pure $ map (\s -> c {completionSuggestion = s}) ss
data Suggestion
= SuggestionBare !String
| SuggestionCompleter !Completer
-- For tidier tests
instance IsString Suggestion where
fromString = SuggestionBare
evalSuggestion :: String -> Suggestion -> IO [String]
evalSuggestion arg = \case
SuggestionBare s -> pure $ filter (arg `isPrefixOf`) [s]
SuggestionCompleter (Completer act) -> act arg
pureCompletionQuery :: Parser a -> Int -> [String] -> [Completion Suggestion]
pureCompletionQuery parser ix args =
fromMaybe [] $ evalState (go parser) selectedArgs
where
(selectedArgs, mCursorArg) = selectArgs ix args
goCommand :: Command a -> State Args (Maybe [Completion Suggestion])
goCommand = go . commandParser -- TODO complete with the command
combineOptions = Just . concat . catMaybes
tryOrRestore :: State Args (Maybe a) -> State Args (Maybe a)
tryOrRestore func = do
before <- get
mA <- func
case mA of
Nothing -> do
put before
pure Nothing
Just a -> pure (Just a)
orCompletions :: Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
orCompletions p1 p2 = do
p1s <- tryOrRestore $ go p1
p2s <- tryOrRestore $ go p2
pure $ case (p1s, p2s) of
(Nothing, Nothing) -> Nothing
(Just cs, Nothing) -> Just cs
(Nothing, Just cs) -> Just cs
(Just cs1, Just cs2) -> Just $ cs1 ++ cs2
andCompletions :: Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
andCompletions p1 p2 = do
p1s <- tryOrRestore $ go p1
case p1s of
Nothing -> pure Nothing
Just cs1 -> do
p2s <- tryOrRestore $ go p2
pure $ case p2s of
Nothing -> Nothing
Just cs2 -> pure $ cs1 ++ cs2
-- Nothing means "this branch was not valid"
-- Just [] means "no completions"
go :: Parser a -> State Args (Maybe [Completion Suggestion])
go = \case
ParserPure _ -> pure $ Just []
-- Parse both and combine the result
ParserAp p1 p2 -> andCompletions p1 p2
-- Parse either: either completions are valid
ParserAlt p1 p2 -> orCompletions p1 p2
ParserSelect p1 p2 -> andCompletions p1 p2
ParserEmpty _ -> pure Nothing
ParserMany _ p -> do
mR <- go p
case mR of
Nothing -> pure Nothing
Just os -> fmap (os ++) <$> go p
ParserSome _ p -> do
mR <- go p
case mR of
Nothing -> pure Nothing
Just os -> fmap (os ++) <$> go p
ParserAllOrNothing _ p -> go p
ParserCheck _ _ _ p -> go p
ParserWithConfig _ p1 p2 ->
-- The config-file auto-completion is probably less important, we put it second.
andCompletions p2 p1
ParserCommands _ _ cs -> do
as <- get
let possibilities = Args.consumeArgument as
fmap combineOptions $ forM possibilities $ \(mArg, rest) -> do
case mArg of
Nothing -> do
if argsAtEnd rest
then do
let arg = fromMaybe "" mCursorArg
let matchingCommands = filter ((arg `isPrefixOf`) . commandArg) cs
pure $
Just $
map
( \Command {..} ->
Completion
{ completionSuggestion = SuggestionBare commandArg,
completionDescription = Just commandHelp
}
)
matchingCommands
else pure Nothing -- TODO: What does this mean?
Just arg ->
case find ((== arg) . commandArg) cs of
Just c -> do
put rest
goCommand c
Nothing -> pure Nothing -- Invalid command
ParserSetting _ Setting {..} -> do
let arg = fromMaybe "" mCursorArg
let completionDescription = settingHelp
let completeWithCompleter = pure $ Just $ maybeToList $ do
c <- settingCompleter
let completionSuggestion = SuggestionCompleter c
pure Completion {..}
let completeWithCompleterAtEnd = do
as <- get
if argsAtEnd as then completeWithCompleter else pure $ Just []
let completeWithDasheds = do
let isLong = \case
DashedLong _ -> True
DashedShort _ -> False
let favorableDasheds = if any isLong settingDasheds then filter isLong settingDasheds else settingDasheds
let suggestions = filter (arg `isPrefixOf`) (map Args.renderDashed favorableDasheds)
let completions =
map
( ( \completionSuggestion ->
Completion {..}
)
. SuggestionBare
)
suggestions
pure $ Just completions
if settingHidden
then pure $ Just []
else do
as <- get
if settingTryArgument
then do
case Args.consumeArgument as of
[] -> completeWithCompleterAtEnd
-- TODO in theory we really need to try all possible consumptions of an argument.
-- This would complicate this function quite a bit, so we
-- just try the first option and leave it there for now.
(mConsumed, as') : _ -> do
put as'
case mConsumed of
Nothing -> completeWithCompleterAtEnd
Just _ -> pure $ Just []
else
if isJust settingSwitchValue
then do
-- Try to parse the switch first, so we don't suggest it if
-- it's already been parsed.
case Args.consumeSwitch settingDasheds as of
Nothing ->
-- A switch can be anywhere, doesn't need to be at the end.
completeWithDasheds
Just as' -> do
put as'
pure $ Just []
else do
if settingTryOption
then do
-- First we try to consume the option so we don't suggest it if it's already been parsed
case Args.consumeOption settingDasheds as of
Just (_, as') -> do
put as'
pure $ Just []
Nothing -> do
if argsAtEnd as
then completeWithDasheds
else do
-- If we're not at the end, we may be between an option's
-- dashed an the option value being tab-completed In that case
-- we need to parse the dashed as normal and check if that
-- brings us to the end.
--
-- We use 'consumeSwitch' to consume the dashed part of
-- the option because consumeOption would try to
-- consume the option argument too.
case Args.consumeSwitch settingDasheds as of
Nothing -> pure $ Just []
Just as' -> do
put as'
completeWithCompleterAtEnd
else do
-- We can't auto-complete settings parsed from env vars
-- or config values, but this path is still valid.
--
-- TODO consider checking if env vars or config vals
-- are parsed, then this path may still be invalid
-- afteral.
pure $ Just []