{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

module OptEnvConf.Completion
  ( generateBashCompletionScript,
    bashCompletionScript,
    generateZshCompletionScript,
    zshCompletionScript,
    generateFishCompletionScript,
    fishCompletionScript,
    runCompletionQuery,
    pureCompletionQuery,
    Completion (..),
  )
where

import Control.Monad.State
import Data.List
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import OptEnvConf.Args as Args
import OptEnvConf.Casing
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
"    echo \"${COMPREPLY[@]}\" > hm.log",
          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
  let completions :: [Completion]
completions = Parser a -> Int -> [String] -> [Completion]
forall a. Parser a -> Int -> [String] -> [Completion]
pureCompletionQuery Parser a
parser Int
index [String]
ws
  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) -> [Completion] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \Completion {String
Maybe String
completionSuggestion :: String
completionDescription :: Maybe String
completionSuggestion :: Completion -> String
completionDescription :: Completion -> 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]
completions
    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) -> [Completion] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Completion -> String
completionSuggestion [Completion]
completions
  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

selectArgs :: Int -> [String] -> (Args, Maybe String)
selectArgs :: Int -> [String] -> (Args, Maybe String)
selectArgs Int
_ix [String]
args =
  let selectedArgs :: [String]
selectedArgs = [String]
args -- take ix args
   in ([String] -> Args
parseArgs [String]
selectedArgs, NonEmpty String -> String
forall a. NonEmpty a -> a
NE.last (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 [String]
selectedArgs)

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

pureCompletionQuery :: Parser a -> Int -> [String] -> [Completion]
pureCompletionQuery :: forall a. Parser a -> Int -> [String] -> [Completion]
pureCompletionQuery Parser a
parser Int
ix [String]
args =
  -- TODO use the index properly (?)
  [Completion] -> Maybe [Completion] -> [Completion]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Completion] -> [Completion])
-> Maybe [Completion] -> [Completion]
forall a b. (a -> b) -> a -> b
$ State Args (Maybe [Completion]) -> Args -> Maybe [Completion]
forall s a. State s a -> s -> a
evalState (Parser a -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
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])
    goCommand :: forall a. Command a -> State Args (Maybe [Completion])
goCommand = Parser a -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go (Parser a -> State Args (Maybe [Completion]))
-> (Command a -> Parser a)
-> Command a
-> State Args (Maybe [Completion])
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
    -- Nothing means "this branch was not valid"
    -- Just means "no completions"
    go :: Parser a -> State Args (Maybe [Completion])
    go :: forall a. Parser a -> State Args (Maybe [Completion])
go = \case
      ParserPure a
_ -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just []
      ParserAp Parser (a1 -> a)
p1 Parser a1
p2 -> do
        Maybe [Completion]
c1 <- Parser (a1 -> a) -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser (a1 -> a)
p1
        case Maybe [Completion]
c1 of
          Just [] -> Parser a1 -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a1
p2
          Just [Completion]
ss -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just [Completion]
ss
          Maybe [Completion]
Nothing -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just []
      ParserAlt Parser a
p1 Parser a
p2 -> do
        Maybe [Completion]
s1s <- Parser a -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a
p1
        Maybe [Completion]
s2s <- Parser a -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a
p2
        Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> [Completion] -> [Completion]
forall a. [a] -> [a] -> [a]
(++) ([Completion] -> [Completion] -> [Completion])
-> Maybe [Completion] -> Maybe ([Completion] -> [Completion])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Completion]
s1s Maybe ([Completion] -> [Completion])
-> Maybe [Completion] -> Maybe [Completion]
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Completion]
s2s
      ParserSelect Parser (Either a1 a)
p1 Parser (a1 -> a)
p2 -> do
        Maybe [Completion]
c1 <- Parser (Either a1 a) -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser (Either a1 a)
p1
        case Maybe [Completion]
c1 of
          Just [] -> Parser (a1 -> a) -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser (a1 -> a)
p2
          Just [Completion]
ss -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just [Completion]
ss
          Maybe [Completion]
Nothing -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just []
      ParserEmpty Maybe SrcLoc
_ -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion]
forall a. Maybe a
Nothing
      ParserMany Parser a1
p -> do
        Maybe [Completion]
