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

    import Control.Applicative
    import Control.Monad (void)
    import Data.Monoid
    import Data.Foldable (traverse_)
    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 :: forall a. Parser (a -> a)
    helper =
      Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a. Mod OptionFields (a -> a) -> Parser (a -> a)
    helperWith ([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 String
    "help",
        Char -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'h',
        String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "Show this help text"
      ])

    -- | Like helper, but with a minimal set of modifiers that can be extended
    -- as desired.
    --
    -- > opts :: ParserInfo Sample
    -- > opts = info (sample <**> helperWith (mconcat [
    -- >          long "help",
    -- >          short 'h',
    -- >          help "Show this help text",
    -- >          hidden
    -- >        ])) mempty
    helperWith :: Mod OptionFields (a -> a) -> Parser (a -> a)
    helperWith :: forall a. Mod OptionFields (a -> a) -> Parser (a -> a)
    helperWith Mod OptionFields (a -> a)
    modifiers =
      ReadM (a -> a) -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a. ReadM a -> Mod OptionFields a -> Parser a
    option ReadM (a -> a)
    forall {b}. ReadM b
    helpReader (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
          [ (a -> a) -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasValue f => a -> Mod f a
    value a -> a
    forall a. a -> a
    id,
            String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
    metavar String
    "",
            Mod OptionFields (a -> a)
    forall (f :: * -> *) a. Mod f a
    noGlobal,
            ParseError -> Mod OptionFields (a -> a)
    forall a. ParseError -> Mod OptionFields a
    noArgError (Maybe String -> ParseError
    ShowHelpText Maybe String
    forall a. Maybe a
    Nothing),
            Mod OptionFields (a -> a)
    forall (f :: * -> *) a. Mod f a
    hidden,
            Mod OptionFields (a -> a)
    modifiers
          ]
      where
        helpReader :: ReadM b
    helpReader = do
          potentialCommand <- ReadM String
    readerAsk
          readerAbort $
            ShowHelpText (Just potentialCommand)

    -- | 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 :: forall a. Mod CommandFields a -> Parser a
    hsubparser 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 CommandFields a -> CommandFields a
    _ DefaultProp a
    d OptProperties -> OptProperties
    g = String -> Mod CommandFields a
    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
    metavar String
    "COMMAND" Mod CommandFields a -> Mod CommandFields a -> Mod CommandFields a
    forall a. Monoid a => a -> a -> a
    `mappend` Mod CommandFields a
    m
        (Maybe String
    groupName, [(String, ParserInfo a)]
    cmds) = Mod CommandFields a -> (Maybe String, [(String, ParserInfo a)])
    forall a.
    Mod CommandFields a -> (Maybe String, [(String, ParserInfo a)])
    mkCommand Mod CommandFields a
    m
        rdr :: OptReader a
    rdr = Maybe String -> [(String, ParserInfo a)] -> OptReader a
    forall a. Maybe String -> [(String, ParserInfo a)] -> OptReader a
    CmdReader Maybe String
    groupName ((((String, ParserInfo a) -> (String, ParserInfo a))
    -> [(String, ParserInfo a)] -> [(String, ParserInfo a)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((String, ParserInfo a) -> (String, ParserInfo a))
     -> [(String, ParserInfo a)] -> [(String, ParserInfo a)])
    -> ((ParserInfo a -> ParserInfo a)
        -> (String, ParserInfo a) -> (String, ParserInfo a))
    -> (ParserInfo a -> ParserInfo a)
    -> [(String, ParserInfo a)]
    -> [(String, ParserInfo a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ParserInfo a -> ParserInfo a)
    -> (String, ParserInfo a) -> (String, ParserInfo a)
    forall a b. (a -> b) -> (String, a) -> (String, b)
    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 [(String, ParserInfo a)]
    cmds)
        add_helper :: ParserInfo a -> ParserInfo a
    add_helper ParserInfo a
    pinfo = ParserInfo a
    pinfo
          { infoParser = infoParser pinfo <**> helper }

    -- | A hidden \"--version\" option that displays the version.
    --
    -- > opts :: ParserInfo Sample
    -- > opts = info (sample <**> simpleVersioner "v1.2.3") mempty
    simpleVersioner :: String -- ^ Version string to be shown
                    -> Parser (a -> a)
    simpleVersioner :: forall a. String -> Parser (a -> a)
    simpleVersioner String
    version = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
    infoOption String
    version (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 String
    "version"
        , String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "Show version information"
        , Mod OptionFields (a -> a)
    forall (f :: * -> *) a. Mod f a
    hidden
        ]

    -- | Run a program description.
    --
    -- Parse command line arguments. Display help text and exit if any parse error
    -- occurs.
    execParser :: ParserInfo a -> IO a
    execParser :: forall a. 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 :: forall a. ParserPrefs -> ParserInfo a -> IO a
    customExecParser ParserPrefs
    pprefs 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 a b. IO a -> (a -> IO b) -> IO b
    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 :: forall a. ParserResult a -> IO a
    handleParseResult (Success a
    a) = a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
    handleParseResult (Failure ParserFailure ParserHelp
    failure) = do
          progn <- IO String
    getProgName
          let (msg, exit) = renderFailure failure progn
          case exit of
            ExitCode
    ExitSuccess -> String -> IO ()
    putStrLn String
    msg
            ExitCode
    _           -> Handle -> String -> IO ()
    hPutStrLn Handle
    stderr String
    msg
          exitWith exit
    handleParseResult (CompletionInvoked CompletionResult
    compl) = do
          progn <- IO String
    getProgName
          msg <- execCompletion compl progn
          putStr msg
          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 :: forall a. ParserResult a -> Maybe a
    getParseResult (Success a
    a) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a
    getParseResult ParserResult a
    _ = Maybe a
    forall a. Maybe a
    Nothing

    -- | 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 :: forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
    execParserPure ParserPrefs
    pprefs ParserInfo a
    pinfo [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 a
    r), [Context]
    _) -> a -> ParserResult a
    forall a. a -> ParserResult a
    Success a
    r
        (Right (Left CompletionResult
    c), [Context]
    _) -> CompletionResult -> ParserResult a
    forall a. CompletionResult -> ParserResult a
    CompletionInvoked CompletionResult
    c
        (Left ParseError
    err, [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 = (Left <$> bashCompletionParser pinfo pprefs)
                     <|> (Right <$> infoParser 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 Nothing) mempty@
    parserFailure :: ParserPrefs -> ParserInfo a
                  -> ParseError -> [Context]
                  -> ParserFailure ParserHelp
    parserFailure :: forall a.
    ParserPrefs
    -> ParserInfo a
    -> ParseError
    -> [Context]
    -> ParserFailure ParserHelp
    parserFailure ParserPrefs
    pprefs ParserInfo a
    pinfo ParseError
    msg [Context]
    ctx0 = (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
    $ \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
    $ \[String]
    names 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
                , [Context] -> ParserHelp
    globals [Context]
    ctx
                , ParserHelp
    error_help ]
      in (ParserHelp
    h, ExitCode
    exit_code, ParserPrefs -> Int
    prefColumns ParserPrefs
    pprefs)
      where
        --
        -- Add another context layer if the argument to --help is
        -- a valid command.
        ctx :: [Context]
    ctx = case ParseError
    msg of
          ShowHelpText (Just String
    potentialCommand) ->
            let ctx1 :: [Context]
    ctx1 = [Context]
    -> ParserInfo a
    -> (forall b. [String] -> ParserInfo b -> [Context])
    -> [Context]
    forall a c.
    [Context]
    -> ParserInfo a -> (forall b. [String] -> ParserInfo b -> c) -> c
    with_context [Context]
    ctx0 ParserInfo a
    pinfo ((forall b. [String] -> ParserInfo b -> [Context]) -> [Context])
    -> (forall b. [String] -> ParserInfo b -> [Context]) -> [Context]
    forall a b. (a -> b) -> a -> b
    $ \[String]
    _ ParserInfo b
    pinfo' ->
                  (Either ParseError (Maybe (Parser b), [String]), [Context])
    -> [Context]
    forall a b. (a, b) -> b
    snd
                    ((Either ParseError (Maybe (Parser b), [String]), [Context])
     -> [Context])
    -> (Either ParseError (Maybe (Parser b), [String]), [Context])
    -> [Context]
    forall a b. (a -> b) -> a -> b
    $ (P (Maybe (Parser b), [String])
     -> ParserPrefs
     -> (Either ParseError (Maybe (Parser b), [String]), [Context]))
    -> ParserPrefs
    -> P (Maybe (Parser b), [String])
    -> (Either ParseError (Maybe (Parser b), [String]), [Context])
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip P (Maybe (Parser b), [String])
    -> ParserPrefs
    -> (Either ParseError (Maybe (Parser b), [String]), [Context])
    forall a. P a -> ParserPrefs -> (Either ParseError a, [Context])
    runP ParserPrefs
    defaultPrefs { prefBacktrack = SubparserInline }
                    (P (Maybe (Parser b), [String])
     -> (Either ParseError (Maybe (Parser b), [String]), [Context]))
    -> P (Maybe (Parser b), [String])
    -> (Either ParseError (Maybe (Parser b), [String]), [Context])
    forall a b. (a -> b) -> a -> b
    $ ArgPolicy
    -> Parser b -> String -> [String] -> P (Maybe (Parser b), [String])
    forall (m :: * -> *) a.
    MonadP m =>
    ArgPolicy
    -> Parser a -> String -> [String] -> m (Maybe (Parser a), [String])
    runParserStep (ParserInfo b -> ArgPolicy
    forall a. ParserInfo a -> ArgPolicy
    infoPolicy ParserInfo b
    pinfo') (ParserInfo b -> Parser b
    forall a. ParserInfo a -> Parser a
    infoParser ParserInfo b
    pinfo') String
    potentialCommand []
            in [Context]
    ctx1 [Context] -> [Context] -> [Context]
    forall a. Monoid a => a -> a -> a
    `mappend` [Context]
    ctx0
          ParseError
    _ ->
            [Context]
    ctx0

        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)
          ParseError
    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 :: forall a c.
    [Context]
    -> ParserInfo a -> (forall b. [String] -> ParserInfo b -> c) -> c
    with_context [] ParserInfo a
    i 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 String
    _ ParserInfo a
    i:[Context]
    _) ParserInfo a
    _ 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

        globals :: [Context] -> ParserHelp
        globals :: [Context] -> ParserHelp
    globals [Context]
    cs =
          let
            voided :: [ParserInfo ()]
    voided =
              (Context -> ParserInfo ()) -> [Context] -> [ParserInfo ()]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(Context String
    _ ParserInfo a
    p) -> ParserInfo a -> ParserInfo ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParserInfo a
    p) [Context]
    cs [ParserInfo ()] -> [ParserInfo ()] -> [ParserInfo ()]
    forall a. Monoid a => a -> a -> a
    `mappend` ParserInfo () -> [ParserInfo ()]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ParserInfo a -> ParserInfo ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParserInfo a
    pinfo)

            globalParsers :: Parser ()
    globalParsers =
              (ParserInfo () -> Parser ()) -> [ParserInfo ()] -> Parser ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ ParserInfo () -> Parser ()
    forall a. ParserInfo a -> Parser a
    infoParser ([ParserInfo ()] -> Parser ()) -> [ParserInfo ()] -> Parser ()
    forall a b. (a -> b) -> a -> b
    $
                Int -> [ParserInfo ()] -> [ParserInfo ()]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [ParserInfo ()]
    voided
          in
            if ParserPrefs -> Bool
    prefHelpShowGlobal ParserPrefs
    pprefs then
              ParserPrefs -> Parser () -> ParserHelp
    forall a. ParserPrefs -> Parser a -> ParserHelp
    parserGlobals ParserPrefs
    pprefs Parser ()
    globalParsers
            else
              ParserHelp
    forall a. Monoid a => a
    mempty

        usage_help :: String -> [String] -> ParserInfo a -> ParserHelp
    usage_help String
    progn [String]
    names ParserInfo a
    i = case ParseError
    msg of
          InfoMsg String
    _
            -> ParserHelp
    forall a. Monoid a => a
    mempty
          ParseError
    _
            -> [ParserHelp] -> ParserHelp
    forall a. Monoid a => [a] -> a
    mconcat [
                Chunk Doc -> ParserHelp
    usageHelp (Doc -> Chunk Doc
    forall a. a -> Chunk a
    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)
              , Chunk Doc -> ParserHelp
    descriptionHelp (ParserInfo a -> Chunk Doc
    forall a. ParserInfo a -> Chunk Doc
    infoProgDesc 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 String
    m
            -> String -> Chunk Doc
    stringChunk String
    m

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

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

          MissingError IsCmdStart
    _ (SomeParser Parser a
    x)
            -> String -> Chunk Doc
    stringChunk String
    "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 String
    x
            -> String -> Chunk Doc
    stringChunk (String -> Chunk Doc) -> String -> Chunk Doc
    forall a b. (a -> b) -> a -> b
    $ String
    "The option `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "` expects an argument."

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

          ParseError
    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 String
    arg (SomeParser 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 a b. Chunk (a -> b) -> Chunk a -> Chunk b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Int -> Doc -> Doc
    forall ann. Int -> Doc ann -> Doc ann
    indent Int
    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 a b. (a -> b) -> [a] -> [b]
    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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    good Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2 then
                                String -> Chunk Doc
    stringChunk String
    "Did you mean this?"
                              else
                                String -> Chunk Doc
    stringChunk String
    "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 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
    < Int
    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. ArgumentReachability -> Option x -> [String])
    -> Parser a -> [[String]]
    forall b a.
    (forall x. ArgumentReachability -> Option x -> b)
    -> Parser a -> [b]
    mapParser ArgumentReachability -> Option x -> [String]
    forall x. ArgumentReachability -> 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 :: ArgumentReachability -> Option a -> [String]
    opt_completions ArgumentReachability
    reachability Option a
    opt = case Option a -> OptReader a
    forall a. Option a -> OptReader a
    optMain Option a
    opt of
                  OptReader [OptName]
    ns CReader a
    _ String -> ParseError
    _ -> (OptName -> String) -> [OptName] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap OptName -> String
    showOption [OptName]
    ns
                  FlagReader [OptName]
    ns a
    _  -> (OptName -> String) -> [OptName] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap OptName -> String
    showOption [OptName]
    ns
                  ArgReader CReader a
    _      -> []
                  CmdReader Maybe String
    _ [(String, ParserInfo a)]
    ns    | ArgumentReachability -> Bool
    argumentIsUnreachable ArgumentReachability
    reachability
                                   -> []
                                    | Bool
    otherwise
                                   -> (String, ParserInfo a) -> String
    forall a b. (a, b) -> a
    fst ((String, ParserInfo a) -> String)
    -> [(String, ParserInfo a)] -> [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(String, ParserInfo a)]
    ns
          ParseError
    _
            -> Chunk Doc
    forall a. Monoid a => a
    mempty

        base_help :: ParserInfo a -> ParserHelp
        base_help :: forall a. ParserInfo a -> ParserHelp
    base_help 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 IsCmdStart
    CmdStart  SomeParser
    _  | ParserPrefs -> Bool
    prefShowHelpOnEmpty ParserPrefs
    pprefs
                                   -> Bool
    True
          InfoMsg String
    _                -> Bool
    False
          ParseError
    _                        -> ParserPrefs -> Bool
    prefShowHelpOnError ParserPrefs
    pprefs

    renderFailure :: ParserFailure ParserHelp -> String -> (String, ExitCode)
    renderFailure :: ParserFailure ParserHelp -> String -> (String, ExitCode)
    renderFailure ParserFailure ParserHelp
    failure String
    progn =
      let (ParserHelp
    h, ExitCode
    exit, 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)