mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
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
This commit is contained in:
parent
cde562600c
commit
860477bb1f
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user