{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts    #-}
{- |
   Module      : Text.Pandoc.App.Completion
   Copyright   : Copyright (C) 2006-2024 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley@edu>
   Stability   : alpha
   Portability : portable

Generation of shell completion scripts for bash, zsh and fish.
The scripts are generated at runtime from pandoc's single list of
command-line options ('OptionSpec'), together with the completion
metadata that each option carries (its 'CompletionKind' and a short
description).  All completions are static: the lists of formats,
styles, engines and data files are embedded into the generated script,
so no call to pandoc is made while completing.
-}
module Text.Pandoc.App.Completion ( generateCompletion ) where

import Data.List (intercalate)
import Data.Text (Text)
import qualified Data.List as L
import qualified Data.Text as T
import System.Console.GetOpt (ArgDescr (..))
import Text.Pandoc.App.Opt (CompletionShell (..), OptionSpec (..),
                            CompletionKind (..))

-- | Generate a completion script for the given shell.  The completion
-- behaviour and descriptions are taken from the per-option 'OptionSpec'
-- data, so the script cannot drift from the actual options.
generateCompletion :: CompletionShell
                   -> [OptionSpec]   -- ^ the option list
                   -> [Text]         -- ^ input formats
                   -> [Text]         -- ^ output formats
                   -> [Text]         -- ^ highlighting style names
                   -> [Text]         -- ^ math methods
                   -> [String]       -- ^ PDF engines
                   -> [String]       -- ^ data files
                   -> IO Text
generateCompletion :: CompletionShell
-> [OptionSpec]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [[Char]]
-> [[Char]]
-> IO Text
generateCompletion CompletionShell
Bash   = [OptionSpec]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [[Char]]
-> [[Char]]
-> IO Text
bashScript
generateCompletion CompletionShell
Zsh    = [OptionSpec]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [[Char]]
-> [[Char]]
-> IO Text
zshScript
generateCompletion CompletionShell
Fish   = [OptionSpec]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [[Char]]
-> [[Char]]
-> IO Text
fishScript

-- | The list of all option names (short and long), space separated.
allOptionNames :: [OptionSpec] -> String
allOptionNames :: [OptionSpec] -> [Char]
allOptionNames [OptionSpec]
opts =
  [[Char]] -> [Char]
unwords [ [Char]
name | OptionSpec [Char]
shorts [[Char]]
longs ArgDescr (Opt -> ExceptT OptInfo IO Opt)
_ CompletionKind
_ Text
_ <- [OptionSpec]
opts
                 , [Char]
name <- (Char -> [Char]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> Char
'-' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char
c]) [Char]
shorts [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
                             ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
longs ]

-- | The completion kind and description for an option.  This is taken
-- directly from the 'OptionSpec'; there is no separate specification to
-- keep in sync.
optionKindDesc :: OptionSpec -> (CompletionKind, Text)
optionKindDesc :: OptionSpec -> (CompletionKind, Text)
optionKindDesc (OptionSpec [Char]
_ [[Char]]
_ ArgDescr (Opt -> ExceptT OptInfo IO Opt)
_ CompletionKind
k Text
desc) = (CompletionKind
k, Text
desc)

placeholder :: ArgDescr a -> Maybe String
placeholder :: forall a. ArgDescr a -> Maybe [Char]
placeholder (ReqArg [Char] -> a
_ [Char]
s) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s
placeholder (OptArg Maybe [Char] -> a
_ [Char]
s) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s
placeholder ArgDescr a
_ = Maybe [Char]
forall a. Maybe a
Nothing

-- | Whether an option needs an explicit @case "${prev}"@ arm in the bash
-- script.  Options that just take a file or are boolean flags fall
-- through to the default file completion, so they need no arm.
isCompletableKind :: CompletionKind -> Bool
isCompletableKind :: CompletionKind -> Bool
isCompletableKind CompletionKind
OptFlag = Bool
False
isCompletableKind CompletionKind
Files   = Bool
False
isCompletableKind CompletionKind
_       = Bool
True

-- | The argument passed to @compgen -W@ for an option of the given kind.
-- Dynamic kinds reference the shell variables that pandoc fills in;
-- fixed enumerations are listed verbatim.
prevSource :: CompletionKind  -- ^ completion kind
           -> String          -- ^ engine list (already space-joined)
           -> String
prevSource :: CompletionKind -> [Char] -> [Char]
prevSource CompletionKind
InputFormats    [Char]
_ = [Char]
"${informats}"
prevSource CompletionKind
OutputFormats   [Char]
_ = [Char]
"${outformats}"
prevSource CompletionKind
HighlightStyles [Char]
_ = [Char]
"${highlight_styles}"
prevSource CompletionKind
MathMethods [Char]
_     = [Char]
"${math_methods}"
prevSource CompletionKind
DataFiles       [Char]
_ = [Char]
"${datafiles}"
prevSource CompletionKind
Engines         [Char]
e = [Char]
e
prevSource (Fixed [[Char]]
vs)      [Char]
_ = [[Char]] -> [Char]
unwords [[Char]]
vs
prevSource CompletionKind
OptFlag         [Char]
_ = [Char]
""
prevSource CompletionKind
Files           [Char]
_ = [Char]
""

----------------------------------------------------------------------
-- bash
----------------------------------------------------------------------

-- | The bash completion script reproduces the historical script that
-- was previously generated from @data/bash_completion.tpl@.  The list
-- of options completed per value (the @case "${prev}"@ arms) is derived
-- from the option list, so it cannot drift from the actual options.
bashScript :: [OptionSpec] -> [Text] -> [Text] -> [Text] ->
              [Text] -> [String] -> [String] -> IO Text
bashScript :: [OptionSpec]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [[Char]]
-> [[Char]]
-> IO Text
bashScript [OptionSpec]
opts [Text]
informats [Text]
outformats [Text]
hstyles [Text]
mmethods [[Char]]
engines [[Char]]
datafiles = do
  let optsStr :: [Char]
optsStr   = [OptionSpec] -> [Char]
allOptionNames [OptionSpec]
opts
      infStr :: [Char]
infStr    = [[Char]] -> [Char]
unwords ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
informats)
      outfStr :: [Char]
