Add option to use option groups in brief help description

[tbidne]

Resolves #523.

What

Adds a new preference:

data BriefDescOpt
  = BriefDescOptGroups (Maybe (String -> Maybe Doc))
  | BriefDescOptList

BriefDescOptGroups modifies the brief help description so that options are replaced by the groups to which they belong. For example, instead of:

parser_group.basic - a test for optparse-applicative

Usage: parser_group_basic --hello TARGET [--file-log-path PATH] 
                          [--file-log-verbosity INT] [-q|--quiet] [--poll]
                          --timeout INT (-v|--verbosity ARG) Command

  Shows parser groups

Available options:
  --hello TARGET           Target for the greeting
  -q,--quiet               Whether to be quiet
  -v,--verbosity ARG       Console verbosity
  -h,--help                Show this help text

Logging
  --file-log-path PATH     Log file path
  --file-log-verbosity INT File log verbosity

System Options
  --poll                   Whether to poll
  --timeout INT            Whether to time out

We have:

parser_group.basic - a test for optparse-applicative

Usage: parser_group_basic [Available options] [Logging] [System Options] Command

  Shows parser groups

Available options:
  --hello TARGET           Target for the greeting
  -q,--quiet               Whether to be quiet
  -v,--verbosity ARG       Console verbosity
  -h,--help                Show this help text

Logging
  --file-log-path PATH     Log file path
  --file-log-verbosity INT File log verbosity

System Options
  --poll                   Whether to poll
  --timeout INT            Whether to time out

Implementation

This is achieved by filtering options/flags out of the parser p to get a new parser p', mapping those to their string option group names ns, then rendering [ns, p'].

Notes

• There is some default styling (BriefDescOptGroups Nothing) that adds square brackets and drops the trailing colon, if it exists. A bit arbitrary, though arguably "canonical", since Available options: has one and therefore becomes Available options: -> [Available options].

• The user has the freedom to implement their own styling by supplying a String -> Maybe Doc function, and can even exclude groups entirely by returning Nothing e.g.

  styleFn :: String -> Maybe Doc
  styleFn "Available options:" = Nothing
  styleFn g = Just . brackets . pretty $ g

I'm curious what others think. Thanks!

[tbidne]

@nmattia

Here's how your help page looks with the changes here:

λ. cabal run niv -- update -h
Examples:

  niv update                     # update all packages
  niv update nixpkgs             # update nixpkgs
  niv update my-package -v beta-0.2 # update my-package to version "beta-0.2"

Usage: niv update [ATTRIBUTES] [PACKAGE]

  Update dependencies

ATTRIBUTES
  -a,--attribute KEY=VAL   Set the package spec attribute <KEY> to <VAL>, where
                           <VAL> may be JSON.
  -s,--string-attribute KEY=VAL
                           Set the package spec attribute <KEY> to <VAL>.
  -o,--owner OWNER         Set the repository owner (for github)
  --repo REPO              Set the repository name (for github)
  -b,--branch BRANCH       Set the branch (for git/github)
  -r,--rev REV             Set the revision/commit (for git/github)
  -v,--version VERSION     Set the version
  -t,--template URL        Used during 'update' when building URL. Occurrences
                           of <foo> are replaced with attribute 'foo'.
  -T,--type TYPE           The type of the URL target. The value can be either
                           'file' or 'tarball'. If not set, the value is
                           inferred from the suffix of the URL.

Available options:
  -h,--help                Show this help text

Click to expand diff

Note that there are some unrelated changes here to make it compile with HEAD (removing fullDesc). The important bits are parserOptionGroup and briefDescOpt.

diff --git a/src/Niv/Cli.hs b/src/Niv/Cli.hs
index 5e02dea..6667c39 100644
--- a/src/Niv/Cli.hs
+++ b/src/Niv/Cli.hs
@@ -70,20 +70,26 @@ getCmds = snd <$> ask
 cli :: [String] -> IO ()
 cli args = do
   ((fsj, colors), nio) <-
-    pure args >>= Opts.handleParseResult . execParserPure' Opts.defaultPrefs opts
+    pure args >>= Opts.handleParseResult . execParserPure' prefs opts
   setColors colors
   hSetEncoding stdout utf8 -- required for printing out unicode on some systems
   runReaderT (runNIO nio) (fsj, [gitCmd, localCmd, githubCmd])
   warnIfOutdated
   where
+    prefs =
+      Opts.prefs $ Opts.briefDescOpt (Opts.BriefDescOptGroups $ Just styleGroups)
+
+    styleGroups :: String -> Maybe Opts.Doc
+    styleGroups "Available options:" = Nothing
+    styleGroups g = Just . Opts.brackets . Opts.pretty $ g
+
     execParserPure' pprefs pinfo [] =
       Opts.Failure $
         Opts.parserFailure pprefs pinfo (Opts.ShowHelpText Nothing) mempty
     execParserPure' pprefs pinfo as = Opts.execParserPure pprefs pinfo as
     opts = Opts.info ((,) <$> ((,) <$> parseFindSourcesJson <*> parseColors) <*> (parseCommand <**> Opts.helper <**> versionflag)) $ mconcat desc
     desc =
