From 81503e0e0c44333af65dfd2cc00a4cbc430cb4f4 Mon Sep 17 00:00:00 2001 From: Ilya Baryshnikov Date: Sun, 2 Aug 2026 16:00:07 +0300 Subject: [PATCH 1/5] fix parsing of boolean values to debug-info --- Cabal/src/Distribution/Simple/Compiler.hs | 30 ++++++++++++------- .../ProjectConfig/DebugInfo/cabal.out | 3 ++ .../ProjectConfig/DebugInfo/cabal.test.hs | 6 ++-- changelog.d/12202.md | 8 +++++ 4 files changed, 33 insertions(+), 14 deletions(-) create mode 100644 changelog.d/12202.md diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 40e7a36da76..7e548642172 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -463,22 +463,32 @@ 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 = intToDebugInfoLevel <$> 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" + [(i, "")] -> intToDebugInfoLevel i _ -> error $ "Can't parse debug info level " ++ s +intToDebugInfoLevel :: Int -> DebugInfoLevel +intToDebugInfoLevel i + | i >= minLevel && i <= maxLevel = toEnum i + | otherwise = + error $ + "Bad debug info level: " + ++ show i + ++ ". Valid values are " + ++ show minLevel + ++ ".." + ++ show maxLevel + where + minLevel = fromEnum (minBound :: DebugInfoLevel) + maxLevel = fromEnum (maxBound :: DebugInfoLevel) + -- ------------------------------------------------------------ -- * Languages and Extensions diff --git a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out b/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out index 19b2a69fa0a..733b6d5a815 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out +++ b/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- -O1 +In order, the following would be built: + - debug-info-0 (lib) (first run) diff --git a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs index 66fb7f795f0..c0a56a3580b 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs +++ b/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 diff --git a/changelog.d/12202.md b/changelog.d/12202.md new file mode 100644 index 00000000000..ba99c7f4575 --- /dev/null +++ b/changelog.d/12202.md @@ -0,0 +1,8 @@ +--- +synopsis: Fix parsing of boolean values ​​to debug-info +packages: [Cabal] +prs: 12202 +issues: 12140 +--- + +`False` values ​​are treated as `NoDebugInfo`, and `True` values ​​are treated as `NormalDebugInfo`. From e6859225d221abf64338b89d0dde8091a462457e Mon Sep 17 00:00:00 2001 From: Ilya Baryshnikov Date: Fri, 21 Aug 2026 18:11:16 +0300 Subject: [PATCH 2/5] add suggestions --- Cabal/src/Distribution/Simple/Compiler.hs | 38 +++-------------------- Cabal/src/Distribution/Simple/Utils.hs | 19 ++++++++++++ 2 files changed, 23 insertions(+), 34 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 7e548642172..e82f5d26c09 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -416,29 +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 + [(i, "")] -> intToEnum "optimisation level" 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) - -- ------------------------------------------------------------ -- * Debug info levels @@ -466,29 +451,14 @@ parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel parsecDebugInfoLevel = boolParser <|> intParser where boolParser = bool NoDebugInfo NormalDebugInfo <$> parsec - intParser = intToDebugInfoLevel <$> integral + intParser = intToEnum "debug info level" <$> integral flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel flagToDebugInfoLevel Nothing = NormalDebugInfo flagToDebugInfoLevel (Just s) = case reads s of - [(i, "")] -> intToDebugInfoLevel i + [(i, "")] -> intToEnum "debug info level" i _ -> error $ "Can't parse debug info level " ++ s -intToDebugInfoLevel :: Int -> DebugInfoLevel -intToDebugInfoLevel i - | i >= minLevel && i <= maxLevel = toEnum i - | otherwise = - error $ - "Bad debug info level: " - ++ show i - ++ ". Valid values are " - ++ show minLevel - ++ ".." - ++ show maxLevel - where - minLevel = fromEnum (minBound :: DebugInfoLevel) - maxLevel = fromEnum (maxBound :: DebugInfoLevel) - -- ------------------------------------------------------------ -- * Languages and Extensions diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs index 3186e2950f1..2b67dfa2888 100644 --- a/Cabal/src/Distribution/Simple/Utils.hs +++ b/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 From eab16d9cf7ecfad1df434a3a1744ead4926e34f5 Mon Sep 17 00:00:00 2001 From: Ilya Baryshnikov Date: Fri, 21 Aug 2026 18:17:51 +0300 Subject: [PATCH 3/5] fix changelog --- changelog.d/12202.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/changelog.d/12202.md b/changelog.d/12202.md index ba99c7f4575..6889e15c366 100644 --- a/changelog.d/12202.md +++ b/changelog.d/12202.md @@ -1,8 +1,8 @@ --- -synopsis: Fix parsing of boolean values ​​to debug-info +synopsis: Fix parsing of boolean values to debug-info packages: [Cabal] prs: 12202 issues: 12140 --- -`False` values ​​are treated as `NoDebugInfo`, and `True` values ​​are treated as `NormalDebugInfo`. +`False` values are treated as `NoDebugInfo`, and `True` values are treated as `NormalDebugInfo`. From 51b27a47b2a1a5832498d599b9bb030c55be49ed Mon Sep 17 00:00:00 2001 From: Ilya Baryshnikov Date: Fri, 21 Aug 2026 18:47:03 +0300 Subject: [PATCH 4/5] fix command line --- Cabal/src/Distribution/Simple/Compiler.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index e82f5d26c09..59eadac3a40 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -422,7 +422,9 @@ flagToOptimisationLevel :: Maybe String -> OptimisationLevel flagToOptimisationLevel Nothing = NormalOptimisation flagToOptimisationLevel (Just s) = case reads s of [(i, "")] -> intToEnum "optimisation level" i - _ -> error $ "Can't parse optimisation level " ++ s + _ -> case reads s of + [(b, "")] -> if b then NormalOptimisation else NoOptimisation + _ -> error $ "Can't parse optimisation level " ++ s -- ------------------------------------------------------------ @@ -457,7 +459,9 @@ flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel flagToDebugInfoLevel Nothing = NormalDebugInfo flagToDebugInfoLevel (Just s) = case reads s of [(i, "")] -> intToEnum "debug info level" i - _ -> error $ "Can't parse debug info level " ++ s + _ -> case reads s of + [(b, "")] -> if b then NormalDebugInfo else NoDebugInfo + _ -> error $ "Can't parse debug info level " ++ s -- ------------------------------------------------------------ From c1e18826af0ad345659ef59e30148900819099cb Mon Sep 17 00:00:00 2001 From: Ilya Baryshnikov Date: Sat, 22 Aug 2026 09:14:47 +0300 Subject: [PATCH 5/5] add unit-tests --- .../UnitTests/Distribution/Simple/Compiler.hs | 97 ++++++++++++++++++- Cabal/src/Distribution/Simple/Compiler.hs | 18 ++-- changelog.d/12202.md | 44 ++++++++- 3 files changed, 145 insertions(+), 14 deletions(-) diff --git a/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs b/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs index 35834d0a940..c0c73e2a6cc 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs @@ -2,10 +2,12 @@ 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 @@ -13,6 +15,91 @@ 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 ()) diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 59eadac3a40..91e65cfa561 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -420,11 +420,10 @@ parsecOptimisationLevel = boolParser <|> intParser flagToOptimisationLevel :: Maybe String -> OptimisationLevel flagToOptimisationLevel Nothing = NormalOptimisation -flagToOptimisationLevel (Just s) = case reads s of - [(i, "")] -> intToEnum "optimisation level" i - _ -> case reads s of - [(b, "")] -> if b then NormalOptimisation else NoOptimisation - _ -> error $ "Can't parse optimisation level " ++ s +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 -- ------------------------------------------------------------ @@ -457,11 +456,10 @@ parsecDebugInfoLevel = boolParser <|> intParser flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel flagToDebugInfoLevel Nothing = NormalDebugInfo -flagToDebugInfoLevel (Just s) = case reads s of - [(i, "")] -> intToEnum "debug info level" i - _ -> case reads s of - [(b, "")] -> if b then NormalDebugInfo else NoDebugInfo - _ -> 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 -- ------------------------------------------------------------ diff --git a/changelog.d/12202.md b/changelog.d/12202.md index 6889e15c366..6e4d083b0d9 100644 --- a/changelog.d/12202.md +++ b/changelog.d/12202.md @@ -1,8 +1,48 @@ --- -synopsis: Fix parsing of boolean values to debug-info +synopsis: Accept boolean values for `debug-info` and `optimization` levels packages: [Cabal] prs: 12202 issues: 12140 --- -`False` values are treated as `NoDebugInfo`, and `True` values are treated as `NormalDebugInfo`. +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- -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- -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- -O0 +```