outfStr   = [[Char]] -> [Char]
unwords ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
outformats)
      hsStr :: [Char]
hsStr     = [[Char]] -> [Char]
unwords ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
hstyles)
      mmStr :: [Char]
mmStr     = [[Char]] -> [Char]
unwords ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
mmethods)
      dfStr :: [Char]
dfStr     = [[Char]] -> [Char]
unwords [[Char]]
datafiles
      engStr :: [Char]
engStr    = [[Char]] -> [Char]
unwords [[Char]]
engines
      caseBody :: [Text]
caseBody  = (([Char], [[Char]]) -> [Text]) -> [([Char], [[Char]])] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [[Char]]) -> [Text]
armToLines ([OptionSpec] -> [Char] -> [([Char], [[Char]])]
bashCaseArms [OptionSpec]
opts [Char]
engStr)
  Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"# This script enables bash autocompletion for pandoc.  To enable"
    , Text
"# bash completion, add this to your .bashrc:"
    , Text
"# eval \"$(pandoc --completion=bash)\""
    , Text
""
    , Text
"_pandoc()"
    , Text
"{"
    , Text
"    local cur prev opts informats outformats highlight_styles math_methods datafiles"
    , Text
"    COMPREPLY=()"
    , Text
"    cur=\"${COMP_WORDS[COMP_CWORD]}\""
    , Text
"    prev=\"${COMP_WORDS[COMP_CWORD-1]}\""
    , Text
""
    , Text
"    # These should be filled in by pandoc:"
    , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"    opts=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
optsStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"    informats=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
infStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"    outformats=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
outfStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"    highlight_styles=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
hsStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"    math_methods=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
mmStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"    datafiles=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dfStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    , Text
""
    , Text
"    case \"${prev}\" in"
    ]
    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
