Improve errors on duplicate record field names (#9010)

* Improve errors on duplicate record field names fixes #8994 changelog_begin changelog_end * Apparently I was wrong about names changelog_begin changelog_end * hlint changelog_begin changelog_end * newlines don’t render well in daml build changelog_begin changelog_end * maybe I should test if my code compiles before pushing changelog_begin changelog_end
digital-asset · Mar 4, 2021 · e542128 · e542128
1 parent 65fbcfe
commit e542128
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 1 deletion.
diff --git a/compiler/damlc/daml-preprocessor/src/DA/Daml/Preprocessor.hs b/compiler/damlc/daml-preprocessor/src/DA/Daml/Preprocessor.hs
@@ -28,6 +28,7 @@ import           Data.List.NonEmpty (NonEmpty ((:|)))
 import qualified Data.List.NonEmpty as NE
 import           Data.List.Extra
 import           Data.Maybe
+import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import           System.FilePath (splitDirectories)
 
@@ -220,7 +221,42 @@ checkRecordConstructor (GHC.L _ m) = mapMaybe getRecordError (GHC.hsmodDecls m)
         , "Possible solution: Change the constructor name to", tyNameStr ]
 
 checkDataTypes :: GHC.ParsedSource -> [(GHC.SrcSpan, String)]
-checkDataTypes m = checkAmbiguousDataTypes m ++ checkUnlabelledConArgs m ++ checkThetas m
+checkDataTypes m = checkAmbiguousDataTypes m ++ checkUnlabelledConArgs m ++ checkThetas m ++ checkDuplicateRecordFields m
+
+checkDuplicateRecordFields :: GHC.ParsedSource -> [(GHC.SrcSpan, String)]
+checkDuplicateRecordFields m =
+    [ err
+    | GHC.L _ con <- universeConDecl m
+    , err <- conErrs (GHC.getConArgs con)
+    ]
+  where
+      conErrs :: GHC.HsConDeclDetails GHC.GhcPs -> [(GHC.SrcSpan, String)]
+      conErrs (GHC.RecCon (GHC.L _ fields)) =
+          let names = map fieldName fields
+              grouped = Map.fromListWith (++) [(GHC.unLoc n, [n]) | n <- names]
+          in concatMap errors (Map.elems grouped)
+      conErrs _ = []
+
+      -- The first field name is the one the user wrote which we want here. Later (there should only ever be 2)
+      -- field names are autogenerated and don’t matter here.
+      fieldName :: GHC.LConDeclField GHC.GhcPs -> GHC.Located GHC.RdrName
+      fieldName (GHC.L _ GHC.ConDeclField { cd_fld_names = (n : _) }) = GHC.rdrNameFieldOcc (GHC.unLoc n)
+      fieldName (GHC.L _ GHC.ConDeclField { cd_fld_names = [] }) =
+          error "Internal error: cd_fld_names should contain exactly one name but got an empty list"
+      fieldName (GHC.L _ (GHC.XConDeclField GHC.NoExt)) = error "Internal error: unexpected XConDeclField"
+      fieldError :: GHC.SrcSpan -> GHC.Located GHC.RdrName -> (GHC.SrcSpan, String)
+      fieldError def (GHC.L l n) =
+          ( l
+          , unwords
+            [ "Duplicate field name " ++ showSDocUnsafe (ppr n) ++ "."
+            , "Original definition at " ++ showSDocUnsafe (ppr def) ++ "."
+            ]
+          )
+      -- the list should always be non-empty but easy enough to handle this case without crashing
+      errors xs = case sortOn GHC.getLoc xs of
+        [] -> []
+        (hd : tl) -> map (fieldError (GHC.getLoc hd)) tl
+
 
 checkAmbiguousDataTypes :: GHC.ParsedSource -> [(GHC.SrcSpan, String)]
 checkAmbiguousDataTypes (GHC.L _ m) =

diff --git a/compiler/damlc/tests/daml-test-files/DuplicateRecordFields.daml b/compiler/damlc/tests/daml-test-files/DuplicateRecordFields.daml
@@ -0,0 +1,20 @@
+-- Copyright (c) 2020, Digital Asset (Switzerland) GmbH and/or its affiliates.
+-- All rights reserved.
+
+-- @ERROR range=12:5-12:6; Duplicate field name a
+-- @ERROR range=13:5-13:6; Duplicate field name a
+-- @ERROR range=17:5-17:6; Duplicate field name b
+
+module DuplicateRecordFields where
+
+data T = T with
+    a : Int
+    a : Bool
+    a : Int
+
+template T with
+    b : Int
+    b : Bool
+    p : Party
+  where
+    signatory p