{-# 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 :: Path Abs File -> String -> IO ()
generateBashCompletionScript Path Abs File
progPath String
progname = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String -> String
bashCompletionScript Path Abs File
progPath String
progname

-- | Generated bash shell completion script
bashCompletionScript :: Path Abs File -> String -> String
bashCompletionScript :: Path Abs File -> String -> String
bashCompletionScript Path Abs File
progPath String
progname =
  let functionName :: String
functionName = String -> String
progNameToFunctionName String
progname
   in [String] -> String
unlines
        [ String
functionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()",
          String
"{",
          String
"    local CMDLINE",
          String
"    local IFS=$'\\n'",
          String
"    CMDLINE=(--query-opt-env-conf-completion)",
          String
"    CMDLINE+=(--completion-index $COMP_CWORD)",
          String
"",
          String
"    for arg in ${COMP_WORDS[@]}; do",
          String
"        CMDLINE=(${CMDLINE[@]} --completion-word $arg)",
          String
"    done",
          String
"",
          String
"    COMPREPLY=( $(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path Abs File -> String
fromAbsFile Path Abs File
progPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" \"${CMDLINE[@]}\") )",
          String
"}",
          String
"",
          String
"complete -o filenames -F " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
functionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
progname
        ]

generateZshCompletionScript :: Path Abs File -> String -> IO ()
generateZshCompletionScript :: Path Abs File -> String -> IO ()
generateZshCompletionScript Path Abs File
progPath String
progname = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String -> String
zshCompletionScript Path Abs File
progPath String
progname

-- | Generated zsh shell completion script
zshCompletionScript :: Path Abs File -> String -> String
zshCompletionScript :: Path Abs File -> String -> String
zshCompletionScript Path Abs File
progPath String
progname =
  [String] -> String
unlines
    [ String
"#compdef " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
progname,
      String
"",
      String
"local request",
      String
"local completions",
      String
"local word",
      String
"local index=$((CURRENT - 1))",
      String
"",
      String
"request=(--query-opt-env-conf-completion --completion-enriched --completion-index $index)",
      String
"for arg in ${words[@]}; do",
      String
"  request=(${request[@]} --completion-word $arg)",
      String
"done",
      String
"",
      String
"IFS=$'\\n' completions=($( " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path Abs File -> String
fromAbsFile Path Abs File
progPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" \"${request[@]}\" ))",
      String
"",
      String
"for word in $completions; do",
      String
"  local -a parts",
      String
"",
      String
"  # Split the line at a tab if there is one.",
      String
"  IFS=$'\\t' parts=($( echo $word ))",
      String
"",
      String
"  if [[ -n $parts[2] ]]; then",
      String
"     if [[ $word[1] == \"-\" ]]; then",
      String
"       local desc=(\"$parts[1] ($parts[2])\")",
      String
"       compadd -d desc -- $parts[1]",
      String
"     else",
      String
"       local desc=($(print -f  \"%-019s -- %s\" $parts[1] $parts[2]))",
      String
"       compadd -l -d desc -- $parts[1]",
      String
"     fi",
      String
"  else",
      String
"    compadd -f -- $word",
      String
"  fi",
      String
"done"
    ]

generateFishCompletionScript :: Path Abs File -> String -> IO ()
generateFishCompletionScript :: Path Abs File -> String -> IO ()
generateFishCompletionScript Path Abs File
progPath String
progname = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String -> String
fishCompletionScript Path Abs File
progPath String
progname

-- | Generated fish shell completion script
fishCompletionScript :: Path Abs File -> String -> String
fishCompletionScript :: Path Abs File -> String -> String
fishCompletionScript Path Abs File
progPath String
progname =
  let functionName :: String
functionName = String -> String
progNameToFunctionName String
progname
   in [String] -> String
unlines
        [ String
" function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
functionName,
          String
"    set -l cl (commandline --tokenize --current-process)",
          String
"    # Hack around fish issue #3934",
          String
"    set -l cn (commandline --tokenize --cut-at-cursor --current-process)",
          String
"    set -l cn (count $cn)",
          String
"    set -l tmpline --query-opt-env-conf-completion --completion-enriched --completion-index $cn",
          String
"    for arg in $cl",
          String
"      set tmpline $tmpline --completion-word $arg",
          String
"    end",
          String
"    for opt in (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path Abs File -> String
fromAbsFile Path Abs File
progPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" $tmpline)",
          String
"      if test -d $opt",
          String
"        echo -E \"$opt/\"",
          String
"      else",
          String
"        echo -E \"$opt\"",
          String
"      end",
          String
"    end",
          String
"end",
          String
"",
          String
"complete --no-files --command " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path Abs File -> String
fromAbsFile Path Abs File
progPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --arguments '(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
functionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")'"
        ]

-- This should be a name that a normal user would never want to define themselves.
progNameToFunctionName :: String -> String
progNameToFunctionName :: String -> String
progNameToFunctionName String
progname = String
"_opt_env_conf_completion_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
toShellFunctionCase String
progname

runCompletionQuery ::
  Parser a ->
  -- | Enriched
  Bool ->
  -- | Where completion is invoked (inbetween arguments)
  Int ->
  -- Provider arguments
  [String] ->
  IO ()
runCompletionQuery :: forall a. Parser a -> Bool -> Int -> [String] -> IO ()
runCompletionQuery Parser a
parser Bool
enriched Int
index' [String]
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 :: Int
index = Int -> Int
forall a. Enum a => a -> a
pred Int
index'
  let ws :: [String]
ws = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
ws'
  let arg :: String
arg = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
index [String]
ws
  let completions :: [Completion Suggestion]
completions = Parser a -> Int -> [String] -> [Completion Suggestion]
forall a. Parser a -> Int -> [String] -> [Completion Suggestion]
pureCompletionQuery Parser a
parser Int
index [String]
ws
  [Completion String]
evaluatedCompletions <- String -> [Completion Suggestion] -> IO [Completion String]
evalCompletions String
arg [Completion Suggestion]
completions
  -- You can use this for debugging inputs:
  -- import System.IO
  -- hPutStrLn stderr $ show (enriched, index, ws)
  -- hPutStrLn stderr $ show evaluatedCompletions
  if Bool
enriched
    then
      String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
          (Completion String -> String) -> [Completion String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \Completion {String
Maybe String
completionSuggestion :: String
completionDescription :: Maybe String
completionSuggestion :: forall a. Completion a -> a
completionDescription :: forall a. Completion a -> Maybe String
..} -> case Maybe String
completionDescription of
                Maybe String
Nothing -> String
completionSuggestion
                Just String
d -> String
completionSuggestion String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
d
            )
            [Completion String]
evaluatedCompletions
    else String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Completion String -> String) -> [Completion String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Completion String -> String
forall a. Completion a -> a
completionSuggestion [Completion String]
evaluatedCompletions
  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: Int -> [String] -> (Args, Maybe String)
selectArgs Int
ix [String]
args =
  ( [String] -> Args
parseArgs ([String] -> Args) -> [String] -> Args
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
ix [String]
args,
    NonEmpty String -> String
forall a. NonEmpty a -> a
NE.head (NonEmpty String -> String)
-> Maybe (NonEmpty String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
ix [String]
args)
  )

data Completion a = Completion
  { -- | Completion
    forall a. Completion a -> a
completionSuggestion :: !a,
    -- | Description
    forall a. Completion a -> Maybe String
completionDescription :: !(Maybe String)
  }
  deriving (Int -> Completion a -> String -> String
[Completion a] -> String -> String
Completion a -> String
(Int -> Completion a -> String -> String)
-> (Completion a -> String)
-> ([Completion a] -> String -> String)
-> Show (Completion a)
forall a. Show a => Int -> Completion a -> String -> String
forall a. Show a => [Completion a] -> String -> String
forall a. Show a => Completion a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Completion a -> String -> String
showsPrec :: Int -> Completion a -> String -> String
$cshow :: forall a. Show a => Completion a -> String
show :: Completion a -> String
$cshowList :: forall a. Show a => [Completion a] -> String -> String
showList :: [Completion a] -> String -> String
Show, Completion a -> Completion a -> Bool
(Completion a -> Completion a -> Bool)
-> (Completion a -> Completion a -> Bool) -> Eq (Completion a)
forall a. Eq a => Completion a -> Completion a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Completion a -> Completion a -> Bool
== :: Completion a -> Completion a -> Bool
$c/= :: forall a. Eq a => Completion a -> Completion a -> Bool
/= :: Completion a -> Completion a -> Bool
Eq, Eq (Completion a)
Eq (Completion a) =>
(Completion a -> Completion a -> Ordering)
-> (Completion a -> Completion a -> Bool)
-> (Completion a -> Completion a -> Bool)
-> (Completion a -> Completion a -> Bool)
-> (Completion a -> Completion a -> Bool)
-> (Completion a -> Completion a -> Completion a)
-> (Completion a -> Completion a -> Completion a)
-> Ord (Completion a)
Completion a -> Completion a -> Bool
Completion a -> Completion a -> Ordering
Completion a -> Completion a -> Completion a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Completion a)
forall a. Ord a => Completion a -> Completion a -> Bool
forall a. Ord a => Completion a -> Completion a -> Ordering
forall a. Ord a => Completion a -> Completion a -> Completion a
$ccompare :: forall a. Ord a => Completion a -> Completion a -> Ordering
compare :: Completion a -> Completion a -> Ordering
$c< :: forall a. Ord a => Completion a -> Completion a -> Bool
< :: Completion a -> Completion a -> Bool
$c<= :: forall a. Ord a => Completion a -> Completion a -> Bool
<= :: Completion a -> Completion a -> Bool
$c> :: forall a. Ord a => Completion a -> Completion a -> Bool
> :: Completion a -> Completion a -> Bool
$c>= :: forall a. Ord a => Completion a -> Completion a -> Bool
>= :: Completion a -> Completion a -> Bool
$cmax :: forall a. Ord a => Completion a -> Completion a -> Completion a
max :: Completion a -> Completion a -> Completion a
$cmin :: forall a. Ord a => Completion a -> Completion a -> Completion a
min :: Completion a -> Completion a -> Completion a
Ord)