caseBody [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
    [ Text
"         *)"
    , Text
"             ;;"
    , Text
"    esac"
    , Text
""
    , Text
"    case \"${cur}\" in"
    , Text
"         -*)"
    , Text
"             COMPREPLY=( $(compgen -W \"${opts}\" -- ${cur}) )"
    , Text
"             return 0"
    , Text
"             ;;"
    , Text
"         *)"
    , Text
"             local IFS=$'\\n'"
    , Text
"             COMPREPLY=( $(compgen -X '' -f \"${cur}\") )"
    , Text
"             return 0"
    , Text
"             ;;"
    , Text
"    esac"
    , Text
""
    , Text
"}"
    , Text
""
    , Text
"complete -o filenames -o bashdefault -F _pandoc pandoc"
    ]

-- | The @case "${prev}"@ arms, one per distinct completion source,
-- merging all options that share the same source so that (for example)
-- @--from@ and @--read@ end up in a single arm.
bashCaseArms :: [OptionSpec] -> String -> [(String, [String])]
bashCaseArms :: [OptionSpec] -> [Char] -> [([Char], [[Char]])]
bashCaseArms [OptionSpec]
opts [Char]
engStr =
  let arms :: [([Char], [[Char]])]
arms = [ (CompletionKind -> [Char] -> [Char]
prevSource CompletionKind
k [Char]
engStr, [[Char]]
names)
             | o :: OptionSpec
o@(OptionSpec [Char]
shorts [[Char]]
longs ArgDescr (Opt -> ExceptT OptInfo IO Opt)
_ CompletionKind
_ Text
_) <- [OptionSpec]
opts
             , let (CompletionKind
k, Text
_) = OptionSpec -> (CompletionKind, Text)
optionKindDesc OptionSpec
o
             , CompletionKind -> Bool
isCompletableKind CompletionKind
k
             , let names :: [[Char]]
names = (Char -> [Char]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> Char
'-' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char
c]) [Char]
shorts [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
                           ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
longs ]
  in [([Char], [[Char]])] -> [([Char], [[Char]])]
mergeArms [([Char], [[Char]])]
arms

-- | Merge arms that share the same completion source, preserving the
-- order in which the sources first appear in the option list.
mergeArms :: [(String, [String])] -> [(String, [String])]
mergeArms :: [([Char], [[Char]])] -> [([Char], [[Char]])]
mergeArms = ([([Char], [[Char]])]
 -> ([Char], [[Char]]) -> [([Char], [[Char]])])
-> [([Char], [[Char]])]
-> [([Char], [[Char]])]
-> [([Char], [[Char]])]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' [([Char], [[Char]])] -> ([Char], [[Char]]) -> [([Char], [[Char]])]
forall {a} {a}. Eq a => [(a, [a])] -> (a, [a]) -> [(a, [a])]
go []
  where go :: [(a, [a])] -> (a, [a]) -> [(a, [a])]
go [] (a
src, [a]
ns) = [(a
src, [a]
ns)]
        go (x :: (a, [a])
x@(a
s, [a]
ns0) : [(a, [a])]
xs) (a
src, [a]
ns)
          | a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
src  = (a
s, [a]
ns0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ns) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, [a])]
xs
          | Bool
otherwise = (a, [a])
x (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, [a])] -> (a, [a]) -> [(a, [a])]
go [(a, [a])]
xs (a
src, [a]
ns)

-- | Render one merged arm as the four lines of a bash @case@ body.
armToLines :: (String, [String]) -> [Text]
armToLines :: ([Char], [[Char]]) -> [Text]
armToLines ([Char]
src, [[Char]]
names) =
  let pat :: [Char]
