Change group semantics per PR discussion

- Nested groups no longer overwrite; we concatenate them instead.
- We no longer sort groups alphabetically; this means, in particular,
  that duplicate groups are only merged when they are consecutive.
  This behavior matches command groups.

README.md

@@ -766,34 +766,29 @@ Then the `--help` page `Available options` will look like:
 ```
 Available options:
   <main options>
-  <other options>
 
 Group A:
   <A options>
 
 Group B:
   <B options>
+
+Available options:
+  <other 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
-  ```
+- Parser groups are like command groups in that groups are listed in creation
+  order, and (non-consecutive) duplicate groups are allowed.
 
-- Nested groups are overwritten by the outermost group:
+- Nested groups are concatenated:
 
     ```haskell
     parserOptionGroup "Group A" (parserOptionGroup "Group Z" parseA)
     ```
 
-    Will group `parseA` under `Group A`.
+    Will group `parseA` under `GroupA.Group Z`.
 
 ### Command groups
 

src/Options/Applicative/Builder.hs

@@ -381,27 +381,20 @@ 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
+-- | Prepends a group to 'OptProperties'. Nested groups are concatenated
+-- together e.g.
 --
--- Despite the nested definition, these would still be flattened on the help
--- page.
+-- @
+--   optPropertiesGroup "Group Outer" (optPropertiesGroup "Group Inner" o)
+-- @
 --
--- 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 }
+-- will render as "Group Outer.Group Inner".
+optPropertiesGroup :: String -> OptProperties -> OptProperties
+optPropertiesGroup g o = o { propGroup = OptGroup (g : gs) }
+  where
+    OptGroup gs = propGroup o
 