instance (IsString str) => IsString (Completion str) where
  fromString :: String -> Completion str
fromString String
s =
    Completion
      { completionSuggestion :: str
completionSuggestion = String -> str
forall a. IsString a => String -> a
fromString String
s,
        completionDescription :: Maybe String
completionDescription = Maybe String
forall a. Maybe a
Nothing
      }

evalCompletions :: String -> [Completion Suggestion] -> IO [Completion String]
evalCompletions :: String -> [Completion Suggestion] -> IO [Completion String]
evalCompletions String
arg = ([[Completion String]] -> [Completion String])
-> IO [[Completion String]] -> IO [Completion String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Completion String]] -> [Completion String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[Completion String]] -> IO [Completion String])
-> ([Completion Suggestion] -> IO [[Completion String]])
-> [Completion Suggestion]
-> IO [Completion String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Completion Suggestion -> IO [Completion String])
-> [Completion Suggestion] -> IO [[Completion String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> Completion Suggestion -> IO [Completion String]
evalCompletion String
arg)

evalCompletion :: String -> Completion Suggestion -> IO [Completion String]
evalCompletion :: String -> Completion Suggestion -> IO [Completion String]
evalCompletion String
arg Completion Suggestion
c = do
  [String]
ss <- String -> Suggestion -> IO [String]
evalSuggestion String
arg (Completion Suggestion -> Suggestion
forall a. Completion a -> a
completionSuggestion Completion Suggestion
c)
  [Completion String] -> IO [Completion String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion String] -> IO [Completion String])
