Add support for emitting debug info

If the compiler (e.g. GHC 7.10) supports outputting OS native debug
info (e.g. DWARF) passing --enable-debug-info[=n] to cabal will
instruct it to do so.

Cabal/Distribution/Simple/Compiler.hs

@@ -40,6 +40,10 @@ module Distribution.Simple.Compiler (
         OptimisationLevel(..),
         flagToOptimisationLevel,
 
+        -- * Support for debug info levels
+        DebugInfoLevel(..),
+        flagToDebugInfoLevel,
+
         -- * Support for language extensions
         Flag,
         languageToFlags,
@@ -193,6 +197,33 @@ flagToOptimisationLevel (Just s) = case reads s of
                         ++ ". Valid values are 0..2"
   _             -> error $ "Can't parse optimisation level " ++ s
 
+-- ------------------------------------------------------------
+-- * 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
+
+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/Distribution/Simple/Configure.hs

@@ -660,6 +660,7 @@ configure (pkg_descr0, pbi) cfg
                     withDynExe          = withDynExe_,
                     withProfExe         = withProfExe_,
                     withOptimization    = fromFlag $ configOptimization cfg,
+                    withDebugInfo       = fromFlag $ configDebugInfo cfg,
                     withGHCiLib         = fromFlagOrDefault ghciLibByDefault $
                                           configGHCiLib cfg,
                     splitObjs           = split_objs,

Cabal/Distribution/Simple/GHC/ImplInfo.hs

@@ -48,6 +48,7 @@ data GhcImplInfo = GhcImplInfo
   , alwaysNondecIndent   :: Bool -- ^ NondecreasingIndentation is always on
   , flagGhciScript       :: Bool -- ^ -ghci-script flag supported
   , flagPackageConf      :: Bool -- ^ use package-conf instead of package-db
+  , flagDebugInfo        :: Bool -- ^ -g flag supported
   }
 
 getImplInfo :: Compiler -> GhcImplInfo
@@ -80,6 +81,7 @@ ghcVersionImplInfo (Version v _) = GhcImplInfo
   , alwaysNondecIndent   = v <  [7,1]
   , flagGhciScript       = v >= [7,2]
   , flagPackageConf      = v <  [7,5]
+  , flagDebugInfo        = v >= [7,10]
   }
 
 ghcjsVersionImplInfo :: Version -> Version -> GhcImplInfo
@@ -99,6 +101,7 @@ ghcjsVersionImplInfo _ghcjsVer _ghcVer = GhcImplInfo
   , alwaysNondecIndent   = False
   , flagGhciScript       = True
   , flagPackageConf      = False
+  , flagDebugInfo        = False
   }
 
 lhcVersionImplInfo :: Version -> GhcImplInfo

Cabal/Distribution/Simple/GHC/Internal.hs

@@ -38,7 +38,7 @@ import Distribution.PackageDescription as PD
          , hcOptions, usedExtensions, ModuleRenaming, lookupRenaming )
 import Distribution.Compat.Exception ( catchExit, catchIO )
 import Distribution.Simple.Compiler
-         ( CompilerFlavor(..), Compiler(..), OptimisationLevel(..) )
+         ( CompilerFlavor(..), Compiler(..), DebugInfoLevel(..), OptimisationLevel(..) )
 import Distribution.Simple.Program.GHC
 import Distribution.Simple.Setup
          ( toFlag )
@@ -339,6 +339,11 @@ componentCcGhcOptions verbosity implInfo lbi bi clbi pref filename =
                              (case withOptimization lbi of
                                   NoOptimisation -> []
                                   _              -> ["-O2"]) ++
+                             (case withDebugInfo lbi of
+                                  NoDebugInfo   -> []
+                                  MinimalDebugInfo -> ["-g1"]
+                                  NormalDebugInfo  -> ["-g"]
+                                  MaximalDebugInfo -> ["-g3"]) ++
                                   PD.ccOptions bi,
       ghcOptObjDir         = toFlag odir
     }
