fix(Cabal): Accept boolean values for debug-info and optimization levels

Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs

@@ -2,17 +2,104 @@ module UnitTests.Distribution.Simple.Compiler
   ( tests
   ) where
 
+import Control.Exception qualified as C
 import Data.List (isInfixOf)
 import Data.Map (fromList)
 import Distribution.Compiler
 import Distribution.Package
+import Distribution.Parsec (eitherParsec)
 import Distribution.Simple.Compiler
 import Distribution.Version
 import Language.Haskell.Extension
 import Test.Tasty
 import Test.Tasty.HUnit
 import Text.Read (readMaybe)
 
+tests :: [TestTree]
+tests =
+  [ testGroup "flagToDebugInfoLevel" flagToDebugInfoLevelTests
+  , testGroup "flagToOptimisationLevel" flagToOptimisationLevelTests
+  , testGroup "DebugInfoLevel Parsec" debugInfoLevelParsecTests
+  , testGroup "OptimisationLevel Parsec" optimisationLevelParsecTests
+  , testGroup "Show/Read instance" showReadTests
+  ]
+
+flagToDebugInfoLevelTests :: [TestTree]
+flagToDebugInfoLevelTests =
+  [ testCase "defaults to NormalDebugInfo" $
+      flagToDebugInfoLevel Nothing @?= NormalDebugInfo
+  , testCase "--enable-debug-info=True" $
+      flagToDebugInfoLevel (Just "True") @?= NormalDebugInfo
+  , testCase "--enable-debug-info=False" $
+      flagToDebugInfoLevel (Just "False") @?= NoDebugInfo
+  , testCase "--enable-debug-info=0" $
+      flagToDebugInfoLevel (Just "0") @?= NoDebugInfo
+  , testCase "--enable-debug-info=1" $
+      flagToDebugInfoLevel (Just "1") @?= MinimalDebugInfo
+  , testCase "--enable-debug-info=2" $
+      flagToDebugInfoLevel (Just "2") @?= NormalDebugInfo
+  , testCase "--enable-debug-info=3" $
+      flagToDebugInfoLevel (Just "3") @?= MaximalDebugInfo
+  , testCase "--enable-debug-info=4 is out of range" $
+      assertError "expected an error for out-of-range debug info level" $
+        flagToDebugInfoLevel (Just "4")
+  , testCase "--enable-debug-info=foo is unparsable" $
+      assertError "expected an error for unparsable debug info level" $
+        flagToDebugInfoLevel (Just "foo")
+  ]
+
+flagToOptimisationLevelTests :: [TestTree]
+flagToOptimisationLevelTests =
+  [ testCase "defaults to NormalOptimisation" $
+      flagToOptimisationLevel Nothing @?= NormalOptimisation
+  , testCase "--enable-optimization=True" $
+      flagToOptimisationLevel (Just "True") @?= NormalOptimisation
+  , testCase "--enable-optimization=False" $
+      flagToOptimisationLevel (Just "False") @?= NoOptimisation
+  , testCase "--enable-optimization=0" $
+      flagToOptimisationLevel (Just "0") @?= NoOptimisation
+  , testCase "--enable-optimization=1" $
+      flagToOptimisationLevel (Just "1") @?= NormalOptimisation
+  , testCase "--enable-optimization=2" $
+      flagToOptimisationLevel (Just "2") @?= MaximumOptimisation
+  , testCase "--enable-optimization=3 is out of range" $
+      assertError "expected an error for out-of-range optimisation level" $
+        flagToOptimisationLevel (Just "3")
+  , testCase "--enable-optimization=foo is unparsable" $
+      assertError "expected an error for unparsable optimisation level" $
+        flagToOptimisationLevel (Just "foo")
+  ]
+
+debugInfoLevelParsecTests :: [TestTree]
+debugInfoLevelParsecTests =
+  [ testCase "parses True" $
+      eitherParsec "True" @?= (Right NormalDebugInfo :: Either String DebugInfoLevel)
+  , testCase "parses False" $
+      eitherParsec "False" @?= (Right NoDebugInfo :: Either String DebugInfoLevel)
+  , testCase "parses 0" $
+      eitherParsec "0" @?= (Right NoDebugInfo :: Either String DebugInfoLevel)
+  , testCase "parses 1" $
+      eitherParsec "1" @?= (Right MinimalDebugInfo :: Either String DebugInfoLevel)
+  , testCase "parses 2" $
+      eitherParsec "2" @?= (Right NormalDebugInfo :: Either String DebugInfoLevel)
+  , testCase "parses 3" $
+      eitherParsec "3" @?= (Right MaximalDebugInfo :: Either String DebugInfoLevel)
+  ]
+
+optimisationLevelParsecTests :: [TestTree]
+optimisationLevelParsecTests =
+  [ testCase "parses True" $
+      eitherParsec "True" @?= (Right NormalOptimisation :: Either String OptimisationLevel)
+  , testCase "parses False" $
+      eitherParsec "False" @?= (Right NoOptimisation :: Either String OptimisationLevel)
+  , testCase "parses 0" $
+      eitherParsec "0" @?= (Right NoOptimisation :: Either String OptimisationLevel)
+  , testCase "parses 1" $
+      eitherParsec "1" @?= (Right NormalOptimisation :: Either String OptimisationLevel)
+  , testCase "parses 2" $
+      eitherParsec "2" @?= (Right MaximumOptimisation :: Either String OptimisationLevel)
+  ]
+
 -- | A 'Compiler' as configured for a recent GHC, with 'compilerWiredInUnitIds'
 -- populated (GHC >= 9.14) or not (older compilers).
 testCompiler :: Maybe [(PackageName, UnitId)] -> Compiler
