Skip to content

Commit

Permalink
Flavor keyword adds corresponding Daml{Record,Variant,Enum} constrain…
Browse files Browse the repository at this point in the history
…t to data type dumb theta
  • Loading branch information
moisesackerman-da committed Mar 27, 2024
1 parent 8aa6af7 commit b5d1d4c
Showing 1 changed file with 20 additions and 5 deletions.
25 changes: 20 additions & 5 deletions compiler/parser/RdrHsSyn.hs
Original file line number Diff line number Diff line change
Expand Up @@ -268,6 +268,15 @@ data DataFlavor
| FlavorVariant
| FlavorEnum

dataFlavorToCxt :: Located DataFlavor -> LHsContext GhcPs
dataFlavorToCxt (L loc flavor) =
L loc [rdrNameToType . L loc . qualifyDesugar . mkClsOcc $ flavorString]
where
flavorString = case flavor of
FlavorRecord -> "DamlRecord"
FlavorVariant -> "DamlVariant"
FlavorEnum -> "DamlEnum"

mkFlavoredTyData ::
SrcSpan
-> NewOrFlavoredData
Expand All @@ -277,13 +286,19 @@ mkFlavoredTyData ::
-> [LConDecl GhcPs]
-> HsDeriving GhcPs
-> P (LTyClDecl GhcPs)
mkFlavoredTyData loc new_or_flavored_data cType hdr ksig data_cons maybe_deriv =
mkFlavoredTyData loc new_or_flavored_data cType hdr' ksig data_cons maybe_deriv =
mkTyData loc new_or_data cType hdr ksig data_cons maybe_deriv
where
new_or_data = case new_or_flavored_data of
UnflavoredNewType -> NewType
UnflavoredDataType -> DataType
FlavoredDataType {} -> DataType
(new_or_data, hdr) = case new_or_flavored_data of
UnflavoredNewType -> (NewType, hdr')
UnflavoredDataType -> (DataType, hdr')
FlavoredDataType flavor ->
let L hdrLoc (mCxt, tycl_hdr) = hdr'
L userCxtLoc userCxt = fromMaybe (noLoc []) mCxt
L flavorCxtLoc flavorCxt = dataFlavorToCxt flavor
fullCxt = L (combineSrcSpans userCxtLoc flavorCxtLoc) (userCxt ++ flavorCxt)
flavoredHdr = L hdrLoc (Just fullCxt, tycl_hdr)
in (DataType, flavoredHdr)

mkTyData :: SrcSpan
-> NewOrData
Expand Down

0 comments on commit b5d1d4c

Please sign in to comment.