module Options.Applicative.Help.Core (
  cmdDesc,
  briefDesc,
  missingDesc,
  fullDesc,
  ParserHelp(..),
  errorHelp,
  headerHelp,
  suggestionsHelp,
  usageHelp,
  bodyHelp,
  footerHelp,
  parserHelp,
  parserUsage,
  ) where

import Control.Applicative
import Control.Monad (guard)
import Data.Function (on)
import Data.List (sort, intersperse, groupBy)
import Data.Foldable (any)
import Data.Maybe (maybeToList, catMaybes, fromMaybe)
import Data.Monoid (mempty)
import Data.Semigroup (Semigroup (..))
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 }

safelast :: [a] -> Maybe a
safelast :: [a] -> Maybe a
safelast = (Maybe a -> a -> Maybe a) -> Maybe a -> [a] -> Maybe a
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 -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
optDesc :: ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
optDesc pprefs :: ParserPrefs
pprefs style :: OptDescStyle
style info :: OptHelpInfo
info opt :: 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]
descs
        = (OptName -> Doc) -> [OptName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
string (String -> Doc) -> (OptName -> String) -> OptName -> Doc
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]
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 "=" 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
        | 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
      suffix :: Chunk Doc
suffix
        | OptHelpInfo -> Bool
hinfoMulti OptHelpInfo
info
        = String -> Chunk Doc
stringChunk (String -> Chunk Doc)
-> (ParserPrefs -> String) -> ParserPrefs -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs -> String
prefMultiSuffix (ParserPrefs -> Chunk Doc) -> ParserPrefs -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ ParserPrefs
pprefs
        | Bool
otherwise
        = Chunk Doc
forall a. Monoid a => a
mempty
      wrapping :: Wrapping
wrapping
        = Bool -> Wrapping
wrapIf ([OptName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OptName]
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1)
      rendered :: Chunk Doc
rendered
        | Bool -> Bool
not Bool
show_opt
        = Chunk Doc
forall a. Monoid a => a
mempty
        | Bool
otherwise
        = Chunk Doc
desc Chunk Doc -> Chunk Doc -> Chunk Doc
forall a. Semigroup a => a -> a -> a
<> Chunk Doc
suffix
      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 (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, Wrapping
wrapping)

-- | Generate descriptions for commands.
cmdDesc :: Parser a -> [(Maybe String, Chunk Doc)]
cmdDesc :: Parser a -> [(Maybe String, Chunk Doc)]
cmdDesc = (forall x. OptHelpInfo -> Option x -> (Maybe String, Chunk Doc))
-> Parser a -> [(Maybe String, Chunk Doc)]
forall b a.
(forall x. OptHelpInfo -> Option x -> b) -> Parser a -> [b]
mapParser forall x. OptHelpInfo -> 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 _ opt :: Option a
opt =
      case Option a -> OptReader a
forall a. Option a -> OptReader a
optMain Option a
opt of
        CmdReader gn :: Maybe String
gn cmds :: [String]
cmds p :: String -> Maybe (ParserInfo a)
p -> (,) Maybe String
gn (Chunk Doc -> (Maybe String, Chunk Doc))
-> Chunk Doc -> (Maybe String, Chunk Doc)
forall a b. (a -> b) -> a -> b
$
          [(Doc, Doc)] -> Chunk Doc