@@ -372,6 +377,7 @@ componentGhcOptions verbosity lbi bi clbi odir =
       ghcOptStubDir         = toFlag odir,
       ghcOptOutputDir       = toFlag odir,
       ghcOptOptimisation    = toGhcOptimisation (withOptimization lbi),
+      ghcOptDebugInfo       = toGhcDebugInfo (withDebugInfo lbi),
       ghcOptExtra           = toNubListR $ hcOptions GHC bi,
       ghcOptLanguage        = toFlag (fromMaybe Haskell98 (defaultLanguage bi)),
       -- Unsupported extensions have already been checked by configure
@@ -383,6 +389,11 @@ componentGhcOptions verbosity lbi bi clbi odir =
     toGhcOptimisation NormalOptimisation  = toFlag GhcNormalOptimisation
     toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
 
+    toGhcDebugInfo NoDebugInfo      = mempty
+    toGhcDebugInfo MinimalDebugInfo = toFlag GhcMinimalDebugInfo
+    toGhcDebugInfo NormalDebugInfo  = toFlag GhcNormalDebugInfo
+    toGhcDebugInfo MaximalDebugInfo = toFlag GhcMaximalDebugInfo
+
 -- | Strip out flags that are not supported in ghci
 filterGhciFlags :: [String] -> [String]
 filterGhciFlags = filter supported

Cabal/Distribution/Simple/LocalBuildInfo.hs

@@ -73,7 +73,8 @@ import Distribution.Package
          ( PackageId, Package(..), InstalledPackageId(..), PackageKey
          , PackageName )
 import Distribution.Simple.Compiler
-         ( Compiler, compilerInfo, PackageDBStack, OptimisationLevel )
+         ( Compiler, compilerInfo, PackageDBStack, DebugInfoLevel
+         , OptimisationLevel )
 import Distribution.Simple.PackageIndex
          ( InstalledPackageIndex, allPackages )
 import Distribution.ModuleName ( ModuleName )
@@ -139,6 +140,7 @@ data LocalBuildInfo = LocalBuildInfo {
         withDynExe    :: Bool,  -- ^Whether to link executables dynamically
         withProfExe   :: Bool,  -- ^Whether to build executables for profiling.
         withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available).
+        withDebugInfo :: DebugInfoLevel, -- ^Whether to emit debug info (if available).
         withGHCiLib   :: Bool,  -- ^Whether to build libs suitable for use with GHCi.
         splitObjs     :: Bool,  -- ^Use -split-objs with GHC, if available
         stripExes     :: Bool,  -- ^Whether to strip executables during install

Cabal/Distribution/Simple/Program/GHC.hs

