Import all dependencies via Pkg_$pkgid (#4696)

Previously, we mapped `dependencies` under
Pkg_$pkgId.originalmodule name and imported them this way. However, we
did not map `dependencies` the same way. This PR unifies the two and
cleans up the import handling logic a bit.

This also fixes imports if we have two packages with the same name but
a different version since the package name (which is the only thing
usable in package-qualified imports) is not sufficient to
disambiguate. I’ve added a test for this.

changelog_begin
changelog_end

compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs

@@ -51,8 +51,9 @@ data Config = Config
         -- ^ maps a package reference to a unit id
     , configSelfPkgId :: LF.PackageId
         -- ^ package id for this package, we need it to build a closed LF.World
-    , configStablePackages :: Set LF.PackageId
-        -- ^ set of package ids for stable packages
+    , configStablePackages :: MS.Map LF.PackageId UnitId
+        -- ^ map from a package id of a stable package to the unit id
+        -- of the corresponding package, i.e., daml-prim/daml-stdlib.
     , configDependencyPackages :: Set LF.PackageId
         -- ^ set of package ids for dependencies (not data-dependencies)
     , configSdkPrefix :: [T.Text]
@@ -157,14 +158,37 @@ isDuplicate env ty1 ty2 =
             esyn2 <- LF.expandTypeSynonyms ty2
             pure (LF.alphaEquiv esyn1 esyn2)
 
+data ImportOrigin = FromCurrentSdk UnitId | FromPackage LF.PackageId
+    deriving (Eq, Ord)
+
 -- | A module reference coming from DAML-LF.
 data ModRef = ModRef
-    { modRefPackageQualify :: Bool
-    -- ^ If True, we use a package-qualified import.
-    , modRefUnitId :: UnitId
-    , modRefModule :: LF.ModuleName
+    { modRefModule :: LF.ModuleName
+    , modRefOrigin :: ImportOrigin
     } deriving (Eq, Ord)
 
+modRefImport :: Config -> ModRef -> LImportDecl GhcPs
+modRefImport Config{..} ModRef{..} = noLoc ImportDecl
+    { ideclSourceSrc = NoSourceText
+    , ideclName = (noLoc . mkModuleName . T.unpack . LF.moduleNameString) modName
+    , ideclPkgQual = Nothing
+    , ideclSource = False
+    , ideclSafe = False
+    , ideclImplicit = False
+    , ideclQualified = False
+    , ideclAs = Nothing
+    , ideclHiding = Nothing
+    , ideclExt = noExt
+    }
+  where
+      modName = case modRefOrigin of
+          FromCurrentSdk _ -> LF.ModuleName (configSdkPrefix <> LF.unModuleName modRefModule)
+          FromPackage importPkgId
+             | importPkgId == configSelfPkgId -> modRefModule
+             -- The module names from the current package are the only ones that are not modified
+             | otherwise -> prefixDependencyModule importPkgId modRefModule
+
+
 -- | Monad for generating a value together with its module references.
 newtype Gen t = Gen (Writer (Set ModRef) t)
     deriving (Functor, Applicative, Monad)
@@ -431,31 +455,10 @@ generateSrcFromLf env = noLoc mod
     -- imports needed by the module declarations
     imports
      =
-        [ noLoc $
-        ImportDecl
-            { ideclExt = noExt
-            , ideclSourceSrc = NoSourceText
-            , ideclName =
-                  noLoc $ mkModuleName $ T.unpack $ LF.moduleNameString modRefModule
-            , ideclPkgQual = do
-                guard modRefPackageQualify -- we don’t do package qualified imports
-                    -- for modules that should come from the current SDK.
-                Just $ StringLiteral NoSourceText $ mkFastString $
-                    -- Package qualified imports for the current package
-                    -- need to use "this" instead of the package id.
-                    if modRefUnitId == unitId
-                        then "this"
-                        else T.unpack . LF.unPackageName . fst $ LF.splitUnitId modRefUnitId
-            , ideclSource = False
-            , ideclSafe = False
-            , ideclImplicit = False
-            , ideclQualified = True
-            , ideclAs = Nothing
-            , ideclHiding = Nothing
-            } :: LImportDecl GhcPs
-        | ModRef{..} <- Set.toList modRefs
+        [ modRefImport config modRef
+        | modRef@ModRef{..} <- Set.toList modRefs
          -- don’t import ourselves
-        , not (modRefModule == lfModName && modRefUnitId == unitId)
+        , not (modRefModule == lfModName && modRefOrigin == FromPackage (configSelfPkgId config))
         -- GHC.Prim doesn’t need to and cannot be explicitly imported (it is not exposed since the interface file is black magic
         -- hardcoded in GHC).
         , modRefModule /= LF.ModuleName ["CurrentSdk", "GHC", "Prim"]
@@ -511,8 +514,8 @@ mkStubBind env lname = do
 
 mkErrorCall :: Env -> String -> Gen (LHsExpr GhcPs)
 mkErrorCall env msg = do
-    ghcErr <- genStableModule env (stringToUnitId "daml-prim") (LF.ModuleName ["GHC", "Err"])
-    dataString <- genStableModule env (stringToUnitId "daml-prim") (LF.ModuleName ["Data", "String"])
+    ghcErr <- genStableModule env primUnitId (LF.ModuleName ["GHC", "Err"])
+    dataString <- genStableModule env primUnitId (LF.ModuleName ["Data", "String"])
     let errorFun = noLoc $ HsVar noExt $ noLoc $ mkOrig ghcErr $ mkOccName varName "error" :: LHsExpr GhcPs
     let fromStringFun = noLoc $ HsVar noExt $ noLoc $ mkOrig dataString $ mkOccName varName "fromString" :: LHsExpr GhcPs
     let errorMsg = noLoc $ HsLit noExt (HsString (SourceText $ show msg) $ mkFastString msg) :: LHsExpr GhcPs
@@ -541,29 +544,31 @@ isConstraint = \case
 genModule :: Env -> LF.PackageRef -> LF.ModuleName -> Gen Module
 genModule env pkgRef modName = do
     let Config{..} = envConfig env
-        (packageQualified, modName') = case pkgRef of
+        origin = case pkgRef of
             LF.PRImport pkgId
-                | pkgId `Set.member` configDependencyPackages -> (False, prefixDependencyModule pkgId modName)
-                | pkgId `Set.member` configStablePackages -> (False, prefixModuleName configSdkPrefix modName)
-            _ -> (True, modName)
-        unitId = configGetUnitId pkgRef
-    genModuleAux packageQualified unitId modName'
+                | Just unitId <- MS.lookup pkgId configStablePackages -> FromCurrentSdk unitId
+                | otherwise -> FromPackage pkgId
+            LF.PRSelf -> FromPackage configSelfPkgId
+    genModuleAux (envConfig env) origin modName
 
 genStableModule :: Env -> UnitId -> LF.ModuleName -> Gen Module
-genStableModule env unitId = genModuleAux False unitId . prefixModuleName (configSdkPrefix $ envConfig env)
+genStableModule env currentSdkPkg = genModuleAux (envConfig env) (FromCurrentSdk currentSdkPkg)
 
 prefixModuleName :: [T.Text] -> LF.ModuleName -> LF.ModuleName
 prefixModuleName prefix (LF.ModuleName mod) = LF.ModuleName (prefix <> mod)
 
 prefixDependencyModule :: LF.PackageId -> LF.ModuleName -> LF.ModuleName
 prefixDependencyModule (LF.PackageId pkgId) = prefixModuleName ["Pkg_" <> pkgId]
 
-genModuleAux :: Bool -> UnitId -> LF.ModuleName -> Gen Module
-genModuleAux isQualified unitId modName = do
-    let ghcModName = mkModuleName . T.unpack $ LF.moduleNameString modName
-        modRef = ModRef isQualified unitId modName
+genModuleAux :: Config -> ImportOrigin -> LF.ModuleName -> Gen Module
+genModuleAux conf origin moduleName = do
+    let modRef = ModRef moduleName origin
+    let ghcModuleName = (unLoc . ideclName . unLoc . modRefImport conf) modRef
+    let unitId = case origin of
+            FromCurrentSdk unitId -> unitId
+            FromPackage pkgId -> configGetUnitId conf (LF.PRImport pkgId)
     emitModRef modRef
-    pure $ mkModule unitId ghcModName
+    pure $ mkModule unitId ghcModuleName
 
 -- | We cannot refer to a class C reexported from the current module M using M.C. Therefore
 -- we have to rewrite it to the original module. The map only contains type synonyms reexported

compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs

@@ -155,7 +155,7 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
               (LF.PackageName "daml-prim", Nothing) | pkgId `Set.notMember` dependencyPkgIds -> (LF.PackageName ("daml-prim-" <> LF.unPackageId pkgId), Nothing)
               (LF.PackageName "daml-stdlib", _) | pkgId `Set.notMember` dependencyPkgIds -> (LF.PackageName ("daml-stdlib-" <> LF.unPackageId pkgId), Nothing)
               (name, mbVersion) -> (name, mbVersion)
-        pure (pkgId, package, dalf, pkgNameVersion name mbVersion)
+        pure (pkgNameVersion name mbVersion, LF.DalfPackage pkgId (LF.ExternalPackage pkgId package) dalf)
 
     -- All transitive packages from DARs specified in  `dependencies`. This is only used for unit-id collision checks.
     transitiveDependencies <- fmap concat $ forM depsExtracted $ \ExtractedDar{..} -> forM edDalfs $ \zipEntry -> do
@@ -167,8 +167,8 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
        pure (pkgId, pkgNameVersion pkgName mbPkgVer)
 
     let unitIdConflicts = MS.filter ((>=2) . Set.size) .  MS.fromListWith Set.union $ concat
-            [ [ (unitId, Set.singleton pkgId)
-              | (pkgId, _package, _dalf, unitId) <- pkgs ]
+            [ [ (unitId, Set.singleton (LF.dalfPackageId dalfPkg))
+              | (unitId, dalfPkg) <- pkgs ]
             , [ (unitId, Set.singleton (LF.dalfPackageId dalfPkg))
               | (unitId, dalfPkg) <- MS.toList dependencies ]
             , [ (unitId, Set.singleton pkgId)
@@ -196,18 +196,18 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
         let pkgIdStr = T.unpack $ LF.unPackageId pkgId
         let (pkgName, mbPkgVersion) = LF.splitUnitId (unitId pkgNode)
         let deps =
-                [ unitIdString (unitId depPkgNode) <.> "dalf"
+                [ (unitId depPkgNode, dalfPackage depPkgNode)
                 | (depPkgNode, depPkgId) <- map vertexToNode $ reachable depGraph vertex
                 , pkgId /= depPkgId
                 , not (depPkgId `Set.member` stablePkgIds)
                 ]
         let workDir = dbPath </> unitIdStr <> "-" <> pkgIdStr
         createDirectoryIfMissing True workDir
         -- write the dalf package
-        BS.writeFile (workDir </> unitIdStr <.> "dalf") $ encodedDalf pkgNode
+        BS.writeFile (workDir </> unitIdStr <.> "dalf") $ LF.dalfPackageBytes (dalfPackage pkgNode)
 
         generateAndInstallIfaceFiles
-            (dalf pkgNode)
+            (LF.extPackagePkg $ LF.dalfPackagePkg $ dalfPackage pkgNode)
             (stubSources pkgNode)
             opts
             workDir
@@ -242,8 +242,8 @@ generateAndInstallIfaceFiles ::
     -> LF.PackageId
     -> LF.PackageName
     -> Maybe LF.PackageVersion
-    -> [String]
-    -> MS.Map UnitId LF.DalfPackage
+    -> [(UnitId, LF.DalfPackage)] -- ^ List of packages referenced by this package.
+    -> MS.Map UnitId LF.DalfPackage -- ^ Map of all packages in `dependencies`.
     -> IO ()
 generateAndInstallIfaceFiles dalf src opts workDir dbPath projectPackageDatabase pkgIdStr pkgName mbPkgVersion deps dependencies = do
     loggerH <- getLogger opts "generate interface files"
@@ -259,7 +259,8 @@ generateAndInstallIfaceFiles dalf src opts workDir dbPath projectPackageDatabase
                   | mod <- NM.toList $ LF.packageModules $ LF.extPackagePkg dalfPackagePkg
                   , let modName = LF.moduleName mod
                   ]
-            | (unitId, LF.DalfPackage{..}) <- MS.toList dependencies]
+            | (unitId, LF.DalfPackage{..}) <- MS.toList dependencies <> deps
+            ]
     opts <-
         pure $ opts
             { optIfaceDir = Nothing
@@ -272,10 +273,7 @@ generateAndInstallIfaceFiles dalf src opts workDir dbPath projectPackageDatabase
             , optGhcCustomOpts = []
             , optPackageImports =
                   baseImports ++
-                  depImps ++
-                  [ exposePackage (GHC.stringToUnitId $ takeBaseName dep) True []
-                  | dep <- deps
-                  ]
+                  depImps
             -- When compiling dummy interface files for a data-dependency,
             -- we know all package flags so we don’t need to infer anything.
             , optInferDependantPackages = InferDependantPackages False
@@ -300,7 +298,9 @@ generateAndInstallIfaceFiles dalf src opts workDir dbPath projectPackageDatabase
                     , pSrc = error "src field was used for creation of pkg conf file"
                     , pExposedModules = Nothing
                     , pVersion = mbPkgVersion
-                    , pDependencies = deps
+                    -- TODO Appending ".dalf" makes no sense but is needed to make `mkConfFile` happy.
+                    -- We should refactor this to allow us to pass unit ids verbatim.
+                    , pDependencies = map (\(unitId, _) -> unitIdString unitId <.> "dalf") deps
                     , pDataDependencies = []
                     , pSdkVersion = error "sdk version field was used for creation of pkg conf file"
                     }
@@ -471,7 +471,7 @@ lfVersionString = DA.Pretty.renderPretty
 
 -- | The graph will have an edge from package A to package B if A depends on B.
 buildLfPackageGraph
-    :: [(LF.PackageId, LF.Package, BS.ByteString, UnitId)]
+    :: [(UnitId, LF.DalfPackage)]
     -> MS.Map (UnitId, LF.ModuleName) LF.DalfPackage
     -> MS.Map UnitId LF.DalfPackage
     -> ( Graph
@@ -482,21 +482,23 @@ 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 [(pkgId, unitId) | (pkgId, _pkg, _bs, unitId) <- pkgs] `MS.union`
-        MS.fromList [(LF.dalfPackageId pkg, unitId) | (unitId, pkg) <- MS.toList dependencyPkgs]
+        MS.fromList [(LF.dalfPackageId pkg, unitId) | (unitId, pkg) <- MS.toList dependencyPkgs <> pkgs]
+
+    packages =
+        MS.fromList
+            [ (LF.dalfPackageId dalfPkg, LF.extPackagePkg $ LF.dalfPackagePkg dalfPkg)
+            | dalfPkg <- MS.elems dependencyPkgs <> MS.elems stablePkgs <> map snd pkgs
+            ]
 
-    packages = MS.unions
-      [ MS.fromList [(pkgId, pkg) | (pkgId, pkg, _, _) <- pkgs]
-      , MS.fromList [(LF.dalfPackageId dalfPkg, LF.extPackagePkg $ LF.dalfPackagePkg dalfPkg) | dalfPkg <- MS.elems dependencyPkgs <> MS.elems stablePkgs]
-      ]
 
     -- order the packages in topological order
     (depGraph, vertexToNode, _keyToVertex) =
         graphFromEdges
-            [ (PackageNode src unitId dalf bs, pkgId, pkgRefs)
-            | (pkgId, dalf, bs, unitId) <- pkgs
-            , let pkgRefs = [ pid | LF.PRImport pid <- toListOf packageRefs dalf ]
-            , let src = generateSrcPkgFromLf (config pkgId unitId) dalf
+            [ (PackageNode src unitId dalfPkg, LF.dalfPackageId dalfPkg, pkgRefs)
+            | (unitId, dalfPkg) <- pkgs
+            , let pkg = LF.extPackagePkg (LF.dalfPackagePkg dalfPkg)
+            , let pkgRefs = [ pid | LF.PRImport pid <- toListOf packageRefs pkg ]
+            , let src = generateSrcPkgFromLf (config (LF.dalfPackageId dalfPkg) unitId) pkg
             ]
     vertexToNode' v = case vertexToNode v of
         -- We don’t care about outgoing edges.
@@ -506,7 +508,7 @@ buildLfPackageGraph pkgs stablePkgs dependencyPkgs = (depGraph, vertexToNode')
         { configPackages = packages
         , configGetUnitId = getUnitId unitId pkgMap
         , configSelfPkgId = pkgId
-        , configStablePackages = Set.fromList $ map LF.dalfPackageId $ MS.elems stablePkgs
+        , configStablePackages = MS.fromList [ (LF.dalfPackageId dalfPkg, unitId) | ((unitId, _), dalfPkg) <- MS.toList stablePkgs ]
         , configDependencyPackages = Set.fromList $ map LF.dalfPackageId $ MS.elems dependencyPkgs
         , configSdkPrefix = [T.pack currentSdkPrefix]
         }
@@ -516,8 +518,7 @@ data PackageNode = PackageNode
   -- ^ Sources for the stub package containining data type definitions
   -- ^ Sources for the package containing instances for Template, Choice, …
   , unitId :: UnitId
-  , dalf :: LF.Package
-  , encodedDalf :: BS.ByteString
+  , dalfPackage :: LF.DalfPackage
   }
 
 currentSdkPrefix :: String

compiler/damlc/tests/src/DA/Test/Packaging.hs

@@ -845,6 +845,7 @@ dataDependencyTests damlc repl davlDar oldProjDar = testGroup "Data Dependencies
 
           step "Validating DAR"
           callProcessSilent repl ["validate", tmpDir </> "b" </> "b.dar"]
+
     , testCaseSteps "Tuples" $ \step -> withTempDir $ \tmpDir -> do
           step "Building dep"
           createDirectoryIfMissing True (tmpDir </> "dep")
@@ -878,6 +879,90 @@ dataDependencyTests damlc repl davlDar oldProjDar = testGroup "Data Dependencies
               , "f (X (a, b)) = a <> show b"
               ]
           withCurrentDirectory (tmpDir </> "proj") $ callProcessSilent damlc ["build", "-o", tmpDir </> "proj" </> "proj.dar"]
+
+    , testCaseSteps "Colliding package names" $ \step -> withTempDir $ \tmpDir -> do
+          forM_ ["1", "2"] $ \version -> do
+              step ("Building 'lib" <> version <> "'")
+              let projDir = tmpDir </> "lib-" <> version
+              createDirectoryIfMissing True projDir
+              writeFileUTF8 (projDir </> "daml.yaml") $ unlines
+                  [ "sdk-version: " <> sdkVersion
+                  , "version: " <> show version
+                  , "name: lib"
+                  , "source: ."
+                  , "dependencies: [daml-prim, daml-stdlib]"
+                  ]
+              writeFileUTF8 (projDir </> "Lib.daml") $ unlines
+                  [ "daml 1.2 module Lib where"
+                  , "data X" <> version <> " = X"
+                  ]
+              withCurrentDirectory projDir $ callProcessSilent damlc ["build", "-o", projDir </> "lib.dar"]
+
+          step "Building a"
+          let projDir = tmpDir </> "a"
+          createDirectoryIfMissing True projDir
+          writeFileUTF8 (projDir </> "daml.yaml") $ unlines
+               [ "sdk-version: " <> sdkVersion
+               , "version: 0.0.0"
+               , "name: a"
+               , "source: ."
+               , "dependencies: [daml-prim, daml-stdlib]"
+               , "data-dependencies:"
+               , "- " <> show (tmpDir </> "lib-1" </> "lib.dar")
+               ]
+          writeFileUTF8 (projDir </> "A.daml") $ unlines
+              [ "daml 1.2 module A where"
+              , "import Lib"
+              , "data A = A X1"
+              ]
+          withCurrentDirectory projDir $ callProcessSilent damlc ["build", "-o", projDir </> "a.dar"]
+
+          step "Building b"
+          let projDir = tmpDir </> "b"
+          createDirectoryIfMissing True projDir
+          writeFileUTF8 (projDir </> "daml.yaml") $ unlines
+               [ "sdk-version: " <> sdkVersion
+               , "version: 0.0.0"
+               , "name: b"
+               , "source: ."
+               , "dependencies: [daml-prim, daml-stdlib]"
+               , "data-dependencies:"
+               , "- " <> show (tmpDir </> "lib-2" </> "lib.dar")
+               , "- " <> show (tmpDir </> "a" </> "a.dar")
+               ]
+          writeFileUTF8 (projDir </> "B.daml") $ unlines
+              [ "daml 1.2 module B where"
+              , "import Lib"
+              , "import A"
+              , "data B1 = B1 A"
+              , "data B2 = B2 X2"
+              ]
+          withCurrentDirectory projDir $ callProcessSilent damlc ["build", "-o", projDir </> "b.dar"]
+
+          -- At this point b has references to both lib-1 and lib-2 in its transitive dependency closure.
+          -- Now try building `c` which references `b` as a `data-dependency` and see if it
+          -- manages to produce an import of `Lib` for the dummy interface of `B` that resolves correctly.
+          step "Building c"
+          let projDir = tmpDir </> "c"
+          createDirectoryIfMissing True projDir
+          writeFileUTF8 (projDir </> "daml.yaml") $ unlines
+               [ "sdk-version: " <> sdkVersion
+               , "version: 0.0.0"
+               , "name: c"
+               , "source: ."
+               , "dependencies: [daml-prim, daml-stdlib]"
+               , "data-dependencies:"
+               , "- " <> show (tmpDir </> "b" </> "b.dar")
+               , "- " <> show (tmpDir </> "lib-2" </> "lib.dar")
+               ]
+          writeFileUTF8 (projDir </> "C.daml") $ unlines
+              [ "daml 1.2 module C where"
+              , "import B"
+              , "import Lib"
+              , "f : B2 -> X2"
+              , "f (B2 x) = x"
+              ]
+          withCurrentDirectory projDir $ callProcessSilent damlc ["build", "-o", projDir </> "c.dar"]
     ] <>
     [ testCase ("Dalf imports (withArchiveChoice=" <> show withArchiveChoice <> ")") $ withTempDir $ \projDir -> do
         let genSimpleDalfExe