{-# 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b. a -> b -> a
const forall a. a -> Maybe a
Just) 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 =
        forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OptReader a -> [OptName]
optionNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Option a -> OptReader a
optMain forall a b. (a -> b) -> a -> b
$ Option a
opt
      meta :: Chunk Doc
meta =
        String -> Chunk Doc
stringChunk forall a b. (a -> b) -> a -> b
$ forall a. Option a -> String
optMetaVar Option a
opt
      descs :: [Doc ann]
descs =
        forall a b. (a -> b) -> [a] -> [b]
map (forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptName -> String
showOption) [OptName]
names
      descriptions :: Chunk Doc
descriptions =
        forall a. Semigroup a => [a] -> Chunk a
listToChunk (forall a. a -> [a] -> [a]
intersperse (OptDescStyle -> Doc
descSep OptDescStyle
style) forall {ann}. [Doc ann]
descs)
      desc :: Chunk Doc
desc
        | ParserPrefs -> Bool
prefHelpLongEquals ParserPrefs
pprefs Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. Chunk a -> Bool
isEmpty Chunk Doc
meta) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any OptName -> Bool
isLongName (forall a. [a] -> Maybe a
safelast [OptName]
names) =
          Chunk Doc
descriptions forall a. Semigroup a => a -> a -> a
<> String -> Chunk Doc
stringChunk String
"=" 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 (forall a. Option a -> OptProperties
optProps Option a
opt)) =
          Bool
False
        | forall a. Option a -> OptVisibility
optVisibility Option a
opt forall a. Eq a => a -> a -> Bool
== OptVisibility
Hidden =
          OptDescStyle -> Bool
descHidden OptDescStyle
style
        | Bool
otherwise =
          forall a. Option a -> OptVisibility
optVisibility Option a
opt forall a. Eq a => a -> a -> Bool
== OptVisibility
Visible
      wrapping :: Parenthetic
wrapping
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptName]
names =
          Parenthetic
NeverRequired
        | forall (t :: * -> *) a. Foldable t => t a -> Int
length [OptName]
names 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 =
          forall a. Monoid a => a
mempty
        | Bool
otherwise =
          Chunk Doc
desc
      modified :: Chunk Doc
modified =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 b a.
(forall x. ArgumentReachability -> Option x -> b)
-> Parser a -> [b]
mapParser 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 forall a. Option a -> OptReader a
optMain Option a
opt of
        CmdReader Maybe String
gn [(String, ParserInfo a)]
cmds ->
          (,) Maybe String
gn forall a b. (a -> b) -> a -> b
$
            Int -> [(Doc, Doc)] -> Chunk Doc
tabulate (ParserPrefs -> Int
prefTabulateFill ParserPrefs
pprefs)
              [ (forall a ann. Pretty a => a -> Doc ann
pretty String
nm, forall ann. Doc ann -> Doc ann
align (forall a. Monoid a => Chunk a -> a
extractChunk (forall a. ParserInfo a -> Chunk Doc
infoProgDesc ParserInfo a
cmd)))
              | (String
nm, ParserInfo a
cmd) <- forall a. [a] -> [a]
reverse [(String, ParserInfo a)]
cmds
              ]
        OptReader a
_ -> 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 = 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 = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs
-> OptDescStyle
-> OptTree (Chunk Doc, Parenthetic)
-> (Chunk Doc, Parenthetic)
foldTree ParserPrefs
pprefs OptDescStyle
style
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. OptTree a -> OptTree a
mfilterOptional
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
(forall x. ArgumentReachability -> Option x -> b)
-> Parser a -> OptTree b
treeMapParser (forall a.
ParserPrefs
-> OptDescStyle
-> ArgumentReachability
-> Option a
-> (Chunk Doc, Parenthetic)
optDesc ParserPrefs
pprefs OptDescStyle
style)
  where
    mfilterOptional :: OptTree a -> OptTree a
mfilterOptional
      | Bool
showOptional =
        forall a. a -> a
id
      | Bool
otherwise =
        forall {a}. OptTree a -> OptTree a
filterOptional
    style :: OptDescStyle
style = OptDescStyle
      { descSep :: Doc
descSep = 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 forall a. Eq a => a -> a -> Bool
== AltNodeType
MarkDefault =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> Doc ann
brackets Chunk Doc
chunk
  | Parenthetic
wrapping forall a. Ord a => a -> a -> Bool
> Parenthetic
mustWrapBeyond =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
(<</>>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
wrapOver AltNodeType
NoDefault Parenthetic
MaybeRequired 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 =
        forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OptTree (Chunk Doc, Parenthetic) -> Chunk Doc -> Chunk Doc
go forall a. Monoid a => a
mempty [OptTree (Chunk Doc, Parenthetic)]
xs
      wrapLevel :: Parenthetic
wrapLevel =
        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))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
