Display -O and -g as numeric levels instead of booleans

Author: zlonast

Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs

@@ -41,6 +41,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

@@ -18,20 +18,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

@@ -174,11 +174,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

@@ -309,7 +309,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.

Cabal/src/Distribution/Simple/Command.hs

@@ -79,7 +79,6 @@ module Distribution.Simple.Command
   , reqArg'
   , optArg
   , optArg'
-  , optArgDef'
   , noArg
   , boolOpt
   , boolOpt'
@@ -280,15 +279,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

@@ -52,14 +52,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
@@ -96,22 +88,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)
 
@@ -304,95 +304,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

@@ -164,6 +164,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/Flag.hs

@@ -31,6 +31,8 @@ module Distribution.Simple.Flag
   , maybeToFlag
   , mergeListFlag
   , BooleanFlag (..)
+  , NoFlagValue (..)
+  , fromNoFlag
   ) where
 
 import Data.Monoid (Last (..))
@@ -123,3 +125,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

Cabal/src/Distribution/Simple/GHC/Internal.hs

@@ -76,11 +76,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

@@ -48,12 +48,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]