From 7a9f97386bece90144292dc7f1cabff239b6db82 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 4 Sep 2021 12:49:42 +0200 Subject: [PATCH] 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. --- Cabal/src/Distribution/Simple/Build.hs | 19 +++++++++++++- .../src/Distribution/Simple/ShowBuildInfo.hs | 25 +++++++------------ 2 files changed, 27 insertions(+), 17 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index 8891490a197..8a4beecfce4 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/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 diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 8cc098a2819..1a6d1b30c43 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/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 $