Avoid including daml-stdlib and daml-prim twice (digital-asset#4222)

This fixes digital-asset#4114 and cleans up the situation around `data-dependencies` and `dependencies` as described in digital-asset#4218. There is still more work to be done here mostly around ironing out all the edge cases and producing useful error messages instead of silentely doing the wrong thing but I’ll leave that to a separate PR. To test this, I’ve fixed the packaging tests to no longer deduplicate package ids (which means they would return the wrong number if daml-prim ends up in there twice) and I addded a test where we have 3 projects: - `lib` - `a` which depends on `lib` - `b` which depends on `lib` via `dependencies` and 'a' via `data-dependencies`. changelog_begin changelog_end
axman6 · Jan 27, 2020 · 40292c2 · 40292c2
1 parent 830c2c6
commit 40292c2
Show file tree

Hide file tree

Showing 4 changed files with 115 additions and 33 deletions.
diff --git a/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs b/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs
@@ -11,6 +11,8 @@ import Control.Lens (toListOf)
 import Control.Lens.MonoTraversal (monoTraverse)
 import Control.Monad
 import Data.List.Extra
+import Data.Set (Set)
+import qualified Data.Set as Set
 import qualified Data.Map.Strict as MS
 import Data.Maybe
 import qualified Data.NameMap as NM
@@ -40,7 +42,7 @@ import SdkVersion
 data Env = Env
     { envPkgs :: MS.Map UnitId LF.Package
     , envGetUnitId :: LF.PackageRef -> UnitId
-    , envStablePackages :: MS.Map LF.PackageId (UnitId, LF.ModuleName)
+    , envStablePackages :: Set LF.PackageId
     , envQualify :: Bool
     , envSdkPrefix :: Maybe String
     , envMod :: LF.Module
@@ -165,7 +167,7 @@ generateSrcFromLf env = noLoc mod
         , modRef /= LF.ModuleName ["CurrentSdk", "GHC", "Prim"]
         ]
     isStable LF.PRSelf = False
-    isStable (LF.PRImport pkgId) = pkgId `MS.member` envStablePackages env
+    isStable (LF.PRImport pkgId) = pkgId `Set.member` envStablePackages env
 
     modRefs :: [(Bool, GHC.UnitId, LF.ModuleName)]
     modRefs = nubSort . concat . concat $
@@ -340,7 +342,7 @@ convType env =
 addSdkPrefixIfStable :: Env -> LF.PackageRef -> LF.ModuleName -> LF.ModuleName
 addSdkPrefixIfStable _ LF.PRSelf mod = mod
 addSdkPrefixIfStable env (LF.PRImport pkgId) m@(LF.ModuleName n)
-    | pkgId `MS.member` envStablePackages env
+    | pkgId `Set.member` envStablePackages env
     = LF.ModuleName (sdkPrefix ++ n)
 
     | otherwise
@@ -438,7 +440,7 @@ mkTyConTypeUnqual = mkTyConType False
 generateSrcPkgFromLf ::
        MS.Map UnitId LF.Package
     -> (LF.PackageRef -> UnitId)
-    -> MS.Map LF.PackageId (UnitId, LF.ModuleName)
+    -> Set LF.PackageId
     -> Maybe String
     -> LF.Package
     -> [(NormalizedFilePath, String)]
@@ -485,7 +487,7 @@ genericInstances env externPkgId =
 
 generateGenInstancesPkgFromLf ::
        (LF.PackageRef -> UnitId)
-    -> MS.Map LF.PackageId (UnitId, LF.ModuleName)
+    -> Set LF.PackageId
     -> Maybe String
     -> LF.PackageId
     -> LF.Package

diff --git a/compiler/damlc/lib/DA/Cli/Damlc.hs b/compiler/damlc/lib/DA/Cli/Damlc.hs
@@ -828,10 +828,8 @@ execGenerateSrc opts dalfOrDar mbOutDir = Command GenerateSrc Nothing effect
                 [ (LF.dalfPackageId dalfPkg, unitId)
                 | (unitId, dalfPkg) <- allDalfPkgs ]
 
-            stablePkgIds :: MS.Map LF.PackageId (UnitId, LF.ModuleName)
-            stablePkgIds = MS.fromList
-                [ (LF.dalfPackageId dalfPkg, k)
-                | (k, dalfPkg) <- MS.toList stableDalfPkgMap ]
+            stablePkgIds :: Set.Set LF.PackageId
+            stablePkgIds = Set.fromList $ map LF.dalfPackageId $ MS.elems stableDalfPkgMap
 
             genSrcs = generateSrcPkgFromLf pkgMap (getUnitId unitId unitIdMap) stablePkgIds (Just "CurrentSdk") pkg
 
@@ -870,7 +868,7 @@ execGenerateGenSrc darFp mbQual outDir = Command GenerateGenerics Nothing effect
             decode $ BSL.toStrict $ ZipArchive.fromEntry mainDalfEntry
         let getUid = getUnitId unitId pkgMap
         -- TODO Passing MS.empty is not right but this command is only used for debugging so for now this is fine.
-        let genSrcs = generateGenInstancesPkgFromLf getUid MS.empty Nothing mainPkgId mainLfPkg (fromMaybe "" mbQual)
+        let genSrcs = generateGenInstancesPkgFromLf getUid Set.empty Nothing mainPkgId mainLfPkg (fromMaybe "" mbQual)
         forM_ genSrcs $ \(path, src) -> do
             let fp = fromMaybe "" outDir </> fromNormalizedFilePath path
             createDirectoryIfMissing True $ takeDirectory fp

diff --git a/compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs b/compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs
@@ -25,6 +25,8 @@ import Data.Graph
 import Data.List.Extra
 import qualified Data.Map.Strict as MS
 import Data.Maybe
+import Data.Set (Set)
+import qualified Data.Set as Set
 import qualified Data.Text.Extended as T
 import Development.IDE.Core.Service (runAction)
 import Development.IDE.Core.Shake
@@ -79,14 +81,36 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
 
     deps <- expandSdkPackages (filter (`notElem` basePackages) deps)
     depsExtracted <- mapM extractDar deps
+
     let uniqSdkVersions = nubSort $ unPackageSdkVersion thisSdkVer : map edSdkVersions depsExtracted
     let depsSdkVersions = map edSdkVersions depsExtracted
     unless (all (== unPackageSdkVersion thisSdkVer) depsSdkVersions) $
            fail $
            "Package dependencies from different SDK versions: " ++
            intercalate ", " uniqSdkVersions
 
-    -- deal with data imports first
+    -- Register deps at the very beginning. This allows data-dependencies to
+    -- depend on dependencies which is necessary so that we can reconstruct typeclass
+    -- instances for a typeclass defined in a library.
+    -- It does mean that we can’t have a dependency from a dependency on a
+    -- data-dependency but that seems acceptable.
+    -- See https://github.com/digital-asset/daml/issues/4218 for more details.
+    -- TODO Enforce this with useful error messages
+    forM_ depsExtracted $
+        \ExtractedDar{..} -> installDar dbPath edConfFiles edDalfs edSrcs
+
+    loggerH <- getLogger opts "generate package maps"
+    -- mkOptions is necessary to pick up the proper packagedb paths.
+    stablePkgsOpts <- mkOptions opts
+    (stablePkgs, dependencies) <- withDamlIdeState stablePkgsOpts loggerH diagnosticsLogger $ \ide -> runAction ide $
+        (,) <$> useNoFile_ GenerateStablePackages <*> useNoFile_ GeneratePackageMap
+    let stablePkgIds :: Set LF.PackageId
+        stablePkgIds = Set.fromList $ map LF.dalfPackageId $ MS.elems stablePkgs
+    -- This includes both SDK dependencies like daml-prim and daml-stdlib but also DARs specified
+    -- in the dependencies field.
+    let dependencyPkgIds = Set.fromList $ map LF.dalfPackageId $ MS.elems dependencies
+
+    -- Now handle data imports.
     let (fpDars, fpDalfs) = partition ((== ".dar") . takeExtension) dataDeps
     dars <- mapM extractDar fpDars
     -- These are the dalfs that are in a DAR that has been passed in via data-dependencies.
@@ -117,22 +141,21 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
         -- one of them), we instead include the package hash in the unit id.
         --
         -- In principle, we can run into the same issue if you combine "dependencies"
