1module Options.Applicative.Help.Core (
2  cmdDesc,
3  briefDesc,
4  missingDesc,
5  fullDesc,
6  ParserHelp(..),
7  errorHelp,
8  headerHelp,
9  suggestionsHelp,
10  usageHelp,
11  bodyHelp,
12  footerHelp,
13  parserHelp,
14  parserUsage,
15  ) where
16
17import Control.Applicative
18import Control.Monad (guard)
19import Data.Function (on)
20import Data.List (sort, intersperse, groupBy)
21import Data.Foldable (any)
22import Data.Maybe (maybeToList, catMaybes, fromMaybe)
23import Data.Monoid (mempty)
24import Data.Semigroup (Semigroup (..))
25import Prelude hiding (any)
26
27import Options.Applicative.Common
28import Options.Applicative.Types
29import Options.Applicative.Help.Pretty
30import Options.Applicative.Help.Chunk
31
32-- | Style for rendering an option.
33data OptDescStyle = OptDescStyle
34  { descSep :: Doc
35  , descHidden :: Bool }
36
37safelast :: [a] -> Maybe a
38safelast = foldl (const Just) Nothing
39
40-- | Generate description for a single option.
41optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
42optDesc pprefs style info opt =
43  let names
44        = sort . optionNames . optMain $ opt
45      meta
46        = stringChunk $ optMetaVar opt
47      descs
48        = map (string . showOption) names
49      descriptions
50        = listToChunk (intersperse (descSep style) descs)
51      desc
52        | prefHelpLongEquals pprefs && not (isEmpty meta) && any isLongName (safelast names)
53        = descriptions <> stringChunk "=" <> meta
54        | otherwise
55        = descriptions <<+>> meta
56      show_opt
57        | optVisibility opt == Hidden
58        = descHidden style
59        | otherwise
60        = optVisibility opt == Visible
61      suffix
62        | hinfoMulti info
63        = stringChunk . prefMultiSuffix $ pprefs
64        | otherwise
65        = mempty
66      wrapping
67        = wrapIf (length names > 1)
68      rendered
69        | not show_opt
70        = mempty
71        | otherwise
72        = desc <> suffix
73      modified
74        = maybe id fmap (optDescMod opt) rendered
75  in  (modified, wrapping)
76
77-- | Generate descriptions for commands.
78cmdDesc :: Parser a -> [(Maybe String, Chunk Doc)]
79cmdDesc = mapParser desc
80  where
81    desc _ opt =
82      case optMain opt of
83        CmdReader gn cmds p -> (,) gn $
84          tabulate [(string cmd, align (extractChunk d))
85                   | cmd <- reverse cmds
86                   , d <- maybeToList . fmap infoProgDesc $ p cmd ]
87        _ -> mempty
88
89-- | Generate a brief help text for a parser.
90briefDesc :: ParserPrefs -> Parser a -> Chunk Doc
91briefDesc = briefDesc' True
92
93-- | Generate a brief help text for a parser, only including mandatory
94--   options and arguments.
95missingDesc :: ParserPrefs -> Parser a -> Chunk Doc
96missingDesc = briefDesc' False
97
98-- | Generate a brief help text for a parser, allowing the specification
99--   of if optional arguments are show.
100briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
101briefDesc' showOptional pprefs
102    = wrap NoDefault . foldTree . mfilterOptional . treeMapParser (optDesc pprefs style)
103  where
104    mfilterOptional
105      | showOptional
106      = id
107      | otherwise
108      = filterOptional
109
110    style = OptDescStyle
111      { descSep = string "|"
112      , descHidden = False }
113
114-- | Wrap a doc in parentheses or brackets if required.
115wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
116wrap altnode (chunk, wrapping)
117  | altnode == MarkDefault
118  = fmap brackets chunk
119  | needsWrapping wrapping
120  = fmap parens chunk
121  | otherwise
122  = chunk
123
124-- Fold a tree of option docs into a single doc with fully marked
125-- optional areas and groups.
126foldTree :: OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
127foldTree (Leaf x)
128  = x
129foldTree (MultNode xs)
130  = (foldr ((<</>>) . wrap NoDefault . foldTree) mempty xs, Bare)
131foldTree (AltNode b xs)
132  = (\x -> (x, Bare))
133  . fmap groupOrNestLine
134  . wrap b
135  . alt_node
136  . filter (not . isEmpty . fst)
137  . map foldTree $ xs
138    where
139
140  alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
141  alt_node [n] = n
142  alt_node ns = (\y -> (y, Wrapped))
143              . foldr (chunked altSep . wrap NoDefault) mempty
144              $ ns
145
146-- | Generate a full help text for a parser.
147fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
148fullDesc pprefs = tabulate . catMaybes . mapParser doc
149  where
150    doc info opt = do
151      guard . not . isEmpty $ n
152      guard . not . isEmpty $ h
153      return (extractChunk n, align . extractChunk $ h <<+>> hdef)
154      where
155        n = fst $ optDesc pprefs style info opt
156        h = optHelp opt
157        hdef = Chunk . fmap show_def . optShowDefault $ opt
158        show_def s = parens (string "default:" <+> string s)
159    style = OptDescStyle
160      { descSep = string ","
161      , descHidden = True }
162
163errorHelp :: Chunk Doc -> ParserHelp
164errorHelp chunk = mempty { helpError = chunk }
165
166headerHelp :: Chunk Doc -> ParserHelp
167headerHelp chunk = mempty { helpHeader = chunk }
168
169suggestionsHelp :: Chunk Doc -> ParserHelp
170suggestionsHelp chunk = mempty { helpSuggestions = chunk }
171
172usageHelp :: Chunk Doc -> ParserHelp
173usageHelp chunk = mempty { helpUsage = chunk }
174
175bodyHelp :: Chunk Doc -> ParserHelp
176bodyHelp chunk = mempty { helpBody = chunk }
177
178footerHelp :: Chunk Doc -> ParserHelp
179footerHelp chunk = mempty { helpFooter = chunk }
180
181-- | Generate the help text for a program.
182parserHelp :: ParserPrefs -> Parser a -> ParserHelp
183parserHelp pprefs p = bodyHelp . vsepChunks
184  $ with_title "Available options:" (fullDesc pprefs p)
185  : (group_title <$> cs)
186  where
187    def = "Available commands:"
188
189    cs = groupBy ((==) `on` fst) $ cmdDesc p
190
191    group_title a@((n,_):_) = with_title (fromMaybe def n) $
192      vcatChunks (snd <$> a)
193    group_title _ = mempty
194
195
196    with_title :: String -> Chunk Doc -> Chunk Doc
197    with_title title = fmap (string title .$.)
198
199-- | Generate option summary.
200parserUsage :: ParserPrefs -> Parser a -> String -> Doc
201parserUsage pprefs p progn = hsep
202  [ string "Usage:"
203  , string progn
204  , align (extractChunk (briefDesc pprefs p)) ]
205
206data Wrapping
207  = Bare
208  | Wrapped
209  deriving (Eq, Show)
210
211wrapIf :: Bool -> Wrapping
212wrapIf b = if b then Wrapped else Bare
213
214needsWrapping :: Wrapping -> Bool
215needsWrapping = (==) Wrapped
216