From 237426c3eef0cef055fd88a43ba196fcce5722db Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Fri, 19 Jun 2026 22:50:32 +0300 Subject: [PATCH 1/7] add test for cabal/config --- .../InitSectionFieldsBools/cabal.out | 2 ++ .../InitSectionFieldsBools/cabal.test.hs | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+) create mode 100644 cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.out create mode 100644 cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs diff --git a/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.out b/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.out new file mode 100644 index 00000000000..e3dc6d7eee9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.out @@ -0,0 +1,2 @@ +# cabal user-config +Writing default configuration to /cabal.dist/cabal-config diff --git a/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs b/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs new file mode 100644 index 00000000000..5ff680a62ba --- /dev/null +++ b/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs @@ -0,0 +1,18 @@ +import Test.Cabal.Prelude +import Data.List (isInfixOf, groupBy) +import Data.Function (on) + +main = cabalTest $ do + workdir <- fmap testWorkDir getTestEnv + let conf = workdir "cabal-config" + + cabalG ["--config-file", conf] "user-config" ["init"] + confContents <- liftIO $ readFile conf + + let ls = lines confContents + sections = groupBy ((==) `on` (== "")) ls + [initLs] = filter ((== "-- full-version: False") . head) sections + init = unlines initLs + + assertBool "init section of config should contain debug-info: False" ("debug-info: False" `isInfixOf` init) + assertBool "init section of config should contain optimization: True" ("optimization: True" `isInfixOf` init) From 129fc67a3e551f419dbaf1c468b1241f3ab09d64 Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Fri, 5 Jun 2026 20:18:51 +0300 Subject: [PATCH 2/7] Display -O and -g as numeric levels instead of booleans --- .../src/Test/QuickCheck/Instances/Cabal.hs | 2 + .../src/Data/TreeDiff/Instances/Cabal.hs | 14 +- Cabal/Cabal.cabal | 2 + Cabal/src/Distribution/Simple/Build.hs | 2 +- Cabal/src/Distribution/Simple/Command.hs | 10 -- Cabal/src/Distribution/Simple/Compiler.hs | 121 +++--------------- Cabal/src/Distribution/Simple/Configure.hs | 1 + Cabal/src/Distribution/Simple/Flag.hs | 14 ++ Cabal/src/Distribution/Simple/GHC/Internal.hs | 2 + Cabal/src/Distribution/Simple/Program/GHC.hs | 3 +- Cabal/src/Distribution/Simple/Setup/Config.hs | 34 ++--- Cabal/src/Distribution/Simple/UHC.hs | 1 + .../src/Distribution/Types/DebugInfoLevel.hs | 73 +++++++++++ Cabal/src/Distribution/Types/DumpBuildInfo.hs | 26 +++- .../Distribution/Types/LocalBuildConfig.hs | 32 +++-- .../src/Distribution/Types/LocalBuildInfo.hs | 2 + .../Distribution/Types/OptimisationLevel.hs | 72 +++++++++++ .../parser-tests/Tests/ParserTests.hs | 4 +- .../src/Distribution/Client/Config.hs | 75 +++-------- .../src/Distribution/Client/DistDirLayout.hs | 2 +- .../src/Distribution/Client/PackageHash.hs | 6 +- .../Client/ProjectConfig/Legacy.hs | 99 ++++---------- .../Distribution/Client/ProjectConfig/Lens.hs | 6 +- .../Client/ProjectConfig/Types.hs | 4 +- .../Client/ProjectOrchestration.hs | 17 +-- .../Distribution/Client/ProjectPlanning.hs | 5 +- .../src/Distribution/Client/ScriptUtils.hs | 5 +- .../Distribution/Client/Configure.hs | 2 +- .../InitSectionFieldsBools/cabal.test.hs | 4 +- .../ProjectConfig/FlagsBools/cabal.project | 1 + changelog.d/11937.md | 10 ++ 31 files changed, 325 insertions(+), 326 deletions(-) create mode 100644 Cabal/src/Distribution/Types/DebugInfoLevel.hs create mode 100644 Cabal/src/Distribution/Types/OptimisationLevel.hs create mode 100644 changelog.d/11937.md diff --git a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs index 0cdff2283e9..345f9981fea 100644 --- a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs +++ b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs @@ -40,6 +40,8 @@ import Distribution.Types.VersionRange.Internal import Distribution.Utils.NubList import Distribution.Verbosity import Distribution.Version +import Distribution.Types.DebugInfoLevel (DebugInfoLevel) +import Distribution.Types.OptimisationLevel (OptimisationLevel) import Test.QuickCheck.GenericArbitrary diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs index f28af98b600..2e7cf79b306 100644 --- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs +++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs @@ -17,20 +17,22 @@ import Distribution.Compiler (CompilerFlavor, CompilerId, import Distribution.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) import Distribution.ModuleName (ModuleName) import Distribution.PackageDescription -import Distribution.Simple.Compiler (DebugInfoLevel, OptimisationLevel, ProfDetailLevel) +import Distribution.Simple.Compiler (ProfDetailLevel) import Distribution.Simple.InstallDirs -import Distribution.Simple.InstallDirs.Internal +import Distribution.Simple.InstallDirs.Internal (PathComponent) import Distribution.Simple.Setup (HaddockTarget, TestShowDetails) -import Distribution.System +import Distribution.System (OS, Arch) import Distribution.Types.AbiHash (AbiHash) import Distribution.Types.ComponentId (ComponentId) import Distribution.Types.DumpBuildInfo (DumpBuildInfo) -import Distribution.Types.PackageVersionConstraint +import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint) import Distribution.Types.UnitId (DefUnitId, UnitId) import Distribution.Utils.NubList (NubList) import Distribution.Utils.Path (SymbolicPathX) -import Distribution.Verbosity -import Distribution.Verbosity.Internal +import Distribution.Verbosity (VerbosityLevel, VerbosityFlags) +import Distribution.Verbosity.Internal (VerbosityFlag) +import Distribution.Types.DebugInfoLevel (DebugInfoLevel) +import Distribution.Types.OptimisationLevel (OptimisationLevel) import qualified Distribution.Compat.NonEmptySet as NES diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 1faa5302923..a4a0f9f95d2 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -176,11 +176,13 @@ library Distribution.TestSuite Distribution.Types.AnnotatedId Distribution.Types.ComponentInclude + Distribution.Types.DebugInfoLevel Distribution.Types.DumpBuildInfo Distribution.Types.PackageName.Magic Distribution.Types.ComponentLocalBuildInfo Distribution.Types.LocalBuildConfig Distribution.Types.LocalBuildInfo + Distribution.Types.OptimisationLevel Distribution.Types.TargetInfo Distribution.Types.GivenComponent Distribution.Types.ParStrat diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index 1ceb75a4a54..10cc75f151e 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -304,7 +304,7 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do removeFileForcibly buildInfoFile where buildInfoFile = interpretSymbolicPathLBI lbi $ buildInfoPref distPref - shouldDumpBuildInfo = fromFlagOrDefault NoDumpBuildInfo dumpBuildInfoFlag == DumpBuildInfo + shouldDumpBuildInfo = fromNoFlag dumpBuildInfoFlag == DumpBuildInfo -- \| Given the flavor of the compiler, try to find out -- which program we need. diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index 937662b1d33..11bfc6d6947 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -73,7 +73,6 @@ module Distribution.Simple.Command , reqArg' , optArg , optArg' - , optArgDef' , noArg , boolOpt , boolOpt' @@ -274,15 +273,6 @@ optArg' optArg' ad mkflag showflag = optArg ad (succeedReadE (mkflag . Just)) ("", mkflag Nothing) showflag -optArgDef' - :: Monoid b - => ArgPlaceHolder - -> (String, Maybe String -> b) - -> (b -> [Maybe String]) - -> MkOptDescr (a -> b) (b -> a -> a) a -optArgDef' ad (dv, mkflag) showflag = - optArg ad (succeedReadE (mkflag . Just)) (dv, mkflag Nothing) showflag - noArg :: Eq b => b -> MkOptDescr (a -> b) (b -> a -> a) a noArg flag sf lf d = choiceOpt [(flag, (sf, lf), d)] sf lf d diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index fbf159f11a6..076e52eb9b5 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -48,14 +48,6 @@ module Distribution.Simple.Compiler , coercePackageDBStack , readPackageDb - -- * Support for optimisation levels - , OptimisationLevel (..) - , flagToOptimisationLevel - - -- * Support for debug info levels - , DebugInfoLevel (..) - , flagToDebugInfoLevel - -- * Support for language extensions , CompilerFlag , languageToFlags @@ -92,22 +84,30 @@ module Distribution.Simple.Compiler , showProfDetailLevel ) where -import Distribution.Compat.CharParsing import Distribution.Compat.Prelude -import Distribution.Parsec -import Distribution.Pretty +import Distribution.Parsec (CabalParsing, Parsec (..), parsecToken) +import Distribution.Pretty (prettyShow) import Prelude () import Distribution.Compiler import Distribution.Package (PackageName) -import Distribution.Simple.Utils +import Distribution.Simple.Utils (lowercase, safeLast) import Distribution.Types.UnitId (UnitId) import Distribution.Utils.Path -import Distribution.Version - -import Language.Haskell.Extension + ( CWD + , FileOrDir (..) + , Pkg + , PkgDB + , SymbolicPath + , getSymbolicPath + , interpretSymbolicPath + , makeSymbolicPath + , symbolicPathRelative_maybe + ) +import Distribution.Version (Version, mkVersion) + +import Language.Haskell.Extension (Extension, Language (..)) -import Data.Bool (bool) import qualified Data.Map as Map (lookup) import System.Directory (canonicalizePath) @@ -300,95 +300,6 @@ coercePackageDBStack = map coercePackageDB -- ------------------------------------------------------------ --- * Optimisation levels - --- ------------------------------------------------------------ - --- | Some compilers support optimising. Some have different levels. --- For compilers that do not the level is just capped to the level --- they do support. -data OptimisationLevel - = NoOptimisation - | NormalOptimisation - | MaximumOptimisation - deriving (Bounded, Enum, Eq, Generic, Read, Show) - -instance Binary OptimisationLevel -instance NFData OptimisationLevel -instance Structured OptimisationLevel - -instance Parsec OptimisationLevel where - parsec = parsecOptimisationLevel - -parsecOptimisationLevel :: CabalParsing m => m OptimisationLevel -parsecOptimisationLevel = boolParser <|> intParser - where - boolParser = bool NoOptimisation NormalOptimisation <$> parsec - intParser = intToOptimisationLevel <$> 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) - --- ------------------------------------------------------------ - --- * Debug info levels - --- ------------------------------------------------------------ - --- | Some compilers support emitting debug info. Some have different --- levels. For compilers that do not the level is just capped to the --- level they do support. -data DebugInfoLevel - = NoDebugInfo - | MinimalDebugInfo - | NormalDebugInfo - | MaximalDebugInfo - deriving (Bounded, Enum, Eq, Generic, Read, Show) - -instance Binary DebugInfoLevel -instance NFData DebugInfoLevel -instance Structured DebugInfoLevel - -instance Parsec DebugInfoLevel where - parsec = parsecDebugInfoLevel - -parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel -parsecDebugInfoLevel = flagToDebugInfoLevel . pure <$> parsecToken - -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 - --- ------------------------------------------------------------ - -- * Languages and Extensions -- ------------------------------------------------------------ diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 53c3b35caa0..a5adee3e755 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -157,6 +157,7 @@ import Distribution.Pretty ) import Distribution.Simple.Errors import Distribution.Types.AnnotatedId +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) import Distribution.Utils.Path import Distribution.Utils.Structured (structuredDecodeOrFailIO, structuredEncode) import System.Directory diff --git a/Cabal/src/Distribution/Simple/Flag.hs b/Cabal/src/Distribution/Simple/Flag.hs index fffe7646a7d..08a1ac49963 100644 --- a/Cabal/src/Distribution/Simple/Flag.hs +++ b/Cabal/src/Distribution/Simple/Flag.hs @@ -28,6 +28,8 @@ module Distribution.Simple.Flag , maybeToFlag , mergeListFlag , BooleanFlag (..) + , NoFlagValue (..) + , fromNoFlag ) where import Data.Monoid (Last (..)) @@ -120,3 +122,15 @@ class BooleanFlag a where instance BooleanFlag Bool where asBool = id + +-- | Flag is a Monoid, with 'NoFlag' as the identity element, and 'Flag' as the binary operation. +-- +-- @since 3.18.0.0 +class NoFlagValue a where + noFlagValue :: a + +-- | Extracts a value from a 'Flag', and returns the 'noFlagValue' on 'NoFlag'. +-- +-- @since 3.18.0.0 +fromNoFlag :: NoFlagValue a => Flag a -> a +fromNoFlag = fromFlagOrDefault noFlagValue diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 6959b8f48b6..5ad852fe742 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -72,11 +72,13 @@ import Distribution.Simple.Utils import Distribution.System import Distribution.Types.BuildInfo import Distribution.Types.ComponentLocalBuildInfo +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) import Distribution.Types.GivenComponent import qualified Distribution.Types.InstalledPackageInfo as IPI import Distribution.Types.Library import Distribution.Types.LocalBuildInfo import Distribution.Types.ModuleRenaming +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import Distribution.Types.PackageName import Distribution.Types.TargetInfo import Distribution.Types.UnitId diff --git a/Cabal/src/Distribution/Simple/Program/GHC.hs b/Cabal/src/Distribution/Simple/Program/GHC.hs index 1b6a1857d11..caf8fe89886 100644 --- a/Cabal/src/Distribution/Simple/Program/GHC.hs +++ b/Cabal/src/Distribution/Simple/Program/GHC.hs @@ -45,12 +45,13 @@ import Distribution.Verbosity import Distribution.Version import GHC.IO.Encoding (TextEncoding) -import Language.Haskell.Extension +import Language.Haskell.Extension (Extension, Language) import Data.List (stripPrefix) import qualified Data.Map as Map import Data.Monoid (All (..), Any (..), Endo (..)) import qualified Data.Set as Set +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) import qualified System.Process as Process normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String] diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 839241eed0f..57dd83d65f5 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -59,14 +59,19 @@ import Distribution.Simple.Program import Distribution.Simple.Setup.Common import Distribution.Simple.Utils import Distribution.Types.ComponentId -import Distribution.Types.DumpBuildInfo +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) +import qualified Distribution.Types.DebugInfoLevel as D +import Distribution.Types.DumpBuildInfo (DumpBuildInfo (..)) import Distribution.Types.GivenComponent import Distribution.Types.Module +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) +import qualified Distribution.Types.OptimisationLevel as O import Distribution.Types.PackageVersionConstraint import Distribution.Types.UnitId import Distribution.Utils.NubList import Distribution.Utils.Path import Distribution.Verbosity +import Text.Printf (printf) import qualified Text.PrettyPrint as Disp @@ -567,18 +572,16 @@ configureOptions showOrParseArgs = "optimization" configOptimization (\v flags -> flags{configOptimization = v}) - [ optArgDef' + [ reqArg' "n" - (show NoOptimisation, Flag . flagToOptimisationLevel) + (Flag . fromString) ( \case - Flag NoOptimisation -> [] - Flag NormalOptimisation -> [Nothing] - Flag MaximumOptimisation -> [Just "2"] - _ -> [] + NoFlag -> [] + Flag flag -> [O.toString flag] ) "O" ["enable-optimization", "enable-optimisation"] - "Build with optimization (n is 0--2, default is 1)" + (printf "Build with optimization (n is %s--%s, default is %s)" (O.toString minBound) (O.toString maxBound) (O.toString noFlagValue)) , noArg (Flag NoOptimisation) [] @@ -589,19 +592,16 @@ configureOptions showOrParseArgs = "debug-info" configDebugInfo (\v flags -> flags{configDebugInfo = v}) - [ optArg' + [ reqArg' "n" - (Flag . flagToDebugInfoLevel) + (Flag . fromString) ( \case - Flag NoDebugInfo -> [] - Flag MinimalDebugInfo -> [Just "1"] - Flag NormalDebugInfo -> [Nothing] - Flag MaximalDebugInfo -> [Just "3"] - _ -> [] + NoFlag -> [] + Flag flag -> [D.toString flag] ) - "" + "g" ["enable-debug-info"] - "Emit debug info (n is 0--3, default is 0)" + (printf "Emit debug info (n is %s--%s, default is %s)" (D.toString minBound) (D.toString maxBound) (D.toString noFlagValue)) , noArg (Flag NoDebugInfo) [] diff --git a/Cabal/src/Distribution/Simple/UHC.hs b/Cabal/src/Distribution/Simple/UHC.hs index bdea3d94fa1..e431e4c5f5a 100644 --- a/Cabal/src/Distribution/Simple/UHC.hs +++ b/Cabal/src/Distribution/Simple/UHC.hs @@ -41,6 +41,7 @@ import Distribution.Simple.Program import Distribution.Simple.Utils import Distribution.System import Distribution.Types.MungedPackageId +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version diff --git a/Cabal/src/Distribution/Types/DebugInfoLevel.hs b/Cabal/src/Distribution/Types/DebugInfoLevel.hs new file mode 100644 index 00000000000..4087a781e62 --- /dev/null +++ b/Cabal/src/Distribution/Types/DebugInfoLevel.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE InstanceSigs #-} + +module Distribution.Types.DebugInfoLevel + ( DebugInfoLevel (..) + , toString + ) +where + +import Distribution.Compat.CharParsing (integral) +import Distribution.Compat.Prelude +import Distribution.Parsec (CabalParsing, Parsec (..)) +import Prelude () + +import Data.Bool (bool) +import Distribution.Simple.Flag (NoFlagValue (..)) + +-- ------------------------------------------------------------ + +-- * Debug info levels + +-- ------------------------------------------------------------ + +-- | Some compilers support emitting debug info. Some have different +-- levels. For compilers that do not the level is just capped to the +-- level they do support. +data DebugInfoLevel + = NoDebugInfo + | MinimalDebugInfo + | NormalDebugInfo + | MaximalDebugInfo + deriving stock (Bounded, Enum, Eq, Generic, Read, Show) + +instance Binary DebugInfoLevel +instance NFData DebugInfoLevel +instance Structured DebugInfoLevel + +instance NoFlagValue DebugInfoLevel where + noFlagValue :: DebugInfoLevel + noFlagValue = NoDebugInfo + +instance Parsec DebugInfoLevel where + parsec :: CabalParsing m => m DebugInfoLevel + parsec = boolParser <|> intParser + where + boolParser = bool NoDebugInfo NormalDebugInfo <$> parsec + intParser = intToDebugInfoLevel <$> integral + +instance IsString DebugInfoLevel where + fromString :: String -> DebugInfoLevel + fromString s = case reads s of + [(i, "")] -> intToDebugInfoLevel i + _ -> error $ "Can't parse debug info level " ++ s + +toString :: DebugInfoLevel -> String +toString = show . fromEnum + +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) diff --git a/Cabal/src/Distribution/Types/DumpBuildInfo.hs b/Cabal/src/Distribution/Types/DumpBuildInfo.hs index 6b3bcb06488..5442935413c 100644 --- a/Cabal/src/Distribution/Types/DumpBuildInfo.hs +++ b/Cabal/src/Distribution/Types/DumpBuildInfo.hs @@ -1,24 +1,36 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} + module Distribution.Types.DumpBuildInfo ( DumpBuildInfo (..) + , toString ) where -import Distribution.Compat.Prelude -import Distribution.Parsec +import Distribution.Compat.Prelude (Binary, Generic, NFData, Structured) +import Distribution.Parsec (CabalParsing, Parsec (..)) +import Distribution.Simple.Flag (NoFlagValue (..)) data DumpBuildInfo = NoDumpBuildInfo | DumpBuildInfo - deriving (Read, Show, Eq, Ord, Enum, Bounded, Generic) + deriving stock (Read, Show, Eq, Ord, Enum, Bounded, Generic) instance Binary DumpBuildInfo instance NFData DumpBuildInfo instance Structured DumpBuildInfo -instance Parsec DumpBuildInfo where - parsec = parsecDumpBuildInfo +instance NoFlagValue DumpBuildInfo where + noFlagValue :: DumpBuildInfo + noFlagValue = NoDumpBuildInfo -parsecDumpBuildInfo :: CabalParsing m => m DumpBuildInfo -parsecDumpBuildInfo = boolToDumpBuildInfo <$> parsec +instance Parsec DumpBuildInfo where + parsec :: CabalParsing m => m DumpBuildInfo + parsec = boolToDumpBuildInfo <$> parsec boolToDumpBuildInfo :: Bool -> DumpBuildInfo boolToDumpBuildInfo bool = if bool then DumpBuildInfo else NoDumpBuildInfo + +toString :: DumpBuildInfo -> String +toString = \case + NoDumpBuildInfo -> "False" + DumpBuildInfo -> "True" diff --git a/Cabal/src/Distribution/Types/LocalBuildConfig.hs b/Cabal/src/Distribution/Types/LocalBuildConfig.hs index 984cbc18161..37ba5c701a8 100644 --- a/Cabal/src/Distribution/Types/LocalBuildConfig.hs +++ b/Cabal/src/Distribution/Types/LocalBuildConfig.hs @@ -17,25 +17,23 @@ module Distribution.Types.LocalBuildConfig import Distribution.Compat.Prelude import Prelude () -import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Types.ComponentRequestedSpec -import Distribution.Types.GivenComponent -import Distribution.Types.PackageDescription -import Distribution.Types.UnitId +import Distribution.Types.ComponentLocalBuildInfo (ComponentLocalBuildInfo) +import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec) +import Distribution.Types.GivenComponent (PromisedComponent) +import Distribution.Types.PackageDescription (PackageDescription) +import Distribution.Types.UnitId (UnitId) -import Distribution.PackageDescription -import Distribution.Simple.Compiler -import Distribution.Simple.Flag -import Distribution.Simple.InstallDirs hiding - ( absoluteInstallDirs - , prefixRelativeInstallDirs - , substPathTemplate - ) -import Distribution.Simple.PackageIndex +import Distribution.PackageDescription (ComponentName, FlagAssignment, PackageName) +import Distribution.Simple.Compiler (Compiler, PackageDBStack, ProfDetailLevel) +import Distribution.Simple.Flag (maybeToFlag, toFlag) +import Distribution.Simple.InstallDirs (InstallDirTemplates, PathTemplate) +import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Program.Db (ProgramDb) -import Distribution.Simple.Setup.Config -import Distribution.System -import Distribution.Utils.Path +import Distribution.Simple.Setup.Config (ConfigFlags (..)) +import Distribution.System (Platform) +import Distribution.Types.DebugInfoLevel (DebugInfoLevel) +import Distribution.Types.OptimisationLevel (OptimisationLevel) +import Distribution.Utils.Path (FileOrDir (..), Pkg, SymbolicPath) import Distribution.Compat.Graph (Graph) diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index 7e91a5ebeb2..14da1656c82 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -129,6 +129,8 @@ import Distribution.System import qualified Data.Map as Map import Distribution.Compat.Graph (Graph) import qualified Distribution.Compat.Graph as Graph +import Distribution.Types.DebugInfoLevel (DebugInfoLevel) +import Distribution.Types.OptimisationLevel (OptimisationLevel) import qualified System.FilePath as FilePath (takeDirectory) diff --git a/Cabal/src/Distribution/Types/OptimisationLevel.hs b/Cabal/src/Distribution/Types/OptimisationLevel.hs new file mode 100644 index 00000000000..cca447a7bb9 --- /dev/null +++ b/Cabal/src/Distribution/Types/OptimisationLevel.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE InstanceSigs #-} + +module Distribution.Types.OptimisationLevel + ( OptimisationLevel (..) + , toString + ) +where + +import Distribution.Compat.CharParsing (integral) +import Distribution.Compat.Prelude +import Distribution.Parsec (CabalParsing, Parsec (..)) +import Prelude () + +import Data.Bool (bool) +import Distribution.Simple.Flag (NoFlagValue (..)) + +-- ------------------------------------------------------------ + +-- * Optimisation levels + +-- ------------------------------------------------------------ + +-- | Some compilers support optimising. Some have different levels. +-- For compilers that do not the level is just capped to the level +-- they do support. +data OptimisationLevel + = NoOptimisation + | NormalOptimisation + | MaximumOptimisation + deriving stock (Bounded, Enum, Eq, Generic, Read, Show) + +instance Binary OptimisationLevel +instance NFData OptimisationLevel +instance Structured OptimisationLevel + +instance NoFlagValue OptimisationLevel where + noFlagValue :: OptimisationLevel + noFlagValue = NormalOptimisation + +instance Parsec OptimisationLevel where + parsec :: CabalParsing m => m OptimisationLevel + parsec = boolParser <|> intParser + where + boolParser = bool NoOptimisation NormalOptimisation <$> parsec + intParser = intToOptimisationLevel <$> integral + +instance IsString OptimisationLevel where + fromString :: String -> OptimisationLevel + fromString s = case reads s of + [(i, "")] -> intToOptimisationLevel i + _ -> error $ "Can't parse optimisation level " ++ s + +toString :: OptimisationLevel -> String +toString = show . fromEnum + +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) diff --git a/cabal-install/parser-tests/Tests/ParserTests.hs b/cabal-install/parser-tests/Tests/ParserTests.hs index 25ada09ce64..5ea07821c23 100644 --- a/cabal-install/parser-tests/Tests/ParserTests.hs +++ b/cabal-install/parser-tests/Tests/ParserTests.hs @@ -31,7 +31,7 @@ import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnviron import Distribution.Compat.Prelude import Distribution.Compiler (CompilerFlavor (..)) import Distribution.Parsec (simpleParsec) -import Distribution.Simple.Compiler (DebugInfoLevel (..), OptimisationLevel (..), PackageDBX (..), ProfDetailLevel (..)) +import Distribution.Simple.Compiler (PackageDBX (..), ProfDetailLevel (..)) import Distribution.Simple.Flag import Distribution.Simple.InstallDirs (InstallDirs (..), toPathTemplate) import Distribution.Simple.Setup (DumpBuildInfo (..), HaddockTarget (..), TestShowDetails (..)) @@ -50,7 +50,9 @@ import Distribution.Solver.Types.Settings ) import Distribution.System (OS (..), buildOS) import Distribution.Types.CondTree (CondTree (..)) +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) import Distribution.Types.Flag (mkFlagAssignment) +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import Distribution.Types.PackageId (PackageIdentifier (..)) import Distribution.Types.PackageName import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..)) diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 03c6fd87652..5ec73f8b4ec 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DerivingVia #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} -- | @@ -161,10 +160,7 @@ import Distribution.Simple.Command , ShowOrParseArgs (..) , commandDefaultFlags ) -import Distribution.Simple.Compiler - ( DebugInfoLevel (..) - , OptimisationLevel (..) - ) +import Distribution.Simple.Flag (Flag, flagElim, flagToMaybe, fromFlagOrDefault, toFlag, pattern Flag, pattern NoFlag) import Distribution.Simple.InstallDirs ( InstallDirs (..) , PathTemplate @@ -178,7 +174,6 @@ import Distribution.Simple.Setup ( BenchmarkFlags (..) , CommonSetupFlags (..) , ConfigFlags (..) - , Flag , HaddockFlags (..) , TestFlags (..) , configureOptions @@ -186,16 +181,11 @@ import Distribution.Simple.Setup , defaultConfigFlags , defaultHaddockFlags , defaultTestFlags - , flagToMaybe - , fromFlagOrDefault , haddockOptions , installDirsOptions , optionDistPref , programDbOptions , programDbPaths' - , toFlag - , pattern Flag - , pattern NoFlag ) import Distribution.Simple.Utils ( cabalVersion @@ -207,6 +197,8 @@ import Distribution.Simple.Utils , writeFileAtomic ) import Distribution.Solver.Types.ConstraintSource +import qualified Distribution.Types.DebugInfoLevel as DebugInfoLevel +import qualified Distribution.Types.OptimisationLevel as OptimisationLevel import Distribution.Utils.Path (getSymbolicPath, unsafeMakeSymbolicPath) import Distribution.Verbosity ( normal @@ -1180,58 +1172,23 @@ configFieldDescriptions src = (Flag <$> parsec <|> pure NoFlag) configHcFlavor (\v flags -> flags{configHcFlavor = v}) - , -- TODO: The following is a temporary fix. The "optimization" - -- and "debug-info" fields are OptArg, and viewAsFieldDescr - -- fails on that. Instead of a hand-written hackaged parser - -- and printer, we should handle this case properly in the - -- library. - liftField - configOptimization - ( \v flags -> - flags{configOptimization = v} - ) - $ let name = "optimization" - in FieldDescr - name - ( \case - Flag NoOptimisation -> Disp.text "False" - Flag NormalOptimisation -> Disp.text "True" - Flag MaximumOptimisation -> Disp.text "2" - _ -> Disp.empty - ) - ( \line str _ -> case () of - _ - | str == "0" -> ParseOk [] (Flag NoOptimisation) - | str == "1" -> ParseOk [] (Flag NormalOptimisation) - | str == "2" -> ParseOk [] (Flag MaximumOptimisation) - | lstr == "false" -> ParseOk [] (Flag NoOptimisation) - | lstr == "true" -> ParseOk [] (Flag NormalOptimisation) - | otherwise -> ParseFailed (NoParse name line) - where - lstr = lowercase str - ) + , liftField configOptimization (\v flags -> flags{configOptimization = v}) $ + let name = "optimization" + in FieldDescr + name + (flagElim Disp.empty (Disp.text . OptimisationLevel.toString)) + ( \line str _ -> case maybe NoFlag Flag (simpleParsec str) of + NoFlag -> ParseFailed (NoParse name line) + flag -> ParseOk [] flag + ) , liftField configDebugInfo (\v flags -> flags{configDebugInfo = v}) $ let name = "debug-info" in FieldDescr name - ( \case - Flag NoDebugInfo -> Disp.text "False" - Flag MinimalDebugInfo -> Disp.text "1" - Flag NormalDebugInfo -> Disp.text "True" - Flag MaximalDebugInfo -> Disp.text "3" - _ -> Disp.empty - ) - ( \line str _ -> case () of - _ - | str == "0" -> ParseOk [] (Flag NoDebugInfo) - | str == "1" -> ParseOk [] (Flag MinimalDebugInfo) - | str == "2" -> ParseOk [] (Flag NormalDebugInfo) - | str == "3" -> ParseOk [] (Flag MaximalDebugInfo) - | lstr == "false" -> ParseOk [] (Flag NoDebugInfo) - | lstr == "true" -> ParseOk [] (Flag NormalDebugInfo) - | otherwise -> ParseFailed (NoParse name line) - where - lstr = lowercase str + (flagElim Disp.empty (Disp.text . DebugInfoLevel.toString)) + ( \line str _ -> case maybe NoFlag Flag (simpleParsec str) of + NoFlag -> ParseFailed (NoParse name line) + flag -> ParseOk [] flag ) ] ++ toSavedConfig diff --git a/cabal-install/src/Distribution/Client/DistDirLayout.hs b/cabal-install/src/Distribution/Client/DistDirLayout.hs index ca32684dd98..a182f01a091 100644 --- a/cabal-install/src/Distribution/Client/DistDirLayout.hs +++ b/cabal-install/src/Distribution/Client/DistDirLayout.hs @@ -44,7 +44,6 @@ import Distribution.Package ) import Distribution.Simple.Compiler ( Compiler (..) - , OptimisationLevel (..) , PackageDBCWD , PackageDBStackCWD , PackageDBX (..) @@ -53,6 +52,7 @@ import Distribution.Simple.Configure (interpretPackageDbFlags) import Distribution.System import Distribution.Types.ComponentName import Distribution.Types.LibraryName +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) -- | Information which can be used to construct the path to -- the build directory of a build. This is LESS fine-grained diff --git a/cabal-install/src/Distribution/Client/PackageHash.hs b/cabal-install/src/Distribution/Client/PackageHash.hs index 7fdb3a571e3..dd59e9af47c 100644 --- a/cabal-install/src/Distribution/Client/PackageHash.hs +++ b/cabal-install/src/Distribution/Client/PackageHash.hs @@ -39,8 +39,6 @@ import Distribution.Package import Distribution.Simple.Compiler ( AbiTag (..) , CompilerId - , DebugInfoLevel (..) - , OptimisationLevel (..) , PackageDBCWD , ProfDetailLevel (..) , showProfDetailLevel @@ -55,10 +53,12 @@ import Distribution.System , Platform , buildOS ) +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) import Distribution.Types.Flag ( FlagAssignment , showFlagAssignment ) +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import Distribution.Types.PkgconfigVersion (PkgconfigVersion) import qualified Data.ByteString.Lazy.Char8 as LBS @@ -324,7 +324,7 @@ renderPackageHashInputs , opt "split-sections" False prettyShow pkgHashSplitSections , opt "stripped-lib" False prettyShow pkgHashStripLibs , opt "stripped-exe" True prettyShow pkgHashStripExes - , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "debug-info" NoDebugInfo (show . fromEnum) pkgHashDebugInfo , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index fe39c8a23e0..1ad94dd7b03 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -85,8 +85,6 @@ import Distribution.PackageDescription.Configuration (simplifyWithSysParams) import Distribution.Simple.Compiler ( Compiler (..) , CompilerInfo (..) - , DebugInfoLevel (..) - , OptimisationLevel (..) , compilerInfo , interpretPackageDB ) @@ -107,8 +105,6 @@ import Distribution.Simple.Setup ( BenchmarkFlags (..) , CommonSetupFlags (..) , ConfigFlags (..) - , DumpBuildInfo (DumpBuildInfo, NoDumpBuildInfo) - , Flag , HaddockFlags (..) , TestFlags (..) , benchmarkOptions' @@ -124,13 +120,9 @@ import Distribution.Simple.Setup , showPackageDb , splitArgs , testOptions' - , toFlag - , pattern Flag - , pattern NoFlag ) import Distribution.Simple.Utils ( debug - , lowercase , noticeDoc ) import Distribution.Types.CondTree @@ -141,6 +133,7 @@ import Distribution.Types.CondTree , mapTreeData , traverseCondTreeV ) +import qualified Distribution.Types.DumpBuildInfo as DumpBuildInfo import Distribution.Types.SourceRepo (RepoType) import Distribution.Utils.NubList ( fromNubList @@ -196,6 +189,9 @@ import qualified Data.ByteString.Char8 as BS import Data.Functor ((<&>)) import qualified Data.Map as Map import qualified Data.Set as Set +import Distribution.Simple.Flag (Flag, flagElim, toFlag, pattern Flag, pattern NoFlag) +import qualified Distribution.Types.DebugInfoLevel as DebugInfoLevel +import qualified Distribution.Types.OptimisationLevel as OptimisationLevel import Network.URI (URI (..), nullURIAuth) import System.Directory (makeAbsolute) import System.FilePath (splitFileName) @@ -1674,79 +1670,36 @@ legacyPackageConfigFieldDescrs = (\v flags -> flags{configHcFlavor = v}) overrideDumpBuildInfo = - liftField - configDumpBuildInfo - (\v flags -> flags{configDumpBuildInfo = v}) - $ let name = "build-info" - in FieldDescr - name - ( \case - Flag NoDumpBuildInfo -> Disp.text "False" - Flag DumpBuildInfo -> Disp.text "True" - _ -> Disp.empty - ) - ( \line str _ -> case () of - _ - | lstr == "false" -> ParseOk [] (Flag NoDumpBuildInfo) - | lstr == "true" -> ParseOk [] (Flag DumpBuildInfo) - | otherwise -> ParseFailed (NoParse name line) - where - lstr = lowercase str - ) - - -- TODO: [code cleanup] The following is a hack. The "optimization" and - -- "debug-info" fields are OptArg, and viewAsFieldDescr fails on that. - -- Instead of a hand-written parser and printer, we should handle this case - -- properly in the library. + liftField configDumpBuildInfo (\v flags -> flags{configDumpBuildInfo = v}) $ + let name = "build-info" + in FieldDescr + name + (flagElim Disp.empty (Disp.text . DumpBuildInfo.toString)) + ( \line str _ -> case maybe NoFlag Flag (simpleParsec str) of + NoFlag -> ParseFailed (NoParse name line) + flag -> ParseOk [] flag + ) overrideFieldOptimization = - liftField - configOptimization - (\v flags -> flags{configOptimization = v}) - $ let name = "optimization" - in FieldDescr - name - ( \case - Flag NoOptimisation -> Disp.text "False" - Flag NormalOptimisation -> Disp.text "True" - Flag MaximumOptimisation -> Disp.text "2" - _ -> Disp.empty - ) - ( \line str _ -> case () of - _ - | str == "0" -> ParseOk [] (Flag NoOptimisation) - | str == "1" -> ParseOk [] (Flag NormalOptimisation) - | str == "2" -> ParseOk [] (Flag MaximumOptimisation) - | lstr == "false" -> ParseOk [] (Flag NoOptimisation) - | lstr == "true" -> ParseOk [] (Flag NormalOptimisation) - | otherwise -> ParseFailed (NoParse name line) - where - lstr = lowercase str - ) + liftField configOptimization (\v flags -> flags{configOptimization = v}) $ + let name = "optimization" + in FieldDescr + name + (flagElim Disp.empty (Disp.text . OptimisationLevel.toString)) + ( \line str _ -> case maybe NoFlag Flag (simpleParsec str) of + NoFlag -> ParseFailed (NoParse name line) + flag -> ParseOk [] flag + ) overrideFieldDebugInfo = liftField configDebugInfo (\v flags -> flags{configDebugInfo = v}) $ let name = "debug-info" in FieldDescr name - ( \case - Flag NoDebugInfo -> Disp.text "False" - Flag MinimalDebugInfo -> Disp.text "1" - Flag NormalDebugInfo -> Disp.text "True" - Flag MaximalDebugInfo -> Disp.text "3" - _ -> Disp.empty - ) - ( \line str _ -> case () of - _ - | str == "0" -> ParseOk [] (Flag NoDebugInfo) - | str == "1" -> ParseOk [] (Flag MinimalDebugInfo) - | str == "2" -> ParseOk [] (Flag NormalDebugInfo) - | str == "3" -> ParseOk [] (Flag MaximalDebugInfo) - | lstr == "false" -> ParseOk [] (Flag NoDebugInfo) - | lstr == "true" -> ParseOk [] (Flag NormalDebugInfo) - | otherwise -> ParseFailed (NoParse name line) - where - lstr = lowercase str + (flagElim Disp.empty (Disp.text . DebugInfoLevel.toString)) + ( \line str _ -> case maybe NoFlag Flag (simpleParsec str) of + NoFlag -> ParseFailed (NoParse name line) + flag -> ParseOk [] flag ) prefixTest name diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs index 69d4e5e3aed..70f37ea38d2 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs @@ -24,9 +24,7 @@ import Distribution.PackageDescription ( FlagAssignment ) import Distribution.Simple.Compiler - ( DebugInfoLevel (..) - , OptimisationLevel (..) - , PackageDBCWD + ( PackageDBCWD , ProfDetailLevel ) import Distribution.Simple.InstallDirs @@ -51,6 +49,8 @@ import Distribution.Solver.Types.Settings , ReorderGoals (..) , StrongFlags (..) ) +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint ) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index 09d67a319e2..4c420ea7752 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -68,8 +68,6 @@ import Distribution.PackageDescription import Distribution.Simple.Compiler ( Compiler , CompilerFlavor - , DebugInfoLevel (..) - , OptimisationLevel (..) , PackageDBCWD , ProfDetailLevel ) @@ -98,6 +96,8 @@ import Distribution.Version import qualified Data.Map as Map import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath) +import Distribution.Types.DebugInfoLevel (DebugInfoLevel) +import Distribution.Types.OptimisationLevel (OptimisationLevel) import Distribution.Types.ParStrat import Distribution.Verbosity (VerbosityFlags) diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index cecea153f39..917b0e7e10e 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -181,17 +181,13 @@ import Distribution.Client.Errors import Distribution.Package import Distribution.Simple.Command (commandShowOptions) import Distribution.Simple.Compiler - ( OptimisationLevel (..) - , compilerCompatVersion + ( compilerCompatVersion , compilerId , compilerInfo , showCompilerId ) import Distribution.Simple.Configure (computeEffectiveProfiling) -import Distribution.Simple.Flag - ( flagToMaybe - , fromFlagOrDefault - ) +import Distribution.Simple.Flag (flagToMaybe, fromFlagOrDefault, fromNoFlag) import Distribution.Simple.LocalBuildInfo ( ComponentName (..) , pkgComponents @@ -215,6 +211,7 @@ import Distribution.Types.Flag , diffFlagAssignment , showFlagAssignment ) +import qualified Distribution.Types.OptimisationLevel as OptimisationLevel import Distribution.Utils.NubList ( fromNubList ) @@ -1255,13 +1252,7 @@ printPlan "Build profile: " ++ unwords [ "-w " ++ (showCompilerId . pkgConfigCompiler) elaboratedShared - , "-O" - ++ ( case globalOptimization <> localOptimization of -- if local is not set, read global - Setup.Flag NoOptimisation -> "0" - Setup.Flag NormalOptimisation -> "1" - Setup.Flag MaximumOptimisation -> "2" - Setup.NoFlag -> "1" - ) + , "-O" ++ (OptimisationLevel.toString . fromNoFlag) (globalOptimization <> localOptimization) ] ++ "\n" diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 6e2ef652cd8..ea597d40193 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -234,6 +234,8 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Distribution.Client.Errors import Distribution.Solver.Types.ProjectConfigPath +import Distribution.Types.DebugInfoLevel (DebugInfoLevel (..)) +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import GHC.Stack (HasCallStack) import System.Directory (getCurrentDirectory) import System.FilePath @@ -1248,7 +1250,8 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do -- the hashes for the packages -- hashesFromRepoMetadata <- - Sec.uncheckClientErrors $ -- TODO: [code cleanup] wrap in our own exceptions + Sec.uncheckClientErrors $ -- TODO: [code cleanup] wrap in our own exceptions -- TODO: [code cleanup] wrap in our own exceptions + -- TODO: [code cleanup] wrap in our own exceptions fmap (Map.fromList . concat) $ sequence -- Reading the repo index is expensive so we group the packages by repo diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 656a515a26c..4fb8d55ecab 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -125,11 +125,10 @@ import Distribution.Parsec import qualified Distribution.SPDX.License as SPDX import Distribution.Simple.Compiler ( Compiler (..) - , OptimisationLevel (..) ) import Distribution.Simple.Flag ( flagToMaybe - , fromFlagOrDefault + , fromNoFlag ) import Distribution.Simple.PackageDescription ( parseString @@ -440,7 +439,7 @@ scriptDistDirParams scriptPath ctx compiler platform = , distParamComponentName = Just $ CExeName cn , distParamCompilerId = compilerId compiler , distParamPlatform = platform - , distParamOptimization = fromFlagOrDefault NormalOptimisation optimization + , distParamOptimization = fromNoFlag optimization } where cn = scriptComponentName scriptPath diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs b/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs index 21a6bcabb46..07694e82214 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Configure.hs @@ -9,9 +9,9 @@ import Distribution.Client.NixStyleOptions import Distribution.Client.ProjectConfig.Types import Distribution.Client.ProjectFlags import Distribution.Client.Setup -import Distribution.Simple import Distribution.Simple.Flag import Distribution.Simple.Utils (removeFileForcibly) +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import Distribution.Verbosity import System.Directory import System.FilePath diff --git a/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs b/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs index 5ff680a62ba..3944c7aa30d 100644 --- a/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ConfigFile/InitSectionFieldsBools/cabal.test.hs @@ -14,5 +14,5 @@ main = cabalTest $ do [initLs] = filter ((== "-- full-version: False") . head) sections init = unlines initLs - assertBool "init section of config should contain debug-info: False" ("debug-info: False" `isInfixOf` init) - assertBool "init section of config should contain optimization: True" ("optimization: True" `isInfixOf` init) + assertBool "init section of config should contain debug-info: 0" ("debug-info: 0" `isInfixOf` init) + assertBool "init section of config should contain optimization: 1" ("optimization: 1" `isInfixOf` init) diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FlagsBools/cabal.project b/cabal-testsuite/PackageTests/ProjectConfig/FlagsBools/cabal.project index 84e7456eccf..f405ea33f39 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/FlagsBools/cabal.project +++ b/cabal-testsuite/PackageTests/ProjectConfig/FlagsBools/cabal.project @@ -2,6 +2,7 @@ packages: . build-info: true optimization: tRuE +debug-info: fALSe package test flags: -bar diff --git a/changelog.d/11937.md b/changelog.d/11937.md new file mode 100644 index 00000000000..c06bc953cbc --- /dev/null +++ b/changelog.d/11937.md @@ -0,0 +1,10 @@ +--- +synopsis: "Display -O and -g as numeric levels instead of booleans" +packages: [Cabal, cabal-install] +prs: 11937 +--- + +The rendering of certain boolean‑like flags has been changed to use numeric levels: +- For the `-O` (optimisation) flag, `True` or an unspecified value now renders as `1`, while `False` renders as `0`. +- For the `-g` (debug info) flag, `True` or an unspecified value now renders `2`, while `False` renders as `0`. +This makes the displayed compiler flags more consistent with their internal semantics (e.g. optimisation level 1 is the default). From 6ff90bbdcd759ba7a92a2b5f9b820946fd56dab8 Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Tue, 28 Jul 2026 16:44:20 +0300 Subject: [PATCH 3/7] add feedback --- Cabal/src/Distribution/Simple/Flag.hs | 4 ++-- Cabal/src/Distribution/Simple/Setup/Config.hs | 2 +- Cabal/src/Distribution/Types/DebugInfoLevel.hs | 6 ------ Cabal/src/Distribution/Types/OptimisationLevel.hs | 6 ------ cabal-install/src/Distribution/Client/ProjectPlanning.hs | 3 +-- .../PackageTests/ProjectConfig/DebugInfo/cabal.out | 3 +++ .../PackageTests/ProjectConfig/DebugInfo/cabal.test.hs | 6 ++---- 7 files changed, 9 insertions(+), 21 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Flag.hs b/Cabal/src/Distribution/Simple/Flag.hs index 08a1ac49963..4c6f7afca89 100644 --- a/Cabal/src/Distribution/Simple/Flag.hs +++ b/Cabal/src/Distribution/Simple/Flag.hs @@ -125,12 +125,12 @@ instance BooleanFlag Bool where -- | Flag is a Monoid, with 'NoFlag' as the identity element, and 'Flag' as the binary operation. -- --- @since 3.18.0.0 +-- @since 3.20.0.0 class NoFlagValue a where noFlagValue :: a -- | Extracts a value from a 'Flag', and returns the 'noFlagValue' on 'NoFlag'. -- --- @since 3.18.0.0 +-- @since 3.20.0.0 fromNoFlag :: NoFlagValue a => Flag a -> a fromNoFlag = fromFlagOrDefault noFlagValue diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 57dd83d65f5..95f35e93bcc 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -439,7 +439,7 @@ configureOptions showOrParseArgs = configHcFlavor (\v flags -> flags{configHcFlavor = v}) ( choiceOpt - [ (Flag GHC, ("g", ["ghc"]), "compile with GHC") + [ (Flag GHC, ([], ["ghc"]), "compile with GHC") , (Flag GHCJS, ([], ["ghcjs"]), "compile with GHCJS") , (Flag UHC, ([], ["uhc"]), "compile with UHC") ] diff --git a/Cabal/src/Distribution/Types/DebugInfoLevel.hs b/Cabal/src/Distribution/Types/DebugInfoLevel.hs index 4087a781e62..938246e5e45 100644 --- a/Cabal/src/Distribution/Types/DebugInfoLevel.hs +++ b/Cabal/src/Distribution/Types/DebugInfoLevel.hs @@ -17,12 +17,6 @@ import Prelude () import Data.Bool (bool) import Distribution.Simple.Flag (NoFlagValue (..)) --- ------------------------------------------------------------ - --- * Debug info levels - --- ------------------------------------------------------------ - -- | Some compilers support emitting debug info. Some have different -- levels. For compilers that do not the level is just capped to the -- level they do support. diff --git a/Cabal/src/Distribution/Types/OptimisationLevel.hs b/Cabal/src/Distribution/Types/OptimisationLevel.hs index cca447a7bb9..94b27f088dd 100644 --- a/Cabal/src/Distribution/Types/OptimisationLevel.hs +++ b/Cabal/src/Distribution/Types/OptimisationLevel.hs @@ -17,12 +17,6 @@ import Prelude () import Data.Bool (bool) import Distribution.Simple.Flag (NoFlagValue (..)) --- ------------------------------------------------------------ - --- * Optimisation levels - --- ------------------------------------------------------------ - -- | Some compilers support optimising. Some have different levels. -- For compilers that do not the level is just capped to the level -- they do support. diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index ea597d40193..77be4c1fa20 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1250,8 +1250,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do -- the hashes for the packages -- hashesFromRepoMetadata <- - Sec.uncheckClientErrors $ -- TODO: [code cleanup] wrap in our own exceptions -- TODO: [code cleanup] wrap in our own exceptions - -- TODO: [code cleanup] wrap in our own exceptions + Sec.uncheckClientErrors $ -- TODO: [code cleanup] wrap in our own exceptions fmap (Map.fromList . concat) $ sequence -- Reading the repo index is expensive so we group the packages by repo diff --git a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out b/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out index 19b2a69fa0a..affd6b255e1 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) \ No newline at end of file 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 From 1dd1a87456f6ff57d5a50daefb9e3317831d149f Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Tue, 28 Jul 2026 18:00:23 +0300 Subject: [PATCH 4/7] update hangelog --- changelog.d/11937.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/changelog.d/11937.md b/changelog.d/11937.md index c06bc953cbc..c27bc3e2741 100644 --- a/changelog.d/11937.md +++ b/changelog.d/11937.md @@ -8,3 +8,6 @@ The rendering of certain boolean‑like flags has been changed to use numeric le - For the `-O` (optimisation) flag, `True` or an unspecified value now renders as `1`, while `False` renders as `0`. - For the `-g` (debug info) flag, `True` or an unspecified value now renders `2`, while `False` renders as `0`. This makes the displayed compiler flags more consistent with their internal semantics (e.g. optimisation level 1 is the default). +- The `-g` flag is being repurposed to exclusively control debug information, + aligning it with common build system conventions. Previously, `-g` served as + an alias for `--ghc`. Please use the explicit `--ghc` flag instead. From 6ca5fc0d6928e48d3caad6a28b068bacf2203bfa Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Thu, 30 Jul 2026 07:40:56 +0300 Subject: [PATCH 5/7] add suggestions --- Cabal/src/Distribution/Simple/Setup/Config.hs | 12 ++++++------ changelog.d/11937.md | 14 +++++++++++--- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 95f35e93bcc..73b7a285947 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -572,12 +572,12 @@ configureOptions showOrParseArgs = "optimization" configOptimization (\v flags -> flags{configOptimization = v}) - [ reqArg' + [ optArg' "n" - (Flag . fromString) + (Flag . maybe noFlagValue fromString) ( \case NoFlag -> [] - Flag flag -> [O.toString flag] + Flag flag -> [Just $ O.toString flag] ) "O" ["enable-optimization", "enable-optimisation"] @@ -592,12 +592,12 @@ configureOptions showOrParseArgs = "debug-info" configDebugInfo (\v flags -> flags{configDebugInfo = v}) - [ reqArg' + [ optArg' "n" - (Flag . fromString) + (Flag . maybe noFlagValue fromString) ( \case NoFlag -> [] - Flag flag -> [D.toString flag] + Flag flag -> [Just $ D.toString flag] ) "g" ["enable-debug-info"] diff --git a/changelog.d/11937.md b/changelog.d/11937.md index c27bc3e2741..2abaeb616e1 100644 --- a/changelog.d/11937.md +++ b/changelog.d/11937.md @@ -8,6 +8,14 @@ The rendering of certain boolean‑like flags has been changed to use numeric le - For the `-O` (optimisation) flag, `True` or an unspecified value now renders as `1`, while `False` renders as `0`. - For the `-g` (debug info) flag, `True` or an unspecified value now renders `2`, while `False` renders as `0`. This makes the displayed compiler flags more consistent with their internal semantics (e.g. optimisation level 1 is the default). -- The `-g` flag is being repurposed to exclusively control debug information, - aligning it with common build system conventions. Previously, `-g` served as - an alias for `--ghc`. Please use the explicit `--ghc` flag instead. +- Removes the short `-g` option for the `--ghc` flag. This is now used as the short option for `--enable-debug-info`. +```diff + $ cabal build --help +... +- -g, --ghc compile with GHC ++ --ghc compile with GHC +... +- --enable-debug-info[=n] Emit debug info (n is 0--3, default is 0) ++ -g n or -gn, --enable-debug-info[=n] ++ Emit debug info (n is 0--3, default is 0) +``` From 033ce1459d97067851087d763125c9a4f9ff6882 Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Fri, 31 Jul 2026 07:28:34 +0300 Subject: [PATCH 6/7] add suggestions --- Cabal/src/Distribution/Simple/Build.hs | 2 +- Cabal/src/Distribution/Simple/Flag.hs | 14 -------------- Cabal/src/Distribution/Simple/Setup/Config.hs | 8 ++++---- Cabal/src/Distribution/Types/DebugInfoLevel.hs | 16 +++++----------- Cabal/src/Distribution/Types/DumpBuildInfo.hs | 13 +++++-------- .../src/Distribution/Types/OptimisationLevel.hs | 16 +++++----------- .../Distribution/Client/ProjectOrchestration.hs | 6 +++--- .../src/Distribution/Client/ScriptUtils.hs | 5 +++-- changelog.d/11937.md | 5 +++++ 9 files changed, 31 insertions(+), 54 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index 10cc75f151e..8ac5cc2c4f0 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -304,7 +304,7 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do removeFileForcibly buildInfoFile where buildInfoFile = interpretSymbolicPathLBI lbi $ buildInfoPref distPref - shouldDumpBuildInfo = fromNoFlag dumpBuildInfoFlag == DumpBuildInfo + shouldDumpBuildInfo = dumpBuildInfoFlag == Flag DumpBuildInfo -- \| Given the flavor of the compiler, try to find out -- which program we need. diff --git a/Cabal/src/Distribution/Simple/Flag.hs b/Cabal/src/Distribution/Simple/Flag.hs index 4c6f7afca89..fffe7646a7d 100644 --- a/Cabal/src/Distribution/Simple/Flag.hs +++ b/Cabal/src/Distribution/Simple/Flag.hs @@ -28,8 +28,6 @@ module Distribution.Simple.Flag , maybeToFlag , mergeListFlag , BooleanFlag (..) - , NoFlagValue (..) - , fromNoFlag ) where import Data.Monoid (Last (..)) @@ -122,15 +120,3 @@ class BooleanFlag a where instance BooleanFlag Bool where asBool = id - --- | Flag is a Monoid, with 'NoFlag' as the identity element, and 'Flag' as the binary operation. --- --- @since 3.20.0.0 -class NoFlagValue a where - noFlagValue :: a - --- | Extracts a value from a 'Flag', and returns the 'noFlagValue' on 'NoFlag'. --- --- @since 3.20.0.0 -fromNoFlag :: NoFlagValue a => Flag a -> a -fromNoFlag = fromFlagOrDefault noFlagValue diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 73b7a285947..84b21663d4f 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -574,14 +574,14 @@ configureOptions showOrParseArgs = (\v flags -> flags{configOptimization = v}) [ optArg' "n" - (Flag . maybe noFlagValue fromString) + (Flag . maybe O.defaultOptimisationLevel fromString) ( \case NoFlag -> [] Flag flag -> [Just $ O.toString flag] ) "O" ["enable-optimization", "enable-optimisation"] - (printf "Build with optimization (n is %s--%s, default is %s)" (O.toString minBound) (O.toString maxBound) (O.toString noFlagValue)) + (printf "Build with optimization (n is %s--%s, default is %s)" (O.toString minBound) (O.toString maxBound) (O.toString O.defaultOptimisationLevel)) , noArg (Flag NoOptimisation) [] @@ -594,14 +594,14 @@ configureOptions showOrParseArgs = (\v flags -> flags{configDebugInfo = v}) [ optArg' "n" - (Flag . maybe noFlagValue fromString) + (Flag . maybe D.defaultDebugInfo fromString) ( \case NoFlag -> [] Flag flag -> [Just $ D.toString flag] ) "g" ["enable-debug-info"] - (printf "Emit debug info (n is %s--%s, default is %s)" (D.toString minBound) (D.toString maxBound) (D.toString noFlagValue)) + (printf "Emit debug info (n is %s--%s, default is %s)" (D.toString minBound) (D.toString maxBound) (D.toString D.defaultDebugInfo)) , noArg (Flag NoDebugInfo) [] diff --git a/Cabal/src/Distribution/Types/DebugInfoLevel.hs b/Cabal/src/Distribution/Types/DebugInfoLevel.hs index 938246e5e45..b584575931a 100644 --- a/Cabal/src/Distribution/Types/DebugInfoLevel.hs +++ b/Cabal/src/Distribution/Types/DebugInfoLevel.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE InstanceSigs #-} module Distribution.Types.DebugInfoLevel ( DebugInfoLevel (..) , toString + , defaultDebugInfo ) where @@ -15,7 +14,6 @@ import Distribution.Parsec (CabalParsing, Parsec (..)) import Prelude () import Data.Bool (bool) -import Distribution.Simple.Flag (NoFlagValue (..)) -- | Some compilers support emitting debug info. Some have different -- levels. For compilers that do not the level is just capped to the @@ -26,14 +24,10 @@ data DebugInfoLevel | NormalDebugInfo | MaximalDebugInfo deriving stock (Bounded, Enum, Eq, Generic, Read, Show) + deriving anyclass (Binary, NFData, Structured) -instance Binary DebugInfoLevel -instance NFData DebugInfoLevel -instance Structured DebugInfoLevel - -instance NoFlagValue DebugInfoLevel where - noFlagValue :: DebugInfoLevel - noFlagValue = NoDebugInfo +defaultDebugInfo :: DebugInfoLevel +defaultDebugInfo = NoDebugInfo instance Parsec DebugInfoLevel where parsec :: CabalParsing m => m DebugInfoLevel diff --git a/Cabal/src/Distribution/Types/DumpBuildInfo.hs b/Cabal/src/Distribution/Types/DumpBuildInfo.hs index 5442935413c..6f5a4bf57b5 100644 --- a/Cabal/src/Distribution/Types/DumpBuildInfo.hs +++ b/Cabal/src/Distribution/Types/DumpBuildInfo.hs @@ -1,27 +1,24 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} module Distribution.Types.DumpBuildInfo ( DumpBuildInfo (..) , toString + , defaultDumpBuildInfo ) where import Distribution.Compat.Prelude (Binary, Generic, NFData, Structured) import Distribution.Parsec (CabalParsing, Parsec (..)) -import Distribution.Simple.Flag (NoFlagValue (..)) data DumpBuildInfo = NoDumpBuildInfo | DumpBuildInfo deriving stock (Read, Show, Eq, Ord, Enum, Bounded, Generic) + deriving anyclass (Binary, NFData, Structured) -instance Binary DumpBuildInfo -instance NFData DumpBuildInfo -instance Structured DumpBuildInfo - -instance NoFlagValue DumpBuildInfo where - noFlagValue :: DumpBuildInfo - noFlagValue = NoDumpBuildInfo +defaultDumpBuildInfo :: DumpBuildInfo +defaultDumpBuildInfo = NoDumpBuildInfo instance Parsec DumpBuildInfo where parsec :: CabalParsing m => m DumpBuildInfo diff --git a/Cabal/src/Distribution/Types/OptimisationLevel.hs b/Cabal/src/Distribution/Types/OptimisationLevel.hs index 94b27f088dd..f89218b75a0 100644 --- a/Cabal/src/Distribution/Types/OptimisationLevel.hs +++ b/Cabal/src/Distribution/Types/OptimisationLevel.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE InstanceSigs #-} module Distribution.Types.OptimisationLevel ( OptimisationLevel (..) , toString + , defaultOptimisationLevel ) where @@ -15,7 +14,6 @@ import Distribution.Parsec (CabalParsing, Parsec (..)) import Prelude () import Data.Bool (bool) -import Distribution.Simple.Flag (NoFlagValue (..)) -- | Some compilers support optimising. Some have different levels. -- For compilers that do not the level is just capped to the level @@ -25,14 +23,10 @@ data OptimisationLevel | NormalOptimisation | MaximumOptimisation deriving stock (Bounded, Enum, Eq, Generic, Read, Show) + deriving anyclass (Binary, NFData, Structured) -instance Binary OptimisationLevel -instance NFData OptimisationLevel -instance Structured OptimisationLevel - -instance NoFlagValue OptimisationLevel where - noFlagValue :: OptimisationLevel - noFlagValue = NormalOptimisation +defaultOptimisationLevel :: OptimisationLevel +defaultOptimisationLevel = NormalOptimisation instance Parsec OptimisationLevel where parsec :: CabalParsing m => m OptimisationLevel diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 917b0e7e10e..9548fff5d99 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -187,7 +187,7 @@ import Distribution.Simple.Compiler , showCompilerId ) import Distribution.Simple.Configure (computeEffectiveProfiling) -import Distribution.Simple.Flag (flagToMaybe, fromFlagOrDefault, fromNoFlag) +import Distribution.Simple.Flag (flagToMaybe, fromFlagOrDefault) import Distribution.Simple.LocalBuildInfo ( ComponentName (..) , pkgComponents @@ -211,7 +211,7 @@ import Distribution.Types.Flag , diffFlagAssignment , showFlagAssignment ) -import qualified Distribution.Types.OptimisationLevel as OptimisationLevel +import qualified Distribution.Types.OptimisationLevel as O import Distribution.Utils.NubList ( fromNubList ) @@ -1252,7 +1252,7 @@ printPlan "Build profile: " ++ unwords [ "-w " ++ (showCompilerId . pkgConfigCompiler) elaboratedShared - , "-O" ++ (OptimisationLevel.toString . fromNoFlag) (globalOptimization <> localOptimization) + , "-O" ++ (O.toString . fromFlagOrDefault O.defaultOptimisationLevel) (globalOptimization <> localOptimization) ] ++ "\n" diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 4fb8d55ecab..107044c3938 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -128,7 +128,7 @@ import Distribution.Simple.Compiler ) import Distribution.Simple.Flag ( flagToMaybe - , fromNoFlag + , fromFlagOrDefault ) import Distribution.Simple.PackageDescription ( parseString @@ -166,6 +166,7 @@ import Distribution.Types.GenericPackageDescription as GPD ( GenericPackageDescription (..) , emptyGenericPackageDescription ) +import qualified Distribution.Types.OptimisationLevel as O import Distribution.Types.PackageDescription ( PackageDescription (..) , emptyPackageDescription @@ -439,7 +440,7 @@ scriptDistDirParams scriptPath ctx compiler platform = , distParamComponentName = Just $ CExeName cn , distParamCompilerId = compilerId compiler , distParamPlatform = platform - , distParamOptimization = fromNoFlag optimization + , distParamOptimization = fromFlagOrDefault O.defaultOptimisationLevel optimization } where cn = scriptComponentName scriptPath diff --git a/changelog.d/11937.md b/changelog.d/11937.md index 2abaeb616e1..63613bdd20b 100644 --- a/changelog.d/11937.md +++ b/changelog.d/11937.md @@ -4,6 +4,11 @@ packages: [Cabal, cabal-install] prs: 11937 --- +### Cabal API Changes +- The types `OptimisationLevel` and `DebugInfoLevel` have been moved from `Distribution.Simple.Compiler` +to `Distribution.Types.OptimisationLevel` and `Distribution.Types.DebugInfoLevel` respectively. + +### Changes The rendering of certain boolean‑like flags has been changed to use numeric levels: - For the `-O` (optimisation) flag, `True` or an unspecified value now renders as `1`, while `False` renders as `0`. - For the `-g` (debug info) flag, `True` or an unspecified value now renders `2`, while `False` renders as `0`. From 1714ba96e4b350b9ddfdffc8d5455d250ef58b4c Mon Sep 17 00:00:00 2001 From: Ilia Baryshnikov Date: Sat, 1 Aug 2026 07:20:31 +0300 Subject: [PATCH 7/7] remove defaults functions --- Cabal/src/Distribution/Simple/Setup/Config.hs | 8 ++++---- Cabal/src/Distribution/Types/DebugInfoLevel.hs | 4 ---- Cabal/src/Distribution/Types/DumpBuildInfo.hs | 4 ---- Cabal/src/Distribution/Types/OptimisationLevel.hs | 4 ---- .../src/Distribution/Client/ProjectOrchestration.hs | 3 ++- cabal-install/src/Distribution/Client/ScriptUtils.hs | 4 ++-- 6 files changed, 8 insertions(+), 19 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 84b21663d4f..fd052de41da 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -574,14 +574,14 @@ configureOptions showOrParseArgs = (\v flags -> flags{configOptimization = v}) [ optArg' "n" - (Flag . maybe O.defaultOptimisationLevel fromString) + (Flag . maybe NormalOptimisation fromString) ( \case NoFlag -> [] Flag flag -> [Just $ O.toString flag] ) "O" ["enable-optimization", "enable-optimisation"] - (printf "Build with optimization (n is %s--%s, default is %s)" (O.toString minBound) (O.toString maxBound) (O.toString O.defaultOptimisationLevel)) + (printf "Build with optimization (n is %s--%s, default is %s)" (O.toString minBound) (O.toString maxBound) (O.toString NormalOptimisation)) , noArg (Flag NoOptimisation) [] @@ -594,14 +594,14 @@ configureOptions showOrParseArgs = (\v flags -> flags{configDebugInfo = v}) [ optArg' "n" - (Flag . maybe D.defaultDebugInfo fromString) + (Flag . maybe NoDebugInfo fromString) ( \case NoFlag -> [] Flag flag -> [Just $ D.toString flag] ) "g" ["enable-debug-info"] - (printf "Emit debug info (n is %s--%s, default is %s)" (D.toString minBound) (D.toString maxBound) (D.toString D.defaultDebugInfo)) + (printf "Emit debug info (n is %s--%s, default is %s)" (D.toString minBound) (D.toString maxBound) (D.toString NoDebugInfo)) , noArg (Flag NoDebugInfo) [] diff --git a/Cabal/src/Distribution/Types/DebugInfoLevel.hs b/Cabal/src/Distribution/Types/DebugInfoLevel.hs index b584575931a..036dd49948f 100644 --- a/Cabal/src/Distribution/Types/DebugInfoLevel.hs +++ b/Cabal/src/Distribution/Types/DebugInfoLevel.hs @@ -4,7 +4,6 @@ module Distribution.Types.DebugInfoLevel ( DebugInfoLevel (..) , toString - , defaultDebugInfo ) where @@ -26,9 +25,6 @@ data DebugInfoLevel deriving stock (Bounded, Enum, Eq, Generic, Read, Show) deriving anyclass (Binary, NFData, Structured) -defaultDebugInfo :: DebugInfoLevel -defaultDebugInfo = NoDebugInfo - instance Parsec DebugInfoLevel where parsec :: CabalParsing m => m DebugInfoLevel parsec = boolParser <|> intParser diff --git a/Cabal/src/Distribution/Types/DumpBuildInfo.hs b/Cabal/src/Distribution/Types/DumpBuildInfo.hs index 6f5a4bf57b5..0ffa303c507 100644 --- a/Cabal/src/Distribution/Types/DumpBuildInfo.hs +++ b/Cabal/src/Distribution/Types/DumpBuildInfo.hs @@ -5,7 +5,6 @@ module Distribution.Types.DumpBuildInfo ( DumpBuildInfo (..) , toString - , defaultDumpBuildInfo ) where import Distribution.Compat.Prelude (Binary, Generic, NFData, Structured) @@ -17,9 +16,6 @@ data DumpBuildInfo deriving stock (Read, Show, Eq, Ord, Enum, Bounded, Generic) deriving anyclass (Binary, NFData, Structured) -defaultDumpBuildInfo :: DumpBuildInfo -defaultDumpBuildInfo = NoDumpBuildInfo - instance Parsec DumpBuildInfo where parsec :: CabalParsing m => m DumpBuildInfo parsec = boolToDumpBuildInfo <$> parsec diff --git a/Cabal/src/Distribution/Types/OptimisationLevel.hs b/Cabal/src/Distribution/Types/OptimisationLevel.hs index f89218b75a0..acd300a7a20 100644 --- a/Cabal/src/Distribution/Types/OptimisationLevel.hs +++ b/Cabal/src/Distribution/Types/OptimisationLevel.hs @@ -4,7 +4,6 @@ module Distribution.Types.OptimisationLevel ( OptimisationLevel (..) , toString - , defaultOptimisationLevel ) where @@ -25,9 +24,6 @@ data OptimisationLevel deriving stock (Bounded, Enum, Eq, Generic, Read, Show) deriving anyclass (Binary, NFData, Structured) -defaultOptimisationLevel :: OptimisationLevel -defaultOptimisationLevel = NormalOptimisation - instance Parsec OptimisationLevel where parsec :: CabalParsing m => m OptimisationLevel parsec = boolParser <|> intParser diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 9548fff5d99..05b94cc0681 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -211,6 +211,7 @@ import Distribution.Types.Flag , diffFlagAssignment , showFlagAssignment ) +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import qualified Distribution.Types.OptimisationLevel as O import Distribution.Utils.NubList ( fromNubList @@ -1252,7 +1253,7 @@ printPlan "Build profile: " ++ unwords [ "-w " ++ (showCompilerId . pkgConfigCompiler) elaboratedShared - , "-O" ++ (O.toString . fromFlagOrDefault O.defaultOptimisationLevel) (globalOptimization <> localOptimization) + , "-O" ++ (O.toString . fromFlagOrDefault NormalOptimisation) (globalOptimization <> localOptimization) ] ++ "\n" diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 107044c3938..d7315626da3 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -166,7 +166,7 @@ import Distribution.Types.GenericPackageDescription as GPD ( GenericPackageDescription (..) , emptyGenericPackageDescription ) -import qualified Distribution.Types.OptimisationLevel as O +import Distribution.Types.OptimisationLevel (OptimisationLevel (..)) import Distribution.Types.PackageDescription ( PackageDescription (..) , emptyPackageDescription @@ -440,7 +440,7 @@ scriptDistDirParams scriptPath ctx compiler platform = , distParamComponentName = Just $ CExeName cn , distParamCompilerId = compilerId compiler , distParamPlatform = platform - , distParamOptimization = fromFlagOrDefault O.defaultOptimisationLevel optimization + , distParamOptimization = fromFlagOrDefault NormalOptimisation optimization } where cn = scriptComponentName scriptPath