-        -- (which have precompiled interface files with uncontrollable unit ids) and
-        -- "data-dependencies" but given that our long-term goal is to kill "dependencies"
-        -- completely, we ignore that for now.
+        -- (which have precompiled interface files) and
+        -- "data-dependencies". However, there you can get away with changing the
+        -- package name and version to change the unit id which is not possible for
+        -- daml-prim.
+        --
+        -- If the version of daml-prim/daml-stdlib in a data-dependency is the same
+        -- as the one we are currently compiling against, we don’t need to apply this
+        -- hack.
         let parsedUnitId = parseUnitId name pkgId
         let unitId = stringToUnitId $ case splitUnitId parsedUnitId of
-              ("daml-prim", Nothing) -> "daml-prim-" <> T.unpack (LF.unPackageId pkgId)
-              ("daml-stdlib", _) -> "daml-stdlib-" <> T.unpack (LF.unPackageId pkgId)
+              ("daml-prim", Nothing) | pkgId `Set.notMember` dependencyPkgIds -> "daml-prim-" <> T.unpack (LF.unPackageId pkgId)
+              ("daml-stdlib", _) | pkgId `Set.notMember` dependencyPkgIds -> "daml-stdlib-" <> T.unpack (LF.unPackageId pkgId)
               _ -> parsedUnitId
         pure (pkgId, package, dalf, unitId)
 
