hadrian: Introduce notion of flavour transformers

This extends Hadrian's notion of "flavour", as described in #18942.

3 files changed, 104 insertions, 5 deletions

diff --git a/hadrian/doc/flavours.md b/hadrian/doc/flavours.md
index de7e515154..c5441f05d6 100644
--- a/hadrian/doc/flavours.md
+++ b/hadrian/doc/flavours.md
@@ -174,6 +174,50 @@ In addition to the above, there are LLVM variants for the flavours `quick`,
 is an additional `-fllvm` flag in `hsDefault` when the stage0 compiler is GHC.
 See `src/Settings/Flavours/Llvm.hs` for details.
 
+## Flavour transformers
+
+Each of the flavours described above is intended as a starting-point for
+configuring your GHC build. In addition, Hadrian supports a number of "flavour
+transformers" which modify the configuration in various ways.
+
+These can be appended to the flavour name passed via the `--flavour`
+command-line flag, separated by the `+` character. For instance,
+
+```
+hadrian --flavour=perf+thread_sanitizer
+```
+
+The supported transformers are listed below:
+
+<table>
+    <tr>
+        <th>Transformer name</th>
+        <th>Effect</th>
+    </tr>
+    <tr>
+        <td><code>werror</code></td>
+        <td>Use the `-Werror` flag for all stage1+ compilation.</td>
+    </tr>
+    <tr>
+        <td><code>debug_info</code></td>
+        <td>Enable production of native debugging information (via GHC/GCC's `-g3`)
+            during stage1+ compilations.</td>
+    </tr>
+    <tr>
+        <td><code>ticky_ghc</code></td>
+        <td>Compile the GHC executable with Ticky-Ticky profiler support.</td>
+    </tr>
+    <tr>
+        <td><code>split_sections</code></td>
+        <td>Enable section splitting for all libraries (except for the GHC
+            library due to the long linking times that this causes).</td>
+    </tr>
+    <tr>
+        <td><code>thread_sanitizer</code></td>
+        <td>Build the runtime system with ThreadSanitizer support</td>
+    </tr>
+</table>
+
 ## Ways
 
 Libraries and GHC can be built in different _ways_, e.g. with or without profiling
diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index 364261259f..06f72a06eb 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -1,7 +1,9 @@
 module Flavour
   ( Flavour (..), werror
   , DocTargets, DocTarget(..)
+  , parseFlavour
     -- * Flavour transformers
+  , flavourTransformers
   , addArgs
   , splitSections, splitSectionsIf
   , enableThreadSanitizer
@@ -10,8 +12,14 @@ module Flavour
 
 import Expression
 import Data.Set (Set)
+import Data.Map (Map)
+import qualified Data.Map as M
 import Packages
 
+import Text.Parsec.Prim as P
+import Text.Parsec.Combinator as P
+import Text.Parsec.Char as P
+
 -- Please update doc/{flavours.md, user-settings.md} when changing this file.
 -- | 'Flavour' is a collection of build settings that fully define a GHC build.
 -- Note the following type semantics:
@@ -69,6 +77,55 @@ type DocTargets = Set DocTarget
 data DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan | SphinxInfo
   deriving (Eq, Ord, Show, Bounded, Enum)
 
+flavourTransformers :: Map String (Flavour -> Flavour)
+flavourTransformers = M.fromList
+    [ "werror" =: werror
+    , "debug_info" =: enableDebugInfo
+    , "ticky_ghc" =: enableTickyGhc
+    , "split_sections" =: splitSections
+    , "thread_sanitizer" =: enableThreadSanitizer
+    ]
+  where (=:) = (,)
+
+type Parser = Parsec String ()
+
+parseFlavour :: [Flavour]  -- ^ base flavours
+             -> Map String (Flavour -> Flavour) -- ^ modifiers
+             -> String
+             -> Either String Flavour
+parseFlavour baseFlavours transformers str =
+    case P.runParser parser () "" str of
+      Left perr -> Left $ unlines $
+                    [ "error parsing flavour specifier: " ++ show perr
+                    , ""
+                    , "known flavours:"
+                    ] ++
+                    [ "  " ++ name f | f <- baseFlavours ] ++
+                    [ ""
+                    , "known flavour transformers:"
+                    ] ++
+                    [ "  " ++ nm | nm <- M.keys transformers ]
+      Right f -> Right f
+  where
+    parser :: Parser Flavour
+    parser = do
+      base <- baseFlavour
+      transs <- P.many flavourTrans
+      return $ foldr ($) base transs
+
+    baseFlavour :: Parser Flavour
+    baseFlavour =
+        P.choice [ f <$ P.try (P.string (name f))
+                 | f <- baseFlavours
+                 ]
+
+    flavourTrans :: Parser (Flavour -> Flavour)
+    flavourTrans = do
+        void $ P.char '+'
+        P.choice [ trans <$ P.try (P.string nm)
+                 | (nm, trans) <- M.toList transformers
+                 ]
+
 -- | Add arguments to the 'args' of a 'Flavour'.
 addArgs :: Args -> Flavour -> Flavour
 addArgs args' fl = fl { args = args fl <> args' }
diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs
index ff51c01acb..43af1330ca 100755
--- a/hadrian/src/Settings.hs
+++ b/hadrian/src/Settings.hs
@@ -75,11 +75,9 @@ flavour = do
     let flavours = hadrianFlavours ++ userFlavours
         (_settingErrs, tweak) = applySettings kvs
 
-    return $
-      case filter (\fl -> name fl == flavourName) flavours of
-        []  -> error $ "Unknown build flavour: " ++ flavourName
-        [f] -> tweak f
-        _   -> error $ "Multiple build flavours named " ++ flavourName
+    case parseFlavour flavours flavourTransformers flavourName of
+      Left err -> fail err
+      Right f -> return $ tweak f
 
 -- TODO: switch to Set Package as the order of packages should not matter?
 -- Otherwise we have to keep remembering to sort packages from time to time.