@@ -2,6 +2,7 @@ module Distribution.Simple.Program.GHC (
     GhcOptions(..),
     GhcMode(..),
     GhcOptimisation(..),
+    GhcDebugInfo(..),
     GhcDynLinkMode(..),
 
     ghcInvocation,
@@ -152,6 +153,9 @@ data GhcOptions = GhcOptions {
   -- | What optimisation level to use; the @ghc -O@ flag.
   ghcOptOptimisation  :: Flag GhcOptimisation,
 
+    -- | What debug info level to use; the @ghc -g@ flag.
+  ghcOptDebugInfo  :: Flag GhcDebugInfo,
+
   -- | Compile in profiling mode; the @ghc -prof@ flag.
   ghcOptProfilingMode :: Flag Bool,
 
@@ -219,6 +223,12 @@ data GhcOptimisation = GhcNoOptimisation             -- ^ @-O0@
                      | GhcSpecialOptimisation String -- ^ e.g. @-Odph@
  deriving (Show, Eq)
 
+data GhcDebugInfo = GhcNoDebugInfo       -- ^ @-g0@
+                  | GhcMinimalDebugInfo  -- ^ @-g1@
+                  | GhcNormalDebugInfo   -- ^ @-g@
+                  | GhcMaximalDebugInfo  -- ^ @-g3@
+ deriving (Show, Eq)
+
 data GhcDynLinkMode = GhcStaticOnly       -- ^ @-static@
                     | GhcDynamicOnly      -- ^ @-dynamic@
                     | GhcStaticAndDynamic -- ^ @-static -dynamic-too@
@@ -273,6 +283,13 @@ renderGhcOptions comp opts
       Just GhcMaximumOptimisation     -> ["-O2"]
       Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph
 
+  , concat [ case flagToMaybe (ghcOptDebugInfo opts) of
+        Nothing                      -> []
+        Just GhcNoDebugInfo          -> ["-g0"]
+        Just GhcMinimalDebugInfo     -> ["-g1"]
+        Just GhcNormalDebugInfo      -> ["-g"]
+        Just GhcMaximalDebugInfo     -> ["-g3"] | flagDebugInfo implInfo ]
+
   , [ "-prof" | flagBool ghcOptProfilingMode ]
 
   , [ "-split-objs" | flagBool ghcOptSplitObjs ]
@@ -475,6 +492,7 @@ instance Monoid GhcOptions where
     ghcOptExtensions         = mempty,
     ghcOptExtensionMap       = mempty,
     ghcOptOptimisation       = mempty,
+    ghcOptDebugInfo          = mempty,
     ghcOptProfilingMode      = mempty,
     ghcOptSplitObjs          = mempty,
     ghcOptNumJobs            = mempty,
@@ -527,6 +545,7 @@ instance Monoid GhcOptions where
     ghcOptExtensions         = combine ghcOptExtensions,
     ghcOptExtensionMap       = combine ghcOptExtensionMap,
     ghcOptOptimisation       = combine ghcOptOptimisation,
+    ghcOptDebugInfo          = combine ghcOptDebugInfo,
     ghcOptProfilingMode      = combine ghcOptProfilingMode,
     ghcOptSplitObjs          = combine ghcOptSplitObjs,
     ghcOptNumJobs            = combine ghcOptNumJobs,

Cabal/Distribution/Simple/Setup.hs

@@ -82,6 +82,7 @@ import Distribution.Simple.Command hiding (boolOpt, boolOpt')
 import qualified Distribution.Simple.Command as Command
 import Distribution.Simple.Compiler
          ( CompilerFlavor(..), defaultCompilerFlavor, PackageDB(..)
+         , DebugInfoLevel(..), flagToDebugInfoLevel
          , OptimisationLevel(..), flagToOptimisationLevel
          , absolutePackageDBPath )
 import Distribution.Simple.Utils
@@ -319,7 +320,8 @@ data ConfigFlags = ConfigFlags {
       -- the user via the '--dependency' and '--flags' options.
     configFlagError :: Flag String,
       -- ^Halt and show an error message indicating an error in flag assignment
-    configRelocatable :: Flag Bool -- ^ Enable relocatable package built
+    configRelocatable :: Flag Bool, -- ^ Enable relocatable package built
+    configDebugInfo :: Flag DebugInfoLevel  -- ^ Emit debug info.
   }
   deriving (Generic, Read, Show)
 
@@ -361,7 +363,8 @@ defaultConfigFlags progConf = emptyConfigFlags {
     configLibCoverage  = NoFlag,
     configExactConfiguration = Flag False,
     configFlagError    = NoFlag,
-    configRelocatable  = Flag False
+    configRelocatable  = Flag False,
+    configDebugInfo    = Flag NoDebugInfo
   }
 
 configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags
@@ -470,6 +473,22 @@ configureOptions showOrParseArgs =
                 "Build without optimization"
          ]
 
+      ,multiOption "debug-info"
+         configDebugInfo (\v flags -> flags { configDebugInfo = v })
+         [optArg' "n" (Flag . flagToDebugInfoLevel)
+                     (\f -> case f of
+                              Flag NoDebugInfo      -> []
+                              Flag MinimalDebugInfo -> [Just "1"]
+                              Flag NormalDebugInfo  -> [Nothing]
+                              Flag MaximalDebugInfo -> [Just "3"]
+                              _                     -> [])
+                 "" ["enable-debug-info"]
+                 "Emit debug info (n is 0--3, default is 0)",
+          noArg (Flag NoDebugInfo) []
+                ["disable-debug-info"]
+                "Don't emit debug info"
+         ]
+
       ,option "" ["library-for-ghci"]
          "compile library for use with GHCi"
          configGHCiLib (\v flags -> flags { configGHCiLib = v })
@@ -730,7 +749,8 @@ instance Monoid ConfigFlags where
     configExactConfiguration  = mempty,
     configBenchmarks          = mempty,
     configFlagError     = mempty,
-    configRelocatable   = mempty
+    configRelocatable   = mempty,
+    configDebugInfo     = mempty
   }
   mappend a b =  ConfigFlags {
     configPrograms      = configPrograms b,
@@ -771,7 +791,8 @@ instance Monoid ConfigFlags where
     configExactConfiguration  = combine configExactConfiguration,
     configBenchmarks          = combine configBenchmarks,
     configFlagError     = combine configFlagError,
-    configRelocatable   = combine configRelocatable
+    configRelocatable   = combine configRelocatable,
+    configDebugInfo     = combine configDebugInfo
   }
     where combine field = field a `mappend` field b
 

cabal-install/Distribution/Client/Config.hs

@@ -53,7 +53,7 @@ import Distribution.Utils.NubList
          ( NubList, fromNubList, toNubList)
 
 import Distribution.Simple.Compiler
-         ( OptimisationLevel(..) )
+         ( DebugInfoLevel(..), OptimisationLevel(..) )
 import Distribution.Simple.Setup
          ( ConfigFlags(..), configureOptions, defaultConfigFlags
          , HaddockFlags(..), haddockOptions, defaultHaddockFlags
@@ -261,6 +261,7 @@ instance Monoid SavedConfig where
         -- TODO: NubListify
         configConfigureArgs       = lastNonEmpty configConfigureArgs,
         configOptimization        = combine configOptimization,
+        configDebugInfo           = combine configDebugInfo,
         configProgPrefix          = combine configProgPrefix,
         configProgSuffix          = combine configProgSuffix,
         -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
@@ -601,10 +602,11 @@ configFieldDescriptions =
        [simpleField "compiler"
           (fromFlagOrDefault Disp.empty . fmap Text.disp) (optional Text.parse)
           configHcFlavor (\v flags -> flags { configHcFlavor = v })
-        -- TODO: The following is a temporary fix. The "optimization" field is
-        -- OptArg, and viewAsFieldDescr fails on that. Instead of a hand-written
-        -- hackaged parser and printer, we should handle this case properly in
-        -- the library.
+        -- 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
@@ -626,6 +628,29 @@ configFieldDescriptions =
                lstr = lowercase str
                caseWarning = PWarning $
                  "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")
+       ,liftField configDebugInfo (\v flags -> flags { configDebugInfo = v }) $
+        let name = "debug-info" in
+        FieldDescr name
+          (\f -> case f of
+                   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 == "False" -> ParseOk [] (Flag NoDebugInfo)
+             |  str == "True"  -> ParseOk [] (Flag NormalDebugInfo)
+             |  str == "0"     -> ParseOk [] (Flag NoDebugInfo)
+             |  str == "1"     -> ParseOk [] (Flag MinimalDebugInfo)
+             |  str == "2"     -> ParseOk [] (Flag NormalDebugInfo)
+             |  str == "3"     -> ParseOk [] (Flag MaximalDebugInfo)
+             | lstr == "false" -> ParseOk [caseWarning] (Flag NoDebugInfo)
+             | lstr == "true"  -> ParseOk [caseWarning] (Flag NormalDebugInfo)
+             | otherwise       -> ParseFailed (NoParse name line)
+             where
+               lstr = lowercase str
+               caseWarning = PWarning $
+                 "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")
        ]
 
   ++ toSavedConfig liftConfigExFlag