    {-# LANGUAGE CPP #-}
    module Options.Applicative.Help.Core (
      cmdDesc,
      briefDesc,
      missingDesc,
      fullDesc,
      globalDesc,
      ParserHelp(..),
      errorHelp,
      headerHelp,
      suggestionsHelp,
      usageHelp,
      descriptionHelp,
      bodyHelp,
      footerHelp,
      globalsHelp,
      parserHelp,
      parserUsage,
      parserGlobals
      ) where

    import Control.Applicative
    import Control.Monad (guard)
    import Data.Function (on)
    import Data.List (sort, intersperse, groupBy)
    import Data.Foldable (any, foldl')
    import Data.Maybe (catMaybes, fromMaybe)
    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid (mempty)
    #endif
    #if !MIN_VERSION_base(4,11,0)
    import Data.Semigroup (Semigroup (..))
    #endif
    import Prelude hiding (any)

    import Options.Applicative.Common
    import Options.Applicative.Types
    import Options.Applicative.Help.Pretty
    import Options.Applicative.Help.Chunk

    -- | Style for rendering an option.
    data OptDescStyle
      = OptDescStyle
          { OptDescStyle -> Doc
    descSep :: Doc,
            OptDescStyle -> Bool
    descHidden :: Bool,
            OptDescStyle -> Bool
    descGlobal :: Bool
          }

    safelast :: [a] -> Maybe a
    safelast :: forall a. [a] -> Maybe a
    safelast = (Maybe a -> a -> Maybe a) -> Maybe a -> [a] -> Maybe a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ((a -> Maybe a) -> Maybe a -> a -> Maybe a
    forall a b. a -> b -> a
    const a -> Maybe a
    forall a. a -> Maybe a
    Just) Maybe a
    forall a. Maybe a
    Nothing

    -- | Generate description for a single option.
    optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (Chunk Doc, Parenthetic)
    optDesc :: forall a.
    ParserPrefs
    -> OptDescStyle
    -> ArgumentReachability
    -> Option a
    -> (Chunk Doc, Parenthetic)
    optDesc ParserPrefs
    pprefs OptDescStyle
    style ArgumentReachability
    _reachability Option a
    opt =
      let names :: [OptName]
    names =
            [OptName] -> [OptName]
    forall a. Ord a => [a] -> [a]
    sort ([OptName] -> [OptName])
    -> (Option a -> [OptName]) -> Option a -> [OptName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OptReader a -> [OptName]
    forall a. OptReader a -> [OptName]
    optionNames (OptReader a -> [OptName])
    -> (Option a -> OptReader a) -> Option a -> [OptName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Option a -> OptReader a
    forall a. Option a -> OptReader a
    optMain (Option a -> [OptName]) -> Option a -> [OptName]
    forall a b. (a -> b) -> a -> b
    $ Option a
    opt
          meta :: Chunk Doc
    meta =
            String -> Chunk Doc
    stringChunk (String -> Chunk Doc) -> String -> Chunk Doc
    forall a b. (a -> b) -> a -> b
    $ Option a -> String
    forall a. Option a -> String
    optMetaVar Option a
    opt
          descs :: [Doc ann]
    descs =
            (OptName -> Doc ann) -> [OptName] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (String -> Doc ann) -> (OptName -> String) -> OptName -> Doc ann
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OptName -> String
    showOption) [OptName]
    names
          descriptions :: Chunk Doc
    descriptions =
            [Doc] -> Chunk Doc
    forall a. Semigroup a => [a] -> Chunk a
    listToChunk (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (OptDescStyle -> Doc
    descSep OptDescStyle
    style) [Doc]
    forall {ann}. [Doc ann]
    descs)
          desc :: Chunk Doc
    desc
            | ParserPrefs -> Bool
    prefHelpLongEquals ParserPrefs
    pprefs Bool -> Bool -> Bool
    && Bool -> Bool
    not (Chunk Doc -> Bool
    forall a. Chunk a -> Bool
    isEmpty Chunk Doc
    meta) Bool -> Bool -> Bool
    && (OptName -> Bool) -> Maybe OptName -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any OptName -> Bool
    isLongName ([OptName] -> Maybe OptName
    forall a. [a] -> Maybe a
    safelast [OptName]
    names) =
              Chunk Doc
    descriptions Chunk Doc -> Chunk Doc -> Chunk Doc
    forall a. Semigroup a => a -> a -> a
    <> String -> Chunk Doc
    stringChunk String
    "=" Chunk Doc -> Chunk Doc -> Chunk Doc
    forall a. Semigroup a => a -> a -> a
    <> Chunk Doc
    meta
            | Bool
    otherwise =
              Chunk Doc
    descriptions Chunk Doc -> Chunk Doc -> Chunk Doc
    <<+>> Chunk Doc
    meta
          show_opt :: Bool
    show_opt
            | OptDescStyle -> Bool
    descGlobal OptDescStyle
    style Bool -> Bool -> Bool
    && Bool -> Bool
    not (OptProperties -> Bool
    propShowGlobal (Option a -> OptProperties
    forall a. Option a -> OptProperties
    optProps Option a
    opt)) =
              Bool
    False
            | Option a -> OptVisibility
    forall a. Option a -> OptVisibility
    optVisibility Option a
    opt OptVisibility -> OptVisibility -> Bool
    forall a. Eq a => a -> a -> Bool
    == OptVisibility
    Hidden =
              OptDescStyle -> Bool
    descHidden OptDescStyle
    style
            | Bool
    otherwise =
              Option a -> OptVisibility
    forall a. Option a -> OptVisibility
    optVisibility Option a
    opt OptVisibility -> OptVisibility -> Bool
    forall a. Eq a => a -> a -> Bool
    == OptVisibility
    Visible
          wrapping :: Parenthetic
    wrapping
            | [OptName] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [OptName]
    names =
              Parenthetic
    NeverRequired
            | [OptName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [OptName]
    names Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 =
              Parenthetic
    MaybeRequired
            | Bool
    otherwise =
              Parenthetic
    AlwaysRequired
          rendered :: Chunk Doc
    rendered
            | Bool -> Bool
    not Bool
    show_opt =
              Chunk Doc
    forall a. Monoid a => a
    mempty
            | Bool
    otherwise =
              Chunk Doc
    desc
          modified :: Chunk Doc
    modified =
            (Chunk Doc -> Chunk Doc)
    -> ((Doc -> Doc) -> Chunk Doc -> Chunk Doc)
    -> Maybe (Doc -> Doc)
    -> Chunk Doc
    -> Chunk Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Chunk Doc -> Chunk Doc
    forall a. a -> a
    id (Doc -> Doc) -> Chunk Doc -> Chunk Doc
    forall a b. (a -> b) -> Chunk a -> Chunk b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Option a -> Maybe (Doc -> Doc)
    forall a. Option a -> Maybe (Doc -> Doc)
    optDescMod Option a
    opt) Chunk Doc
    rendered
       in (Chunk Doc
    modified, Parenthetic
    wrapping)

    -- | Generate descriptions for commands.
    cmdDesc :: ParserPrefs -> Parser a -> [(Maybe String, Chunk Doc)]
    cmdDesc :: forall a. ParserPrefs -> Parser a -> [(Maybe String, Chunk Doc)]
    cmdDesc ParserPrefs
    pprefs = (forall x.
     ArgumentReachability -> Option x -> (Maybe String, Chunk Doc))
    -> Parser a -> [(Maybe String, Chunk Doc)]
    forall b a.
    (forall x. ArgumentReachability -> Option x -> b)
    -> Parser a -> [b]
    mapParser ArgumentReachability -> Option x -> (Maybe String, Chunk Doc)
    forall x.
    ArgumentReachability -> Option x -> (Maybe String, Chunk Doc)
    forall {p} {a}. p -> Option a -> (Maybe String, Chunk Doc)
    desc
      where
        desc :: p -> Option a -> (Maybe String, Chunk Doc)
    desc p
    _ Option a
    opt =
          case Option a -> OptReader a
    forall a. Option a -> OptReader a
    optMain Option a
    opt of
            CmdReader Maybe String
    gn [(String, ParserInfo a)]
    cmds ->
              (,) Maybe String
    gn (Chunk Doc -> (Maybe String, Chunk Doc))
    -> Chunk Doc -> (Maybe String, Chunk Doc)
    forall a b. (a -> b) -> a -> b
    $
                Int -> [(Doc, Doc)] -> Chunk Doc
    tabulate (ParserPrefs -> Int
    prefTabulateFill ParserPrefs
    pprefs)
                  [ (String -> Doc
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    nm, Doc -> Doc
    forall ann. Doc ann -> Doc ann
    align (Chunk Doc -> Doc
    forall a. Monoid a => Chunk a -> a
    extractChunk (ParserInfo a -> Chunk Doc
    forall a. ParserInfo a -> Chunk Doc
    infoProgDesc ParserInfo a
    cmd)))
                  | (String
    nm, ParserInfo a
    cmd) <- [(String, ParserInfo a)] -> [(String, ParserInfo a)]
    forall a. [a] -> [a]
    reverse [(String, ParserInfo a)]
    cmds
                  ]
            OptReader a
    _ -> (Maybe String, Chunk Doc)
    forall a. Monoid a => a
    mempty

    -- | Generate a brief help text for a parser.
    briefDesc :: ParserPrefs -> Parser a -> Chunk Doc
    briefDesc :: forall a. ParserPrefs -> Parser a -> Chunk Doc
    briefDesc = Bool -> ParserPrefs -> Parser a -> Chunk Doc
    forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
    briefDesc' Bool
    True

    -- | Generate a brief help text for a parser, only including mandatory
    --   options and arguments.
    missingDesc :: ParserPrefs -> Parser a -> Chunk Doc
    missingDesc :: forall a. ParserPrefs -> Parser a -> Chunk Doc
    missingDesc = Bool -> ParserPrefs -> Parser a -> Chunk Doc
    forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
    briefDesc' Bool
    False

    -- | Generate a brief help text for a parser, allowing the specification
    --   of if optional arguments are show.
    briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
    briefDesc' :: forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
    briefDesc' Bool
    showOptional ParserPrefs
    pprefs =
      AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
    wrapOver AltNodeType
    NoDefault Parenthetic
    MaybeRequired
        ((Chunk Doc, Parenthetic) -> Chunk Doc)
    -> (Parser a -> (Chunk Doc, Parenthetic)) -> Parser a -> Chunk Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParserPrefs
    -> OptDescStyle
    -> OptTree (Chunk Doc, Parenthetic)
    -> (Chunk Doc, Parenthetic)
    foldTree ParserPrefs
    pprefs OptDescStyle
    style
        (OptTree (Chunk Doc, Parenthetic) -> (Chunk Doc, Parenthetic))
    -> (Parser a -> OptTree (Chunk Doc, Parenthetic))
    -> Parser a
    -> (Chunk Doc, Parenthetic)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OptTree (Chunk Doc, Parenthetic)
    -> OptTree (Chunk Doc, Parenthetic)
    forall {a}. OptTree a -> OptTree a
    mfilterOptional
        (OptTree (Chunk Doc, Parenthetic)
     -> OptTree (Chunk Doc, Parenthetic))
    -> (Parser a -> OptTree (Chunk Doc, Parenthetic))
    -> Parser a
    -> OptTree (Chunk Doc, Parenthetic)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall x.
     ArgumentReachability -> Option x -> (Chunk Doc, Parenthetic))
    -> Parser a -> OptTree (Chunk Doc, Parenthetic)
    forall b a.
    (forall x. ArgumentReachability -> Option x -> b)
    -> Parser a -> OptTree b
    treeMapParser (ParserPrefs
    -> OptDescStyle
    -> ArgumentReachability
    -> Option x
    -> (Chunk Doc, Parenthetic)
    forall a.
    ParserPrefs
    -> OptDescStyle
    -> ArgumentReachability
    -> Option a
    -> (Chunk Doc, Parenthetic)
    optDesc ParserPrefs
    pprefs OptDescStyle
    style)
      where
        mfilterOptional :: OptTree a -> OptTree a
    mfilterOptional
          | Bool
    showOptional =
            OptTree a -> OptTree a
    forall a. a -> a
    id
          | Bool
    otherwise =
            OptTree a -> OptTree a
    forall {a}. OptTree a -> OptTree a
    filterOptional
        style :: OptDescStyle
    style = OptDescStyle
          { descSep :: Doc
    descSep = Char -> Doc
    forall ann. Char -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Char
    '|',
            descHidden :: Bool
    descHidden = Bool
    False,
            descGlobal :: Bool
    descGlobal = Bool
    False
          }

    -- | Wrap a doc in parentheses or brackets if required.
    wrapOver :: AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
    wrapOver :: AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
    wrapOver AltNodeType
    altnode Parenthetic
    mustWrapBeyond (Chunk Doc
    chunk, Parenthetic
    wrapping)
      | AltNodeType
    altnode AltNodeType -> AltNodeType -> Bool
    forall a. Eq a => a -> a -> Bool
    == AltNodeType
    MarkDefault =
        (Doc -> Doc) -> Chunk Doc -> Chunk Doc
    forall a b. (a -> b) -> Chunk a -> Chunk b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Doc -> Doc
    forall ann. Doc ann -> Doc ann
    brackets Chunk Doc
    chunk
      | Parenthetic
    wrapping Parenthetic -> Parenthetic -> Bool
    forall a. Ord a => a -> a -> Bool
    > Parenthetic
    mustWrapBeyond =
        (Doc -> Doc) -> Chunk Doc -> Chunk Doc
    forall a b. (a -> b) -> Chunk a -> Chunk b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Doc -> Doc
    forall ann. Doc ann -> Doc ann
    parens Chunk Doc
    chunk
      | Bool
    otherwise =
        Chunk Doc
    chunk

    -- Fold a tree of option docs into a single doc with fully marked
    -- optional areas and groups.
    foldTree :: ParserPrefs -> OptDescStyle -> OptTree (Chunk Doc, Parenthetic) -> (Chunk Doc, Parenthetic)
    foldTree :: ParserPrefs
    -> OptDescStyle
    -> OptTree (Chunk Doc, Parenthetic)
    -> (Chunk Doc, Parenthetic)
    foldTree ParserPrefs
    _ OptDescStyle
    _ (Leaf (Chunk Doc, Parenthetic)
    x) =
      (Chunk Doc, Parenthetic)
    x
    foldTree ParserPrefs
    prefs OptDescStyle
    s (MultNode [OptTree (Chunk Doc, Parenthetic)]
    xs) =
      let go :: OptTree (Chunk Doc, Parenthetic) -> Chunk Doc -> Chunk Doc
    go =
            Chunk Doc -> Chunk Doc -> Chunk Doc
    (<</>>) (Chunk Doc -> Chunk Doc -> Chunk Doc)
    -> (OptTree (Chunk Doc, Parenthetic) -> Chunk Doc)
    -> OptTree (Chunk Doc, Parenthetic)
    -> Chunk Doc
    -> Chunk Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
    wrapOver AltNodeType
    NoDefault Parenthetic
    MaybeRequired ((Chunk Doc, Parenthetic) -> Chunk Doc)
    -> (OptTree (Chunk Doc, Parenthetic) -> (Chunk Doc, Parenthetic))
    -> OptTree (Chunk Doc, Parenthetic)
    -> Chunk Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParserPrefs
    -> OptDescStyle
    -> OptTree (Chunk Doc, Parenthetic)
    -> (Chunk Doc, Parenthetic)
    foldTree ParserPrefs
    prefs OptDescStyle
    s
          x :: Chunk Doc
    x =
            (OptTree (Chunk Doc, Parenthetic) -> Chunk Doc -> Chunk Doc)
    -> Chunk Doc -> [OptTree (Chunk Doc, Parenthetic)] -> Chunk Doc
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr OptTree (Chunk Doc, Parenthetic) -> Chunk Doc -> Chunk Doc
    go Chunk Doc
    forall a. Monoid a => a
    mempty [OptTree (Chunk Doc, Parenthetic)]
    xs
          wrapLevel :: Parenthetic
    wrapLevel =
            [OptTree (Chunk Doc, Parenthetic)] -> Parenthetic
    forall {a}. [a] -> Parenthetic
    mult_wrap [OptTree (Chunk Doc, Parenthetic)]
    xs
       in (Chunk Doc
    x, Parenthetic
    wrapLevel)
      where
        mult_wrap :: [a] -> Parenthetic
    mult_wrap [a
    _] = Parenthetic
    NeverRequired
        mult_wrap [a]
    _ = Parenthetic
    MaybeRequired
    foldTree ParserPrefs
    prefs OptDescStyle
    s (AltNode AltNodeType
    b [OptTree (Chunk Doc, Parenthetic)]
    xs) =
      (\Chunk Doc
    x -> (Chunk Doc
    x, Parenthetic
    NeverRequired))
        (Chunk Doc -> (Chunk Doc, Parenthetic))
    -> ([OptTree (Chunk Doc, Parenthetic)] -> Chunk Doc)
    -> [OptTree (Chunk Doc, Parenthetic)]
    -> (Chunk Doc, Parenthetic)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Doc -> Doc) -> Chunk Doc -> Chunk Doc
    forall a b. (a -> b) -> Chunk a -> Chunk b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Doc -> Doc
    groupOrNestLine
        (Chunk Doc -> Chunk Doc)
    -> ([OptTree (Chunk Doc, Parenthetic)] -> Chunk Doc)
    -> [OptTree (Chunk Doc, Parenthetic)]
    -> Chunk Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
    wrapOver AltNodeType
    b Parenthetic
    MaybeRequired
        ((Chunk Doc, Parenthetic) -> Chunk Doc)
    -> ([OptTree (Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic))
    -> [OptTree (Chunk Doc, Parenthetic)]
    -> Chunk Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic)
    alt_node
        ([(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic))
    -> ([OptTree (Chunk Doc, Parenthetic)]
        -> [(Chunk Doc, Parenthetic)])
    -> [OptTree (Chunk Doc, Parenthetic)]
    -> (Chunk Doc, Parenthetic)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Chunk Doc, Parenthetic) -> Bool)
    -> [(Chunk Doc, Parenthetic)] -> [(Chunk Doc, Parenthetic)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((Chunk Doc, Parenthetic) -> Bool)
    -> (Chunk Doc, Parenthetic)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Chunk Doc -> Bool
    forall a. Chunk a -> Bool
    isEmpty (Chunk Doc -> Bool)
    -> ((Chunk Doc, Parenthetic) -> Chunk Doc)
    -> (Chunk Doc, Parenthetic)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Chunk Doc, Parenthetic) -> Chunk Doc
    forall a b. (a, b) -> a
    fst)
        ([(Chunk Doc, Parenthetic)] -> [(Chunk Doc, Parenthetic)])
    -> ([OptTree (Chunk Doc, Parenthetic)]
        -> [(Chunk Doc, Parenthetic)])
    -> [OptTree (Chunk Doc, Parenthetic)]
    -> [(Chunk Doc, Parenthetic)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OptTree (Chunk Doc, Parenthetic) -> (Chunk Doc, Parenthetic))
    -> [OptTree (Chunk Doc, Parenthetic)] -> [(Chunk Doc, Parenthetic)]
    forall a b. (a -> b) -> [a] -> [b]
    map (ParserPrefs
    -> OptDescStyle
    -> OptTree (Chunk Doc, Parenthetic)
    -> (Chunk Doc, Parenthetic)
    foldTree ParserPrefs
    prefs OptDescStyle
    s)
        ([OptTree (Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic))
    -> [OptTree (Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic)
    forall a b. (a -> b) -> a -> b
    $ [OptTree (Chunk Doc, Parenthetic)]
    xs
      where
        alt_node :: [(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic)
        alt_node :: [(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic)
    alt_node [(Chunk Doc, Parenthetic)
    n] = (Chunk Doc, Parenthetic)
    n
        alt_node [(Chunk Doc, Parenthetic)]
    ns =
          (\Chunk Doc
    y -> (Chunk Doc
    y, Parenthetic
    AlwaysRequired))
            (Chunk Doc -> (Chunk Doc, Parenthetic))
    -> ([(Chunk Doc, Parenthetic)] -> Chunk Doc)
    -> [(Chunk Doc, Parenthetic)]
    -> (Chunk Doc, Parenthetic)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Chunk Doc, Parenthetic) -> Chunk Doc -> Chunk Doc)
    -> Chunk Doc -> [(Chunk Doc, Parenthetic)] -> Chunk Doc
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((Doc -> Doc -> Doc) -> Chunk Doc -> Chunk Doc -> Chunk Doc
    forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
    chunked Doc -> Doc -> Doc
    altSep (Chunk Doc -> Chunk Doc -> Chunk Doc)
    -> ((Chunk Doc, Parenthetic) -> Chunk Doc)
    -> (Chunk Doc, Parenthetic)
    -> Chunk Doc
    -> Chunk Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
    wrapOver AltNodeType
    NoDefault Parenthetic
    MaybeRequired) Chunk Doc
    forall a. Monoid a => a
    mempty
            ([(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic))
    -> [(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic)
    forall a b. (a -> b) -> a -> b
    $ [(Chunk Doc, Parenthetic)]
    ns
    foldTree ParserPrefs
    prefs OptDescStyle
    s (BindNode OptTree (Chunk Doc, Parenthetic)
    x) =
      let rendered :: Chunk Doc
    rendered =
            AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
    wrapOver AltNodeType
    NoDefault Parenthetic
    NeverRequired (ParserPrefs
    -> OptDescStyle
    -> OptTree (Chunk Doc, Parenthetic)
    -> (Chunk Doc, Parenthetic)
    foldTree ParserPrefs
    prefs OptDescStyle
    s OptTree (Chunk Doc, Parenthetic)
    x)

          -- We always want to display the rendered option
          -- if it exists, and only attach the suffix then.
          withSuffix :: Chunk Doc
    withSuffix =
            Chunk Doc
    rendered Chunk Doc -> (Doc -> Chunk Doc) -> Chunk Doc
    forall a b. Chunk a -> (a -> Chunk b) -> Chunk b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\Doc
    r -> Doc -> Chunk Doc
    forall a. a -> Chunk a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Doc
    r Chunk Doc -> Chunk Doc -> Chunk Doc
    forall a. Semigroup a => a -> a -> a
    <> String -> Chunk Doc
    stringChunk (ParserPrefs -> String
    prefMultiSuffix ParserPrefs
    prefs))
       in (Chunk Doc
    withSuffix, Parenthetic
    NeverRequired)

    -- | Generate a full help text for a parser
    fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
    fullDesc :: forall a. ParserPrefs -> Parser a -> Chunk Doc
    fullDesc = Bool -> ParserPrefs -> Parser a -> Chunk Doc
    forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
    optionsDesc Bool
    False

    -- | Generate a help text for the parser, showing
    --   only what is relevant in the "Global options: section"
    globalDesc :: ParserPrefs -> Parser a -> Chunk Doc
    globalDesc :: forall a. ParserPrefs -> Parser a -> Chunk Doc
    globalDesc = Bool -> ParserPrefs -> Parser a -> Chunk Doc
    forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
    optionsDesc Bool
    True

    -- | Common generator for full descriptions and globals
    optionsDesc :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
    optionsDesc :: forall a. Bool -> ParserPrefs -> Parser a -> Chunk Doc
    optionsDesc Bool
    global ParserPrefs
    pprefs = Int -> [(Doc, Doc)] -> Chunk Doc
    tabulate (ParserPrefs -> Int
    prefTabulateFill ParserPrefs
    pprefs) ([(Doc, Doc)] -> Chunk Doc)
    -> (Parser a -> [(Doc, Doc)]) -> Parser a -> Chunk Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe (Doc, Doc)] -> [(Doc, Doc)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (Doc, Doc)] -> [(Doc, Doc)])
    -> (Parser a -> [Maybe (Doc, Doc)]) -> Parser a -> [(Doc, Doc)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall x. ArgumentReachability -> Option x -> Maybe (Doc, Doc))
    -> Parser a -> [Maybe (Doc, Doc)]
    forall b a.
    (forall x. ArgumentReachability -> Option x -> b)
    -> Parser a -> [b]
    mapParser ArgumentReachability -> Option x -> Maybe (Doc, Doc)
    forall x. ArgumentReachability -> Option x -> Maybe (Doc, Doc)
    forall {m :: * -> *} {a}.
    (Monad m, Alternative m) =>
    ArgumentReachability -> Option a -> m (Doc, Doc)
    doc
      where
        doc :: ArgumentReachability -> Option a -> m (Doc, Doc)
    doc ArgumentReachability
    info Option a
    opt = do
          Bool -> m ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> m ()) -> (Chunk Doc -> Bool) -> Chunk Doc -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool
    not (Bool -> Bool) -> (Chunk Doc -> Bool) -> Chunk Doc -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Chunk Doc -> Bool
    forall a. Chunk a -> Bool
    isEmpty (Chunk Doc -> m ()) -> Chunk Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Chunk Doc
    n
          Bool -> m ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> m ()) -> (Chunk Doc -> Bool) -> Chunk Doc -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool
    not (Bool -> Bool) -> (Chunk Doc -> Bool) -> Chunk Doc -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Chunk Doc -> Bool
    forall a. Chunk a -> Bool
    isEmpty (Chunk Doc -> m ()) -> Chunk Doc -> m ()
    forall a b. (a -> b) -> a -> b
    $ Chunk Doc
    h
          (Doc, Doc) -> m (Doc, Doc)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Chunk Doc -> Doc
    forall a. Monoid a => Chunk a -> a
    extractChunk Chunk Doc
    n, Doc -> Doc
    forall ann. Doc ann -> Doc ann
    align (Doc -> Doc) -> (Chunk Doc -> Doc) -> Chunk Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Chunk Doc -> Doc
    forall a. Monoid a => Chunk a -> a
    extractChunk (Chunk Doc -> Doc) -> Chunk Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Chunk Doc
    h Chunk Doc -> Chunk Doc -> Chunk Doc
    <</>> Chunk Doc
    forall {ann}. Chunk (Doc ann)
    hdef)
          where
            n :: Chunk Doc
    n = (Chunk Doc, Parenthetic) -> Chunk Doc
    forall a b. (a, b) -> a
    fst ((Chunk Doc, Parenthetic) -> Chunk Doc)
    -> (Chunk Doc, Parenthetic) -> Chunk Doc
    forall a b. (a -> b) -> a -> b
    $ ParserPrefs
    -> OptDescStyle
    -> ArgumentReachability
    -> Option a
    -> (Chunk Doc, Parenthetic)
    forall a.
    ParserPrefs
    -> OptDescStyle
    -> ArgumentReachability
    -> Option a
    -> (Chunk Doc, Parenthetic)
    optDesc ParserPrefs
    pprefs OptDescStyle
    style ArgumentReachability
    info Option a
    opt
            h :: Chunk Doc
    h = Option a -> Chunk Doc
    forall a. Option a -> Chunk Doc
    optHelp Option a
    opt
            hdef :: Chunk (Doc ann)
    hdef = Maybe (Doc ann) -> Chunk (Doc ann)
    forall a. Maybe a -> Chunk a
    Chunk (Maybe (Doc ann) -> Chunk (Doc ann))
    -> (Option a -> Maybe (Doc ann)) -> Option a -> Chunk (Doc ann)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Doc ann) -> Maybe String -> Maybe (Doc ann)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Doc ann
    forall {a} {ann}. Pretty a => a -> Doc ann
    show_def (Maybe String -> Maybe (Doc ann))
    -> (Option a -> Maybe String) -> Option a -> Maybe (Doc ann)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Option a -> Maybe String
    forall a. Option a -> Maybe String
    optShowDefault (Option a -> Chunk (Doc ann)) -> Option a -> Chunk (Doc ann)
    forall a b. (a -> b) -> a -> b
    $ Option a
    opt
            show_def :: a -> Doc ann
    show_def a
    s = Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    parens (String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    "default:" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty a
    s)
        style :: OptDescStyle
    style = OptDescStyle
          { descSep :: Doc
    descSep = Char -> Doc
    forall ann. Char -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Char
    ',',
            descHidden :: Bool
    descHidden = Bool
    True,
            descGlobal :: Bool
    descGlobal = Bool
    global
          }

    errorHelp :: Chunk Doc -> ParserHelp
    errorHelp :: Chunk Doc -> ParserHelp
    errorHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpError = chunk }

    headerHelp :: Chunk Doc -> ParserHelp
    headerHelp :: Chunk Doc -> ParserHelp
    headerHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpHeader = chunk }

    suggestionsHelp :: Chunk Doc -> ParserHelp
    suggestionsHelp :: Chunk Doc -> ParserHelp
    suggestionsHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpSuggestions = chunk }

    globalsHelp :: Chunk Doc -> ParserHelp
    globalsHelp :: Chunk Doc -> ParserHelp
    globalsHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpGlobals = chunk }

    usageHelp :: Chunk Doc -> ParserHelp
    usageHelp :: Chunk Doc -> ParserHelp
    usageHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpUsage = chunk }

    descriptionHelp :: Chunk Doc -> ParserHelp
    descriptionHelp :: Chunk Doc -> ParserHelp
    descriptionHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpDescription = chunk }

    bodyHelp :: Chunk Doc -> ParserHelp
    bodyHelp :: Chunk Doc -> ParserHelp
    bodyHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpBody = chunk }

    footerHelp :: Chunk Doc -> ParserHelp
    footerHelp :: Chunk Doc -> ParserHelp
    footerHelp Chunk Doc
    chunk = ParserHelp
    forall a. Monoid a => a
    mempty { helpFooter = chunk }

    -- | Generate the help text for a program.
    parserHelp :: ParserPrefs -> Parser a -> ParserHelp
    parserHelp :: forall a. ParserPrefs -> Parser a -> ParserHelp
    parserHelp ParserPrefs
    pprefs Parser a
    p =
      Chunk Doc -> ParserHelp
    bodyHelp (Chunk Doc -> ParserHelp)
    -> ([Chunk Doc] -> Chunk Doc) -> [Chunk Doc] -> ParserHelp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Chunk Doc] -> Chunk Doc
    vsepChunks ([Chunk Doc] -> ParserHelp) -> [Chunk Doc] -> ParserHelp
    forall a b. (a -> b) -> a -> b
    $
        String -> Chunk Doc -> Chunk Doc
    with_title String
    "Available options:" (ParserPrefs -> Parser a -> Chunk Doc
    forall a. ParserPrefs -> Parser a -> Chunk Doc
    fullDesc ParserPrefs
    pprefs Parser a
    p)
          Chunk Doc -> [Chunk Doc] -> [Chunk Doc]
    forall a. a -> [a] -> [a]
    : ([(Maybe String, Chunk Doc)] -> Chunk Doc
    group_title ([(Maybe String, Chunk Doc)] -> Chunk Doc)
    -> [[(Maybe String, Chunk Doc)]] -> [Chunk Doc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[(Maybe String, Chunk Doc)]]
    cs)
      where
        def :: String
    def = String
    "Available commands:"
        cs :: [[(Maybe String, Chunk Doc)]]
    cs = ((Maybe String, Chunk Doc) -> (Maybe String, Chunk Doc) -> Bool)
    -> [(Maybe String, Chunk Doc)] -> [[(Maybe String, Chunk Doc)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Maybe String -> Maybe String -> Bool)
    -> ((Maybe String, Chunk Doc) -> Maybe String)
    -> (Maybe String, Chunk Doc)
    -> (Maybe String, Chunk Doc)
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Maybe String, Chunk Doc) -> Maybe String
    forall a b. (a, b) -> a
    fst) ([(Maybe String, Chunk Doc)] -> [[(Maybe String, Chunk Doc)]])
    -> [(Maybe String, Chunk Doc)] -> [[(Maybe String, Chunk Doc)]]
    forall a b. (a -> b) -> a -> b
    $ ParserPrefs -> Parser a -> [(Maybe String, Chunk Doc)]
    forall a. ParserPrefs -> Parser a -> [(Maybe String, Chunk Doc)]
    cmdDesc ParserPrefs
    pprefs Parser a
    p

        group_title :: [(Maybe String, Chunk Doc)] -> Chunk Doc
    group_title a :: [(Maybe String, Chunk Doc)]
    a@((Maybe String
    n, Chunk Doc
    _) : [(Maybe String, Chunk Doc)]
    _) =
          String -> Chunk Doc -> Chunk Doc
    with_title (String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    def Maybe String
    n) (Chunk Doc -> Chunk Doc) -> Chunk Doc -> Chunk Doc
    forall a b. (a -> b) -> a -> b
    $
            [Chunk Doc] -> Chunk Doc
    vcatChunks ((Maybe String, Chunk Doc) -> Chunk Doc
    forall a b. (a, b) -> b
    snd ((Maybe String, Chunk Doc) -> Chunk Doc)
    -> [(Maybe String, Chunk Doc)] -> [Chunk Doc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe String, Chunk Doc)]
    a)
        group_title [(Maybe String, Chunk Doc)]
    _ = Chunk Doc
    forall a. Monoid a => a
    mempty

        with_title :: String -> Chunk Doc -> Chunk Doc
        with_title :: String -> Chunk Doc -> Chunk Doc
    with_title String
    title = (Doc -> Doc) -> Chunk Doc -> Chunk Doc
    forall a b. (a -> b) -> Chunk a -> Chunk b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> Doc
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    title Doc -> Doc -> Doc
    .$.)

    parserGlobals :: ParserPrefs -> Parser a -> ParserHelp
    parserGlobals :: forall a. ParserPrefs -> Parser a -> ParserHelp
    parserGlobals ParserPrefs
    pprefs Parser a
    p =
      Chunk Doc -> ParserHelp
    globalsHelp (Chunk Doc -> ParserHelp) -> Chunk Doc -> ParserHelp
    forall a b. (a -> b) -> a -> b
    $
        Doc -> Doc -> Doc
    (.$.) (Doc -> Doc -> Doc) -> Chunk Doc -> Chunk (Doc -> Doc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Chunk Doc
    stringChunk String
    "Global options:"
              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
    <*> ParserPrefs -> Parser a -> Chunk Doc
    forall a. ParserPrefs -> Parser a -> Chunk Doc
    globalDesc ParserPrefs
    pprefs Parser a
    p

    -- | Generate option summary.
    parserUsage :: ParserPrefs -> Parser a -> String -> Doc
    parserUsage :: forall a. ParserPrefs -> Parser a -> String -> Doc
    parserUsage ParserPrefs
    pprefs Parser a
    p String
    progn =
      Doc -> Doc
    forall ann. Doc ann -> Doc ann
    group (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
        [Doc] -> Doc
    forall ann. [Doc ann] -> Doc ann
    hsep
          [ String -> Doc
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    "Usage:",
            String -> Doc
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    progn,
            Int -> Int -> Doc -> Doc
    hangAtIfOver Int
    9 Int
    35 (Chunk Doc -> Doc
    forall a. Monoid a => Chunk a -> a
    extractChunk (ParserPrefs -> Parser a -> Chunk Doc
    forall a. ParserPrefs -> Parser a -> Chunk Doc
    briefDesc ParserPrefs
    pprefs Parser a
    p))
          ]

    -- | Peek at the structure of the rendered tree within.
    --
    --   For example, if a child is an option with multiple
    --   alternatives, such as -a or -b, we need to know this
    --   when wrapping it. For example, whether it's optional:
    --   we don't want to have [(-a|-b)], rather [-a|-b] or
    --   (-a|-b).
    data Parenthetic
      = NeverRequired
      -- ^ Parenthesis are not required.
      | MaybeRequired
      -- ^ Parenthesis should be used if this group can be repeated
      | AlwaysRequired
      -- ^ Parenthesis should always be used.
      deriving (Parenthetic -> Parenthetic -> Bool
    (Parenthetic -> Parenthetic -> Bool)
    -> (Parenthetic -> Parenthetic -> Bool) -> Eq Parenthetic
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Parenthetic -> Parenthetic -> Bool
    == :: Parenthetic -> Parenthetic -> Bool
    $c/= :: Parenthetic -> Parenthetic -> Bool
    /= :: Parenthetic -> Parenthetic -> Bool
    Eq, Eq Parenthetic
    Eq Parenthetic =>
    (Parenthetic -> Parenthetic -> Ordering)
    -> (Parenthetic -> Parenthetic -> Bool)
    -> (Parenthetic -> Parenthetic -> Bool)
    -> (Parenthetic -> Parenthetic -> Bool)
    -> (Parenthetic -> Parenthetic -> Bool)
    -> (Parenthetic -> Parenthetic -> Parenthetic)
    -> (Parenthetic -> Parenthetic -> Parenthetic)
    -> Ord Parenthetic
    Parenthetic -> Parenthetic -> Bool
    Parenthetic -> Parenthetic -> Ordering
    Parenthetic -> Parenthetic -> Parenthetic
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Parenthetic -> Parenthetic -> Ordering
    compare :: Parenthetic -> Parenthetic -> Ordering
    $c< :: Parenthetic -> Parenthetic -> Bool
    < :: Parenthetic -> Parenthetic -> Bool
    $c<= :: Parenthetic -> Parenthetic -> Bool
    <= :: Parenthetic -> Parenthetic -> Bool
    $c> :: Parenthetic -> Parenthetic -> Bool
    > :: Parenthetic -> Parenthetic -> Bool
    $c>= :: Parenthetic -> Parenthetic -> Bool
    >= :: Parenthetic -> Parenthetic -> Bool
    $cmax :: Parenthetic -> Parenthetic -> Parenthetic
    max :: Parenthetic -> Parenthetic -> Parenthetic
    $cmin :: Parenthetic -> Parenthetic -> Parenthetic
    min :: Parenthetic -> Parenthetic -> Parenthetic
    Ord, Int -> Parenthetic -> ShowS
    [Parenthetic] -> ShowS
    Parenthetic -> String
    (Int -> Parenthetic -> ShowS)
    -> (Parenthetic -> String)
    -> ([Parenthetic] -> ShowS)
    -> Show Parenthetic
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Parenthetic -> ShowS
    showsPrec :: Int -> Parenthetic -> ShowS
    $cshow :: Parenthetic -> String
    show :: Parenthetic -> String
    $cshowList :: [Parenthetic] -> ShowS
    showList :: [Parenthetic] -> ShowS
    Show)