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