Add Parser groups, similar to Command groups

README.md

@@ -748,6 +748,53 @@ main = customExecParser p opts
     p = prefs showHelpOnEmpty
 ```
 
+#### Option groups
+
+The `parserOptionGroup` function can be used to group options together under
+a common heading. For example, if we have:
+
+```haskell
+Args
+  <$> parseMain
+  <*> parserOptionGroup "Group A" parseA
+  <*> parserOptionGroup "Group B" parseB
+  <*> parseOther
+```
+
+Then the `--help` page `Available options` will look like:
+
+```
+Available options:
+  <main options>
+  <other options>
+
+Group A:
+  <A options>
+
+Group B:
+  <B options>
+```
+
+Caveats:
+
+- Groups are listed in alphabetical order.
+- Duplicate groups are merged i.e.
+
+  ```haskell
+  -- parseA and parseC will be grouped together
+  parserOptionGroup "Group A" parseA
+  parserOptionGroup "Group B" parseA
+  parserOptionGroup "Group A" parseC
+  ```
+
+- Nested groups are overwritten by the outermost group:
+
+    ```haskell
+    parserOptionGroup "Group A" (parserOptionGroup "Group Z" parseA)
+    ```
+
+    Will group `parseA` under `Group A`.
+
 ### Command groups
 
 One experimental feature which may be useful for programs with many

optparse-applicative.cabal

@@ -131,6 +131,10 @@ test-suite tests
                      , Examples.Formatting
                      , Examples.Hello
                      , Examples.LongSub
+                     , Examples.ParserGroup.AllGrouped
+                     , Examples.ParserGroup.Basic
+                     , Examples.ParserGroup.Duplicates
+                     , Examples.ParserGroup.Nested
 
   build-depends:       base
                      , optparse-applicative

src/Options/Applicative.hs

@@ -105,6 +105,7 @@ module Options.Applicative (
   completer,
   idm,
   mappend,
+  parserOptionGroup,
 
   OptionFields,
   FlagFields,

src/Options/Applicative/Builder.hs

@@ -49,6 +49,7 @@ module Options.Applicative.Builder (
   completer,
   idm,
   mappend,
+  parserOptionGroup,
 
   -- * Readers
   --
@@ -118,6 +119,7 @@ import Options.Applicative.Common
 import Options.Applicative.Types
 import Options.Applicative.Help.Pretty
 import Options.Applicative.Help.Chunk
+import Options.Applicative.Internal (mapParserOptions)
 
 -- Readers --
 
@@ -379,6 +381,78 @@ option r m = mkParser d g rdr
     crdr = CReader (optCompleter fields) r
     rdr = OptReader (optNames fields) crdr (optNoArgError fields)
 
+-- | Add group to 'OptProperties'. Always overwrites the group, if it exists.
+-- This means, in particular, that we do not allow "nested groups" i.e. a
+-- parser group within a parser group.
+optPropertiesGroup :: String -> OptProperties -> OptProperties
+-- If we changed this to only overwrite Nothing, it would allow users to
+-- defined "nested groups" e.g.
+--
+--     parserOptionGroup "General group" $
+--       (,)
+--         <$> parserA
+--         <*> parserOptionGroup "B group" parserB
+--
+-- Despite the nested definition, these would still be flattened on the help
+-- page.
+--
+-- Since we __always__ overwrite the group, the above instead puts
+-- parserA and parserB into the same "General group". We judge this to be
+-- simpler.
+optPropertiesGroup grp o = o { propGroup = Just grp }
+
+-- | Add a group to 'Option'.
+optionGroup :: String -> Option a -> Option a
+optionGroup grp o = o { optProps = props' }
+  where
+    props' = optPropertiesGroup grp (optProps o)
+
+-- | This function can be used to group options together under a common
+-- heading. For example, if we have:
+--
+-- > Args
+-- >   <$> parseMain
+-- >   <*> parserOptionGroup "Group A" parseA
+-- >   <*> parserOptionGroup "Group B" parseB
+-- >   <*> parseOther
+--
+-- Then the help page will look like:
+--
+-- > Available options:
+-- >   <main options>
+-- >   <other options>
+-- >
+-- > Group A:
+-- >   <A options>
+-- >
+-- > Group B:
+-- >   <B options>
+--
+-- Caveats:
+--
+--   - Groups are listed in alphabetical order.
+--
+--   - Duplicate groups are merged i.e.
+--
+--       @
+--         -- parseA and parseC will be grouped together
+--         parserOptionGroup "Group A" parseA
+--         parserOptionGroup "Group B" parseB
+--         parserOptionGroup "Group A" parseC
+--       @
+--
+--   - Nested groups are overwritten by the outermost group:
+--
+--       @
+--         parserOptionGroup "Group A" (parserOptionGroup "Group Z" parseA)
+--       @
+--
+--       Will group @parseA@ under @Group A@.
+--
+-- @since 0.19.0.0
+parserOptionGroup :: String -> Parser a -> Parser a
+parserOptionGroup g = mapParserOptions (optionGroup g)
+
 -- | Modifier for 'ParserInfo'.
 newtype InfoMod a = InfoMod
   { applyInfoMod :: ParserInfo a -> ParserInfo a }

src/Options/Applicative/Builder/Internal.hs

@@ -150,6 +150,7 @@ baseProps = OptProperties
   , propShowDefault = Nothing
   , propDescMod = Nothing
   , propShowGlobal = True
+  , propGroup = Nothing
   }
 
 mkCommand :: Mod CommandFields a -> (Maybe String, [(String, ParserInfo a)])

src/Options/Applicative/Help/Core.hs

@@ -24,7 +24,7 @@ import Control.Monad (guard)
 import Data.Function (on)
 import Data.List (sort, intersperse, groupBy)
 import Data.Foldable (any, foldl')
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (fromMaybe)
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid (mempty)
 #endif
@@ -34,6 +34,7 @@ import Data.Semigroup (Semigroup (..))
 import Prelude hiding (any)
 
 import Options.Applicative.Common
+import Options.Applicative.Internal (sortGroupFst)
 import Options.Applicative.Types
 import Options.Applicative.Help.Pretty
 import Options.Applicative.Help.Chunk
@@ -50,12 +51,13 @@ safelast :: [a] -> Maybe a
 safelast = foldl' (const Just) Nothing
 
 -- | Generate description for a single option.
-optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (Chunk Doc, Parenthetic)
+optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (Maybe String, Chunk Doc, Parenthetic)
 optDesc pprefs style _reachability opt =
   let names =
         sort . optionNames . optMain $ opt
       meta =
         stringChunk $ optMetaVar opt
+      grp = propGroup $ optProps opt
       descs =
         map (pretty . showOption) names
       descriptions =
@@ -86,7 +88,7 @@ optDesc pprefs style _reachability opt =
           desc
       modified =
         maybe id fmap (optDescMod opt) rendered
-   in (modified, wrapping)
+   in (grp, modified, wrapping)
 
 -- | Generate descriptions for commands.
 cmdDesc :: ParserPrefs -> Parser a -> [(Maybe String, Chunk Doc)]
@@ -118,7 +120,7 @@ briefDesc' showOptional pprefs =
   wrapOver NoDefault MaybeRequired
     . foldTree pprefs style
     . mfilterOptional
-    . treeMapParser (optDesc pprefs style)
+    . treeMapParser (\a -> (\(_, x, y) -> (x, y)) . optDesc pprefs style a)
   where
     mfilterOptional
       | showOptional =
@@ -193,14 +195,31 @@ globalDesc = optionsDesc True
 
 -- | Common generator for full descriptions and globals
 optionsDesc :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
-optionsDesc global pprefs = tabulate (prefTabulateFill pprefs) . catMaybes . mapParser doc
+optionsDesc global pprefs p = vsepChunks
+  . fmap formatTitle
+  . fmap tabulateGroup
+  . groupByTitle
+  $ mapParser doc p
   where
+    groupByTitle :: [Maybe (Maybe String, (Doc, Doc))] -> [[(Maybe String, (Doc, Doc))]]
+    groupByTitle = sortGroupFst
+
+    tabulateGroup :: [(Maybe String, (Doc, Doc))] -> (Maybe String, Chunk Doc)
+    tabulateGroup l@((title,_):_) = (title, tabulate (prefTabulateFill pprefs) (snd <$> l))
+    tabulateGroup [] = mempty
+
+    formatTitle :: (Maybe String, Chunk Doc) -> Chunk Doc
+    formatTitle (mTitle, opts) = case mTitle of
+      Nothing -> opts
+      Just title -> (pretty (title ++ ":") .$.) <$> opts
+
+    doc :: ArgumentReachability -> Option a -> Maybe (Maybe String, (Doc, Doc))
     doc info opt = do
       guard . not . isEmpty $ n
       guard . not . isEmpty $ h
-      return (extractChunk n, align . extractChunk $ h <</>> hdef)
+      return (grp, (extractChunk n, align . extractChunk $ h <<+>> hdef))
       where
-        n = fst $ optDesc pprefs style info opt
+        (grp, n, _) = optDesc pprefs style info opt
         h = optHelp opt
         hdef = Chunk . fmap show_def . optShowDefault $ opt
         show_def s = parens (pretty "default:" <+> pretty s)

src/Options/Applicative/Internal.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE RankNTypes #-}
+
 module Options.Applicative.Internal
   ( P
   , MonadP(..)
@@ -24,6 +26,9 @@ module Options.Applicative.Internal
   , cut
   , (<!>)
   , disamb
+
+  , mapParserOptions
+  , sortGroupFst
   ) where
 
 import Control.Applicative
@@ -35,6 +40,9 @@ import Control.Monad.Trans.Except
 import Control.Monad.Trans.Reader
   (mapReaderT, runReader, runReaderT, Reader, ReaderT, ask)
 import Control.Monad.Trans.State (StateT, get, put, modify, evalStateT, runStateT)
+import Data.Function (on)
+import Data.List (groupBy, sortBy)
+import Data.Maybe (catMaybes)
 
 import Options.Applicative.Types
 
@@ -266,3 +274,26 @@ hoistList :: Alternative m => [a] -> m a
 hoistList = foldr cons empty
   where
     cons x xs = pure x <|> xs
+
+-- | Strips 'Nothing', sorts then groups on the first element of the tuple.
+sortGroupFst :: (Ord a) => [Maybe (a, b)] -> [[(a, b)]]
+sortGroupFst =
+  groupFst
+    -- By sorting prior to grouping, we ensure all Eq a's are consecutive,
+    -- meaning we are guaranteed to have exactly one representative for
+    -- each group.
+    . sortBy (compare `on` fst)
+    . catMaybes
+  where
+    groupFst = groupBy ((==) `on` fst)
+
+-- | Maps an Option modifying function over the Parser.
+mapParserOptions :: (forall x. Option x -> Option x) -> Parser a -> Parser a
+mapParserOptions f = go
+  where
+    go :: forall y. Parser y -> Parser y
+    go (NilP x) = NilP x
+    go (OptP o) = OptP (f o)
+    go (MultP p1 p2) = MultP (go p1) (go p2)
+    go (AltP p1 p2) = AltP (go p1) (go p2)
+    go (BindP p1 p2) = BindP (go p1) (\x -> go (p2 x))

src/Options/Applicative/Types.hs

@@ -155,17 +155,20 @@ data OptProperties = OptProperties
   , propShowDefault :: Maybe String       -- ^ what to show in the help text as the default
   , propShowGlobal :: Bool                -- ^ whether the option is presented in global options text
   , propDescMod :: Maybe ( Doc -> Doc )   -- ^ a function to run over the brief description
+  , propGroup :: Maybe String             -- ^ optional group name
   }
 
 instance Show OptProperties where
-  showsPrec p (OptProperties pV pH pMV pSD pSG _)
+  showsPrec p (OptProperties pV pH pMV pSD pSG _ pGrp)
     = showParen (p >= 11)
     $ showString "OptProperties { propVisibility = " . shows pV
     . showString ", propHelp = " . shows pH
     . showString ", propMetaVar = " . shows pMV
     . showString ", propShowDefault = " . shows pSD
     . showString ", propShowGlobal = " . shows pSG
-    . showString ", propDescMod = _ }"
+    . showString ", propDescMod = _"
+    . showString ", propGroup = " . shows pGrp
+    . showString "}"
 
 -- | A single option of a parser.
 data Option a = Option