1-- | You don't need to import this module to enable bash completion.
2--
3-- See
4-- <http://github.com/pcapriotti/optparse-applicative/wiki/Bash-Completion the wiki>
5-- for more information on bash completion.
6module Options.Applicative.BashCompletion
7  ( bashCompletionParser
8  ) where
9
10import Control.Applicative
11import Prelude
12import Data.Foldable ( asum )
13import Data.List ( isPrefixOf )
14import Data.Maybe ( fromMaybe, listToMaybe )
15
16import Options.Applicative.Builder
17import Options.Applicative.Common
18import Options.Applicative.Internal
19import Options.Applicative.Types
20import Options.Applicative.Help.Pretty
21import Options.Applicative.Help.Chunk
22
23-- | Provide basic or rich command completions
24data Richness
25  = Standard
26  -- ^ Add no help descriptions to the completions
27  | Enriched Int Int
28  -- ^ Include tab separated description for options
29  --   and commands when available.
30  --   Takes option description length and command
31  --   description length.
32  deriving (Eq, Ord, Show)
33
34bashCompletionParser :: ParserInfo a -> ParserPrefs -> Parser CompletionResult
35bashCompletionParser pinfo pprefs = complParser
36  where
37    failure opts = CompletionResult
38      { execCompletion = \progn -> unlines <$> opts progn }
39
40    complParser = asum
41      [ failure <$>
42        (  bashCompletionQuery pinfo pprefs
43        -- To get rich completions, one just needs the first
44        -- command. To customise the lengths, use either of
45        -- the `desc-length` options.
46        -- zsh commands can go on a single line, so they might
47        -- want to be longer.
48        <$> ( flag' Enriched (long "bash-completion-enriched" `mappend` internal)
49                <*> option auto (long "bash-completion-option-desc-length" `mappend` internal `mappend` value 40)
50                <*> option auto (long "bash-completion-command-desc-length" `mappend` internal `mappend` value 40)
51          <|> pure Standard
52          )
53        <*> (many . strOption) (long "bash-completion-word"
54                                  `mappend` internal)
55        <*> option auto (long "bash-completion-index" `mappend` internal) )
56      , failure <$>
57          (bashCompletionScript <$>
58            strOption (long "bash-completion-script" `mappend` internal))
59      , failure <$>
60          (fishCompletionScript <$>
61            strOption (long "fish-completion-script" `mappend` internal))
62      , failure <$>
63          (zshCompletionScript <$>
64            strOption (long "zsh-completion-script" `mappend` internal))
65      ]
66
67bashCompletionQuery :: ParserInfo a -> ParserPrefs -> Richness -> [String] -> Int -> String -> IO [String]
68bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl pprefs of
69  Just (Left (SomeParser p, a))
70    -> list_options a p
71  Just (Right c)
72    -> run_completer c
73  Nothing
74    -> return []
75  where
76    compl = runParserInfo pinfo (drop 1 ws')
77
78    list_options a
79      = fmap concat
80      . sequence
81      . mapParser (opt_completions a)
82
83    --
84    -- Prior to 0.14 there was a subtle bug which would
85    -- mean that completions from positional arguments
86    -- further into the parse would be shown.
87    --
88    -- We therefore now check to see that
89    -- hinfoUnreachableArgs is off before running the
90    -- completion for position arguments.
91    --
92    -- For options and flags, ensure that the user
93    -- hasn't disabled them with `--`.
94    opt_completions argPolicy reachability opt = case optMain opt of
95      OptReader ns _ _
96         | argPolicy /= AllPositionals
97        -> return . add_opt_help opt $ show_names ns
98         | otherwise
99        -> return []
100      FlagReader ns _
101         | argPolicy /= AllPositionals
102        -> return . add_opt_help opt $ show_names ns
103         | otherwise
104        -> return []
105      ArgReader rdr
106         | argumentIsUnreachable reachability
107        -> return []
108         | otherwise
109        -> run_completer (crCompleter rdr)
110      CmdReader _ ns p
111         | argumentIsUnreachable reachability
112        -> return []
113         | otherwise
114        -> return . add_cmd_help p $ filter_names ns
115
116    -- When doing enriched completions, add any help specified
117    -- to the completion variables (tab separated).
118    add_opt_help :: Functor f => Option a -> f String -> f String
119    add_opt_help opt = case richness of
120      Standard ->
121        id
122      Enriched len _ ->
123        fmap $ \o ->
124          let h = unChunk $ optHelp opt
125          in  maybe o (\h' -> o ++ "\t" ++ render_line len h') h
126
127    -- When doing enriched completions, add the command description
128    -- to the completion variables (tab separated).
129    add_cmd_help :: Functor f => (String -> Maybe (ParserInfo a)) -> f String -> f String
130    add_cmd_help p = case richness of
131      Standard ->
132        id
133      Enriched _ len ->
134        fmap $ \cmd ->
135          let h = p cmd >>= unChunk . infoProgDesc
136          in  maybe cmd (\h' -> cmd ++ "\t" ++ render_line len h') h
137
138    show_names :: [OptName] -> [String]
139    show_names = filter_names . map showOption
140
141    -- We only want to show a single line in the completion results description.
142    -- If there was a line break, it would come across as a different completion
143    -- possibility.
144    render_line :: Int -> Doc -> String
145    render_line len doc = case lines (displayS (renderPretty 1 len doc) "") of
146      [] -> ""
147      [x] -> x
148      x : _ -> x ++ "..."
149
150    filter_names :: [String] -> [String]
151    filter_names = filter is_completion
152
153    run_completer :: Completer -> IO [String]
154    run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws''))
155
156    (ws', ws'') = splitAt i ws
157
158    is_completion :: String -> Bool
159    is_completion =
160      case ws'' of
161        w:_ -> isPrefixOf w
162        _ -> const True
163
164bashCompletionScript :: String -> String -> IO [String]
165bashCompletionScript prog progn = return
166  [ "_" ++ progn ++ "()"
167  , "{"
168  , "    local CMDLINE"
169  , "    local IFS=$'\\n'"
170  , "    CMDLINE=(--bash-completion-index $COMP_CWORD)"
171  , ""
172  , "    for arg in ${COMP_WORDS[@]}; do"
173  , "        CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)"
174  , "    done"
175  , ""
176  , "    COMPREPLY=( $(" ++ prog ++ " \"${CMDLINE[@]}\") )"
177  , "}"
178  , ""
179  , "complete -o filenames -F _" ++ progn ++ " " ++ progn ]
180
181{-
182/Note/: Fish Shell
183
184Derived from Drezil's post in #169.
185
186@
187commandline
188-c or --cut-at-cursor only print selection up until the current cursor position
189-o or --tokenize tokenize the selection and print one string-type token per line
190@
191
192We tokenize so that the call to count (and hence --bash-completion-index)
193gets the right number use cut-at-curstor to not bother sending anything
194after the cursor position, which allows for completion of the middle of
195words.
196
197Tab characters separate items from descriptions.
198-}
199fishCompletionScript :: String -> String -> IO [String]
200fishCompletionScript prog progn = return
201  [ " function _" ++ progn
202  , "    set -l cl (commandline --tokenize --current-process)"
203  , "    # Hack around fish issue #3934"
204  , "    set -l cn (commandline --tokenize --cut-at-cursor --current-process)"
205  , "    set -l cn (count $cn)"
206  , "    set -l tmpline --bash-completion-enriched --bash-completion-index $cn"
207  , "    for arg in $cl"
208  , "      set tmpline $tmpline --bash-completion-word $arg"
209  , "    end"
210  , "    for opt in (" ++ prog ++ " $tmpline)"
211  , "      if test -d $opt"
212  , "        echo -E \"$opt/\""
213  , "      else"
214  , "        echo -E \"$opt\""
215  , "      end"
216  , "    end"
217  , "end"
218  , ""
219  , "complete --no-files --command " ++ progn ++ " --arguments '(_"  ++ progn ++  ")'"
220  ]
221
222zshCompletionScript :: String -> String -> IO [String]
223zshCompletionScript prog progn = return
224  [ "#compdef " ++ progn
225  , ""
226  , "local request"
227  , "local completions"
228  , "local word"
229  , "local index=$((CURRENT - 1))"
230  , ""
231  , "request=(--bash-completion-enriched --bash-completion-index $index)"
232  , "for arg in ${words[@]}; do"
233  , "  request=(${request[@]} --bash-completion-word $arg)"
234  , "done"
235  , ""
236  , "IFS=$'\\n' completions=($( " ++ prog ++ " \"${request[@]}\" ))"
237  , ""
238  , "for word in $completions; do"
239  , "  local -a parts"
240  , ""
241  , "  # Split the line at a tab if there is one."
242  , "  IFS=$'\\t' parts=($( echo $word ))"
243  , ""
244  , "  if [[ -n $parts[2] ]]; then"
245  , "     if [[ $word[1] == \"-\" ]]; then"
246  , "       local desc=(\"$parts[1] ($parts[2])\")"
247  , "       compadd -d desc -- $parts[1]"
248  , "     else"
249  , "       local desc=($(print -f  \"%-019s -- %s\" $parts[1] $parts[2]))"
250  , "       compadd -l -d desc -- $parts[1]"
251  , "     fi"
252  , "  else"
253  , "    compadd -f -- $word"
254  , "  fi"
255  , "done"
256  ]
257