Make compiler path not nullable in dumped build-info

Refactor the API slightly s.t. a ConfiguredProgram for the Compiler is
passed to build-info generation directly.

Author: fendor

Cabal/src/Distribution/Simple/Build.hs

@@ -69,6 +69,7 @@ import Distribution.Simple.BuildTarget
 import Distribution.Simple.BuildToolDepends
 import Distribution.Simple.PreProcess
 import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Program.Builtin (ghcProgram, ghcjsProgram, uhcProgram, jhcProgram, haskellSuiteProgram)
 import Distribution.Simple.Program.Types
 import Distribution.Simple.Program.Db
 import Distribution.Simple.ShowBuildInfo
@@ -164,7 +165,13 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do
                       (map (showComponentName . componentLocalName . targetCLBI)
                           activeTargets)
     pwd <- getCurrentDirectory
-    let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags activeTargets
+
+    (compilerProg, _) <- case flavorToProgram (compilerFlavor (compiler lbi)) of
+      Nothing -> die' verbosity $ "dumpBuildInfo: Unknown compiler flavor: "
+                               ++ show (compilerFlavor (compiler lbi))
+      Just program -> requireProgram verbosity program (withPrograms lbi)
+
+    let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets
         buildInfoText = renderJson json
     unless (null warns) $
       warn verbosity $ "Encountered warnings while dumping build-info:\n"
@@ -178,6 +185,16 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do
   where
     shouldDumpBuildInfo = fromFlagOrDefault NoDumpBuildInfo dumpBuildInfoFlag == DumpBuildInfo
 
+    -- | Given the flavor of the compiler, try to find out
+    -- which program we need.
+    flavorToProgram :: CompilerFlavor -> Maybe Program
+    flavorToProgram GHC             = Just ghcProgram
+    flavorToProgram GHCJS           = Just ghcjsProgram
+    flavorToProgram UHC             = Just uhcProgram
+    flavorToProgram JHC             = Just jhcProgram
+    flavorToProgram HaskellSuite {} = Just haskellSuiteProgram
+    flavorToProgram _     = Nothing
+
 
 repl     :: PackageDescription  -- ^ Mostly information from the .cabal file
          -> LocalBuildInfo      -- ^ Configuration information

Cabal/src/Distribution/Simple/ShowBuildInfo.hs

@@ -90,11 +90,15 @@ mkBuildInfo
   -> PackageDescription  -- ^ Mostly information from the .cabal file
   -> LocalBuildInfo      -- ^ Configuration information
   -> BuildFlags          -- ^ Flags that the user passed to build
+  -> (ConfiguredProgram, Compiler)
+  -- ^ Compiler information.
+  -- Needs to be passed explicitly, as we can't extract that information here
+  -- without some partial function.
   -> [TargetInfo]
   -> ([String], Json)    -- ^ Json representation of buildinfo alongside generated warnings
-mkBuildInfo wdir pkg_descr lbi _flags targetsToBuild = (warnings, JsonObject buildInfoFields)
+mkBuildInfo wdir pkg_descr lbi _flags compilerInfo targetsToBuild = (warnings, JsonObject buildInfoFields)
   where
-    buildInfoFields = mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) componentInfos
+    buildInfoFields = mkBuildInfo' (uncurry mkCompilerInfo compilerInfo) componentInfos
     componentInfosWithWarnings = map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild
     componentInfos = map snd componentInfosWithWarnings
     warnings = concatMap fst componentInfosWithWarnings
@@ -111,23 +115,12 @@ mkBuildInfo' compilerInfo componentInfos =
   , "components"        .= JsonArray componentInfos
   ]
 
-mkCompilerInfo :: ProgramDb -> Compiler -> Json
-mkCompilerInfo programDb compilerInfo = JsonObject
+mkCompilerInfo :: ConfiguredProgram -> Compiler -> Json
+mkCompilerInfo compilerProgram compilerInfo = JsonObject
   [ "flavour"     .= JsonString (prettyShow $ compilerFlavor compilerInfo)
   , "compiler-id" .= JsonString (showCompilerId compilerInfo)
-  , "path"        .= path
+  , "path"        .= JsonString (programPath compilerProgram)
   ]
-  where
-    path = maybe JsonNull (JsonString . programPath)
-            $ (flavorToProgram . compilerFlavor $ compilerInfo)
-            >>= flip lookupProgram programDb
-
-    flavorToProgram :: CompilerFlavor -> Maybe Program
-    flavorToProgram GHC   = Just ghcProgram
-    flavorToProgram GHCJS = Just ghcjsProgram
-    flavorToProgram UHC   = Just uhcProgram
-    flavorToProgram JHC   = Just jhcProgram
-    flavorToProgram _     = Nothing
 
 mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> ([String], Json)
 mkComponentInfo wdir pkg_descr lbi clbi = (warnings, JsonObject $