-> [Completion String] -> IO [Completion String]
forall a b. (a -> b) -> a -> b
$ (String -> Completion String) -> [String] -> [Completion String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> Completion Suggestion
c {completionSuggestion = s}) [String]
ss

data Suggestion
  = SuggestionBare !String
  | SuggestionCompleter !Completer

-- For tidier tests
instance IsString Suggestion where
  fromString :: String -> Suggestion
fromString = String -> Suggestion
SuggestionBare

evalSuggestion :: String -> Suggestion -> IO [String]
evalSuggestion :: String -> Suggestion -> IO [String]
evalSuggestion String
arg = \case
  SuggestionBare String
s -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
arg String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String
s]
  SuggestionCompleter (Completer String -> IO [String]
act) -> String -> IO [String]
act String
arg

pureCompletionQuery :: Parser a -> Int -> [String] -> [Completion Suggestion]
pureCompletionQuery :: forall a. Parser a -> Int -> [String] -> [Completion Suggestion]
pureCompletionQuery Parser a
parser Int
ix [String]
args =
  [Completion Suggestion]
-> Maybe [Completion Suggestion] -> [Completion Suggestion]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Completion Suggestion] -> [Completion Suggestion])
-> Maybe [Completion Suggestion] -> [Completion Suggestion]
forall a b. (a -> b) -> a -> b
$ State Args (Maybe [Completion Suggestion])
-> Args -> Maybe [Completion Suggestion]
forall s a. State s a -> s -> a
evalState (Parser a -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser a
parser) Args
selectedArgs
  where
    (Args
selectedArgs, Maybe String
mCursorArg) = Int -> [String] -> (Args, Maybe String)
selectArgs Int
ix [String]
args
    goCommand :: Command a -> State Args (Maybe [Completion Suggestion])
    goCommand :: forall a. Command a -> State Args (Maybe [Completion Suggestion])
