| ... |
... |
@@ -15,6 +15,7 @@ module Hadrian.Haskell.Cabal.Parse ( |
|
15
|
15
|
) where
|
|
16
|
16
|
|
|
17
|
17
|
import Data.Bifunctor
|
|
|
18
|
+import Data.Char (isDigit)
|
|
18
|
19
|
import Data.List.Extra
|
|
19
|
20
|
import Development.Shake
|
|
20
|
21
|
import qualified Distribution.Compat.Graph as Graph
|
| ... |
... |
@@ -55,6 +56,8 @@ import Builder |
|
55
|
56
|
import Context
|
|
56
|
57
|
import Settings
|
|
57
|
58
|
import Distribution.Simple.LocalBuildInfo
|
|
|
59
|
+import Distribution.Types.LocalBuildInfo (allTargetsInBuildOrder')
|
|
|
60
|
+import Distribution.Types.TargetInfo (TargetInfo (..))
|
|
58
|
61
|
import qualified Distribution.Simple.Register as C
|
|
59
|
62
|
import System.Directory (getCurrentDirectory)
|
|
60
|
63
|
import qualified Distribution.InstalledPackageInfo as CP
|
| ... |
... |
@@ -394,35 +397,48 @@ registerPackage rs context = do |
|
394
|
397
|
-- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
|
|
395
|
398
|
-- from the local build info @lbi@.
|
|
396
|
399
|
lbi <- liftIO $ C.getPersistBuildConfig Nothing (C.makeSymbolicPath cPath)
|
|
397
|
|
- liftIO $ register db_path pid pd lbi
|
|
|
400
|
+ -- This runs `ghc --abi-hash`, so do it outside the critical section below.
|
|
|
401
|
+ installedPkgInfo <- liftIO $ generateRegistrationInfo pd lbi
|
|
|
402
|
+
|
|
|
403
|
+ let pkg_name = pkgName (package context)
|
|
|
404
|
+ -- Is this a pkg.conf for a previous build?
|
|
|
405
|
+ -- we want to match "ghc-9.15.1-abcd.conf" but not "ghc-boot-9.15.1.conf"
|
|
|
406
|
+ isPkgConf f = case stripPrefix (pkg_name ++ "-") (takeBaseName f) of
|
|
|
407
|
+ Just (c:_) -> isDigit c
|
|
|
408
|
+ _ -> takeBaseName f == pkg_name
|
|
|
409
|
+
|
|
|
410
|
+ -- Unlike `ghc-pkg update/register` (used to populate the inplace and stage0
|
|
|
411
|
+ -- databases), writing the .conf file directly doesn't remove units this
|
|
|
412
|
+ -- package was previously registered under. Stale .conf files from earlier
|
|
|
413
|
+ -- builds make this package's modules ambiguous (#26661), so delete them
|
|
|
414
|
+ -- before writing the new .conf file.
|
|
|
415
|
+ withResources rs $ do
|
|
|
416
|
+ confs <- liftIO $ getDirectoryFilesIO db_path ["*.conf"]
|
|
|
417
|
+ mapM_ (removeFile . (db_path </>))
|
|
|
418
|
+ [ f | f <- confs, isPkgConf f, takeBaseName f /= pid ]
|
|
|
419
|
+ liftIO $ writeUTF8File (db_path </> pid <.> "conf")
|
|
|
420
|
+ (CP.showInstalledPackageInfo installedPkgInfo)
|
|
398
|
421
|
-- Then after the register, which just writes the .conf file, do the recache step.
|
|
399
|
422
|
buildWithResources rs $
|
|
400
|
423
|
target context (GhcPkg Recache (stage context)) [] []
|
|
401
|
424
|
|
|
402
|
425
|
-- This is copied and simplified from Cabal, because we want to install the package
|
|
403
|
426
|
-- into a different package database to the one it was configured against.
|
|
404
|
|
-register :: FilePath
|
|
405
|
|
- -> String -- ^ Package Identifier
|
|
406
|
|
- -> C.PackageDescription
|
|
407
|
|
- -> LocalBuildInfo
|
|
408
|
|
- -> IO ()
|
|
409
|
|
-register pkg_db pid pd lbi
|
|
410
|
|
- = withLibLBI pd lbi $ \lib clbi -> do
|
|
411
|
|
-
|
|
412
|
|
- when reloc $ error "register does not support reloc"
|
|
413
|
|
- installedPkgInfo <- generateRegistrationInfo pd lbi lib clbi
|
|
414
|
|
- writeRegistrationFile installedPkgInfo
|
|
415
|
|
-
|
|
416
|
|
- where
|
|
417
|
|
- regFile = pkg_db </> pid <.> "conf"
|
|
418
|
|
- reloc = relocatable lbi
|
|
419
|
|
-
|
|
420
|
|
- generateRegistrationInfo pkg lbi lib clbi = do
|
|
421
|
|
- abi_hash <- C.mkAbiHash <$> GHC.libAbiHash C.silent pkg lbi lib clbi
|
|
422
|
|
- return (C.absoluteInstalledPackageInfo pkg abi_hash lib lbi clbi)
|
|
423
|
|
-
|
|
424
|
|
- writeRegistrationFile installedPkgInfo = do
|
|
425
|
|
- writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo)
|
|
|
427
|
+-- See generateRegistrationInfo in Distribution.Simple.Register. we can't use it
|
|
|
428
|
+-- directly because it computes the abi-hash using Cabal's internal package
|
|
|
429
|
+-- database, which hadrian never creates.
|
|
|
430
|
+generateRegistrationInfo :: C.PackageDescription
|
|
|
431
|
+ -> LocalBuildInfo
|
|
|
432
|
+ -> IO Installed.InstalledPackageInfo
|
|
|
433
|
+generateRegistrationInfo pd lbi = do
|
|
|
434
|
+ when (relocatable lbi) $ error "register does not support reloc"
|
|
|
435
|
+ case [ (lib, targetCLBI tgt) | tgt <- allTargetsInBuildOrder' pd lbi
|
|
|
436
|
+ , CLib lib <- [targetComponent tgt] ] of
|
|
|
437
|
+ [(lib, clbi)] -> do
|
|
|
438
|
+ abi_hash <- C.mkAbiHash <$> GHC.libAbiHash C.silent pd lbi lib clbi
|
|
|
439
|
+ return (C.absoluteInstalledPackageInfo pd abi_hash lib lbi clbi)
|
|
|
440
|
+ libs -> error $ "generateRegistrationInfo: expected exactly one library for "
|
|
|
441
|
+ ++ C.display (C.package pd) ++ ", got " ++ show (length libs)
|
|
426
|
442
|
|
|
427
|
443
|
|
|
428
|
444
|
-- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs@.
|