@@ -36,8 +123,8 @@ wiredInUnitIds =
   , (mkPackageName "ghc-internal", mkUnitId "ghc-internal-9.14.1")
   ]
 
-tests :: [TestTree]
-tests =
+showReadTests :: [TestTree]
+showReadTests =
   [ testCase "show renders valid Haskell source" $ do
       let shown = show (testCompiler (Just wiredInUnitIds))
       assertBool ("uses mkPackageName: " ++ shown) $
@@ -65,3 +152,9 @@ tests =
         ([] :: [(Compiler, String)])
         (readsPrec 11 (show (testCompiler (Just wiredInUnitIds))))
   ]
+
+assertError :: String -> a -> Assertion
+assertError msg x =
+  C.catch
+    (C.evaluate x >> assertFailure msg)
+    (\(C.ErrorCall _) -> return ())

Cabal/src/Distribution/Simple/Compiler.hs

@@ -416,28 +416,14 @@ parsecOptimisationLevel :: CabalParsing m => m OptimisationLevel
 parsecOptimisationLevel = boolParser <|> intParser
   where
     boolParser = bool NoOptimisation NormalOptimisation <$> parsec
-    intParser = intToOptimisationLevel <$> integral
+    intParser = intToEnum "optimisation level" <$> integral
 
 flagToOptimisationLevel :: Maybe String -> OptimisationLevel
 flagToOptimisationLevel Nothing = NormalOptimisation
-flagToOptimisationLevel (Just s) = case reads s of
-  [(i, "")] -> intToOptimisationLevel i
-  _ -> error $ "Can't parse optimisation level " ++ s
-
-intToOptimisationLevel :: Int -> OptimisationLevel
-intToOptimisationLevel i
-  | i >= minLevel && i <= maxLevel = toEnum i
-  | otherwise =
-      error $
-        "Bad optimisation level: "
-          ++ show i
-          ++ ". Valid values are "
-          ++ show minLevel
-          ++ ".."
-          ++ show maxLevel
-  where
-    minLevel = fromEnum (minBound :: OptimisationLevel)
-    maxLevel = fromEnum (maxBound :: OptimisationLevel)
+flagToOptimisationLevel (Just s)
+  | Just i <- readMaybe s = intToEnum "optimisation level" i
+  | Just b <- readMaybe s = if b then NormalOptimisation else NoOptimisation
+  | otherwise = error $ "Can't parse optimisation level: " ++ s
 
 -- ------------------------------------------------------------
 
@@ -463,21 +449,17 @@ instance Parsec DebugInfoLevel where
   parsec = parsecDebugInfoLevel
 
 parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel
-parsecDebugInfoLevel = flagToDebugInfoLevel . pure <$> parsecToken
+parsecDebugInfoLevel = boolParser <|> intParser
+  where
+    boolParser = bool NoDebugInfo NormalDebugInfo <$> parsec
+    intParser = intToEnum "debug info level" <$> integral
 
 flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
 flagToDebugInfoLevel Nothing = NormalDebugInfo
