Preserve empty variant constructor in data-deps. (#7303)

* Preserve empty variant constructor in data-deps. This fixes #7207 and adds a regression test. In a separate PR I'll add a warning for variants with single argument of unit type and add a changelog entry. changelog_begin changelog_end * Add special case for single constructor variants * Add test for special case
digital-asset · Sep 2, 2020 · a938fd7 · a938fd7
1 parent f2707cc
commit a938fd7
Show file tree

Hide file tree

Showing 2 changed files with 61 additions and 3 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
@@ -450,8 +450,9 @@ generateSrcFromLf env = noLoc mod
             fields' <- mapM (uncurry (mkConDeclField env)) fields
             pure [ mkConDecl occName (RecCon (noLoc fields')) ]
         LF.DataVariant cons -> do
+            let hasExactlyOneConstructor = length cons == 1
             sequence
-                [ mkConDecl (occNameFor conName) <$> convConDetails ty
+                [ mkConDecl (occNameFor conName) <$> convConDetails hasExactlyOneConstructor ty
                 | (conName, ty) <- cons
                 ]
         LF.DataEnum cons -> do
@@ -477,8 +478,15 @@ generateSrcFromLf env = noLoc mod
             , con_args = details
             }
 
-        convConDetails :: LF.Type -> Gen (HsConDeclDetails GhcPs)
-        convConDetails = \case
+        convConDetails :: Bool -> LF.Type -> Gen (HsConDeclDetails GhcPs)
+        convConDetails hasExactlyOneConstructor = \case
+            -- nullary variant constructor (see issue #7207)
+            --
+            -- We translate a variant constructor `C ()` to `C` in DAML. But
+            -- if it's the only constructor, we leave it as `C ()` to distinguish
+            -- it from an enum type.
+            LF.TUnit | not hasExactlyOneConstructor ->
+                pure $ PrefixCon []
 
             -- variant record constructor
             LF.TConApp LF.Qualified{..} _

diff --git a/compiler/damlc/tests/src/DA/Test/Packaging.hs b/compiler/damlc/tests/src/DA/Test/Packaging.hs
@@ -1667,6 +1667,56 @@ dataDependencyTests Tools{damlc,repl,validate,davlDar,oldProjDar} = testGroup "D
         withCurrentDirectory (tmpDir </> "proj") $
             callProcessSilent damlc ["build"]
 
+    , testCaseSteps "Empty variant constructors" $ \step -> withTempDir $ \tmpDir -> do
+        -- This test checks that variant constructors without argument
+        -- are preserved. This is a regression test for issue #7207.
+        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
+            [ "module Foo where"
+            , "data A = B | C Int"
+            , "data D = D ()" -- single-constructor case uses explicit unit
+            ]
+        withCurrentDirectory (tmpDir </> "type") $
+            callProcessSilent damlc ["build", "-o", "type.dar"]
+
+        step "building project that uses it via data-dependencies"
+        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
+            [ "module Main where"
+            , "import Foo"
+            , "mkA : A"
+            , "mkA = B"
+            , "matchA : A -> Int"
+            , "matchA a ="
+            , "  case a of"
+            , "    B -> 0"
+            , "    C n -> n"
+            , "mkD : D"
+            , "mkD = D ()"
+            , "matchD : D -> ()"
+            , "matchD d ="
+            , "  case d of"
+            , "    D () -> ()"
+            ]
+        withCurrentDirectory (tmpDir </> "proj") $
+            callProcessSilent damlc ["build"]
     ]
 
 -- | Check that the given file exists in the dar in the given directory.