tabulate [(String -> Doc
string String
cmd, Doc -> Doc
align (Chunk Doc -> Doc
forall a. Monoid a => Chunk a -> a
extractChunk Chunk Doc
d))
                   | String
cmd <- [String] -> [String]
forall a. [a] -> [a]
reverse [String]
cmds
                   , Chunk Doc
d <- Maybe (Chunk Doc) -> [Chunk Doc]
forall a. Maybe a -> [a]
maybeToList (Maybe (Chunk Doc) -> [Chunk Doc])
-> (Maybe (ParserInfo a) -> Maybe (Chunk Doc))
-> Maybe (ParserInfo a)
-> [Chunk Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParserInfo a -> Chunk Doc)
-> Maybe (ParserInfo a) -> Maybe (Chunk Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParserInfo a -> Chunk Doc
forall a. ParserInfo a -> Chunk Doc
infoProgDesc (Maybe (ParserInfo a) -> [Chunk Doc])
-> Maybe (ParserInfo a) -> [Chunk Doc]
forall a b. (a -> b) -> a -> b
$ String -> Maybe (ParserInfo a)
p String
cmd ]
        _ -> (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 :: 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 :: 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' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
briefDesc' showOptional :: Bool
showOptional pprefs :: ParserPrefs
pprefs
    = AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
NoDefault ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (Parser a -> (Chunk Doc, Wrapping)) -> Parser a -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree (OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping))
-> (Parser a -> OptTree (Chunk Doc, Wrapping))
-> Parser a
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptTree (Chunk Doc, Wrapping) -> OptTree (Chunk Doc, Wrapping)
forall a. OptTree a -> OptTree a
mfilterOptional (OptTree (Chunk Doc, Wrapping) -> OptTree (Chunk Doc, Wrapping))
-> (Parser a -> OptTree (Chunk Doc, Wrapping))
-> Parser a
-> OptTree (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. OptHelpInfo -> Option x -> (Chunk Doc, Wrapping))
-> Parser a -> OptTree (Chunk Doc, Wrapping)
forall b a.
(forall x. OptHelpInfo -> Option x -> b) -> Parser a -> OptTree b
treeMapParser (ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option x -> (Chunk Doc, Wrapping)
forall a.
ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
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 :: Doc -> Bool -> OptDescStyle
OptDescStyle
      { descSep :: Doc
descSep = String -> Doc
string "|"
      , descHidden :: Bool
descHidden = Bool
False }

-- | Wrap a doc in parentheses or brackets if required.
wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap altnode :: AltNodeType
altnode (chunk :: Chunk Doc
chunk, wrapping :: Wrapping
wrapping)
  | AltNodeType
altnode AltNodeType -> AltNodeType -> Bool
forall a. Eq a => a -> a -> Bool
== AltNodeType
MarkDefault
  = (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
brackets Chunk Doc
chunk
  | Wrapping -> Bool
needsWrapping Wrapping
wrapping
  = (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
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 :: OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree :: OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree (Leaf x :: (Chunk Doc, Wrapping)
x)
  = (Chunk Doc, Wrapping)
x
foldTree (MultNode xs :: [OptTree (Chunk Doc, Wrapping)]
xs)
  = ((OptTree (Chunk Doc, Wrapping) -> Chunk Doc -> Chunk Doc)
-> Chunk Doc -> [OptTree (Chunk Doc, Wrapping)] -> Chunk Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Chunk Doc -> Chunk Doc -> Chunk Doc
(<</>>) (Chunk Doc -> Chunk Doc -> Chunk Doc)
-> (OptTree (Chunk Doc, Wrapping) -> Chunk Doc)
-> OptTree (Chunk Doc, Wrapping)
-> Chunk Doc
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
NoDefault ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping))
-> OptTree (Chunk Doc, Wrapping)
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree) Chunk Doc
forall a. Monoid a => a
mempty [OptTree (Chunk Doc, Wrapping)]
xs, Wrapping
Bare)
foldTree (AltNode b :: AltNodeType
b xs :: [OptTree (Chunk Doc, Wrapping)]
xs)
  = (\x :: Chunk Doc
x -> (Chunk Doc
x, Wrapping
Bare))
  (Chunk Doc -> (Chunk Doc, Wrapping))
-> ([OptTree (Chunk Doc, Wrapping)] -> Chunk Doc)
-> [OptTree (Chunk Doc, Wrapping)]
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
groupOrNestLine
  (Chunk Doc -> Chunk Doc)
-> ([OptTree (Chunk Doc, Wrapping)] -> Chunk Doc)
-> [OptTree (Chunk Doc, Wrapping)]
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
b
  ((Chunk Doc, Wrapping) -> Chunk Doc)
-> ([OptTree (Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> [OptTree (Chunk Doc, Wrapping)]
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
alt_node
  ([(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> ([OptTree (Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)])
-> [OptTree (Chunk Doc, Wrapping)]
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chunk Doc, Wrapping) -> Bool)
-> [(Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Chunk Doc, Wrapping) -> Bool) -> (Chunk Doc, Wrapping) -> 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, Wrapping) -> Chunk Doc)
-> (Chunk Doc, Wrapping)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk Doc, Wrapping) -> Chunk Doc
forall a b. (a, b) -> a
fst)
  ([(Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)])
-> ([OptTree (Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)])
-> [OptTree (Chunk Doc, Wrapping)]
-> [(Chunk Doc, Wrapping)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping))
-> [OptTree (Chunk Doc, Wrapping)] -> [(Chunk Doc, Wrapping)]
forall a b. (a -> b) -> [a] -> [b]
map OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
foldTree ([OptTree (Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> [OptTree (Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
forall a b. (a -> b) -> a -> b
$ [OptTree (Chunk Doc, Wrapping)]
xs
    where

  alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
  alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
alt_node [n :: (Chunk Doc, Wrapping)
n] = (Chunk Doc, Wrapping)
n
  alt_node ns :: [(Chunk Doc, Wrapping)]
ns = (\y :: Chunk Doc
y -> (Chunk Doc
y, Wrapping
Wrapped))
              (Chunk Doc -> (Chunk Doc, Wrapping))
-> ([(Chunk Doc, Wrapping)] -> Chunk Doc)
-> [(Chunk Doc, Wrapping)]
-> (Chunk Doc, Wrapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chunk Doc, Wrapping) -> Chunk Doc -> Chunk Doc)
-> Chunk Doc -> [(Chunk Doc, Wrapping)] -> Chunk Doc
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, Wrapping) -> Chunk Doc)
-> (Chunk Doc, Wrapping)
-> Chunk Doc
-> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
wrap AltNodeType
NoDefault) Chunk Doc
forall a. Monoid a => a
mempty
              ([(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping))
-> [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
forall a b. (a -> b) -> a -> b
$ [(Chunk Doc, Wrapping)]
ns

-- | Generate a full help text for a parser.
fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
fullDesc pprefs :: ParserPrefs
pprefs = [(Doc, Doc)] -> Chunk Doc
tabulate ([(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. OptHelpInfo -> Option x -> Maybe (Doc, Doc))
-> Parser a -> [Maybe (Doc, Doc)]
forall b a.
(forall x. OptHelpInfo -> Option x -> b) -> Parser a -> [b]
mapParser forall x. OptHelpInfo -> Option x -> Maybe (Doc, Doc)
forall (m :: * -> *) a.
(Monad m, Alternative m) =>
OptHelpInfo -> Option a -> m (Doc, Doc)
doc
  where
    doc :: OptHelpInfo -> Option a -> m (Doc, Doc)
doc info :: OptHelpInfo
info opt :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Chunk Doc -> Doc
forall a. Monoid a => Chunk a -> a
extractChunk Chunk Doc
n, Doc -> Doc
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
hdef)
      where
        n :: Chunk Doc
n = (Chunk Doc, Wrapping) -> Chunk Doc
forall a b. (a, b) -> a
fst ((Chunk Doc, Wrapping) -> Chunk Doc)
-> (Chunk Doc, Wrapping) -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
forall a.
ParserPrefs
-> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
optDesc ParserPrefs
pprefs OptDescStyle
style OptHelpInfo
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
hdef = Maybe Doc -> Chunk Doc
forall a. Maybe a -> Chunk a
Chunk (Maybe Doc -> Chunk Doc)
-> (Option a -> Maybe Doc) -> Option a -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> Maybe String -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
show_def (Maybe String -> Maybe Doc)
-> (Option a -> Maybe String) -> Option a -> Maybe Doc
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) -> Option a -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ Option a
opt
        show_def :: String -> Doc
show_def s :: String
s = Doc -> Doc
parens (String -> Doc
string "default:" Doc -> Doc -> Doc
<+> String -> Doc
string String
s)
    style :: OptDescStyle
style = OptDescStyle :: Doc -> Bool -> OptDescStyle
OptDescStyle
      { descSep :: Doc
descSep = String -> Doc
string ","
      , descHidden :: Bool
descHidden = Bool
True }

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

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

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

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

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

footerHelp :: Chunk Doc -> ParserHelp
footerHelp :: Chunk Doc -> ParserHelp
footerHelp chunk :: Chunk Doc
chunk = ParserHelp
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 :: ParserPrefs -> Parser a -> ParserHelp
parserHelp pprefs :: ParserPrefs
pprefs p :: 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 "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 = "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
$ Parser a -> [(Maybe String, Chunk Doc)]
forall a. Parser a -> [(Maybe String, Chunk Doc)]
cmdDesc Parser a
p

    group_title :: [(Maybe String, Chunk Doc)] -> Chunk Doc
group_title a :: [(Maybe String, Chunk Doc)]
a@((n :: Maybe String
n,_):_) = 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 _ = Chunk Doc
forall a. Monoid a => a
mempty


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

-- | Generate option summary.
parserUsage :: ParserPrefs -> Parser a -> String -> Doc
parserUsage :: ParserPrefs -> Parser a -> String -> Doc
parserUsage pprefs :: ParserPrefs
pprefs p :: Parser a
p progn :: String
progn = [Doc] -> Doc
hsep
  [ String -> Doc
string "Usage:"
  , String -> Doc
string String
progn
  , Doc -> Doc
align (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)) ]

data Wrapping
  = Bare
  | Wrapped
  deriving (Wrapping -> Wrapping -> Bool
(Wrapping -> Wrapping -> Bool)
-> (Wrapping -> Wrapping -> Bool) -> Eq Wrapping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wrapping -> Wrapping -> Bool
$c/= :: Wrapping -> Wrapping -> Bool
== :: Wrapping -> Wrapping -> Bool
$c== :: Wrapping -> Wrapping -> Bool
Eq, Int -> Wrapping -> ShowS
[Wrapping] -> ShowS
Wrapping -> String
(Int -> Wrapping -> ShowS)
-> (Wrapping -> String) -> ([Wrapping] -> ShowS) -> Show Wrapping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wrapping] -> ShowS
$cshowList :: [Wrapping] -> ShowS
show :: Wrapping -> String
$cshow :: Wrapping -> String
showsPrec :: Int -> Wrapping -> ShowS
$cshowsPrec :: Int -> Wrapping -> ShowS
Show)

wrapIf :: Bool -> Wrapping
wrapIf :: Bool -> Wrapping
wrapIf b :: Bool
b = if Bool
b then Wrapping
Wrapped else Wrapping
Bare

needsWrapping :: Wrapping -> Bool
needsWrapping :: Wrapping -> Bool
needsWrapping = Wrapping -> Wrapping -> Bool
forall a. Eq a => a -> a -> Bool
(==) Wrapping
Wrapped