-
Notifications
You must be signed in to change notification settings - Fork 116
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Allow customization of help info via introducing semantic Doc #482
base: master
Are you sure you want to change the base?
Changes from all commits
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -37,27 +37,37 @@ import Options.Applicative.Common | |
import Options.Applicative.Types | ||
import Options.Applicative.Help.Pretty | ||
import Options.Applicative.Help.Chunk | ||
import Options.Applicative.Help.HelpDoc (HelpDoc, HelpType (CmdName, Description, Metavar, OptionName, Title), annotateHelp, ansiDocToHelpDoc) | ||
|
||
-- XXX(Martin): Seems like this module returns a bunch of helpers for generating Help, there is no | ||
-- single top level function, instead they are called and combined together in | ||
-- Options.Applicative.Extra? Makes it a bit hard to reason about the whole thing for me, | ||
-- plus module named Extra sounds like it wouldn't be doing this, combining them. | ||
|
||
-- | Style for rendering an option. | ||
data OptDescStyle | ||
= OptDescStyle | ||
{ descSep :: Doc, | ||
{ descSep :: HelpDoc, | ||
descHidden :: Bool, | ||
descGlobal :: Bool | ||
} | ||
|
||
safelast :: [a] -> Maybe a | ||
safelast = foldl' (const Just) Nothing | ||
|
||
-- XXX(Martin): What does this really generate? Just the names for the option + metavar? | ||
-- Or does it also generate its usage information? I don't see where usage is getting generated. | ||
-- I guess the question is, what does `Desc` in `optDesc` stand for? What kind of description? | ||
|
||
-- | Generate description for a single option. | ||
optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (Chunk Doc, Parenthetic) | ||
optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (Chunk HelpDoc, Parenthetic) | ||
optDesc pprefs style _reachability opt = | ||
let names = | ||
sort . optionNames . optMain $ opt | ||
meta = | ||
stringChunk $ optMetaVar opt | ||
annotateHelp Metavar <$> stringChunk (optMetaVar opt) | ||
descs = | ||
map (pretty . showOption) names | ||
map (annotateHelp OptionName . pretty . showOption) names | ||
Comment on lines
+68
to
+70
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I did some annotating here. |
||
descriptions = | ||
listToChunk (intersperse (descSep style) descs) | ||
desc | ||
|
@@ -85,35 +95,48 @@ optDesc pprefs style _reachability opt = | |
| otherwise = | ||
desc | ||
modified = | ||
-- TODO(martin): optDescMod here wants to modify the description (`rendered`), but we made | ||
-- description HelpDoc, because we are annotating stuff like metavar and option name, | ||
-- while optDescMode works as AnsiDoc -> AnsiDoc. Figure out what to do: do we make | ||
-- optDescMode work as HelpDoc -> HelpDoc, or do we give up annotating description here | ||
-- and make it AnsiDoc, or maybe there is third option? I am leaning toward making | ||
-- optDescMode operate as HelpDoc -> HelpDoc, but I don't yet understand the whole | ||
-- situation. | ||
maybe id fmap (optDescMod opt) rendered | ||
in (modified, wrapping) | ||
|
||
-- TODO(Martin): I started going through this file and annotating chunks, | ||
-- but there is still more to annotate and I am not having an easy time figuring out what | ||
-- is what in the codebase, so it goes very slow. | ||
|
||
-- | Generate descriptions for commands. | ||
cmdDesc :: ParserPrefs -> Parser a -> [(Maybe String, Chunk Doc)] | ||
cmdDesc :: ParserPrefs -> Parser a -> [(Maybe String, Chunk HelpDoc)] | ||
cmdDesc pprefs = mapParser desc | ||
where | ||
desc _ opt = | ||
case optMain opt of | ||
CmdReader gn cmds -> | ||
(,) gn $ | ||
tabulate (prefTabulateFill pprefs) | ||
[ (pretty nm, align (extractChunk (infoProgDesc cmd))) | ||
| (nm, cmd) <- reverse cmds | ||
[ (annotateHelp CmdName $ pretty cmdName, | ||
align (annotateHelp Description $ ansiDocToHelpDoc $ extractChunk (infoProgDesc cmdInfo)) | ||
) | ||
| (cmdName, cmdInfo) <- reverse cmds | ||
Comment on lines
+121
to
+124
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Some more annotating here. |
||
] | ||
_ -> mempty | ||
|
||
-- | Generate a brief help text for a parser. | ||
briefDesc :: ParserPrefs -> Parser a -> Chunk Doc | ||
briefDesc :: ParserPrefs -> Parser a -> Chunk HelpDoc | ||
briefDesc = briefDesc' 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 HelpDoc | ||
missingDesc = briefDesc' 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 HelpDoc | ||
briefDesc' showOptional pprefs = | ||
wrapOver NoDefault MaybeRequired | ||
. foldTree pprefs style | ||
|
@@ -132,7 +155,7 @@ briefDesc' showOptional pprefs = | |
} | ||
|
||
-- | Wrap a doc in parentheses or brackets if required. | ||
wrapOver :: AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc | ||
wrapOver :: AltNodeType -> Parenthetic -> (Chunk HelpDoc, Parenthetic) -> Chunk HelpDoc | ||
wrapOver altnode mustWrapBeyond (chunk, wrapping) | ||
| altnode == MarkDefault = | ||
fmap brackets chunk | ||
|
@@ -143,7 +166,7 @@ wrapOver altnode mustWrapBeyond (chunk, wrapping) | |
|
||
-- 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 HelpDoc, Parenthetic) -> (Chunk HelpDoc, Parenthetic) | ||
foldTree _ _ (Leaf x) = | ||
x | ||
foldTree prefs s (MultNode xs) = | ||
|
@@ -166,7 +189,7 @@ foldTree prefs s (AltNode b xs) = | |
. map (foldTree prefs s) | ||
$ xs | ||
where | ||
alt_node :: [(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic) | ||
alt_node :: [(Chunk HelpDoc, Parenthetic)] -> (Chunk HelpDoc, Parenthetic) | ||
alt_node [n] = n | ||
alt_node ns = | ||
(\y -> (y, AlwaysRequired)) | ||
|
@@ -183,16 +206,16 @@ foldTree prefs s (BindNode x) = | |
in (withSuffix, NeverRequired) | ||
|
||
-- | Generate a full help text for a parser | ||
fullDesc :: ParserPrefs -> Parser a -> Chunk Doc | ||
fullDesc :: ParserPrefs -> Parser a -> Chunk HelpDoc | ||
fullDesc = optionsDesc 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 :: ParserPrefs -> Parser a -> Chunk HelpDoc | ||
globalDesc = optionsDesc True | ||
|
||
-- | Common generator for full descriptions and globals | ||
optionsDesc :: Bool -> ParserPrefs -> Parser a -> Chunk Doc | ||
optionsDesc :: Bool -> ParserPrefs -> Parser a -> Chunk HelpDoc | ||
optionsDesc global pprefs = tabulate (prefTabulateFill pprefs) . catMaybes . mapParser doc | ||
where | ||
doc info opt = do | ||
|
@@ -201,7 +224,8 @@ optionsDesc global pprefs = tabulate (prefTabulateFill pprefs) . catMaybes . map | |
return (extractChunk n, align . extractChunk $ h <</>> hdef) | ||
where | ||
n = fst $ optDesc pprefs style info opt | ||
h = optHelp opt | ||
-- TODO(Martin) Not 100% if this `ansiDocToHelpDoc` makes sense here as a move, should double check. | ||
h = ansiDocToHelpDoc <$> optHelp opt | ||
hdef = Chunk . fmap show_def . optShowDefault $ opt | ||
show_def s = parens (pretty "default:" <+> pretty s) | ||
style = OptDescStyle | ||
|
@@ -210,47 +234,48 @@ optionsDesc global pprefs = tabulate (prefTabulateFill pprefs) . catMaybes . map | |
descGlobal = global | ||
} | ||
|
||
errorHelp :: Chunk Doc -> ParserHelp | ||
errorHelp :: Chunk HelpDoc -> ParserHelp | ||
errorHelp chunk = mempty { helpError = chunk } | ||
|
||
headerHelp :: Chunk Doc -> ParserHelp | ||
headerHelp :: Chunk HelpDoc -> ParserHelp | ||
headerHelp chunk = mempty { helpHeader = chunk } | ||
|
||
suggestionsHelp :: Chunk Doc -> ParserHelp | ||
suggestionsHelp :: Chunk HelpDoc -> ParserHelp | ||
suggestionsHelp chunk = mempty { helpSuggestions = chunk } | ||
|
||
globalsHelp :: Chunk Doc -> ParserHelp | ||
globalsHelp :: Chunk HelpDoc -> ParserHelp | ||
globalsHelp chunk = mempty { helpGlobals = chunk } | ||
|
||
usageHelp :: Chunk Doc -> ParserHelp | ||
usageHelp :: Chunk HelpDoc -> ParserHelp | ||
usageHelp chunk = mempty { helpUsage = chunk } | ||
|
||
descriptionHelp :: Chunk Doc -> ParserHelp | ||
descriptionHelp :: Chunk HelpDoc -> ParserHelp | ||
descriptionHelp chunk = mempty { helpDescription = chunk } | ||
|
||
bodyHelp :: Chunk Doc -> ParserHelp | ||
bodyHelp :: Chunk HelpDoc -> ParserHelp | ||
bodyHelp chunk = mempty { helpBody = chunk } | ||
|
||
footerHelp :: Chunk Doc -> ParserHelp | ||
footerHelp :: Chunk HelpDoc -> ParserHelp | ||
footerHelp chunk = mempty { helpFooter = chunk } | ||
|
||
-- | Generate the help text for a program. | ||
parserHelp :: ParserPrefs -> Parser a -> ParserHelp | ||
parserHelp pprefs p = | ||
bodyHelp . vsepChunks $ | ||
with_title "Available options:" (fullDesc pprefs p) | ||
: (group_title <$> cs) | ||
optionsHelp : | ||
(cmdGroupHelp <$> cmdGroups) | ||
where | ||
def = "Available commands:" | ||
cs = groupBy ((==) `on` fst) $ cmdDesc pprefs p | ||
optionsHelp = with_title "Available options:" (fullDesc pprefs p) | ||
|
||
cmdGroupHelp cmdGroup@((groupName, _) : _) = | ||
with_title (fromMaybe "Available commands:" groupName) $ | ||
vcatChunks (snd <$> cmdGroup) | ||
cmdGroupHelp _ = mempty | ||
|
||
group_title a@((n, _) : _) = | ||
with_title (fromMaybe def n) $ | ||
vcatChunks (snd <$> a) | ||
group_title _ = mempty | ||
cmdGroups = groupBy ((==) `on` fst) $ cmdDesc pprefs p | ||
|
||
with_title :: String -> Chunk Doc -> Chunk Doc | ||
with_title title = fmap (pretty title .$.) | ||
with_title :: String -> Chunk HelpDoc -> Chunk HelpDoc | ||
with_title title = fmap (annotateHelp Title . (pretty title .$.)) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I did a bit of annotating here. |
||
|
||
|
||
parserGlobals :: ParserPrefs -> Parser a -> ParserHelp | ||
|
@@ -262,7 +287,7 @@ parserGlobals pprefs p = | |
|
||
|
||
-- | Generate option summary. | ||
parserUsage :: ParserPrefs -> Parser a -> String -> Doc | ||
parserUsage :: ParserPrefs -> Parser a -> String -> HelpDoc | ||
parserUsage pprefs p progn = | ||
group $ | ||
hsep | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,35 @@ | ||
module Options.Applicative.Help.HelpDoc | ||
( HelpDoc, | ||
HelpType (..), | ||
ansiDocToHelpDoc, | ||
helpDocToAnsiDoc, | ||
annotateHelp, | ||
annotateStyle, | ||
) | ||
where | ||
|
||
import Options.Applicative.Help.Pretty (AnsiDoc, AnsiStyle, annotate, reAnnotate) | ||
import qualified Prettyprinter as PP | ||
import Prelude | ||
|
||
type HelpDoc = PP.Doc HelpAnn | ||
|
||
data HelpAnn = HelpAnnType HelpType | HelpAnnStyle AnsiStyle | ||
|
||
data HelpType = CmdName | OptionName | Description | Title | Metavar | ||
|
||
annotateHelp :: HelpType -> HelpDoc -> HelpDoc | ||
annotateHelp helpType = annotate $ HelpAnnType helpType | ||
|
||
annotateStyle :: AnsiStyle -> HelpDoc -> HelpDoc | ||
annotateStyle ansiStyle = annotate $ HelpAnnStyle ansiStyle | ||
|
||
ansiDocToHelpDoc :: AnsiDoc -> HelpDoc | ||
ansiDocToHelpDoc = reAnnotate HelpAnnStyle | ||
|
||
helpDocToAnsiDoc :: HelpDoc -> AnsiDoc | ||
-- TODO(Martin): I will want to probably use reAnnotate here -> for each HelpAnn, I will generate 0 | ||
-- to N AnsiStyle annotations. However maybe I should not do this for Docs, but for SimpleDocStream, | ||
-- as they recommended! So maybe we should not implement this function, but instead one that does | ||
-- SimpleDocStream HelpAnn -> SimpleDocStream AnsiStyle. | ||
helpDocToAnsiDoc = error "TODO" |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
It's so we can get a different monoid instance and not add spaces or breaks when things are hidden.
You'll find if its removed that internal and hidden options will affect the way the parser is rendered.