Use optparse-applicative for commands

Cabal/src/Distribution/GetOpt.hs

@@ -38,6 +38,8 @@ module Distribution.GetOpt
 import Distribution.Compat.Prelude
 import Prelude ()
 
+import Data.List (stripPrefix)
+
 -- | What to do with options following non-options
 data ArgOrder a
   = -- | no option processing after first non-option
@@ -170,21 +172,36 @@ fmtLong (OptArg _ ad) lo =
   let opt = "--" ++ lo
    in opt ++ "[=" ++ ad ++ "]"
 
+-- | Wrap text to the given width. Each line of the input is wrapped on its
+-- own, so a description written with explicit line breaks, such as a list of
+-- allowed values, keeps those breaks. A line that starts with a @- @ list
+-- marker gets a hanging indent, so its continuation lines align with the text
+-- after the marker.
 wrapText :: Int -> String -> [String]
-wrapText width = map unwords . wrap 0 [] . words
+wrapText width = concatMap wrapLine . lines
   where
-    wrap :: Int -> [String] -> [String] -> [[String]]
-    wrap 0 [] (w : ws)
-      | length w + 1 > width =
-          wrap (length w) [w] ws
-    wrap col line (w : ws)
-      | col + length w + 1 > width =
-          reverse line : wrap 0 [] (w : ws)
-    wrap col line (w : ws) =
+    wrapLine line = case stripPrefix listMarker line of
+      Just item ->
+        zipWith (++) (listMarker : repeat listIndent) (wrapWords (width - length listMarker) item)
+      Nothing -> wrapWords width line
+
+    listMarker = "- "
+    listIndent = map (const ' ') listMarker
+
+    wrapWords w = map unwords . wrap w 0 [] . words
+
+    wrap :: Int -> Int -> [String] -> [String] -> [[String]]
+    wrap width' 0 [] (w : ws)
+      | length w + 1 > width' =
+          wrap width' (length w) [w] ws
+    wrap width' col line (w : ws)
+      | col + length w + 1 > width' =
+          reverse line : wrap width' 0 [] (w : ws)
+    wrap width' col line (w : ws) =
       let col' = col + length w + 1
-       in wrap col' (w : line) ws
-    wrap _ [] [] = []
-    wrap _ line [] = [reverse line]
+       in wrap width' col' (w : line) ws
+    wrap _ _ [] [] = []
+    wrap _ _ line [] = [reverse line]
 
 -- |
 -- Process the command-line, and return the list of values that matched

Cabal/src/Distribution/Simple/Command.hs

@@ -340,10 +340,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]
@@ -358,10 +358,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/Config.hs

@@ -542,9 +542,7 @@ configureOptions showOrParseArgs =
        , option
           ""
           ["profiling-detail"]
-          ( "Profiling detail level for executable and library (default, "
-              ++ "none, exported-functions, toplevel-functions,  all-functions, late)."
-          )
+          ("Profiling detail level for executable and library.\n" ++ profDetailLevelsHelp)
           configProfDetail
           (\v flags -> flags{configProfDetail = v})
           ( reqArg'
@@ -555,7 +553,7 @@ configureOptions showOrParseArgs =
        , option
           ""
           ["library-profiling-detail"]
-          "Profiling detail level for libraries only."
+          ("Profiling detail level for libraries only.\n" ++ profDetailLevelsHelp)
           configProfLibDetail
           (\v flags -> flags{configProfLibDetail = v})
           ( reqArg'
@@ -912,6 +910,20 @@ showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String]
 showProfDetailLevelFlag NoFlag = []
 showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl]
 
+-- | Help text listing the known profiling detail levels, one per line with
+-- any aliases, so that the option descriptions stay in step with
+-- 'knownProfDetailLevels'.
+profDetailLevelsHelp :: String
+profDetailLevelsHelp =
+  unlines ("Allowed values:" : punctuate [item primary aliases | (primary, aliases, _) <- knownProfDetailLevels])
+  where
+    item primary [] = "- " ++ primary
+    item primary aliases = "- " ++ primary ++ " (or " ++ intercalate ", " aliases ++ ")"
+
+    punctuate [] = []
+    punctuate [x] = [x ++ "."]
+    punctuate (x : xs) = (x ++ ",") : punctuate xs
+
 parsecPromisedComponent :: ParsecParser PromisedComponent
 parsecPromisedComponent = do
   pn <- parsec

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 "

bootstrap/linux-9.10.3.json

@@ -116,7 +116,7 @@
             "revision": null,
             "source": "local",
             "src_sha256": null,
-            "version": "3.18.1.0"
+            "version": "3.19.0.0"
         },
         {
             "cabal_sha256": "b74eed77eb3237c4ab6a39f08bcce4712b4486b091712ee20e92c8864f1e80a0",
@@ -140,7 +140,7 @@
             "revision": null,
             "source": "local",
             "src_sha256": null,
-            "version": "3.18.1.0"
+            "version": "3.19.0.0"
         },
         {
             "cabal_sha256": null,
@@ -150,7 +150,7 @@
             "revision": null,
             "source": "local",
             "src_sha256": null,
-            "version": "3.18"
+            "version": "3.19"
         },
         {
             "cabal_sha256": "39b25fd929b02b01a3fe59fec7ca8b2da6f0f9e282276b7a84e63a4702c4d725",
@@ -210,6 +210,38 @@
             "src_sha256": "d2a33bc281327d8f20afee18287c2e3f923f0cd86bac40dcba120ca3d2014f9b",
             "version": "4000.5.0"
         },