-flagToDebugInfoLevel (Just s) = case reads s of
-  [(i, "")]
-    | i >= fromEnum (minBound :: DebugInfoLevel)
-        && i <= fromEnum (maxBound :: DebugInfoLevel) ->
-        toEnum i
-    | otherwise ->
-        error $
-          "Bad debug info level: "
-            ++ show i
-            ++ ". Valid values are 0..3"
-  _ -> error $ "Can't parse debug info level " ++ s
+flagToDebugInfoLevel (Just s)
+  | Just i <- readMaybe s = intToEnum "debug info level" i
+  | Just b <- readMaybe s = if b then NormalDebugInfo else NoDebugInfo
+  | otherwise = error $ "Can't parse debug info level " ++ s
 
 -- ------------------------------------------------------------
 

Cabal/src/Distribution/Simple/Utils.hs

@@ -201,6 +201,7 @@ module Distribution.Simple.Utils
   , wrapText
   , wrapLine
   , stripCommonPrefix
+  , intToEnum
 
     -- * FilePath stuff
   , isAbsoluteOnAnyPlatform
@@ -2194,3 +2195,21 @@ stripCommonPrefix (x : xs) (y : ys)
   | x == y = stripCommonPrefix xs ys
   | otherwise = y : ys
 stripCommonPrefix _ ys = ys
+
+intToEnum :: (Show a, Enum a, Bounded a) => String -> Int -> a
+intToEnum str i =
+  let res = toEnum i
+      maxLevel = maxBound `asTypeOf` res
+      minLevel = minBound `asTypeOf` res
+   in if i >= fromEnum minLevel && i <= fromEnum maxLevel
+        then res
+        else
+          error $
+            "Bad "
+              ++ str
+              ++ ": "
+              ++ show i
+              ++ ". Valid values are "
+              ++ show minLevel
+              ++ ".."
+              ++ show maxLevel

cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out

@@ -8,3 +8,6 @@ In order, the following would be built:
 # cabal build
 Warnings found while parsing the project file, cabal.boolean.project:
  - cabal.boolean.project:2:1: The field "debug-info" is specified more than once at positions 2:1, 3:1
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following would be built:
+ - debug-info-0 (lib) (first run)

cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs

@@ -6,7 +6,5 @@ main = cabalTest . recordMode RecordMarked $ do
   numeric <- cabal' "build" ["--project-file=cabal.numeric.project", "--dry-run"]
   assertOutputDoesNotContain errMsg numeric
 
-  boolean <- fails $ cabal' "build" ["--project-file=cabal.boolean.project", "--dry-run"]
-  -- TODO: When fixed, change this to assertOutputDoesNotContain.
-  assertOutputContains errMsg boolean
-  pure ()
+  boolean <- cabal' "build" ["--project-file=cabal.boolean.project", "--dry-run"]
+  assertOutputDoesNotContain errMsg boolean

changelog.d/12202.md

@@ -0,0 +1,48 @@
+---
+synopsis: Accept boolean values for `debug-info` and `optimization` levels
+packages: [Cabal]
+prs: 12202
+issues: 12140
+---
+
+The `debug-info` and `optimization`/`optimisation` options now accept boolean
+values in addition to numeric levels, both in project files
+(`debug-info: True`) and on the command line (`--enable-debug-info=True`,
+`--enable-optimization=True`).
+
+`True` is parsed as the normal level and `False` as the disabled level.
+Previously the parsec project-file parser rejected `debug-info: True` with
+"Can't parse debug info level True" (the legacy parser already accepted it),
+and the corresponding command-line options only accepted numeric arguments.
+
+In a project file:
+
+```diff
+- debug-info: True
+- # Can't parse debug info level True
++ debug-info: True
++ # OK, treated as NormalDebugInfo
+```
+
+On the command line:
+
+```diff
+- $ cabal build all --dry-run --enable-debug-info=True
+- Can't parse debug info level True
++ $ cabal build all --dry-run --enable-debug-info=True
++ Resolving dependencies...
++ Build profile: -w ghc-<GHCVER> -O1
++ In order, the following would be built:
++  - debug-info-0 (lib) (first run)
+```
+
+```diff
+- $ cabal build all --dry-run --enable-optimization=True
+- Can't parse optimisation level True
++ $ cabal build all --dry-run --enable-optimization=True
++ Build profile: -w ghc-<GHCVER> -O1
+- $ cabal build all --dry-run --enable-optimization=False
+- Can't parse optimisation level False
++ $ cabal build all --dry-run --enable-optimization=False
++ Build profile: -w ghc-<GHCVER> -O0
+```