-    loggerH <- getLogger opts "generate stable packages"
-    stablePkgsOpts <- mkOptions opts
-    stablePkgs <- withDamlIdeState stablePkgsOpts loggerH diagnosticsLogger $ \ide -> do
-        runAction ide $ useNoFile_ GenerateStablePackages
-    let stablePkgIds = MS.fromList $ map (\(k, pkg) -> (LF.dalfPackageId pkg, k)) $ MS.toList stablePkgs
-
     let (depGraph, vertexToNode) = buildLfPackageGraph pkgs stablePkgIds
     -- Iterate over the dependency graph in topological order.
     -- We do a topological sort on the transposed graph which ensures that
@@ -142,7 +165,7 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
       let (pkgNode, pkgId) = vertexToNode vertex in
       -- stable packages are mapped to the current version of daml-prim/daml-stdlib
       -- so we don’t need to generate interface files for them.
-      unless (pkgId `MS.member` stablePkgIds) $ do
+      unless (pkgId `Set.member` stablePkgIds || pkgId `Set.member` dependencyPkgIds) $ do
         let unitIdStr = unitIdString $ unitId pkgNode
         let _instancesUnitIdStr = "instances-" <> unitIdStr
         let pkgIdStr = T.unpack $ LF.unPackageId pkgId
@@ -151,7 +174,7 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
                 [ unitIdString (unitId depPkgNode) <.> "dalf"
                 | (depPkgNode, depPkgId) <- map vertexToNode $ reachable depGraph vertex
                 , pkgId /= depPkgId
-                , not (depPkgId `MS.member` stablePkgIds)
+                , not (depPkgId `Set.member` stablePkgIds)
                 ]
         let workDir = dbPath </> unitIdStr <> "-" <> pkgIdStr
         createDirectoryIfMissing True workDir
@@ -171,10 +194,6 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
             mbPkgVersion
             deps
 
-    -- finally install the dependecies
-    forM_ depsExtracted $
-        \ExtractedDar{..} -> installDar dbPath edConfFiles edDalfs edSrcs
-
 -- generate interface files and install them in the package database
 generateAndInstallIfaceFiles ::
        LF.Package
@@ -476,7 +495,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)]
-    -> MS.Map LF.PackageId (UnitId, LF.ModuleName)
+    -> Set LF.PackageId
     -> ( Graph
        , Vertex -> (PackageNode, LF.PackageId)
        )

diff --git a/compiler/damlc/tests/src/DA/Test/Packaging.hs b/compiler/damlc/tests/src/DA/Test/Packaging.hs
@@ -579,10 +579,7 @@ dataDependencyTests damlc repl davlDar = testGroup "Data Dependencies" $
           callProcessSilent repl ["validate", projb </> "projb.dar"]
           projbPkgIds <- darPackageIds (projb </> "projb.dar")
           -- daml-prim, daml-stdlib for targetLfVer, daml-prim, daml-stdlib for depLfVer if targetLfVer /= depLfVer, proja and projb
