| ... |
... |
@@ -15,6 +15,8 @@ module Hadrian.Haskell.Cabal.Parse ( |
|
15
|
15
|
) where
|
|
16
|
16
|
|
|
17
|
17
|
import Data.Bifunctor
|
|
|
18
|
+import Data.Char (isDigit)
|
|
|
19
|
+import Data.IORef
|
|
18
|
20
|
import Data.List.Extra
|
|
19
|
21
|
import Development.Shake
|
|
20
|
22
|
import qualified Distribution.Compat.Graph as Graph
|
| ... |
... |
@@ -394,35 +396,54 @@ registerPackage rs context = do |
|
394
|
396
|
-- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
|
|
395
|
397
|
-- from the local build info @lbi@.
|
|
396
|
398
|
lbi <- liftIO $ C.getPersistBuildConfig Nothing (C.makeSymbolicPath cPath)
|
|
397
|
|
- liftIO $ register db_path pid pd lbi
|
|
|
399
|
+ -- This runs `ghc --abi-hash`, so do it before acquiring the package
|
|
|
400
|
+ -- database resource below.
|
|
|
401
|
+ installedPkgInfo <- liftIO $ generateRegistrationInfo pd lbi
|
|
|
402
|
+
|
|
|
403
|
+ let pkg_name = pkgName (package context)
|
|
|
404
|
+ -- Matches "<name>.conf" and "<name>-<version>[-<hash>].conf", but
|
|
|
405
|
+ -- not packages `pkg_name` merely prefixes: versions start with a
|
|
|
406
|
+ -- digit, package name components don't (for "ghc",
|
|
|
407
|
+ -- "ghc-9.15.1-abcd.conf" matches but "ghc-boot-9.15.1.conf" doesn't).
|
|
|
408
|
+ isPkgConf f = case stripPrefix (pkg_name ++ "-") (takeBaseName f) of
|
|
|
409
|
+ Just (c:_) -> isDigit c
|
|
|
410
|
+ _ -> takeBaseName f == pkg_name
|
|
|
411
|
+
|
|
|
412
|
+ -- Unlike `ghc-pkg update/register` (used to populate the inplace and
|
|
|
413
|
+ -- stage0 databases), writing the .conf file directly doesn't remove
|
|
|
414
|
+ -- units this package was previously registered under. Stale .conf files
|
|
|
415
|
+ -- from earlier builds (with a different unit-id hash or version) make
|
|
|
416
|
+ -- this package's modules ambiguous (#26661), so delete them before
|
|
|
417
|
+ -- writing the new .conf file.
|
|
|
418
|
+ --
|
|
|
419
|
+ -- Mutating the database needs exclusive access: a concurrent ghc-pkg
|
|
|
420
|
+ -- crashes if a .conf file it has seen disappears before it reads it.
|
|
|
421
|
+ -- See the comment about the package-db resource in `packageRules`.
|
|
|
422
|
+ withResources rs $ liftIO $ do
|
|
|
423
|
+ confs <- getDirectoryFilesIO db_path ["*.conf"]
|
|
|
424
|
+ let stale = [ f | f <- confs, isPkgConf f, takeBaseName f /= pid ]
|
|
|
425
|
+ unless (null stale) $ removeFiles db_path stale
|
|
|
426
|
+ writeUTF8File (db_path </> pid <.> "conf")
|
|
|
427
|
+ (CP.showInstalledPackageInfo installedPkgInfo)
|
|
398
|
428
|
-- Then after the register, which just writes the .conf file, do the recache step.
|
|
399
|
429
|
buildWithResources rs $
|
|
400
|
430
|
target context (GhcPkg Recache (stage context)) [] []
|
|
401
|
431
|
|
|
402
|
432
|
-- This is copied and simplified from Cabal, because we want to install the package
|
|
403
|
433
|
-- 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)
|
|
|
434
|
+generateRegistrationInfo :: C.PackageDescription
|
|
|
435
|
+ -> LocalBuildInfo
|
|
|
436
|
+ -> IO Installed.InstalledPackageInfo
|
|
|
437
|
+generateRegistrationInfo pd lbi = do
|
|
|
438
|
+ when (relocatable lbi) $ error "register does not support reloc"
|
|
|
439
|
+ ref <- newIORef Nothing
|
|
|
440
|
+ withLibLBI pd lbi $ \lib clbi -> do
|
|
|
441
|
+ abi_hash <- C.mkAbiHash <$> GHC.libAbiHash C.silent pd lbi lib clbi
|
|
|
442
|
+ writeIORef ref (Just (C.absoluteInstalledPackageInfo pd abi_hash lib lbi clbi))
|
|
|
443
|
+ mipi <- readIORef ref
|
|
|
444
|
+ case mipi of
|
|
|
445
|
+ Just ipi -> return ipi
|
|
|
446
|
+ Nothing -> error "generateRegistrationInfo: package has no library"
|
|
426
|
447
|
|
|
427
|
448
|
|
|
428
|
449
|
-- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs@.
|