goCommand = Parser a -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go (Parser a -> State Args (Maybe [Completion Suggestion]))
-> (Command a -> Parser a)
-> Command a
-> State Args (Maybe [Completion Suggestion])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command a -> Parser a
forall a. Command a -> Parser a
commandParser -- TODO complete with the command
    combineOptions :: [Maybe [a]] -> Maybe [a]
combineOptions = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a])
-> ([Maybe [a]] -> [a]) -> [Maybe [a]] -> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([Maybe [a]] -> [[a]]) -> [Maybe [a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [a]] -> [[a]]
forall a. [Maybe a] -> [a]
catMaybes

    tryOrRestore :: State Args (Maybe a) -> State Args (Maybe a)
    tryOrRestore :: forall a. State Args (Maybe a) -> State Args (Maybe a)
tryOrRestore State Args (Maybe a)
func = do
      Args
before <- StateT Args Identity Args
forall s (m :: * -> *). MonadState s m => m s
get
      Maybe a
mA <- State Args (Maybe a)
func
      case Maybe a
mA of
        Maybe a
Nothing -> do
          Args -> StateT Args Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Args
before
          Maybe a -> State Args (Maybe a)
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Just a
a -> Maybe a -> State Args (Maybe a)
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

    orCompletions :: Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
    orCompletions :: forall x y.
Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
orCompletions Parser x
p1 Parser y
p2 = do
      Maybe [Completion Suggestion]
p1s <- State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a. State Args (Maybe a) -> State Args (Maybe a)
tryOrRestore (State Args (Maybe [Completion Suggestion])
 -> State Args (Maybe [Completion Suggestion]))
-> State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ Parser x -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser x
p1
      Maybe [Completion Suggestion]
p2s <- State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a. State Args (Maybe a) -> State Args (Maybe a)
tryOrRestore (State Args (Maybe [Completion Suggestion])
 -> State Args (Maybe [Completion Suggestion]))
-> State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ Parser y -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser y
p2
      Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ case (Maybe [Completion Suggestion]
p1s, Maybe [Completion Suggestion]
p2s) of
        (Maybe [Completion Suggestion]
Nothing, Maybe [Completion Suggestion]
Nothing) -> Maybe [Completion Suggestion]
forall a. Maybe a
Nothing
        (Just [Completion Suggestion]
cs, Maybe [Completion Suggestion]
Nothing) -> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just [Completion Suggestion]
cs
        (Maybe [Completion Suggestion]
Nothing, Just [Completion Suggestion]
cs) -> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just [Completion Suggestion]
cs
        (Just [Completion Suggestion]
cs1, Just [Completion Suggestion]
cs2) -> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just ([Completion Suggestion] -> Maybe [Completion Suggestion])
-> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion]
cs1 [Completion Suggestion]
-> [Completion Suggestion] -> [Completion Suggestion]
forall a. [a] -> [a] -> [a]
++ [Completion Suggestion]
cs2

    andCompletions :: Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
    andCompletions :: forall x y.
Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
andCompletions Parser x
p1 Parser y
p2 = do
      Maybe [Completion Suggestion]