-          -- TODO We should not need nubOrd here. This is currently required since we include the daml-stdlib and daml-prim
-          -- dalfs twice. This is not a problem but wasteful and useless.
-          -- See https://github.com/digital-asset/daml/issues/4114
-          length (nubOrd projbPkgIds) @?= numStablePackages
+          length projbPkgIds @?= numStablePackages
             targetLfVer + 2 + (if targetLfVer /= depLfVer then 2 else 0) + 1 + 1
           length (filter (`notElem` projaPkgIds) projbPkgIds) @?=
               (numStablePackages targetLfVer - numStablePackages depLfVer) + -- new stable packages
@@ -644,6 +641,72 @@ dataDependencyTests damlc repl davlDar = testGroup "Data Dependencies" $
           callProcessSilent repl ["validate", tmpDir </> "foobar.dar"]
           step "Testing scenario"
           callProcessSilent repl ["test", "Main:test", tmpDir </> "foobar.dar"]
+    , testCaseSteps "Mixed dependencies and data-dependencies" $ \step -> withTempDir $ \tmpDir -> do
+          step "Building 'lib'"
+          createDirectoryIfMissing True (tmpDir </> "lib")
+          writeFileUTF8 (tmpDir </> "lib" </> "daml.yaml") $ unlines
+              [ "sdk-version: " <> sdkVersion
+              , "version: 0.0.1"
+              , "name: lib"
+              , "source: ."
+              , "dependencies: [daml-prim, daml-stdlib]"
+              ]
+          writeFileUTF8 (tmpDir </> "lib" </> "Lib.daml") $ unlines
+              [ "daml 1.2 module Lib where"
+              , "inc : Int -> Int"
+              , "inc = (+ 1)"
+              ]
+          withCurrentDirectory (tmpDir </> "lib") $ callProcessSilent damlc ["build", "-o", tmpDir </> "lib" </> "lib.dar"]
+          libPackageIds <- darPackageIds (tmpDir </> "lib" </> "lib.dar")
+
+          step "Building 'a'"
+          createDirectoryIfMissing True (tmpDir </> "a")
+          writeFileUTF8 (tmpDir </> "a" </> "daml.yaml") $ unlines
+              [ "sdk-version: " <> sdkVersion
+              , "version: 0.0.1"
+              , "name: a"
+              , "source: ."
+              , "dependencies:"
+              , "  - daml-prim"
+              , "  - daml-stdlib"
+              , "  - " <> show (tmpDir </> "lib" </> "lib.dar")
+              ]
+          writeFileUTF8 (tmpDir </> "a" </> "A.daml") $ unlines
+              [ "daml 1.2 module A where"
+              , "import Lib"
+              , "two : Int"
+              , "two = inc 1"
+              ]
+          withCurrentDirectory (tmpDir </> "a") $ callProcessSilent damlc ["build", "-o", tmpDir </> "a" </> "a.dar"]
+          aPackageIds <- darPackageIds (tmpDir </> "a" </> "a.dar")
+          length aPackageIds @?= length libPackageIds + 1
+
+          step "Building 'b'"
+          createDirectoryIfMissing True (tmpDir </> "b")
+          writeFileUTF8 (tmpDir </> "b" </> "daml.yaml") $ unlines
+              [ "sdk-version: " <> sdkVersion
+              , "version: 0.0.1"
+              , "name: b"
+              , "source: ."
+              , "dependencies:"
+              , "  - daml-prim"
+              , "  - daml-stdlib"
+              , "  - " <> show (tmpDir </> "lib" </> "lib.dar")
+              , "data-dependencies: [" <> show (tmpDir </> "a" </> "a.dar") <> "]"
+              ]
+          writeFileUTF8 (tmpDir </> "b" </> "B.daml") $ unlines
+              [ "daml 1.2 module B where"
+              , "import Lib"
+              , "import A"
+              , "three : Int"
+              , "three = inc two"
+              ]
+          withCurrentDirectory (tmpDir </> "b") $ callProcessSilent damlc ["build", "-o", tmpDir </> "b" </> "b.dar"]
+          projbPackageIds <- darPackageIds (tmpDir </> "b" </> "b.dar")
+          length projbPackageIds @?= length libPackageIds + 2
+
+          step "Validating DAR"
+          callProcessSilent repl ["validate", tmpDir </> "b" </> "b.dar"]
     ] <>
     [ testCaseSteps "Source generation edge cases" $ \step -> withTempDir $ \tmpDir -> do
       writeFileUTF8 (tmpDir </> "Foo.daml") $ unlines