Use optparse-applicative for commands

Cabal/src/Distribution/Simple/Command.hs

@@ -350,10 +350,10 @@ commandGetOpts
   -> CommandUI flags
   -> [GetOpt.OptDescr (flags -> flags)]
 commandGetOpts showOrParse command =
-  concatMap viewAsGetOpt (commandOptions command showOrParse)
+  concatMap (viewAsGetOpt showOrParse) (commandOptions command showOrParse)
 
-viewAsGetOpt :: OptionField a -> [GetOpt.OptDescr (a -> a)]
-viewAsGetOpt (OptionField _n aa) = concatMap optDescrToGetOpt aa
+viewAsGetOpt :: ShowOrParseArgs -> OptionField a -> [GetOpt.OptDescr (a -> a)]
+viewAsGetOpt showOrParse (OptionField _n aa) = concatMap optDescrToGetOpt aa
   where
     optDescrToGetOpt (ReqArg d (cs, ss) arg_desc set _) =
       [GetOpt.Option cs ss (GetOpt.ReqArg (runReadE set) arg_desc) d]
@@ -368,10 +368,27 @@ viewAsGetOpt (OptionField _n aa) = concatMap optDescrToGetOpt aa
       [GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) d]
     optDescrToGetOpt (BoolOpt d ([], []) (sfF, lfF) set _) =
       [GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) d]
-    optDescrToGetOpt (BoolOpt d (sfT, lfT) (sfF, lfF) set _) =
-      [ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d)
-      , GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) ("Disable " ++ d)
-      ]
+    optDescrToGetOpt (BoolOpt d trueFlags@(sfT, lfT) falseFlags@(sfF, lfF) set _) =
+      case showOrParse of
+        ShowArgs
+          | Just groupedLongFlag <- mkGroupedBoolLongFlag trueFlags falseFlags ->
+              [ GetOpt.Option [] [groupedLongFlag] (GetOpt.NoArg (set True)) ("Toggle " ++ d)
+              ]
+        _ ->
+          [ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d)
+          , GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) ("Disable " ++ d)
+          ]
+
+    mkGroupedBoolLongFlag :: OptFlags -> OptFlags -> Maybe String
+    mkGroupedBoolLongFlag ([], [longA]) ([], [longB]) =
+      checkPair longA longB <|> checkPair longB longA
+      where
+        checkPair longEnable longDisable = do
+          suffixEnable <- List.stripPrefix "enable-" longEnable
+          suffixDisable <- List.stripPrefix "disable-" longDisable
+          guard (suffixEnable == suffixDisable)
+          pure ("[enable|disable]-" ++ suffixEnable)
+    mkGroupedBoolLongFlag _ _ = Nothing
 
 getCurrentChoice :: OptDescr a -> a -> [String]
 getCurrentChoice (ChoiceOpt alts) a =

Cabal/src/Distribution/Simple/Setup/Benchmark.hs