p1s <- State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a. State Args (Maybe a) -> State Args (Maybe a)
tryOrRestore (State Args (Maybe [Completion Suggestion])
 -> State Args (Maybe [Completion Suggestion]))
-> State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ Parser x -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser x
p1
      case Maybe [Completion Suggestion]
p1s of
        Maybe [Completion Suggestion]
Nothing -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion Suggestion]
forall a. Maybe a
Nothing
        Just [Completion Suggestion]
cs1 -> do
          Maybe [Completion Suggestion]
p2s <- State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a. State Args (Maybe a) -> State Args (Maybe a)
tryOrRestore (State Args (Maybe [Completion Suggestion])
 -> State Args (Maybe [Completion Suggestion]))
-> State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ Parser y -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser y
p2
          Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ case Maybe [Completion Suggestion]
p2s of
            Maybe [Completion Suggestion]
Nothing -> Maybe [Completion Suggestion]
forall a. Maybe a
Nothing
            Just [Completion Suggestion]
cs2 -> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion Suggestion] -> Maybe [Completion Suggestion])
-> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion]
cs1 [Completion Suggestion]
-> [Completion Suggestion] -> [Completion Suggestion]
forall a. [a] -> [a] -> [a]
++ [Completion Suggestion]
cs2

    -- Nothing means "this branch was not valid"
    -- Just [] means "no completions"
    go :: Parser a -> State Args (Maybe [Completion Suggestion])
    go :: forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go = \case
      ParserPure a
_ -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []
      -- Parse both and combine the result
      ParserAp Parser (a1 -> a)
p1 Parser a1
p2 -> Parser (a1 -> a)
-> Parser a1 -> State Args (Maybe [Completion Suggestion])
forall x y.
Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
andCompletions Parser (a1 -> a)
p1 Parser a1
p2
      -- Parse either: either completions are valid
      ParserAlt Parser a
p1 Parser a
p2 -> Parser a -> Parser a -> State Args (Maybe [Completion Suggestion])
forall x y.
Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
orCompletions Parser a
p1 Parser a
p2
      ParserSelect Parser (Either a1 a)
p1 Parser (a1 -> a)
p2 -> Parser (Either a1 a)
-> Parser (a1 -> a) -> State Args (Maybe [Completion Suggestion])
forall x y.
Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
andCompletions Parser (Either a1 a)
p1 Parser (a1 -> a)
p2
      ParserEmpty Maybe SrcLoc
_ -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion Suggestion]
forall a. Maybe a
Nothing
      ParserMany Parser a1
p -> do
        Maybe [Completion Suggestion]
mR <- Parser a1 -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser a1
p
        case Maybe [Completion Suggestion]
mR of
          Maybe [Completion Suggestion]
Nothing -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion Suggestion]
forall a. Maybe a
Nothing
          Just [Completion Suggestion]
os -> ([Completion Suggestion] -> [Completion Suggestion])
-> Maybe [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Completion Suggestion]
os [Completion Suggestion]
-> [Completion Suggestion] -> [Completion Suggestion]
forall a. [a] -> [a] -> [a]
++) (Maybe [Completion Suggestion] -> Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a1 -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser a1
p
      ParserSome Parser a1
p -> do
        Maybe [Completion Suggestion]
mR <- Parser a1 -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser a1
p
        case Maybe [Completion Suggestion]
mR of
          Maybe [Completion Suggestion]
Nothing -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion Suggestion]
forall a. Maybe a
Nothing
          Just [Completion Suggestion]
