Do not sort parser groups to match command groups

src/Options/Applicative/Help/Core.hs

@@ -208,10 +208,32 @@ optionsDesc global pprefs p = vsepChunks
     tabulateGroup l@((title,_):_) = (title, tabulate (prefTabulateFill pprefs) (snd <$> l))
     tabulateGroup [] = mempty
 
+    -- REVIEW:
+    --
+    -- Conundrum: If we want to behave like command groups, then:
+    --
+    --   1. Groups should not be alphabetically sorted; first come, first serve
+    --   2. Duplicate groups __are__ allowed. In particular, ungrouped commands
+    --      are titled 'Available commands:', thus there can be multiples of
+    --      this section.
+    --
+    -- 1 just means we do not do any sorting when grouping (sortGroupFst).
+    -- 2 means that we should adorn __each__ ungrouped option with the
+    -- 'Available options:' title, so we need to do it here.
+    --
+    -- The question is, how do we interact with 'Global options:'? Right now
+    -- we treat it identically, simply swapping out the default title. But
+    -- we could do something different.
     formatTitle :: (Maybe String, Chunk Doc) -> Chunk Doc
-    formatTitle (mTitle, opts) = case mTitle of
-      Nothing -> opts
-      Just title -> (pretty (title ++ ":") .$.) <$> opts
+    formatTitle (mTitle, opts) =
+      case mTitle of
+        Nothing -> (pretty defTitle .$.) <$> opts
+        Just title -> (pretty (title ++ ":") .$.) <$> opts
+      where
+        defTitle =
+          if global
+            then "Global options:"
+            else "Available options:"
 
     doc :: ArgumentReachability -> Option a -> Maybe (Maybe String, (Doc, Doc))
     doc info opt = do
@@ -257,7 +279,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 +296,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

@@ -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,15 +275,9 @@ hoistList = foldr cons empty
   where
     cons x xs = pure x <|> xs
 
--- | Strips 'Nothing', sorts then groups on the first element of the tuple.
+-- | Strips 'Nothing', 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
+sortGroupFst = groupFst . catMaybes
   where
     groupFst = groupBy ((==) `on` fst)
 

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

tests/parser_group_nested.err.txt

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

tests/test.hs

@@ -1006,24 +1006,6 @@ prop_stringChunk_2 s = isEmpty (stringChunk s) === null s
 prop_paragraph :: String -> Property
 prop_paragraph s = isEmpty (paragraph s) === null (words s)
 
-prop_sortGroupFst :: [Maybe (Maybe String, Int)] -> Property
-prop_sortGroupFst xs =
-  conjoin
-    [ isSorted result
-    , noDuplicates result
-    ]
-  where
-    result :: [[(Maybe String, Int)]]
-    result = Internal.sortGroupFst xs
-
-    isSorted :: Ord a => [a] -> Bool
-    isSorted [] = True
-    isSorted [_] = True
-    isSorted (y1 : y2 : ys) = y1 <= y2 && isSorted (y2 : ys)
-
-    noDuplicates :: [[(Maybe String, Int)]] -> Bool
-    noDuplicates ys = ys == nubBy ((==) `on` fst . unsafeHead) ys
-
 ---
 
 --