+        {
+            "cabal_sha256": "613dc8d5f6e51babe57398a742ab8d5c2964fa98b773f3bf6e6a72b7e87f1c6e",
+            "component": "lib:colour",
+            "flags": [],
+            "package": "colour",
+            "revision": 0,
+            "source": "hackage",
+            "src_sha256": "1f3b1055675abe4e3362800cc9bf7ab9b92dfdf21a1f6c82b252611270be9680",
+            "version": "2.3.7"
+        },
+        {
+            "cabal_sha256": "1d6061eceaf35a9ed269b81177dd4c8c60403a499526f7f68fdffa4ec7842e7f",
+            "component": "lib:ansi-terminal-types",
+            "flags": [],
+            "package": "ansi-terminal-types",
+            "revision": 0,
+            "source": "hackage",
+            "src_sha256": "9fc9ce2157f1889bd99a4d22c9f1c64589590be0f797c3efe71c8fa17a11a689",
+            "version": "1.1.3"
+        },
+        {
+            "cabal_sha256": "408d9232e5304efead718f96138d6d7eb2da608c6121c5c0dc6a71a833b14320",
+            "component": "lib:ansi-terminal",
+            "flags": [
+                "-example"
+            ],
+            "package": "ansi-terminal",
+            "revision": 0,
+            "source": "hackage",
+            "src_sha256": "9cf083cef2e2ba88a425f132c8a82bfa931eb4b0c38232b2017f8fcea2e23073",
+            "version": "1.1.5"
+        },
         {
             "cabal_sha256": "140fc5adad166f7b527567cbd26ff481e8da4a66bdfc84be3ddf28dbeb66f275",
             "component": "lib:hashable",
@@ -324,7 +356,7 @@
             "revision": null,
             "source": "local",
             "src_sha256": null,
-            "version": "3.18.1.0"
+            "version": "3.19.0.0"
         },
         {
             "cabal_sha256": "0e9de2ccce261e7a5b027e842f6f47f50eb0e6059a0de98a5479f75aa8164107",
@@ -445,7 +477,7 @@
             "revision": null,
             "source": "local",
             "src_sha256": null,
-            "version": "0.1"
+            "version": "3.19"
         },
         {
             "cabal_sha256": "0dc8dc33b9bba0e025e444355f6c2d806f62a4656446961c3647165f80f0d278",
@@ -459,6 +491,61 @@
             "src_sha256": "1066e286615e39ef43f7e7437a4644775246e264c33b4d259b4858cff0985f0b",
             "version": "0.5.1.0"
         },
+        {
+            "cabal_sha256": "e3a802ea939d465b2e37b9fa09d8e5bb88b5775d6d62dd2ec6ca32b63416656d",
+            "component": "lib:prettyprinter",
+            "flags": [
+                "-buildreadme",
+                "+text"
+            ],
+            "package": "prettyprinter",
+            "revision": 0,
+            "source": "hackage",
+            "src_sha256": "f04eb6fd865512ad8672da1e8bfcea1c384509fc2f662c41b7ac39d7898706ee",
+            "version": "1.7.2"
+        },
+        {
+            "cabal_sha256": "5184ba6002a650de3307547347eaba19bdc9b82eb68e943f406818caa215ce4f",
+            "component": "lib:prettyprinter-ansi-terminal",
+            "flags": [
+                "+text"
+            ],
+            "package": "prettyprinter-ansi-terminal",
+            "revision": 0,
+            "source": "hackage",
+            "src_sha256": "912cd340d5c2583111e2eaeb9aa03b87551ca2e3dd78bbfd346756b9f1e6c9fe",
+            "version": "1.1.4"
+        },
+        {
+            "cabal_sha256": "044fb9955f63ee138fcebedfdcbe54afe741f2d5892a2d0bdf3a8052bd342643",
+            "component": "lib:transformers-compat",
+            "flags": [
+                "-five",
+                "+five-three",
+                "-four",
+                "+generic-deriving",
+                "+mtl",
+                "-three",
+                "-two"
+            ],
+            "package": "transformers-compat",
+            "revision": 0,
+            "source": "hackage",
+            "src_sha256": "b62c7304c9f3cbc9463d0739aa85cb9489f217ea092b9d625d417514fbcc9d6a",
+            "version": "0.7.2"
+        },
+        {
+            "cabal_sha256": "f30973861ac7e7ebff05ff8c7c3d1e4d283a1f3850e1cc14106b0693ec1b6d82",
+            "component": "lib:optparse-applicative",
+            "flags": [
+                "+process"
+            ],
+            "package": "optparse-applicative",
+            "revision": 1,
+            "source": "hackage",
+            "src_sha256": "63811ab4fd26e829b8868364325a88be3acc79819f5bb5005b2dd3b961ecc491",
+            "version": "0.18.1.0"
+        },
         {
             "cabal_sha256": "d6c0c6d1136f5046207a331114ff4130e70640452096de7719bf03e3fceb7c7b",
             "component": "lib:regex-base",
@@ -525,7 +612,7 @@
             "revision": null,
             "source": "local",
             "src_sha256": null,
-            "version": "3.18.1.0"
+            "version": "3.19.0.0"
         },
         {
             "cabal_sha256": null,
@@ -539,7 +626,7 @@
             "revision": null,
             "source": "local",
             "src_sha256": null,
-            "version": "3.18.1.0"
+            "version": "3.19.0.0"
         }
     ]
 }