groupOrNestLine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
wrapOver AltNodeType
b Parenthetic
MaybeRequired
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic)
alt_node
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Chunk a -> Bool
isEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ParserPrefs
-> OptDescStyle
-> OptTree (Chunk Doc, Parenthetic)
-> (Chunk Doc, Parenthetic)
foldTree ParserPrefs
prefs OptDescStyle
s)
    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))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked Doc -> Doc -> Doc
altSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
wrapOver AltNodeType
NoDefault Parenthetic
MaybeRequired) forall a. Monoid a => a
mempty
        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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Doc
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
r 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 = 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 = 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
(forall x. ArgumentReachability -> Option x -> b)
-> Parser a -> [b]
mapParser 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
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Chunk a -> Bool
isEmpty forall a b. (a -> b) -> a -> b
$ Chunk Doc
n
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Chunk a -> Bool
isEmpty forall a b. (a -> b) -> a -> b
$ Chunk Doc
h
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => Chunk a -> a
extractChunk Chunk Doc
n, forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => Chunk a -> a
extractChunk forall a b. (a -> b) -> a -> b
$ Chunk Doc
h Chunk Doc -> Chunk Doc -> Chunk Doc
<</>> forall {ann}. Chunk (Doc ann)
hdef)
      where
        n :: Chunk Doc
n = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a.
ParserPrefs
-> OptDescStyle
-> ArgumentReachability
-> Option a
-> (Chunk Doc, Parenthetic)
optDesc ParserPrefs
pprefs OptDescStyle
style ArgumentReachability
info Option a
opt
        h :: Chunk Doc
h = forall a. Option a -> Chunk Doc
optHelp Option a
opt
        hdef :: Chunk (Doc ann)
hdef = forall a. Maybe a -> Chunk a
Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {ann}. Pretty a => a -> Doc ann
show_def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Option a -> Maybe String
optShowDefault forall a b. (a -> b) -> a -> b
$ Option a
opt
        show_def :: a -> Doc ann
show_def a
s = forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty String
"default:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty a
s)
    style :: OptDescStyle
style = OptDescStyle
      { descSep :: Doc
descSep = 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 = forall a. Monoid a => a
mempty { helpError :: Chunk Doc
helpError = Chunk Doc
chunk }

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

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

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

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

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

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

footerHelp :: Chunk Doc -> ParserHelp
footerHelp :: Chunk Doc -> ParserHelp
footerHelp Chunk Doc
chunk = forall a. Monoid a => a
mempty { helpFooter :: Chunk Doc
helpFooter = Chunk Doc
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk Doc] -> Chunk Doc
vsepChunks forall a b. (a -> b) -> a -> b
$
    String -> Chunk Doc -> Chunk Doc
with_title String
"Available options:" (forall a. ParserPrefs -> Parser a -> Chunk Doc
fullDesc ParserPrefs
pprefs Parser a
p)
      forall a. a -> [a] -> [a]
: ([(Maybe String, Chunk Doc)] -> Chunk Doc
group_title 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 = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ 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 (forall a. a -> Maybe a -> a
fromMaybe String
def Maybe String
n) forall a b. (a -> b) -> a -> b
$
        [Chunk Doc] -> Chunk Doc
vcatChunks (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe String, Chunk Doc)]
a)
    group_title [(Maybe String, 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 forall a b. (a -> b) -> a -> b
$
    Doc -> Doc -> Doc
(.$.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Chunk Doc
stringChunk String
"Global options:"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 =
  forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$
    forall ann. [Doc ann] -> Doc ann
hsep
      [ forall a ann. Pretty a => a -> Doc ann
pretty String
"Usage:",
        forall a ann. Pretty a => a -> Doc ann
pretty String
progn,
        Int -> Int -> Doc -> Doc
hangAtIfOver Int
9 Int
35 (forall a. Monoid a => Chunk a -> a
extractChunk (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parenthetic -> Parenthetic -> Bool
$c/= :: Parenthetic -> Parenthetic -> Bool
== :: Parenthetic -> Parenthetic -> Bool
$c== :: Parenthetic -> Parenthetic -> Bool
Eq, Eq 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
min :: Parenthetic -> Parenthetic -> Parenthetic
$cmin :: Parenthetic -> Parenthetic -> Parenthetic
max :: Parenthetic -> Parenthetic -> Parenthetic
$cmax :: Parenthetic -> Parenthetic -> Parenthetic
>= :: Parenthetic -> Parenthetic -> Bool
$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
compare :: Parenthetic -> Parenthetic -> Ordering
$ccompare :: Parenthetic -> Parenthetic -> Ordering
Ord, Int -> Parenthetic -> ShowS
[Parenthetic] -> ShowS
Parenthetic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parenthetic] -> ShowS
$cshowList :: [Parenthetic] -> ShowS
show :: Parenthetic -> String
$cshow :: Parenthetic -> String
showsPrec :: Int -> Parenthetic -> ShowS
$cshowsPrec :: Int -> Parenthetic -> ShowS
Show)