mR <- Parser a1 -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a1
p
        case Maybe [Completion]
mR of
          Maybe [Completion]
Nothing -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion]
forall a. Maybe a
Nothing
          Just [Completion]
os -> ([Completion] -> [Completion])
-> Maybe [Completion] -> Maybe [Completion]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Completion]
os [Completion] -> [Completion] -> [Completion]
forall a. [a] -> [a] -> [a]
++) (Maybe [Completion] -> Maybe [Completion])
-> State Args (Maybe [Completion])
-> State Args (Maybe [Completion])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a1 -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a1
p
      ParserSome Parser a1
p -> do
        Maybe [Completion]
mR <- Parser a1 -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a1
p
        case Maybe [Completion]
mR of
          Maybe [Completion]
Nothing -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Completion]
forall a. Maybe a
Nothing
          Just [Completion]
os -> ([Completion] -> [Completion])
-> Maybe [Completion] -> Maybe [Completion]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Completion]
os [Completion] -> [Completion] -> [Completion]
forall a. [a] -> [a] -> [a]
++) (Maybe [Completion] -> Maybe [Completion])
-> State Args (Maybe [Completion])
-> State Args (Maybe [Completion])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a1 -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a1
p
      ParserAllOrNothing Maybe SrcLoc
_ Parser a
p -> Parser a -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a
p
      ParserCheck Maybe SrcLoc
_ Bool
_ a1 -> IO (Either String a)
_ Parser a1
p -> Parser a1 -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a1
p
      ParserCommands Maybe SrcLoc
_ Maybe String
_ [Command a]
cs -> do
        -- Don't re-use the state accross commands
        [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just ([Completion] -> Maybe [Completion])
-> ([Maybe [Completion]] -> [Completion])
-> [Maybe [Completion]]
-> Maybe [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Completion]] -> [Completion]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Completion]] -> [Completion])
-> ([Maybe [Completion]] -> [[Completion]])
-> [Maybe [Completion]]
-> [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Completion]] -> [[Completion]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Completion]] -> Maybe [Completion])
-> StateT Args Identity [Maybe [Completion]]
-> State Args (Maybe [Completion])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Command a -> State Args (Maybe [Completion]))
-> [Command a] -> StateT Args Identity [Maybe [Completion]]
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 Command a -> State Args (Maybe [Completion])
forall a. Command a -> State Args (Maybe [Completion])
goCommand [Command a]
cs
      ParserWithConfig Maybe SrcLoc
_ Parser (Maybe Object)
p1 Parser a
p2 -> do
        Maybe [Completion]
c1 <- Parser (Maybe Object) -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser (Maybe Object)
p1
        case Maybe [Completion]
c1 of
          Just [] -> Parser a -> State Args (Maybe [Completion])
forall a. Parser a -> State Args (Maybe [Completion])
go Parser a
p2
          Just [Completion]
ss -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just [Completion]
ss
          Maybe [Completion]
Nothing -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just []
      ParserSetting Maybe SrcLoc
_ Setting {Bool
[String]
[Dashed]
[Reader a]
Maybe a
Maybe String
Maybe (NonEmpty String)
Maybe (NonEmpty (ConfigValSetting a))
Maybe (a, String)
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
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
..} ->
        if Bool
settingHidden
          then Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just []
          else do
            case Maybe String
mCursorArg of
              Maybe String
Nothing -> Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just []
              Just String
arg -> do
                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]
settingDasheds)
                let completions :: [Completion]
completions =
                      (String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map
                        ( \String
completionSuggestion ->
                            let completionDescription :: Maybe String
completionDescription = Maybe String
settingHelp
                             in Completion {String
Maybe String
completionSuggestion :: String
completionDescription :: Maybe String
completionSuggestion :: String
completionDescription :: Maybe String
..}
                        )
                        [String]
suggestions
                Maybe [Completion] -> State Args (Maybe [Completion])
forall a. a -> StateT Args Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Completion] -> State Args (Maybe [Completion]))
-> Maybe [Completion] -> State Args (Maybe [Completion])
forall a b. (a -> b) -> a -> b
$ [Completion] -> Maybe [Completion]
forall a. a -> Maybe a
Just [Completion]
completions

-- ParserAp p1 p2 -> do
--   s1s <- go p1 |> go p2