@@ -116,7 +116,7 @@ benchmarkOptions' showOrParseArgs =
     [ option
         []
         ["benchmark-options"]
-        ( "give extra options to benchmark executables "
+        ( "Give extra options to benchmark executables "
             ++ "(split on spaces, use \"\" to prevent splitting; "
             ++ "name templates can use $pkgid, $compiler, "
             ++ "$os, $arch, $benchmark)"
@@ -131,7 +131,7 @@ benchmarkOptions' showOrParseArgs =
     , option
         []
         ["benchmark-option"]
-        ( "give extra option to benchmark executables "
+        ( "Give extra option to benchmark executables "
             ++ "(passed directly as a single argument; "
             ++ "name template can use $pkgid, $compiler, "
             ++ "$os, $arch, $benchmark)"

Cabal/src/Distribution/Simple/Setup/Common.hs

@@ -237,7 +237,7 @@ programDbPaths' mkName progDb showOrParseArgs get set =
       option
         ""
         [mkName prog]
-        ("give the path to " ++ prog)
+        ("Give the path to " ++ prog)
         get
         set
         ( reqArg'
@@ -267,7 +267,7 @@ programDbOption progDb showOrParseArgs get set =
       option
         ""
         [prog ++ "-option"]
-        ( "give an extra option to "
+        ( "Give an extra option to "
             ++ prog
             ++ " (passed directly to "
             ++ prog
@@ -308,7 +308,7 @@ programDbOptions progDb showOrParseArgs get set =
       option
         ""
         [prog ++ "-options"]
-        ( "give extra options to "
+        ( "Give extra options to "
             ++ prog
             ++ " (split on spaces, use \"\" to prevent splitting)"
         )

Cabal/src/Distribution/Simple/Setup/Config.hs

@@ -434,22 +434,22 @@ configureOptions showOrParseArgs =
         configHcFlavor
         (\v flags -> flags{configHcFlavor = v})
         ( choiceOpt
-            [ (Flag GHC, ("g", ["ghc"]), "compile with GHC")
-            , (Flag GHCJS, ([], ["ghcjs"]), "compile with GHCJS")
-            , (Flag UHC, ([], ["uhc"]), "compile with UHC")
+            [ (Flag GHC, ("g", ["ghc"]), "Compile with GHC")
+            , (Flag GHCJS, ([], ["ghcjs"]), "Compile with GHCJS")
+            , (Flag UHC, ([], ["uhc"]), "Compile with UHC")
             ]
         )
     , option
         "w"
         ["with-compiler"]
-        "give the path to a particular compiler"
+        "Give the path to a particular compiler"
         configHcPath
         (\v flags -> flags{configHcPath = v})
         (reqArgFlag "PATH")
     , option
         ""
         ["with-hc-pkg"]
-        "give the path to the package tool"
+        "Give the path to the package tool"
         configHcPkg
         (\v flags -> flags{configHcPkg = v})
         (reqArgFlag "PATH")
@@ -841,7 +841,7 @@ configureOptions showOrParseArgs =
        , option
           ""
           ["response-files"]
-          "enable workaround for old versions of programs like \"ar\" that do not support @file arguments"
+          "Enable workaround for old versions of programs like \"ar\" that do not support @file arguments"
           configUseResponseFiles
           (\v flags -> flags{configUseResponseFiles = v})
           (boolOpt' ([], ["disable-response-files"]) ([], []))

Cabal/src/Distribution/Simple/Setup/Test.hs

@@ -194,11 +194,14 @@ testOptions' showOrParseArgs =
     , option
         []
         ["show-details"]
-        ( "'always': always show results of individual test cases. "
-            ++ "'never': never show results of individual test cases. "
-            ++ "'failures': show results of failing test cases. "
-            ++ "'streaming': show results of test cases in real time."
-            ++ "'direct': send results of test cases in real time; no log file."
+        ( unlines
+            [ "Allowed values:"
+            , "- always: always show results of individual test cases."
+            , "- never: never show results of individual test cases."
+            , "- failures: show results of failing test cases."
+            , "- streaming: show results of test cases in real time."
+            , "- direct: send results of test cases in real time; no log file."
+            ]
         )
         testShowDetails
         (\v flags -> flags{testShowDetails = v})
@@ -218,7 +221,7 @@ testOptions' showOrParseArgs =
     , option
         []
         ["keep-tix-files"]
-        "keep .tix files for HPC between test runs"
+        "Keep .tix files for HPC between test runs"
         testKeepTix
         (\v flags -> flags{testKeepTix = v})
         trueArg
@@ -243,7 +246,7 @@ testOptions' showOrParseArgs =
     , option
         []
         ["test-options"]
-        ( "give extra options to test executables "
+        ( "Give extra options to test executables "
             ++ "(split on spaces, use \"\" to prevent splitting; "
             ++ "name templates can use $pkgid, $compiler, "
             ++ "$os, $arch, $test-suite)"
@@ -258,7 +261,7 @@ testOptions' showOrParseArgs =
     , option
         []
         ["test-option"]
-        ( "give extra option to test executables "
+        ( "Give extra option to test executables "
             ++ "(passed directly as a single argument; "
             ++ "name template can use $pkgid, $compiler, "
             ++ "$os, $arch, $test-suite)"

cabal-install/cabal-install.cabal

@@ -106,6 +106,7 @@ library
         Distribution.Client.CmdClean
         Distribution.Client.CmdConfigure
         Distribution.Client.CmdErrorMessages
+        Distribution.Client.Cmd.UI
         Distribution.Client.CmdExec
         Distribution.Client.CmdFreeze
         Distribution.Client.CmdHaddock
@@ -256,6 +257,7 @@ library
       , HTTP       >= 4000.1.5 && < 4000.6
       , mtl        >= 2.0      && < 2.4
       , network-uri >= 2.6.2.0 && < 2.7
+      , optparse-applicative >= 0.18 && < 0.19
       , pretty     >= 1.1      && < 1.2
       , process    >= 1.2.3.0  && < 1.6.24 || == 1.6.26.0 || >= 1.6.26.2 && < 1.7
       , random     >= 1.2      && < 1.4