Track main unit ids in createProjectPackageDb (#5598)

This is another refactoring PR for createProjectPackageDb. There are
no actual changes but the `DependencyInfo` now includes the list of
main unit ids. This is not used in this PR but the plan is to start
emitting a file here containing those and then we only have to parse
that file instead of reading all DARs again just to figure out the
--package flags. (The reason why it needs to be written to a file
instead of simply returned is that this needs to work even with
--init-package-db=no which is going to become more important for
incremental package db initialization).

changelog_begin
changelog_end
This commit is contained in:
Moritz Kiefer 2020-04-17 14:47:06 +02:00 committed by GitHub
parent adef6192ca
commit b8db6b23b6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 123 additions and 88 deletions

View File

@ -17,7 +17,7 @@ import DA.Daml.LF.Reader
data ExtractedDar = ExtractedDar
{ edSdkVersions :: String
, edMain :: [ZipArchive.Entry]
, edMain :: ZipArchive.Entry
, edConfFiles :: [ZipArchive.Entry]
, edDalfs :: [ZipArchive.Entry]
, edSrcs :: [ZipArchive.Entry]
@ -50,7 +50,7 @@ extractDar fp = do
[".daml", ".hie", ".hi"]
]
dalfs <- forM (dalfPaths dalfManifest) $ \p -> getEntry p archive
pure (ExtractedDar sdkVersion [mainDalfEntry] confFiles dalfs srcs)
pure (ExtractedDar sdkVersion mainDalfEntry confFiles dalfs srcs)
-- | Get an entry from a dar or fail.
getEntry :: FilePath -> ZipArchive.Archive -> IO ZipArchive.Entry

View File

@ -108,18 +108,23 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
let dependenciesInPkgDbIds =
Set.fromList $ map LF.dalfPackageId $ MS.elems dependenciesInPkgDb
-- Now handle data imports.
dalfsFromDataDependencies <- getDalfsFromDataDependencies dependenciesInPkgDbIds dataDeps
-- Now handle data-dependencies.
darsFromDataDependencies <- getDarsFromDataDependencies dependenciesInPkgDbIds dataDeps
let dalfsFromDataDependencies = concatMap dalfs darsFromDataDependencies
-- All transitive packages from DARs specified in `dependencies`.
-- This is only used for unit-id collision checks
-- and dependencies on newer LF versions.
dalfsFromDependencies <- getDalfsFromDependencies depsExtracted
darsFromDependencies <- getDarsFromDependencies dependenciesInPkgDbIds depsExtracted
let dalfsFromDependencies = concatMap dalfs darsFromDependencies
let dependencyInfo = DependencyInfo
{ dependenciesInPkgDb
, dalfsFromDependencies
, dalfsFromDataDependencies
, mainUnitIds =
map (decodedUnitId . mainDalf)
(darsFromDataDependencies ++ darsFromDependencies)
}
-- We perform this check before checking for unit id collisions
@ -328,11 +333,10 @@ getUnitId thisUnitId pkgMap =
installDar ::
FilePath
-> [ZipArchive.Entry]
-> [ZipArchive.Entry]
-> ZipArchive.Entry
-> [ZipArchive.Entry]
-> IO ()
installDar dbPath confFiles dalfs srcs = do
forM_ dalfs $ \dalf -> do
installDar dbPath confFiles dalf srcs = do
let path = dbPath </> ZipArchive.eRelativePath dalf
createDirectoryIfMissing True (takeDirectory path)
BSL.writeFile path (ZipArchive.fromEntry dalf)
@ -381,7 +385,7 @@ lfVersionString = DA.Pretty.renderPretty
-- | The graph will have an edge from package A to package B if A depends on B.
buildLfPackageGraph
:: [(UnitId, LF.DalfPackage)]
:: [DecodedDalf]
-> MS.Map (UnitId, LF.ModuleName) LF.DalfPackage
-> MS.Map UnitId LF.DalfPackage
-> ( Graph
@ -392,23 +396,27 @@ buildLfPackageGraph pkgs stablePkgs dependencyPkgs = (depGraph, vertexToNode')
-- mapping from package id's to unit id's. if the same package is imported with
-- different unit id's, we would loose a unit id here.
pkgMap =
MS.fromList [(LF.dalfPackageId pkg, unitId) | (unitId, pkg) <- MS.toList dependencyPkgs <> pkgs]
MS.fromList [ (LF.dalfPackageId pkg, unitId)
| (unitId, pkg) <-
MS.toList dependencyPkgs <>
map (\DecodedDalf{..} -> (decodedUnitId, decodedDalfPkg)) pkgs
]
packages =
MS.fromList
[ (LF.dalfPackageId dalfPkg, LF.extPackagePkg $ LF.dalfPackagePkg dalfPkg)
| dalfPkg <- MS.elems dependencyPkgs <> MS.elems stablePkgs <> map snd pkgs
| dalfPkg <- MS.elems dependencyPkgs <> MS.elems stablePkgs <> map decodedDalfPkg pkgs
]
-- order the packages in topological order
(depGraph, vertexToNode, _keyToVertex) =
graphFromEdges
[ (PackageNode src unitId dalfPkg, LF.dalfPackageId dalfPkg, pkgRefs)
| (unitId, dalfPkg) <- pkgs
, let pkg = LF.extPackagePkg (LF.dalfPackagePkg dalfPkg)
[ (PackageNode src decodedUnitId decodedDalfPkg, LF.dalfPackageId decodedDalfPkg, pkgRefs)
| DecodedDalf{decodedUnitId, decodedDalfPkg} <- pkgs
, let pkg = LF.extPackagePkg (LF.dalfPackagePkg decodedDalfPkg)
, let pkgRefs = [ pid | LF.PRImport pid <- toListOf packageRefs pkg ]
, let src = generateSrcPkgFromLf (config (LF.dalfPackageId dalfPkg) unitId) pkg
, let src = generateSrcPkgFromLf (config (LF.dalfPackageId decodedDalfPkg) decodedUnitId) pkg
]
vertexToNode' v = case vertexToNode v of
-- We dont care about outgoing edges.
@ -466,16 +474,20 @@ data DependencyInfo = DependencyInfo
-- The rule is run after installing DALFs from `dependencies` so
-- this includes dependencies in the builtin package db like daml-prim
-- as well as the main DALFs of DARs specified in `dependencies`.
, dalfsFromDependencies :: [(LF.PackageId, (UnitId, LF.Version))]
, dalfsFromDependencies :: [DecodedDalf]
-- ^ All dalfs (not just main DALFs) in DARs listed in `dependencies`.
-- This does not include DALFs in the global package db like daml-prim.
-- Note that a DAR does not include interface files for dependencies
-- so to use a DAR as a `dependency` you also need to list the DARs of all
-- of its dependencies.
, dalfsFromDataDependencies :: [(UnitId, LF.DalfPackage)]
, dalfsFromDataDependencies :: [DecodedDalf]
-- ^ All dalfs (not just main DALFs) from DARs and DALFs listed in `data-dependencies`.
-- Note that for data-dependencies it is sufficient to list a DAR without
-- listing all of its dependencies.
, mainUnitIds :: [UnitId]
-- ^ Unit id of the main DALFs specified in dependencies and
-- data-dependencies. This will be used to generate the --package
-- flags which define which packages are exposed by default.
}
checkForIncompatibleLfVersions :: LF.Version -> DependencyInfo -> Either String ()
@ -493,15 +505,11 @@ checkForIncompatibleLfVersions lfTarget DependencyInfo{dalfsFromDependencies, da
]
where
incompatibleLfDeps =
filter (\(_, ver) -> ver > lfTarget) $ concat
[ [ ((pkgId, unitId), version)
| (pkgId, (unitId, version)) <- dalfsFromDependencies
]
, [ ( (LF.dalfPackageId dalfPkg, unitId)
, (LF.packageLfVersion . LF.extPackagePkg . LF.dalfPackagePkg) dalfPkg
filter (\(_, ver) -> ver > lfTarget) $
[ ( (LF.dalfPackageId decodedDalfPkg, decodedUnitId)
, (LF.packageLfVersion . LF.extPackagePkg . LF.dalfPackagePkg) decodedDalfPkg
)
| (unitId, dalfPkg) <- dalfsFromDataDependencies
]
| DecodedDalf{..} <- dalfsFromDataDependencies <> dalfsFromDependencies
]
checkForUnitIdConflicts :: DependencyInfo -> Either String ()
@ -519,15 +527,12 @@ checkForUnitIdConflicts DependencyInfo{..}
]
where
unitIdConflicts = MS.filter ((>=2) . Set.size) . MS.fromListWith Set.union $ concat
[ [ (unitId, Set.singleton (LF.dalfPackageId dalfPkg))
| (unitId, dalfPkg) <- dalfsFromDataDependencies
[ [ (decodedUnitId, Set.singleton (LF.dalfPackageId decodedDalfPkg))
| DecodedDalf{..} <- dalfsFromDataDependencies <> dalfsFromDependencies
]
, [ (unitId, Set.singleton (LF.dalfPackageId dalfPkg))
| (unitId, dalfPkg) <- MS.toList dependenciesInPkgDb
]
, [ (unitId, Set.singleton pkgId)
| (pkgId, (unitId, _)) <- dalfsFromDependencies
]
]
getExposedModules :: Options -> NormalizedFilePath -> IO (MS.Map UnitId (UniqSet GHC.ModuleName))
@ -555,27 +560,59 @@ getExposedModules opts projectRoot = do
GHC.listPackageConfigMap df
getUnitId = GHC.DefiniteUnitId . GHC.DefUnitId . GHC.unitId
getDalfsFromDataDependencies :: Set LF.PackageId -> [FilePath] -> IO [(UnitId, LF.DalfPackage)]
getDalfsFromDataDependencies dependenciesInPkgDb files = do
extractedDars <- mapM extractDar fpDars
-- These are the dalfs that are in a DAR that has been passed in via data-dependencies.
let dalfsFromDars =
[ ( ZipArchive.eRelativePath e
, BSL.toStrict $ ZipArchive.fromEntry e
)
| e <- concatMap edDalfs extractedDars
]
-- These are dalfs that have been passed in directly as DALFs via data-dependencies.
dalfsFromFps <-
-- | data-dependencies accept both DAR files as well as DALFs. The latter
-- is only used in tests and should probably go away at some point.
-- We treat a DALF as a DAR with only that DALF in the main DALF list.
getDarsFromDataDependencies :: Set LF.PackageId -> [FilePath] -> IO [DecodedDar]
getDarsFromDataDependencies dependenciesInPkgDb files = do
dars <- forM fpDars $ \file -> do
extractedDar <- extractDar file
either fail pure (decodeDar dependenciesInPkgDb extractedDar)
dalfs <-
forM fpDalfs $ \fp -> do
bs <- BS.readFile fp
pure (fp, bs)
let allDalfs :: [(FilePath, BS.ByteString)] = dalfsFromDars ++ dalfsFromFps
forM allDalfs $ \(dalfPath, dalf) -> do
decodedDalf <- either fail pure $ decodeDalf dependenciesInPkgDb fp bs
pure (DecodedDar decodedDalf [decodedDalf])
pure (dars ++ dalfs)
where (fpDars, fpDalfs) = partition ((== ".dar") . takeExtension) files
data DecodedDalf = DecodedDalf
{ decodedDalfPkg :: LF.DalfPackage
, decodedUnitId :: UnitId
}
data DecodedDar = DecodedDar
{ mainDalf :: DecodedDalf
, dalfs :: [DecodedDalf]
-- ^ Like in the MANIFEST.MF definition, this includes
-- the main dalf.
}
decodeDar :: Set LF.PackageId -> ExtractedDar -> Either String DecodedDar
decodeDar dependenciesInPkgDb ExtractedDar{..} = do
mainDalf <-
decodeDalf
dependenciesInPkgDb
(ZipArchive.eRelativePath edMain)
(BSL.toStrict $ ZipArchive.fromEntry edMain)
otherDalfs <-
mapM decodeEntry $
filter
(\e -> ZipArchive.eRelativePath e /= ZipArchive.eRelativePath edMain)
edDalfs
let dalfs = mainDalf : otherDalfs
pure DecodedDar{..}
where
decodeEntry entry = decodeDalf
dependenciesInPkgDb
(ZipArchive.eRelativePath entry)
(BSL.toStrict $ ZipArchive.fromEntry entry)
decodeDalf :: Set LF.PackageId -> FilePath -> BS.ByteString -> Either String DecodedDalf
decodeDalf dependenciesInPkgDb path bytes = do
(pkgId, package) <-
either (fail . DA.Pretty.renderPretty) pure $
Archive.decodeArchive Archive.DecodeAsDependency dalf
mapLeft DA.Pretty.renderPretty $
Archive.decodeArchive Archive.DecodeAsDependency bytes
-- daml-prim and daml-stdlib are somewhat special:
--
-- We always have daml-prim and daml-stdlib from the current SDK and we
@ -594,21 +631,19 @@ getDalfsFromDataDependencies dependenciesInPkgDb files = do
-- If the version of daml-prim/daml-stdlib in a data-dependency is the same
-- as the one we are currently compiling against, we dont need to apply this
-- hack.
let (name, mbVersion) = case LF.packageMetadataFromFile dalfPath package pkgId of
(LF.PackageName "daml-prim", Nothing) | pkgId `Set.notMember` dependenciesInPkgDb -> (LF.PackageName ("daml-prim-" <> LF.unPackageId pkgId), Nothing)
(LF.PackageName "daml-stdlib", _) | pkgId `Set.notMember` dependenciesInPkgDb -> (LF.PackageName ("daml-stdlib-" <> LF.unPackageId pkgId), Nothing)
let (name, mbVersion) = case LF.packageMetadataFromFile path package pkgId of
(LF.PackageName "daml-prim", Nothing)
| pkgId `Set.notMember` dependenciesInPkgDb ->
(LF.PackageName ("daml-prim-" <> LF.unPackageId pkgId), Nothing)
(LF.PackageName "daml-stdlib", _)
| pkgId `Set.notMember` dependenciesInPkgDb ->
(LF.PackageName ("daml-stdlib-" <> LF.unPackageId pkgId), Nothing)
(name, mbVersion) -> (name, mbVersion)
pure (pkgNameVersion name mbVersion, LF.DalfPackage pkgId (LF.ExternalPackage pkgId package) dalf)
where (fpDars, fpDalfs) = partition ((== ".dar") . takeExtension) files
pure DecodedDalf
{ decodedDalfPkg = LF.DalfPackage pkgId (LF.ExternalPackage pkgId package) bytes
, decodedUnitId = pkgNameVersion name mbVersion
}
getDalfsFromDependencies :: [ExtractedDar] -> IO [(LF.PackageId, (UnitId, LF.Version))]
getDalfsFromDependencies depsExtracted =
fmap concat $
forM depsExtracted $ \ExtractedDar{..} ->
forM edDalfs $ \zipEntry -> do
let bytes = BSL.toStrict $ ZipArchive.fromEntry zipEntry
(pkgId, pkg) <-
either (fail . DA.Pretty.renderPretty) pure $
Archive.decodeArchive Archive.DecodeAsMain bytes
let (pkgName, mbPkgVer) = LF.packageMetadataFromFile (ZipArchive.eRelativePath zipEntry) pkg pkgId
pure (pkgId, (pkgNameVersion pkgName mbPkgVer, LF.packageLfVersion pkg))
getDarsFromDependencies :: Set LF.PackageId -> [ExtractedDar] -> IO [DecodedDar]
getDarsFromDependencies dependenciesInPkgDb depsExtracted =
either fail pure $ mapM (decodeDar dependenciesInPkgDb) depsExtracted