pat = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"|" [[Char]]
names
  in [ [Char] -> Text
T.pack ([Char]
"         " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
     , [Char] -> Text
T.pack ([Char]
"             COMPREPLY=( $(compgen -W \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
src [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
"\" -- ${cur}) )")
     , Text
"             return 0"
     , Text
"             ;;" ]

----------------------------------------------------------------------
-- zsh
----------------------------------------------------------------------

zshScript :: [OptionSpec] -> [Text] -> [Text] -> [Text] -> [Text] -> [String]
          -> [String] -> IO Text
zshScript :: [OptionSpec]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [[Char]]
-> [[Char]]
-> IO Text
zshScript [OptionSpec]
opts [Text]
informats [Text]
outformats [Text]
hstyles [Text]
mmethods [[Char]]
engines [[Char]]
datafiles = do
  let action :: CompletionKind -> Maybe [Char] -> Text
action CompletionKind
k Maybe [Char]
mbP =
        case CompletionKind
k of
           CompletionKind
OptFlag -> Text
""
           CompletionKind
Files -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> ([Char] -> Text) -> Maybe [Char] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"FILE" [Char] -> Text
T.pack Maybe [Char]
mbP Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":_files"
           Fixed [[Char]]
vs -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> ([Char] -> Text) -> Maybe [Char] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"VALUE" [Char] -> Text
T.pack Maybe [Char]
mbP
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([[Char]] -> [Char]
unwords [[Char]]
vs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
           CompletionKind
InputFormats -> Text
":FORMAT:(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
informats Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
           CompletionKind
OutputFormats -> Text
":FORMAT:(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
outformats Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
           CompletionKind
HighlightStyles -> Text
":STYLE:(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
hstyles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
           CompletionKind
MathMethods -> Text
":METHOD:(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
mmethods Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
           CompletionKind
DataFiles -> Text
":FILE:(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([[Char]] -> [Char]
unwords [[Char]]
datafiles) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
           CompletionKind
Engines -> Text
":PROGRAM:(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([[Char]] -> [Char]
unwords [[Char]]
engines) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      optLines :: [Text]
optLines = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ OptionSpec -> (CompletionKind -> Maybe [Char] -> Text) -> [Text]
zshOptionLine OptionSpec
o CompletionKind -> Maybe [Char] -> Text
action
        | o :: OptionSpec
o@(OptionSpec [Char]
_shorts [[Char]]
_longs ArgDescr (Opt -> ExceptT OptInfo IO Opt)
_ad CompletionKind
_ Text
_) <- [OptionSpec]
opts ]
  Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"#compdef pandoc"
    , Text
""
    , Text
"_pandoc() {"
    , Text
"  local -a args"
    , Text
"  args=("
    ]
    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
optLines
    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"    '*:files:_files'"
       , Text
"  )"
       , Text
"  _arguments -s -S $args"
       , Text
"}"
       , Text
""
       , Text
"_pandoc \"$@\""
       ]

-- | Produce one or more @_arguments@ spec lines (one per name) for an
-- option.  The description and action are embedded in single quotes.
zshOptionLine :: OptionSpec
              -> (CompletionKind -> Maybe String -> Text)
              -> [Text]
zshOptionLine :: OptionSpec -> (CompletionKind -> Maybe [Char] -> Text) -> [Text]
zshOptionLine (OptionSpec [Char]
shorts [[Char]]
longs ArgDescr (Opt -> ExceptT OptInfo IO Opt)
ad CompletionKind
k Text
desc) CompletionKind -> Maybe [Char] -> Text
action =
  let desc' :: Text
desc' = Text -> Text
escapeZshDesc Text
desc
      act :: Text
act   = CompletionKind -> Maybe [Char] -> Text
action CompletionKind
k (ArgDescr (Opt -> ExceptT OptInfo IO Opt) -> Maybe [Char]
forall a. ArgDescr a -> Maybe [Char]
placeholder ArgDescr (Opt -> ExceptT OptInfo IO Opt)
ad)
      line :: [Char] -> Text
