{-# LANGUAGE RankNTypes #-}
module Options.Applicative.Extra (
  -- * Extra parser utilities
  --
  -- | This module contains high-level functions to run parsers.
  helper,
  hsubparser,
  execParser,
  execParserMaybe,
  customExecParser,
  customExecParserMaybe,
  execParserPure,
  getParseResult,
  handleParseResult,
  parserFailure,
  renderFailure,
  ParserFailure(..),
  overFailure,
  ParserResult(..),
  ParserPrefs(..),
  CompletionResult(..),
  ) where

import Control.Applicative
import Data.Monoid
import Prelude
import System.Environment (getArgs, getProgName)
import System.Exit (exitSuccess, exitWith, ExitCode(..))
import System.IO (hPutStrLn, stderr)

import Options.Applicative.BashCompletion
import Options.Applicative.Builder
import Options.Applicative.Builder.Internal
import Options.Applicative.Common
import Options.Applicative.Help

import Options.Applicative.Internal
import Options.Applicative.Types

-- | A hidden \"helper\" option which always fails.
--
-- A common usage pattern is to apply this applicatively when
-- creating a 'ParserInfo'
--
-- > opts :: ParserInfo Sample
-- > opts = info (sample <**> helper) mempty

helper :: Parser (a -> a)
helper :: Parser (a -> a)
helper = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption ParseError
ShowHelpText (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
forall a. Monoid a => [a] -> a
mconcat
  [ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "help"
  , Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'h'
  , String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help "Show this help text"
  , Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
hidden ]

-- | Builder for a command parser with a \"helper\" option attached.
-- Used in the same way as `subparser`, but includes a \"--help|-h\" inside
-- the subcommand.
hsubparser :: Mod CommandFields a -> Parser a
hsubparser :: Mod CommandFields a -> Parser a
hsubparser m :: Mod CommandFields a
m = DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Parser a
forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Parser a
mkParser DefaultProp a
d OptProperties -> OptProperties
g OptReader a
rdr
  where
    Mod _ d :: DefaultProp a
d g :: OptProperties -> OptProperties
g = String -> Mod CommandFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "COMMAND" Mod CommandFields a -> Mod CommandFields a -> Mod CommandFields a
forall a. Monoid a => a -> a -> a
`mappend` Mod CommandFields a
m
    (groupName :: Maybe String
groupName, cmds :: [String]
cmds, subs :: String -> Maybe (ParserInfo a)
subs) = Mod CommandFields a
-> (Maybe String, [String], String -> Maybe (ParserInfo a))
forall a.
Mod CommandFields a
-> (Maybe String, [String], String -> Maybe (ParserInfo a))
mkCommand Mod CommandFields a
m
    rdr :: OptReader a
rdr = Maybe String
-> [String] -> (String -> Maybe (ParserInfo a)) -> OptReader a
forall a.
Maybe String
-> [String] -> (String -> Maybe (ParserInfo a)) -> OptReader a
CmdReader Maybe String
groupName [String]
cmds ((ParserInfo a -> ParserInfo a)
-> Maybe (ParserInfo a) -> Maybe (ParserInfo a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParserInfo a -> ParserInfo a
forall a. ParserInfo a -> ParserInfo a
add_helper (Maybe (ParserInfo a) -> Maybe (ParserInfo a))
-> (String -> Maybe (ParserInfo a))
-> String
-> Maybe (ParserInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (ParserInfo a)
subs)
    add_helper :: ParserInfo a -> ParserInfo a
add_helper pinfo :: ParserInfo a
pinfo = ParserInfo a
pinfo
      { infoParser :: Parser a
infoParser = ParserInfo a -> Parser a
forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
pinfo Parser a -> Parser (a -> a) -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (a -> a)
forall a. Parser (a -> a)
helper }

-- | Run a program description.
--
-- Parse command line arguments. Display help text and exit if any parse error
-- occurs.
execParser :: ParserInfo a -> IO a
execParser :: ParserInfo a -> IO a
execParser = ParserPrefs -> ParserInfo a -> IO a
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
defaultPrefs

-- | Run a program description with custom preferences.
customExecParser :: ParserPrefs -> ParserInfo a -> IO a
customExecParser :: ParserPrefs -> ParserInfo a -> IO a
customExecParser pprefs :: ParserPrefs
pprefs pinfo :: ParserInfo a
pinfo
  = ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure ParserPrefs
pprefs ParserInfo a
pinfo ([String] -> ParserResult a) -> IO [String] -> IO (ParserResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs
  IO (ParserResult a) -> (ParserResult a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserResult a -> IO a
forall a. ParserResult a -> IO a
handleParseResult

-- | Handle `ParserResult`.
handleParseResult :: ParserResult a -> IO a
handleParseResult :: ParserResult a -> IO a
handleParseResult (Success a :: a
a) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
handleParseResult (Failure failure :: ParserFailure ParserHelp
failure) = do
      String
progn <- IO String
getProgName
      let (msg :: String
msg, exit :: ExitCode
exit) = ParserFailure ParserHelp -> String -> (String, ExitCode)
renderFailure ParserFailure ParserHelp
failure String
progn
      case ExitCode
exit of
        ExitSuccess -> String -> IO ()
putStrLn String
msg
        _           -> Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
      ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
exit
handleParseResult (CompletionInvoked compl :: CompletionResult
compl) = do
      String
progn <- IO String
getProgName
      String
msg <- CompletionResult -> String -> IO String
execCompletion CompletionResult
compl String
progn
      String -> IO ()
putStr String
msg
      IO a
forall a. IO a
exitSuccess

-- | Extract the actual result from a `ParserResult` value.
--
-- This function returns 'Nothing' in case of errors.  Possible error messages
-- or completion actions are simply discarded.
--
-- If you want to display error messages and invoke completion actions
-- appropriately, use 'handleParseResult' instead.
getParseResult :: ParserResult a -> Maybe a
getParseResult :: ParserResult a -> Maybe a
getParseResult (Success a :: a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
getParseResult _ = Maybe a
forall a. Maybe a
Nothing

-- | Run a program description in pure code.
--
-- This function behaves like 'execParser', but can be called from pure code.
-- Note that, in case of errors, no message is displayed, and this function
-- simply returns 'Nothing'.
--
-- If you need to keep track of error messages, use 'execParserPure' instead.
{-# DEPRECATED execParserMaybe "Use execParserPure together with getParseResult instead" #-}
execParserMaybe :: ParserInfo a -> [String] -> Maybe a
execParserMaybe :: ParserInfo a -> [String] -> Maybe a
execParserMaybe = ParserPrefs -> ParserInfo a -> [String] -> Maybe a
forall a. ParserPrefs -> ParserInfo a -> [String] -> Maybe a
customExecParserMaybe ParserPrefs
defaultPrefs

-- | Run a program description with custom preferences in pure code.
--
-- See 'execParserMaybe' for details.
{-# DEPRECATED customExecParserMaybe "Use execParserPure together with getParseResult instead" #-}
customExecParserMaybe :: ParserPrefs -> ParserInfo a -> [String] -> Maybe a
customExecParserMaybe :: ParserPrefs -> ParserInfo a -> [String] -> Maybe a
customExecParserMaybe pprefs :: ParserPrefs
pprefs pinfo :: ParserInfo a
pinfo args :: [String]
args = ParserResult a -> Maybe a
forall a. ParserResult a -> Maybe a
getParseResult (ParserResult a -> Maybe a) -> ParserResult a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure ParserPrefs
pprefs ParserInfo a
pinfo [String]
args

-- | The most general way to run a program description in pure code.
execParserPure :: ParserPrefs       -- ^ Global preferences for this parser
               -> ParserInfo a      -- ^ Description of the program to run
               -> [String]          -- ^ Program arguments
               -> ParserResult a
execParserPure :: ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure pprefs :: ParserPrefs
pprefs pinfo :: ParserInfo a
pinfo args :: [String]
args =
  case P (Either CompletionResult a)
-> ParserPrefs
-> (Either ParseError (Either CompletionResult a), [Context])
forall a. P a -> ParserPrefs -> (Either ParseError a, [Context])
runP P (Either CompletionResult a)
p ParserPrefs
pprefs of
    (Right (Right r :: a
r), _) -> a -> ParserResult a
forall a. a -> ParserResult a
Success a
r
    (Right (Left c :: CompletionResult
c), _) -> CompletionResult -> ParserResult a
forall a. CompletionResult -> ParserResult a
CompletionInvoked CompletionResult
c
    (Left err :: ParseError
err, ctx :: [Context]
ctx) -> ParserFailure ParserHelp -> ParserResult a
forall a. ParserFailure ParserHelp -> ParserResult a
Failure (ParserFailure ParserHelp -> ParserResult a)
-> ParserFailure ParserHelp -> ParserResult a
forall a b. (a -> b) -> a -> b
$ ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
parserFailure ParserPrefs
pprefs ParserInfo a
pinfo ParseError
err [Context]
ctx
  where
    pinfo' :: ParserInfo (Either CompletionResult a)
pinfo' = ParserInfo a
pinfo
      { infoParser :: Parser (Either CompletionResult a)
infoParser = (CompletionResult -> Either CompletionResult a
forall a b. a -> Either a b
Left (CompletionResult -> Either CompletionResult a)
-> Parser CompletionResult -> Parser (Either CompletionResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInfo a -> ParserPrefs -> Parser CompletionResult
forall a. ParserInfo a -> ParserPrefs -> Parser CompletionResult
bashCompletionParser ParserInfo a
pinfo ParserPrefs
pprefs)
                 Parser (Either CompletionResult a)
-> Parser (Either CompletionResult a)
-> Parser (Either CompletionResult a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Either CompletionResult a
forall a b. b -> Either a b
Right (a -> Either CompletionResult a)
-> Parser a -> Parser (Either CompletionResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserInfo a -> Parser a
forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
pinfo) }
    p :: P (Either CompletionResult a)
p = ParserInfo (Either CompletionResult a)
-> [String] -> P (Either CompletionResult a)
forall (m :: * -> *) a. MonadP m => ParserInfo a -> [String] -> m a
runParserInfo ParserInfo (Either CompletionResult a)
pinfo' [String]
args

-- | Generate a `ParserFailure` from a `ParseError` in a given `Context`.
--
-- This function can be used, for example, to show the help text for a parser:
--
-- @handleParseResult . Failure $ parserFailure pprefs pinfo ShowHelpText mempty@
parserFailure :: ParserPrefs -> ParserInfo a
              -> ParseError -> [Context]
              -> ParserFailure ParserHelp
parserFailure :: ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
parserFailure pprefs :: ParserPrefs
pprefs pinfo :: ParserInfo a
pinfo msg :: ParseError
msg ctx :: [Context]
ctx = (String -> (ParserHelp, ExitCode, Int)) -> ParserFailure ParserHelp
forall h. (String -> (h, ExitCode, Int)) -> ParserFailure h
ParserFailure ((String -> (ParserHelp, ExitCode, Int))
 -> ParserFailure ParserHelp)
-> (String -> (ParserHelp, ExitCode, Int))
-> ParserFailure ParserHelp
forall a b. (a -> b) -> a -> b
$ \progn :: String
progn ->
  let h :: ParserHelp
h = [Context]
-> ParserInfo a
-> (forall b. [String] -> ParserInfo b -> ParserHelp)
-> ParserHelp
forall a c.
[Context]
-> ParserInfo a -> (forall b. [String] -> ParserInfo b -> c) -> c
with_context [Context]
ctx ParserInfo a
pinfo ((forall b. [String] -> ParserInfo b -> ParserHelp) -> ParserHelp)
-> (forall b. [String] -> ParserInfo b -> ParserHelp) -> ParserHelp
forall a b. (a -> b) -> a -> b
$ \names :: [String]
names pinfo' :: ParserInfo b
pinfo' -> [ParserHelp] -> ParserHelp
forall a. Monoid a => [a] -> a
mconcat
            [ ParserInfo b -> ParserHelp
forall a. ParserInfo a -> ParserHelp
base_help ParserInfo b
pinfo'
            , String -> [String] -> ParserInfo b -> ParserHelp
forall a. String -> [String] -> ParserInfo a -> ParserHelp
usage_help String
progn [String]
names ParserInfo b
pinfo'
            , ParserHelp
suggestion_help
            , ParserHelp
error_help ]
  in (ParserHelp
h, ExitCode
exit_code, ParserPrefs -> Int
prefColumns ParserPrefs
pprefs)
  where
    exit_code :: ExitCode
exit_code = case ParseError
msg of
      ErrorMsg {}        -> Int -> ExitCode
ExitFailure (ParserInfo a -> Int
forall a. ParserInfo a -> Int
infoFailureCode ParserInfo a
pinfo)
      UnknownError       -> Int -> ExitCode
ExitFailure (ParserInfo a -> Int
forall a. ParserInfo a -> Int
infoFailureCode ParserInfo a
pinfo)
      MissingError {}    -> Int -> ExitCode
ExitFailure (ParserInfo a -> Int
forall a. ParserInfo a -> Int
infoFailureCode ParserInfo a
pinfo)
      ExpectsArgError {} -> Int -> ExitCode
ExitFailure (ParserInfo a -> Int
forall a. ParserInfo a -> Int
infoFailureCode ParserInfo a
pinfo)
      UnexpectedError {} -> Int -> ExitCode
ExitFailure (ParserInfo a -> Int
forall a. ParserInfo a -> Int
infoFailureCode ParserInfo a
pinfo)
      ShowHelpText       -> ExitCode
ExitSuccess
      InfoMsg {}         -> ExitCode
ExitSuccess

    with_context :: [Context]
                 -> ParserInfo a
                 -> (forall b . [String] -> ParserInfo b -> c)
                 -> c
    with_context :: [Context]
-> ParserInfo a -> (forall b. [String] -> ParserInfo b -> c) -> c
with_context [] i :: ParserInfo a
i f :: forall b. [String] -> ParserInfo b -> c
f = [String] -> ParserInfo a -> c
forall b. [String] -> ParserInfo b -> c
f [] ParserInfo a
i
    with_context c :: [Context]
c@(Context _ i :: ParserInfo a
i:_) _ f :: forall b. [String] -> ParserInfo b -> c
f = [String] -> ParserInfo a -> c
forall b. [String] -> ParserInfo b -> c
f ([Context] -> [String]
contextNames [Context]
c) ParserInfo a
i

    usage_help :: String -> [String] -> ParserInfo a -> ParserHelp
usage_help progn :: String
progn names :: [String]
names i :: ParserInfo a
i = case ParseError
msg of
      InfoMsg _
        -> ParserHelp
forall a. Monoid a => a
mempty
      _
        -> Chunk Doc -> ParserHelp
usageHelp (Chunk Doc -> ParserHelp) -> Chunk Doc -> ParserHelp
forall a b. (a -> b) -> a -> b
$ [Chunk Doc] -> Chunk Doc
vcatChunks
          [ Doc -> Chunk Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> Chunk Doc) -> ([String] -> Doc) -> [String] -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs -> Parser a -> String -> Doc
forall a. ParserPrefs -> Parser a -> String -> Doc
parserUsage ParserPrefs
pprefs (ParserInfo a -> Parser a
forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
i) (String -> Doc) -> ([String] -> String) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Chunk Doc) -> [String] -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ String
progn String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
names
          , (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc -> Doc
indent 2) (Chunk Doc -> Chunk Doc)
-> (ParserInfo a -> Chunk Doc) -> ParserInfo a -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserInfo a -> Chunk Doc
forall a. ParserInfo a -> Chunk Doc
infoProgDesc (ParserInfo a -> Chunk Doc) -> ParserInfo a -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ ParserInfo a
i ]

    error_help :: ParserHelp
error_help = Chunk Doc -> ParserHelp
errorHelp (Chunk Doc -> ParserHelp) -> Chunk Doc -> ParserHelp
forall a b. (a -> b) -> a -> b
$ case ParseError
msg of
      ShowHelpText
        -> Chunk Doc
forall a. Monoid a => a
mempty

      ErrorMsg m :: String
m
        -> String -> Chunk Doc
stringChunk String
m

      InfoMsg  m :: String
m
        -> String -> Chunk Doc
stringChunk String
m

      MissingError CmdStart _
        | ParserPrefs -> Bool
prefShowHelpOnEmpty ParserPrefs
pprefs
        -> Chunk Doc
forall a. Monoid a => a
mempty

      MissingError _ (SomeParser x :: Parser a
x)
        -> String -> Chunk Doc
stringChunk "Missing:" Chunk Doc -> Chunk Doc -> Chunk Doc
<<+>> ParserPrefs -> Parser a -> Chunk Doc
forall a. ParserPrefs -> Parser a -> Chunk Doc
missingDesc ParserPrefs
pprefs Parser a
x

      ExpectsArgError x :: String
x
        -> String -> Chunk Doc
stringChunk (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ "The option `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "` expects an argument."

      UnexpectedError arg :: String
arg _
        -> String -> Chunk Doc
stringChunk String
msg'
          where
            --
            -- This gives us the same error we have always
            -- reported
            msg' :: String
msg' = case String
arg of
              ('-':_) -> "Invalid option `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"
              _       -> "Invalid argument `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"

      UnknownError
        -> Chunk Doc
forall a. Monoid a => a
mempty


    suggestion_help :: ParserHelp
suggestion_help = Chunk Doc -> ParserHelp
suggestionsHelp (Chunk Doc -> ParserHelp) -> Chunk Doc -> ParserHelp
forall a b. (a -> b) -> a -> b
$ case ParseError
msg of
      UnexpectedError arg :: String
arg (SomeParser x :: Parser a
x)
        --
        -- We have an unexpected argument and the parser which
        -- it's running over.
        --
        -- We can make a good help suggestion here if we do
        -- a levenstein distance between all possible suggestions
        -- and the supplied option or argument.
        -> Chunk Doc
suggestions
          where
            --
            -- Not using chunked here, as we don't want to
            -- show "Did you mean" if there's nothing there
            -- to show
            suggestions :: Chunk Doc
suggestions = Doc -> Doc -> Doc
(.$.) (Doc -> Doc -> Doc) -> Chunk Doc -> Chunk (Doc -> Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chunk Doc
prose
                                Chunk (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Doc -> Doc
indent 4 (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Chunk Doc] -> Chunk Doc
vcatChunks ([Chunk Doc] -> Chunk Doc)
-> ([String] -> [Chunk Doc]) -> [String] -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Chunk Doc) -> [String] -> [Chunk Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Chunk Doc
stringChunk ([String] -> Chunk Doc) -> [String] -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ [String]
good ))

            --
            -- We won't worry about the 0 case, it won't be
            -- shown anyway.
            prose :: Chunk Doc
prose       = if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
good Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2
                            then String -> Chunk Doc
stringChunk "Did you mean this?"
                            else String -> Chunk Doc
stringChunk "Did you mean one of these?"
            --
            -- Suggestions we will show, they're close enough
            -- to what the user wrote
            good :: [String]
good        = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isClose [String]
possibles

            --
            -- Bit of an arbitrary decision here.
            -- Edit distances of 1 or 2 will give hints
            isClose :: String -> Bool
isClose a :: String
a   = String -> String -> Int
forall a. Eq a => [a] -> [a] -> Int
editDistance String
a String
arg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3

            --
            -- Similar to how bash completion works.
            -- We map over the parser and get the names
            -- ( no IO here though, unlike for completers )
            possibles :: [String]
possibles   = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (forall x. OptHelpInfo -> Option x -> [String])
-> Parser a -> [[String]]
forall b a.
(forall x. OptHelpInfo -> Option x -> b) -> Parser a -> [b]
mapParser forall x. OptHelpInfo -> Option x -> [String]
opt_completions Parser a
x

            --
            -- Look at the option and give back the possible
            -- things the user could type. If it's a command
            -- reader also ensure that it can be immediately
            -- reachable from where the error was given.
            opt_completions :: OptHelpInfo -> Option a -> [String]
opt_completions hinfo :: OptHelpInfo
hinfo opt :: Option a
opt = case Option a -> OptReader a
forall a. Option a -> OptReader a
optMain Option a
opt of
              OptReader ns :: [OptName]
ns _ _ -> (OptName -> String) -> [OptName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OptName -> String
showOption [OptName]
ns
              FlagReader ns :: [OptName]
ns _  -> (OptName -> String) -> [OptName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OptName -> String
showOption [OptName]
ns
              ArgReader _      -> []
              CmdReader _ ns :: [String]
ns _  | OptHelpInfo -> Bool
hinfoUnreachableArgs OptHelpInfo
hinfo
                               -> []
                                | Bool
otherwise
                               -> [String]
ns
      _
        -> Chunk Doc
forall a. Monoid a => a
mempty

    base_help :: ParserInfo a -> ParserHelp
    base_help :: ParserInfo a -> ParserHelp
base_help i :: ParserInfo a
i
      | Bool
show_full_help
      = [ParserHelp] -> ParserHelp
forall a. Monoid a => [a] -> a
mconcat [ParserHelp
h, ParserHelp
f, ParserPrefs -> Parser a -> ParserHelp
forall a. ParserPrefs -> Parser a -> ParserHelp
parserHelp ParserPrefs
pprefs (ParserInfo a -> Parser a
forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
i)]
      | Bool
otherwise
      = ParserHelp
forall a. Monoid a => a
mempty
      where
        h :: ParserHelp
h = Chunk Doc -> ParserHelp
headerHelp (ParserInfo a -> Chunk Doc
forall a. ParserInfo a -> Chunk Doc
infoHeader ParserInfo a
i)
        f :: ParserHelp
f = Chunk Doc -> ParserHelp
footerHelp (ParserInfo a -> Chunk Doc
forall a. ParserInfo a -> Chunk Doc
infoFooter ParserInfo a
i)

    show_full_help :: Bool
show_full_help = case ParseError
msg of
      ShowHelpText             -> Bool
True
      MissingError CmdStart  _  | ParserPrefs -> Bool
prefShowHelpOnEmpty ParserPrefs
pprefs
                               -> Bool
True
      InfoMsg _                -> Bool
False
      _                        -> ParserPrefs -> Bool
prefShowHelpOnError ParserPrefs
pprefs

renderFailure :: ParserFailure ParserHelp -> String -> (String, ExitCode)
renderFailure :: ParserFailure ParserHelp -> String -> (String, ExitCode)
renderFailure failure :: ParserFailure ParserHelp
failure progn :: String
progn =
  let (h :: ParserHelp
h, exit :: ExitCode
exit, cols :: Int
cols) = ParserFailure ParserHelp -> String -> (ParserHelp, ExitCode, Int)
forall h. ParserFailure h -> String -> (h, ExitCode, Int)
execFailure ParserFailure ParserHelp
failure String
progn
  in (Int -> ParserHelp -> String
renderHelp Int
cols ParserHelp
h, ExitCode
exit)