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/Configure.hs

@@ -73,6 +73,7 @@ module Distribution.Simple.Configure
 
 import Control.Monad
 import Distribution.Compat.Prelude
+import GHC.Stack (HasCallStack)
 import Prelude ()
 
 import Distribution.Backpack.Configure
@@ -81,7 +82,6 @@ import Distribution.Backpack.DescribeUnitId
 import Distribution.Backpack.Id
 import Distribution.Backpack.PreExistingComponent
 import qualified Distribution.Compat.Graph as Graph
-import Distribution.Compat.Stack
 import Distribution.Compiler
 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
 import qualified Distribution.InstalledPackageInfo as IPI
@@ -253,7 +253,8 @@ instance Exception ConfigStateFileError
 -- missing, if the file cannot be read, or if the file was created by an older
 -- version of Cabal.
 getConfigStateFile
-  :: Maybe (SymbolicPath CWD (Dir Pkg))
+  :: HasCallStack
+  => Maybe (SymbolicPath CWD (Dir Pkg))
   -> SymbolicPath Pkg File
   -- ^ The file path of the @setup-config@ file.
   -> IO LocalBuildInfo
@@ -279,8 +280,6 @@ getConfigStateFile mbWorkDir setupConfigFile = do
             throwIO $ ConfigStateFileBadVersion cabalId compId eResult
         | otherwise = act
   deferErrorIfBadVersion getStoredValue
-  where
-    _ = callStack -- TODO: attach call stack to exception
 
 -- | Read the 'localBuildInfoFile', returning either an error or the local build
 -- info.

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

@@ -194,16 +194,19 @@ 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})
         ( reqArg
-            "FILTER"
+            "always|never|failures|streaming|direct"
             ( parsecToReadE
                 ( \_ ->
                     "--show-details flag expects one of "

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.6.29.0 && < 1.7
       , random     >= 1.2      && < 1.4