hadrian: Introduce enableDebugInfo flavour transformer

Also refactor things a bit to eliminate repetition.

1 files changed, 21 insertions, 9 deletions

diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index e78aa5b9a1..dba8621952 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -1,7 +1,10 @@
 module Flavour
   ( Flavour (..), werror
   , DocTargets, DocTarget(..)
+    -- * Flavour transformers
+  , addArgs
   , splitSections, splitSectionsIf
+  , enableDebugInfo
   ) where
 
 import Expression
@@ -34,7 +37,7 @@ data Flavour = Flavour {
     ghciWithDebugger :: Bool,
     -- | Build profiled GHC.
     ghcProfiled :: Bool,
-    -- | Build GHC with debug information.
+    -- | Build GHC with debugging assertions.
     ghcDebugged :: Bool,
     -- | Whether to build docs and which ones
     --   (haddocks, user manual, haddock manual)
@@ -61,10 +64,21 @@ type DocTargets = Set DocTarget
 data DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan | SphinxInfo
   deriving (Eq, Ord, Show, Bounded, Enum)
 
+-- | Add arguments to the 'args' of a 'Flavour'.
+addArgs :: Args -> Flavour -> Flavour
+addArgs args' fl = fl { args = args fl <> args' }
+
 -- | Turn on -Werror for packages built with the stage1 compiler.
 -- It mimics the CI settings so is useful to turn on when developing.
 werror :: Flavour -> Flavour
-werror fl = fl { args = args fl <> (builder Ghc ? notStage0 ? arg "-Werror") }
+werror = addArgs (builder Ghc ? notStage0 ? arg "-Werror")
+
+-- | Build C and Haskell objects with debugging information.
+enableDebugInfo :: Flavour -> Flavour
+enableDebugInfo = addArgs $ mconcat
+    [ builder (Ghc CompileHs) ? notStage0 ? arg "-g3"
+    , builder (Cc CompileC) ? notStage0 ? arg "-g3"
+    ]
 
 -- | Transform the input 'Flavour' so as to build with
 --   @-split-sections@ whenever appropriate. You can
@@ -74,13 +88,11 @@ werror fl = fl { args = args fl <> (builder Ghc ? notStage0 ? arg "-Werror") }
 --   building it. If the given flavour doesn't build
 --   anything in a @dyn@-enabled way, then 'splitSections' is a no-op.
 splitSectionsIf :: (Package -> Bool) -> Flavour -> Flavour
-splitSectionsIf pkgPredicate fl = fl { args = args fl <> splitSectionsArg }
-
-  where splitSectionsArg = do
-          way <- getWay
-          pkg <- getPackage
-          (Dynamic `wayUnit` way) ? pkgPredicate pkg ?
-            builder (Ghc CompileHs) ? arg "-split-sections"
+splitSectionsIf pkgPredicate = addArgs $ do
+    way <- getWay
+    pkg <- getPackage
+    (Dynamic `wayUnit` way) ? pkgPredicate pkg ?
+        builder (Ghc CompileHs) ? arg "-split-sections"
 
 -- | Like 'splitSectionsIf', but with a fixed predicate: use
 --   split sections for all packages but the GHC library.