Handle generic variant records in data-deps. (#4710)

* Handle generic variant records in data-deps.

Fixes issue #4707.

changelog_begin
changelog_end

* Add usage test of problem constructor

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

@@ -388,7 +388,7 @@ generateSrcFromLf env = noLoc mod
             pure [ mkConDecl occName (RecCon (noLoc fields')) ]
         LF.DataVariant cons -> do
             sequence
-                [ mkConDecl (occNameFor conName) . details <$> convType env reexportedClasses ty
+                [ mkConDecl (occNameFor conName) <$> convConDetails ty
                 | (conName, ty) <- cons
                 ]
         LF.DataEnum cons -> do
@@ -414,13 +414,22 @@ generateSrcFromLf env = noLoc mod
             , con_args = details
             }
 
-        -- In DAML we have sums of products, in DAML-LF a variant only has
-        -- a single field. Here we combine them back into a single type.
-        details :: HsType GhcPs -> HsConDeclDetails GhcPs
-        details = \case
-            HsRecTy _ext fs -> RecCon $ noLoc fs
-            ty -> PrefixCon [noLoc ty]
+        convConDetails :: LF.Type -> Gen (HsConDeclDetails GhcPs)
+        convConDetails = \case
 
+            -- | variant record constructor
+            LF.TConApp LF.Qualified{..} _
+                | LF.TypeConName ns <- qualObject
+                , length ns == 2 ->
+                    case MS.lookup ns (sumProdRecords $ envMod env) of
+                        Nothing ->
+                            error $ "Internal error: Could not find generated record type: " <> T.unpack (T.intercalate "." ns)
+                        Just fs ->
+                            RecCon . noLoc <$> mapM (uncurry (mkConDeclField env)) fs
+
+            -- | normal payload
+            ty ->
+                PrefixCon . pure . noLoc <$> convType env reexportedClasses ty
 
     -- imports needed by the module declarations
     imports
@@ -614,11 +623,6 @@ convType env reexported =
                     ghcMod <- genModule env qualPackage qualModule
                     pure . HsTyVar noExt NotPromoted . noLoc
                         . mkOrig ghcMod . mkOccName varName $ T.unpack name
-                n@[_name0, _name1] -> case MS.lookup n (sumProdRecords $ envMod env) of
-                    Nothing ->
-                        error $ "Internal error: Could not find generated record type: " <> T.unpack (T.intercalate "." n)
-                    Just fs ->
-                        HsRecTy noExt <$> mapM (uncurry (mkConDeclField env)) fs
                 cs -> errTooManyNameComponents cs
         LF.TApp ty1 ty2 -> do
             ty1' <- convType env reexported ty1

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

@@ -1287,6 +1287,50 @@ dataDependencyTests damlc repl davlDar oldProjDar = testGroup "Data Dependencies
               , "f = pure () : Proxy ()"
               ]
           withCurrentDirectory (tmpDir </> "top") $ callProcessSilent damlc ["build", "-o", "top.dar"]
+    , testCaseSteps "Generic variants with record constructors" $ \step -> withTempDir $ \tmpDir -> do
+        -- This test checks that data definitions of the form
+        --    data A t = B t | C { x: t, y: t }
+        -- are handled correctly. This is a regression test for issue #4707.
+        step "building project with type definition"
+        createDirectoryIfMissing True (tmpDir </> "type")
+        writeFileUTF8 (tmpDir </> "type" </> "daml.yaml") $ unlines
+            [ "sdk-version: " <> sdkVersion
+            , "name: type"
+            , "source: ."
+            , "version: 0.1.0"
+            , "dependencies: [daml-prim, daml-stdlib]"
+            ]
+        writeFileUTF8 (tmpDir </> "type" </> "Foo.daml") $ unlines
+            [ "daml 1.2"
+            , "module Foo where"
+            , "data A t = B t | C { x: t, y: t }"
+            ]
+        withCurrentDirectory (tmpDir </> "type") $
+            callProcessSilent damlc ["build", "-o", "type.dar"]
+
+        step "building a project that uses it as a data-dependency"
+        createDirectoryIfMissing True (tmpDir </> "proj")
+        writeFileUTF8 (tmpDir </> "proj" </> "daml.yaml") $ unlines
+            [ "sdk-version: " <> sdkVersion
+            , "name: proj"
+            , "source: ."
+            , "version: 0.1.0"
+            , "dependencies: [daml-prim, daml-stdlib]"
+            , "data-dependencies: "
+            , "  - " <> (tmpDir </> "type" </> "type.dar")
+            ]
+        writeFileUTF8 (tmpDir </> "proj" </> "Main.daml") $ unlines
+            [ "daml 1.2"
+            , "module Main where"
+            , "import Foo"
+            , "mkA : A Int"
+            , "mkA = C with"
+            , "  x = 10"
+            , "  y = 20"
+            ]
+        withCurrentDirectory (tmpDir </> "proj") $
+            callProcessSilent damlc ["build"]
+
     ]
 
 -- | Only displays stdout and stderr on errors