From c26077d870af98dc3148985eb30df58a5e7485fc 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 +++++++------------ .../Distribution/Client/ProjectPlanOutput.hs | 8 +++--- 3 files changed, 31 insertions(+), 21 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 9bfda3eadd5..7d30ba0fc04 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -93,11 +93,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 @@ -114,23 +118,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 $ diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs index ec0d5a676b2..876982a9570 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs @@ -179,17 +179,17 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = where -- | Only add build-info file location if the Setup.hs CLI -- is recent enough to be able to generate build info files. - -- Otherwise, do not add the expected file location. + -- Otherwise, write 'null'. -- - -- Consumers of `plan.json` can use the absence of this file location + -- Consumers of `plan.json` can use the nullability of this file location -- to indicate that the given component uses `build-type: Custom` -- with an old lib:Cabal version. buildInfoFileLocation :: J.Pair buildInfoFileLocation | elabSetupScriptCliVersion elab < mkVersion [3, 7, 0, 0] - = ("build-info" J..= J.Null) + = "build-info" J..= J.Null | otherwise - = ("build-info" J..= J.String (buildInfoPref dist_dir)) + = "build-info" J..= J.String (buildInfoPref dist_dir) packageLocationToJ :: PackageLocation (Maybe FilePath) -> J.Value packageLocationToJ pkgloc =