--- | Add a group to 'Option'.
+-- | Prepends a group per 'optPropertiesGroup'.
 optionGroup :: String -> Option a -> Option a
 optionGroup grp o = o { optProps = props' }
   where
@@ -420,34 +413,28 @@ optionGroup grp o = o { optProps = props' }
 --
 -- > Available options:
 -- >   <main options>
--- >   <other options>
 -- >
 -- > Group A:
 -- >   <A options>
 -- >
 -- > Group B:
 -- >   <B options>
+-- >
+-- > Available options:
+-- >   <other 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
---       @
+--   - Parser groups are like command groups in that groups are listed in
+--     creation order, and (non-consecutive) duplicate groups are allowed.
 --
---   - Nested groups are overwritten by the outermost group:
+--   - Nested groups are concatenated:
 --
 --       @
 --         parserOptionGroup "Group A" (parserOptionGroup "Group Z" parseA)
 --       @
 --
---       Will group @parseA@ under @Group A@.
+--       Will group @parseA@ under @"GroupA.Group Z"@.
 --
 -- @since 0.19.0.0
 parserOptionGroup :: String -> Parser a -> Parser a

src/Options/Applicative/Builder/Internal.hs

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

src/Options/Applicative/Help/Core.hs

@@ -22,7 +22,7 @@ module Options.Applicative.Help.Core (
 import Control.Applicative
 import Control.Monad (guard)
 import Data.Function (on)
-import Data.List (sort, intersperse, groupBy)
+import Data.List (sort, intercalate, intersperse, groupBy)
 import Data.Foldable (any, foldl')
 import Data.Maybe (fromMaybe)
 #if !MIN_VERSION_base(4,8,0)
@@ -34,7 +34,7 @@ import Data.Semigroup (Semigroup (..))
 import Prelude hiding (any)
 
 import Options.Applicative.Common
-import Options.Applicative.Internal (sortGroupFst)
+import Options.Applicative.Internal (groupFst)
 import Options.Applicative.Types
 import Options.Applicative.Help.Pretty
 import Options.Applicative.Help.Chunk
@@ -51,7 +51,7 @@ safelast :: [a] -> Maybe a
 safelast = foldl' (const Just) Nothing
 
 -- | Generate description for a single option.
-optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (Maybe String, Chunk Doc, Parenthetic)
+optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a -> (OptGroup, Chunk Doc, Parenthetic)
 optDesc pprefs style _reachability opt =
   let names =
         sort . optionNames . optMain $ opt
@@ -201,19 +201,29 @@ optionsDesc global pprefs p = vsepChunks
   . groupByTitle
   $ mapParser doc p
   where
-    groupByTitle :: [Maybe (Maybe String, (Doc, Doc))] -> [[(Maybe String, (Doc, Doc))]]
-    groupByTitle = sortGroupFst
+    groupByTitle :: [Maybe (OptGroup, (Doc, Doc))] -> [[(OptGroup, (Doc, Doc))]]
+    groupByTitle = groupFst
 
-    tabulateGroup :: [(Maybe String, (Doc, Doc))] -> (Maybe String, Chunk Doc)
+    tabulateGroup :: [(OptGroup, (Doc, Doc))] -> (OptGroup, 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
+    -- Note that we treat Global/Available options identically, when it comes
+    -- to titles.
+    formatTitle :: (OptGroup, Chunk Doc) -> Chunk Doc
+    formatTitle (OptGroup groups, opts) =
+      case groups of
+        [] -> (pretty defTitle .$.) <$> opts
+        gs@(_:_) -> (renderGroupStr gs .$.) <$> opts
+      where
+        defTitle =
+          if global
+            then "Global options:"
+            else "Available options:"
+
+        renderGroupStr = (<> pretty ":") . pretty . intercalate "."
 
-    doc :: ArgumentReachability -> Option a -> Maybe (Maybe String, (Doc, Doc))
+    doc :: ArgumentReachability -> Option a -> Maybe (OptGroup, (Doc, Doc))
     doc info opt = do
       guard . not . isEmpty $ n
       guard . not . isEmpty $ h
@@ -257,7 +267,7 @@ footerHelp chunk = mempty { helpFooter = chunk }
 parserHelp :: ParserPrefs -> Parser a -> ParserHelp
 parserHelp pprefs p =
   bodyHelp . vsepChunks $
-    with_title "Available options:" (fullDesc pprefs p)
+    (fullDesc pprefs p)
       : (group_title <$> cs)
   where
     def = "Available commands:"
@@ -274,9 +284,7 @@ parserHelp pprefs p =
 
 parserGlobals :: ParserPrefs -> Parser a -> ParserHelp
 parserGlobals pprefs p =
-  globalsHelp $
-    (.$.) <$> stringChunk "Global options:"
-          <*> globalDesc pprefs p
+  globalsHelp $ globalDesc pprefs p
 
 
 

src/Options/Applicative/Internal.hs

@@ -28,7 +28,7 @@ module Options.Applicative.Internal
   , disamb
 
   , mapParserOptions
-  , sortGroupFst
+  , groupFst
   ) where
 
 import Control.Applicative
@@ -41,7 +41,7 @@ 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.List (groupBy)
 import Data.Maybe (catMaybes)
 
 import Options.Applicative.Types
@@ -275,19 +275,15 @@ 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)
+-- | Strips 'Nothing', then groups on the first element of the tuple.
+--
+-- @since 0.19.0.0
+groupFst :: (Eq a) => [Maybe (a, b)] -> [[(a, b)]]
+groupFst = groupBy ((==) `on` fst) . catMaybes
 
 -- | Maps an Option modifying function over the Parser.
+--
+-- @since 0.19.0.0
 mapParserOptions :: (forall x. Option x -> Option x) -> Parser a -> Parser a
 mapParserOptions f = go
   where

src/Options/Applicative/Types.hs

@@ -11,6 +11,7 @@ module Options.Applicative.Types (
 
   OptReader(..),
   OptProperties(..),
+  OptGroup(..),
   OptVisibility(..),
   Backtracking(..),
   ReadM(..),
@@ -147,6 +148,18 @@ data OptVisibility
   | Visible           -- ^ visible both in the full and brief descriptions
   deriving (Eq, Ord, Show)
 
+-- | Groups for optionals. Can be multiple in the case of nested groups.
+--
+-- @since 0.19.0.0
+newtype OptGroup = OptGroup [String]
+  deriving (Eq, Show)
+
+instance Semigroup OptGroup where
+  OptGroup xs <> OptGroup ys = OptGroup (xs ++ ys)
+
+instance Monoid OptGroup where
+  mempty = OptGroup []
+
 -- | Specification for an individual parser option.
 data OptProperties = OptProperties
   { propVisibility :: OptVisibility       -- ^ whether this flag is shown in the brief description
@@ -155,7 +168,10 @@ 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
+  , propGroup :: OptGroup
+    -- ^ optional (nested) group
+    --
+    -- @since 0.19.0.0
   }
 
 instance Show OptProperties where

tests/Examples/ParserGroup/CommandGroups.hs

@@ -112,6 +112,9 @@ sample = do
 
     parseCommand =
       hsubparser
+        ( command "list 2" (info (pure List) $ progDesc "Lists elements")
+        )
+        <|> hsubparser
         ( command "list" (info (pure List) $ progDesc "Lists elements")
             <> command "print" (info (pure Print) $ progDesc "Prints table")
             <> commandGroup "Info commands"

tests/parser_group_all_grouped.err.txt

@@ -6,7 +6,6 @@ Usage: parser_group_all_grouped [--file-log-path PATH]
 
   Every option is grouped
 
-Available options:
 Logging:
   --file-log-path PATH     Log file path
   --file-log-verbosity INT File log verbosity

tests/parser_group_basic.err.txt

@@ -8,14 +8,18 @@ Usage: parser_group_basic --hello TARGET [--file-log-path PATH]
 
 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
 
+Available options:
+  -q,--quiet               Whether to be quiet
+
 System Options:
   --poll                   Whether to poll
   --timeout INT            Whether to time out
+
+Available options:
+  -v,--verbosity ARG       Console verbosity
+  -h,--help                Show this help text

tests/parser_group_command_groups.err.txt

@@ -3,24 +3,31 @@ parser_group.command_groups - a test for optparse-applicative
 Usage: parser_group_command_groups --hello TARGET [--file-log-path PATH] 
                                    [--file-log-verbosity INT] [-q|--quiet] 
                                    [--poll] --timeout INT (-v|--verbosity ARG) 
-                                   (COMMAND | COMMAND | COMMAND)
+                                   (COMMAND | COMMAND | COMMAND | COMMAND)
 
   Option and command 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
 
+Available options:
+  -q,--quiet               Whether to be quiet
+
 System Options:
   --poll                   Whether to poll
   --timeout INT            Whether to time out
 
+Available options:
+  -v,--verbosity ARG       Console verbosity
+  -h,--help                Show this help text
+
+Available commands:
+  list 2                   Lists elements
+
 Info commands
   list                     Lists elements
   print                    Prints table

tests/parser_group_duplicates.err.txt

@@ -8,12 +8,18 @@ Usage: parser_group_duplicates --hello TARGET [--file-log-path PATH]
 
 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
+
+Available options:
+  -q,--quiet               Whether to be quiet
+
+Logging:
   --poll                   Whether to poll
   --timeout INT            Whether to time out
+
+Available options:
+  -v,--verbosity ARG       Console verbosity
+  -h,--help                Show this help text