os -> ([Completion Suggestion] -> [Completion Suggestion])
-> Maybe [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Completion Suggestion]
os [Completion Suggestion]
-> [Completion Suggestion] -> [Completion Suggestion]
forall a. [a] -> [a] -> [a]
++) (Maybe [Completion Suggestion] -> Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
-> State Args (Maybe [Completion Suggestion])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a1 -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser a1
p
      ParserAllOrNothing Maybe SrcLoc
_ Parser a
p -> Parser a -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser a
p
      ParserCheck Maybe SrcLoc
_ Bool
_ a1 -> IO (Either String a)
_ Parser a1
p -> Parser a1 -> State Args (Maybe [Completion Suggestion])
forall a. Parser a -> State Args (Maybe [Completion Suggestion])
go Parser a1
p
      ParserWithConfig Maybe SrcLoc
_ Parser (Maybe Object)
p1 Parser a
p2 ->
        -- The config-file auto-completion is probably less important, we put it second.
        Parser a
-> Parser (Maybe Object)
-> State Args (Maybe [Completion Suggestion])
forall x y.
Parser x -> Parser y -> State Args (Maybe [Completion Suggestion])
andCompletions Parser a
p2 Parser (Maybe Object)
p1
      ParserCommands Maybe SrcLoc
_ Maybe String
_ [Command a]
cs -> do
        Args
as <- StateT Args Identity Args
forall s (m :: * -> *). MonadState s m => m s
get
        let possibilities :: [(Maybe String, Args)]
possibilities = Args -> [(Maybe String, Args)]
Args.consumeArgument Args
as
        ([Maybe [Completion Suggestion]] -> Maybe [Completion Suggestion])
-> StateT Args Identity [Maybe [Completion Suggestion]]
-> State Args (Maybe [Completion Suggestion])
forall a b.
(a -> b) -> StateT Args Identity a -> StateT Args Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe [Completion Suggestion]] -> Maybe [Completion Suggestion]
forall {a}. [Maybe [a]] -> Maybe [a]
combineOptions (StateT Args Identity [Maybe [Completion Suggestion]]
 -> State Args (Maybe [Completion Suggestion]))
-> StateT Args Identity [Maybe [Completion Suggestion]]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [(Maybe String, Args)]
-> ((Maybe String, Args)
    -> State Args (Maybe [Completion Suggestion]))
-> StateT Args Identity [Maybe [Completion Suggestion]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Maybe String, Args)]
possibilities (((Maybe String, Args)
  -> State Args (Maybe [Completion Suggestion]))
 -> StateT Args Identity [Maybe [Completion Suggestion]])
-> ((Maybe String, Args)
    -> State Args (Maybe [Completion Suggestion]))
-> StateT Args Identity [Maybe [Completion Suggestion]]
forall a b. (a -> b) -> a -> b
$ \(Maybe String
mArg, Args
rest) -> do
          case Maybe String
mArg of
            Maybe String
Nothing -> do
              if Args -> Bool
argsAtEnd Args
rest
                then do
                  let arg :: String
arg = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mCursorArg
                  let matchingCommands :: [Command a]
matchingCommands = (Command a -> Bool) -> [Command a] -> [Command a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
arg String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (String -> Bool) -> (Command a -> String) -> Command a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command a -> String
forall a. Command a -> String
commandArg) [Command a]
cs
                  Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$
                    [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just ([Completion Suggestion] -> Maybe [Completion Suggestion])
-> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a b. (a -> b) -> a -> b
$
                      (Command a -> Completion Suggestion)
-> [Command a] -> [Completion Suggestion]
forall a b. (a -> b) -> [a] -> [b]
map
                        ( \Command {String
Maybe SrcLoc
Parser a
commandParser :: forall a. Command a -> Parser a
commandArg :: forall a. Command a -> String
commandSrcLoc :: Maybe SrcLoc
commandArg :: String
commandHelp :: String
commandParser :: Parser a
commandSrcLoc :: forall a. Command a -> Maybe SrcLoc
commandHelp :: forall a. Command a -> String
..} ->
                            Completion
                              { completionSuggestion :: Suggestion
completionSuggestion = String -> Suggestion
SuggestionBare String
commandArg,
                                completionDescription :: Maybe String
completionDescription = String -> Maybe String
forall a. a -> Maybe a
Just String
commandHelp
                              }
                        )
                        [Command a]
matchingCommands
                else Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion Suggestion]
