Skip to content

Commit

Permalink
Make compiler path not nullable in dumped build-info
Browse files Browse the repository at this point in the history
Refactor the API slightly s.t. a ConfiguredProgram for the Compiler is
passed to build-info generation directly.
  • Loading branch information
fendor committed Sep 7, 2021
1 parent 66669b1 commit 0702193
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 21 deletions.
19 changes: 18 additions & 1 deletion Cabal/src/Distribution/Simple/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand All @@ -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
Expand Down
25 changes: 9 additions & 16 deletions Cabal/src/Distribution/Simple/ShowBuildInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -118,23 +122,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 $
Expand Down
8 changes: 4 additions & 4 deletions cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down

0 comments on commit 0702193

Please sign in to comment.