line [Char]
name = [Char] -> Text
T.pack ([Char]
"    '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                  [Char] -> Text
T.pack ([Char]
"]") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
act Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
"'"
  in ([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
line ((Char -> [Char]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> Char
'-' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char
c]) [Char]
shorts [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
longs)

-- | Escape a description for embedding inside a single-quoted zsh
-- @_arguments@ spec.  Single quotes are the only character that needs
-- special treatment; the descriptions are kept free of colons and
-- square brackets.
escapeZshDesc :: Text -> Text
escapeZshDesc :: Text -> Text
escapeZshDesc = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"'\\''"

----------------------------------------------------------------------
-- fish
----------------------------------------------------------------------

fishScript :: [OptionSpec] -> [Text] -> [Text] -> [Text] -> [Text]
           -> [String] -> [String] -> IO Text
fishScript :: [OptionSpec]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [[Char]]
-> [[Char]]
-> IO Text
fishScript [OptionSpec]
opts [Text]
informats [Text]
outformats [Text]
hstyles [Text]
mmethods [[Char]]
engines [[Char]]
datafiles = do
  let argPart :: CompletionKind -> p -> Text
argPart CompletionKind
k p
_mbP =
         case CompletionKind
k of
           CompletionKind
OptFlag -> Text
""
           CompletionKind
Files -> Text
" -r"
           Fixed [[Char]]
vs -> Text
" -r -a \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([[Char]] -> [Char]
unwords [[Char]]
vs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
           CompletionKind
InputFormats -> Text
" -r -a \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
informats Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
           CompletionKind
OutputFormats -> Text
" -r -a \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
outformats Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
           CompletionKind
HighlightStyles -> Text
" -r -a \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
hstyles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
           CompletionKind
MathMethods -> Text
" -r -a \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
mmethods Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
           CompletionKind
DataFiles -> Text
" -r -a \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([[Char]] -> [Char]
unwords [[Char]]
datafiles) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
           CompletionKind
Engines -> Text
" -r -a \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([[Char]] -> [Char]
unwords [[Char]]
engines) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
      optLines :: [Text]
optLines = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ OptionSpec -> (CompletionKind -> Maybe [Char] -> Text) -> [Text]
fishOptionLine OptionSpec
o CompletionKind -> Maybe [Char] -> Text
forall {p}. CompletionKind -> p -> Text
argPart
        | o :: OptionSpec
o@(OptionSpec [Char]
_shorts [[Char]]
_longs ArgDescr (Opt -> ExceptT OptInfo IO Opt)
_ad CompletionKind
_ Text
_) <- [OptionSpec]
opts ]
  Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
optLines

fishOptionLine :: OptionSpec
               -> (CompletionKind -> Maybe String -> Text)
               -> [Text]
fishOptionLine :: OptionSpec -> (CompletionKind -> Maybe [Char] -> Text) -> [Text]
fishOptionLine (OptionSpec [Char]
shorts [[Char]]
longs ArgDescr (Opt -> ExceptT OptInfo IO Opt)
ad CompletionKind
k Text
desc) CompletionKind -> Maybe [Char] -> Text
argPart =
  let shortPart :: Text
shortPart = case [Char]
shorts of
                   [Char
c] -> [Char] -> Text
T.pack ([Char]
" -s " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c])
                   [Char]
_   -> Text
""
      descPart :: Text
descPart = if Text -> Bool
T.null Text
desc
                   then Text
""
                   else [Char] -> Text
T.pack [Char]
" -d \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeFishDesc Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
"\""
  in [ [Char] -> Text
T.pack [Char]
"complete -c pandoc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
shortPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       [Char] -> Text
T.pack ([Char]
" -l " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
descPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       CompletionKind -> Maybe [Char] -> Text
argPart CompletionKind
k (ArgDescr (Opt -> ExceptT OptInfo IO Opt) -> Maybe [Char]
forall a. ArgDescr a -> Maybe [Char]
placeholder ArgDescr (Opt -> ExceptT OptInfo IO Opt)
ad)
     | [Char]
l <- Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
1 [[Char]]
longs ]

-- | Escape a description for a fish completion @-d@ argument, which is
-- wrapped in double quotes.
escapeFishDesc :: Text -> Text
escapeFishDesc :: Text -> Text
escapeFishDesc = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\"
               (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\""
               (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"$" Text
"\\$"