forall a. Maybe a
Nothing -- TODO: What does this mean?
            Just String
arg ->
              case (Command a -> Bool) -> [Command a] -> Maybe (Command a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
arg) (String -> Bool) -> (Command a -> String) -> Command a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command a -> String
forall a. Command a -> String
commandArg) [Command a]
cs of
                Just Command a
c -> do
                  Args -> StateT Args Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Args
rest
                  Command a -> State Args (Maybe [Completion Suggestion])
forall a. Command a -> State Args (Maybe [Completion Suggestion])
goCommand Command a
c
                Maybe (Command a)
Nothing -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion Suggestion]
forall a. Maybe a
Nothing -- Invalid command
      ParserSetting Maybe SrcLoc
_ Setting {Bool
[String]
[Dashed]
[Reader a]
Maybe a
Maybe String
Maybe (NonEmpty String)
Maybe (NonEmpty (ConfigValSetting a))
Maybe (a, String)
Maybe Completer
settingDasheds :: [Dashed]
settingReaders :: [Reader a]
settingTryArgument :: Bool
settingSwitchValue :: Maybe a
settingTryOption :: Bool
settingEnvVars :: Maybe (NonEmpty String)
settingConfigVals :: Maybe (NonEmpty (ConfigValSetting a))
settingDefaultValue :: Maybe (a, String)
settingExamples :: [String]
settingHidden :: Bool
settingMetavar :: Maybe String
settingHelp :: Maybe String
settingCompleter :: Maybe Completer
settingDasheds :: forall a. Setting a -> [Dashed]
settingReaders :: forall a. Setting a -> [Reader a]
settingTryArgument :: forall a. Setting a -> Bool
settingSwitchValue :: forall a. Setting a -> Maybe a
settingTryOption :: forall a. Setting a -> Bool
settingEnvVars :: forall a. Setting a -> Maybe (NonEmpty String)
settingConfigVals :: forall a. Setting a -> Maybe (NonEmpty (ConfigValSetting a))
settingDefaultValue :: forall a. Setting a -> Maybe (a, String)
settingExamples :: forall a. Setting a -> [String]
settingHidden :: forall a. Setting a -> Bool
settingMetavar :: forall a. Setting a -> Maybe String
settingHelp :: forall a. Setting a -> Maybe String
settingCompleter :: forall a. Setting a -> Maybe Completer
..} -> do
        let arg :: String
arg = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mCursorArg
        let completionDescription :: Maybe String
completionDescription = Maybe String
settingHelp
        let completeWithCompleter :: State Args (Maybe [Completion Suggestion])