-      [ Opts.fullDesc,
-        Opts.headerDoc $
+      [ Opts.headerDoc $
           Just $
             Opts.vcat
               [ "niv - dependency manager for Nix projects",
@@ -152,8 +158,7 @@ parseCmdInit :: Opts.ParserInfo (NIO ())
 parseCmdInit = Opts.info (cmdInit <$> parseNixpkgs <**> Opts.helper) $ mconcat desc
   where
     desc =
-      [ Opts.fullDesc,
-        Opts.progDesc
+      [ Opts.progDesc
           "Initialize a Nix project. Existing files won't be modified."
       ]
 
@@ -283,8 +288,7 @@ parseCmdAdd =
     parsePackageNameOverride = PackageName <$> Opts.strOption ( Opts.long "name" <> Opts.short 'n' <> Opts.metavar "NAME")
     description =
       mconcat
-        [ Opts.fullDesc,
-          Opts.progDesc "Add a package",
+        [ Opts.progDesc "Add a package",
           Opts.headerDoc $
             Just $
               Opts.vcat
@@ -348,7 +352,7 @@ parseCmdShow :: Opts.ParserInfo (NIO ())
 parseCmdShow =
   Opts.info
     ((cmdShow <$> Opts.optional parsePackageName) <**> Opts.helper)
-    Opts.fullDesc
+    mempty
 
 -- TODO: nicer output
 cmdShow :: Maybe PackageName -> NIO ()
@@ -399,8 +403,7 @@ parseCmdUpdate =
     $ mconcat desc
   where
     desc =
-      [ Opts.fullDesc,
-        Opts.progDesc "Update dependencies",
+      [ Opts.progDesc "Update dependencies",
         Opts.headerDoc $
           Just $
             Opts.nest 2 $
@@ -511,13 +514,8 @@ checkParsedSpec (unParsedPackageSpec -> parsed) = do
 
 -- Parse a package spec, where any attribute can be specified at most once.
 parsePackageSpec :: Opts.Parser ParsedPackageSpec
-parsePackageSpec = groupOptions "ATTRIBUTES" $ ParsedPackageSpec <$> Opts.some (jsonAttribute <|> stringAttribute <|> knownAttribute)
+parsePackageSpec = Opts.parserOptionGroup "ATTRIBUTES" $ ParsedPackageSpec <$> Opts.some (jsonAttribute <|> stringAttribute <|> knownAttribute)
   where
-    -- this (with `Opts.hidden` set on all options) groups the options below instead of showing them all with the command
-    -- https://github.com/pcapriotti/optparse-applicative/issues/523
-    groupOptions :: String -> Opts.Parser a -> Opts.Parser a
-    groupOptions mv x = Opts.option empty (Opts.metavar mv) <|> Opts.parserOptionGroup mv x
-
     -- shortcuts for many known attributes
     knownAttribute :: Opts.Parser (T.Text, Aeson.Value)
     knownAttribute =
@@ -570,7 +568,7 @@ parsePackageSpec = groupOptions "ATTRIBUTES" $ ParsedPackageSpec <$> Opts.some (
               <> Opts.help "The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL."
           )
 
-    attrOption key mods = (\v -> (key, v)) <$> Opts.strOption (Opts.hidden <> mods)
+    attrOption key mods = (\v -> (key, v)) <$> Opts.strOption mods
 
     -- parse any json value as `--attribute 'foo={"hello": "world"}'`
     -- NOTE: if the string fails to parse as JSON we assume it's a string (a string itself like 'foo' won't
@@ -624,8 +622,7 @@ parseCmdRename =
     $ mconcat desc
   where
     desc =
-      [ Opts.fullDesc,
-        Opts.progDesc "Rename a package",
+      [ Opts.progDesc "Rename a package",
         Opts.headerDoc $
           Just $
             Opts.vcat
@@ -657,8 +654,7 @@ parseCmdModify =
     $ mconcat desc
   where
     desc =
-      [ Opts.fullDesc,
-        Opts.progDesc "Modify dependency attributes without performing an update",
+      [ Opts.progDesc "Modify dependency attributes without performing an update",
         Opts.headerDoc $
           Just $
             Opts.vcat
@@ -693,8 +689,7 @@ parseCmdDrop =
     $ mconcat desc
   where
     desc =
-      [ Opts.fullDesc,
-        Opts.progDesc "Drop dependency",
+      [ Opts.progDesc "Drop dependency",
         Opts.headerDoc $
           Just $
             Opts.vcat
@@ -738,8 +733,7 @@ parseCmdVersion =
     $ mconcat desc
   where
     desc =
-      [ Opts.fullDesc,
-        Opts.progDesc "Print version"
+      [ Opts.progDesc "Print version"
       ]
 
 -------------------------------------------------------------------------------

[nmattia]

@tbidne this looks great, thanks a lot! Small nit, [Available options] looks a bit strange but I see where this is coming from. I'll play with this when I get the chance but LGTM!

edit: just saw the option for custom styling!

[tbidne]

@tbidne this looks great, thanks a lot! Small nit, [Available options] looks a bit strange but I see where this is coming from. I'll play with this when I get the chance but LGTM!

edit: just saw the option for custom styling!

Sure, the idea is to come up with a consistent way to treat groups uniformly, so that requires treating Available options: like any other group. That said, I just simplified some of the interface / implementation, and in doing so you can now exclude arbitrary groups entirely. So if you wanted, you could have:

-- Skips 'Available options:', renders all other groups.
styleFn :: String -> Maybe Doc
styleFn "Available options:" = Nothing
styleFn g = Just . brackets . pretty $ g