feat(Cabal, cabal-install): Display -O and -g as numeric levels instead of booleans

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
 

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
 

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

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 = dumpBuildInfoFlag == Flag DumpBuildInfo
 
     -- \| Given the flavor of the compiler, try to find out
     -- which program we need.

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
 

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
 
 -- ------------------------------------------------------------

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

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

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]

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
 
@@ -434,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")
             ]
@@ -567,18 +572,16 @@ configureOptions showOrParseArgs =
           "optimization"
           configOptimization
           (\v flags -> flags{configOptimization = v})
-          [ optArgDef'
+          [ optArg'
               "n"
-              (show NoOptimisation, Flag . flagToOptimisationLevel)
+              (Flag . maybe NormalOptimisation fromString)
               ( \case
-                  Flag NoOptimisation -> []
-                  Flag NormalOptimisation -> [Nothing]
-                  Flag MaximumOptimisation -> [Just "2"]
-                  _ -> []
+                  NoFlag -> []
+                  Flag flag -> [Just $ 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 NormalOptimisation))
           , noArg
               (Flag NoOptimisation)
               []
@@ -591,17 +594,14 @@ configureOptions showOrParseArgs =
           (\v flags -> flags{configDebugInfo = v})
           [ optArg'
               "n"
-              (Flag . flagToDebugInfoLevel)
+              (Flag . maybe NoDebugInfo fromString)
               ( \case
-                  Flag NoDebugInfo -> []
-                  Flag MinimalDebugInfo -> [Just "1"]
-                  Flag NormalDebugInfo -> [Nothing]
-                  Flag MaximalDebugInfo -> [Just "3"]
-                  _ -> []
+                  NoFlag -> []
+                  Flag flag -> [Just $ 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 NoDebugInfo))
           , noArg
               (Flag NoDebugInfo)
               []

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