completeWithCompleter = Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just ([Completion Suggestion] -> Maybe [Completion Suggestion])
-> [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a b. (a -> b) -> a -> b
$ Maybe (Completion Suggestion) -> [Completion Suggestion]
forall a. Maybe a -> [a]
maybeToList (Maybe (Completion Suggestion) -> [Completion Suggestion])
-> Maybe (Completion Suggestion) -> [Completion Suggestion]
forall a b. (a -> b) -> a -> b
$ do
              Completer
c <- Maybe Completer
settingCompleter
              let completionSuggestion :: Suggestion
completionSuggestion = Completer -> Suggestion
SuggestionCompleter Completer
c
              Completion Suggestion -> Maybe (Completion Suggestion)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Completion {Maybe String
Suggestion
completionSuggestion :: Suggestion
completionDescription :: Maybe String
completionDescription :: Maybe String
completionSuggestion :: Suggestion
..}
        let completeWithCompleterAtEnd :: State Args (Maybe [Completion Suggestion])
completeWithCompleterAtEnd = do
              Args
as <- StateT Args Identity Args
forall s (m :: * -> *). MonadState s m => m s
get
              if Args -> Bool
argsAtEnd Args
as then State Args (Maybe [Completion Suggestion])
completeWithCompleter else Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []
        let completeWithDasheds :: State Args (Maybe [Completion Suggestion])
completeWithDasheds = do
              let isLong :: Dashed -> Bool
isLong = \case
                    DashedLong NonEmpty Char
_ -> Bool
True
                    DashedShort Char
_ -> Bool
False
              let favorableDasheds :: [Dashed]
favorableDasheds = if (Dashed -> Bool) -> [Dashed] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Dashed -> Bool
isLong [Dashed]
settingDasheds then (Dashed -> Bool) -> [Dashed] -> [Dashed]
forall a. (a -> Bool) -> [a] -> [a]
filter Dashed -> Bool
isLong [Dashed]
settingDasheds else [Dashed]
settingDasheds
              let suggestions :: [String]
suggestions = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
arg String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ((Dashed -> String) -> [Dashed] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dashed -> String
Args.renderDashed [Dashed]
favorableDasheds)
              let completions :: [Completion Suggestion]
completions =
                    (String -> Completion Suggestion)
-> [String] -> [Completion Suggestion]
forall a b. (a -> b) -> [a] -> [b]
map
                      ( ( \Suggestion
completionSuggestion ->
                            Completion {Maybe String
Suggestion
completionSuggestion :: Suggestion
completionDescription :: Maybe String
completionDescription :: Maybe String
completionSuggestion :: Suggestion
..}
                        )
                          (Suggestion -> Completion Suggestion)
-> (String -> Suggestion) -> String -> Completion Suggestion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Suggestion
SuggestionBare
                      )
                      [String]
suggestions
              Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just [Completion Suggestion]
completions
        if Bool
settingHidden
          then Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []
          else do
            Args
as <- StateT Args Identity Args
forall s (m :: * -> *). MonadState s m => m s
get
            if Bool
settingTryArgument
              then do
                case Args -> [(Maybe String, Args)]
Args.consumeArgument Args
as of
                  [] -> State Args (Maybe [Completion Suggestion])
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.
                  (Maybe String
mConsumed, Args
as') : [(Maybe String, Args)]
_ -> do
                    Args -> StateT Args Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Args
as'
                    case Maybe String
mConsumed of
                      Maybe String
Nothing -> State Args (Maybe [Completion Suggestion])
completeWithCompleterAtEnd
                      Just String
_ -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []
              else
                if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
settingSwitchValue
                  then do
                    -- Try to parse the switch first, so we don't suggest it if
                    -- it's already been parsed.
                    case [Dashed] -> Args -> Maybe Args
Args.consumeSwitch [Dashed]
settingDasheds Args
as of
                      Maybe Args
Nothing ->
                        -- A switch can be anywhere, doesn't need to be at the end.
                        State Args (Maybe [Completion Suggestion])
completeWithDasheds
                      Just Args
as' -> do
                        Args -> StateT Args Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Args
as'
                        Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []
                  else do
                    if Bool
settingTryOption
                      then do
                        -- First we try to consume the option so we don't suggest it if it's already been parsed
                        case [Dashed] -> Args -> Maybe (String, Args)
Args.consumeOption [Dashed]
settingDasheds Args
as of
                          Just (String
_, Args
as') -> do
                            Args -> StateT Args Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Args
as'
                            Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []
                          Maybe (String, Args)
Nothing -> do
                            if Args -> Bool
argsAtEnd Args
as
                              then State Args (Maybe [Completion Suggestion])
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 [Dashed] -> Args -> Maybe Args
Args.consumeSwitch [Dashed]
settingDasheds Args
as of
                                  Maybe Args
Nothing -> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []
                                  Just Args
as' -> do
                                    Args -> StateT Args Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Args
as'
                                    State Args (Maybe [Completion Suggestion])
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.
                        Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion Suggestion]
 -> State Args (Maybe [Completion Suggestion]))
-> Maybe [Completion Suggestion]
-> State Args (Maybe [Completion Suggestion])
forall a b. (a -> b) -> a -> b
$ [Completion Suggestion] -> Maybe [Completion Suggestion]
forall a. a -> Maybe a
Just []