Merge branch 'master' into pipe-include-module-two

Author: nojaf

CHANGELOG.md

@@ -24,6 +24,7 @@
 - `rescript-tools doc` no longer includes shadowed bindings in its output. https://github.com/rescript-lang/rescript/pull/7497
 - Treat `throw` like `raise` in analysis. https://github.com/rescript-lang/rescript/pull/7521
 - Fix `index out of bounds` exception thrown in rare cases by `rescript-editor-analysis.exe codeAction` command. https://github.com/rescript-lang/rescript/pull/7523
+- Don't produce duplicate type definitions for recursive types on hover. https://github.com/rescript-lang/rescript/pull/7524
 
 #### :nail_care: Polish
 
@@ -35,6 +36,7 @@
 - Remove deprecated pipe last (`|>`) syntax. https://github.com/rescript-lang/rescript/pull/7512
 - Improve error message for pipe (`->`) syntax. https://github.com/rescript-lang/rescript/pull/7520
 - Improve a few error messages around various subtyping issues. https://github.com/rescript-lang/rescript/pull/7404
+- Refactor the ast for record expressions and patterns. https://github.com/rescript-lang/rescript/pull/7528
 - Editor: add completions from included modules. https://github.com/rescript-lang/rescript/pull/7515
 
 # 12.0.0-alpha.13

analysis/src/CompletionExpressions.ml

@@ -59,23 +59,21 @@ let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos
   | Pexp_record (fields, _) -> (
     let fieldWithCursor = ref None in
     let fieldWithExprHole = ref None in
-    fields
-    |> List.iter (fun (fname, exp, _) ->
-           match
-             ( fname.Location.txt,
-               exp.Parsetree.pexp_loc |> CursorPosition.classifyLoc ~pos )
-           with
-           | Longident.Lident fname, HasCursor ->
-             fieldWithCursor := Some (fname, exp)
-           | Lident fname, _ when isExprHole exp ->
-             fieldWithExprHole := Some (fname, exp)
-           | _ -> ());
+    Ext_list.iter fields (fun {lid = fname; x = exp} ->
+        match
+          ( fname.Location.txt,
+            exp.Parsetree.pexp_loc |> CursorPosition.classifyLoc ~pos )
+        with
+        | Longident.Lident fname, HasCursor ->
+          fieldWithCursor := Some (fname, exp)
+        | Lident fname, _ when isExprHole exp ->
+          fieldWithExprHole := Some (fname, exp)
+        | _ -> ());
     let seenFields =
-      fields
-      |> List.filter_map (fun (fieldName, _f, _) ->
-             match fieldName with
-             | {Location.txt = Longident.Lident fieldName} -> Some fieldName
-             | _ -> None)
+      Ext_list.filter_map fields (fun {lid = fieldName} ->
+          match fieldName with
+          | {Location.txt = Longident.Lident fieldName} -> Some fieldName
+          | _ -> None)
     in
     match (!fieldWithCursor, !fieldWithExprHole) with
     | Some (fname, f), _ | None, Some (fname, f) -> (

analysis/src/CompletionFrontEnd.ml

@@ -518,16 +518,15 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
           :: patternPath)
         ?contextPath p
     | Ppat_record (fields, _) ->
-      fields
-      |> List.iter (fun (fname, p, _) ->
-             match fname with
-             | {Location.txt = Longident.Lident fname} ->
-               scopePattern
-                 ~patternPath:
-                   (Completable.NFollowRecordField {fieldName = fname}
-                   :: patternPath)
-                 ?contextPath p
-             | _ -> ())
+      Ext_list.iter fields (fun {lid = fname; x = p} ->
+          match fname with
+          | {Location.txt = Longident.Lident fname} ->
+            scopePattern
+              ~patternPath:
+                (Completable.NFollowRecordField {fieldName = fname}
+                :: patternPath)
+              ?contextPath p
+          | _ -> ())
     | Ppat_array pl ->
       pl
       |> List.iter
@@ -932,7 +931,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
                    ( {
                        pexp_desc =
                          Pexp_record
-                           (({txt = Lident "from"}, fromExpr, _) :: _, _);
+                           ({lid = {txt = Lident "from"}; x = fromExpr} :: _, _);
                      },
                      _ );
              };

analysis/src/CompletionPatterns.ml

@@ -110,24 +110,21 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor
   | Ppat_record (fields, _) -> (
     let fieldWithCursor = ref None in
     let fieldWithPatHole = ref None in
-    fields
-    |> List.iter (fun (fname, f, _) ->
-           match
-             ( fname.Location.txt,
-               f.Parsetree.ppat_loc
-               |> CursorPosition.classifyLoc ~pos:posBeforeCursor )
-           with
-           | Longident.Lident fname, HasCursor ->
-             fieldWithCursor := Some (fname, f)
-           | Lident fname, _ when isPatternHole f ->
-             fieldWithPatHole := Some (fname, f)
-           | _ -> ());
+    Ext_list.iter fields (fun {lid = fname; x = f} ->
+        match
+          ( fname.Location.txt,
+            f.Parsetree.ppat_loc
+            |> CursorPosition.classifyLoc ~pos:posBeforeCursor )
+        with
+        | Longident.Lident fname, HasCursor -> fieldWithCursor := Some (fname, f)
+        | Lident fname, _ when isPatternHole f ->
+          fieldWithPatHole := Some (fname, f)
+        | _ -> ());
     let seenFields =
-      fields
-      |> List.filter_map (fun (fieldName, _f, _) ->
-             match fieldName with
-             | {Location.txt = Longident.Lident fieldName} -> Some fieldName
-             | _ -> None)
+      Ext_list.filter_map fields (fun {lid = fieldName} ->
+          match fieldName with
+          | {Location.txt = Longident.Lident fieldName} -> Some fieldName
+          | _ -> None)
     in
     match (!fieldWithCursor, !fieldWithPatHole) with
     | Some (fname, f), _ | None, Some (fname, f) -> (

analysis/src/DumpAst.ml

@@ -103,13 +103,12 @@ let rec printPattern pattern ~pos ~indentation =
     "Ppat_record(\n"
     ^ addIndentation (indentation + 1)
     ^ "fields:\n"
-    ^ (fields
-      |> List.map (fun ((Location.{txt} as loc), pat, _) ->
-             addIndentation (indentation + 2)
-             ^ (loc |> printLocDenominatorLoc ~pos)
-             ^ (Utils.flattenLongIdent txt |> ident |> str)
-             ^ ": "
-             ^ printPattern pat ~pos ~indentation:(indentation + 2))
+    ^ (Ext_list.map fields (fun {lid; x = pat} ->
+           addIndentation (indentation + 2)
+           ^ (lid |> printLocDenominatorLoc ~pos)
+           ^ (Utils.flattenLongIdent lid.txt |> ident |> str)
+           ^ ": "
+           ^ printPattern pat ~pos ~indentation:(indentation + 2))
       |> String.concat "\n")
     ^ "\n" ^ addIndentation indentation ^ ")"
   | Ppat_tuple patterns ->
@@ -244,13 +243,12 @@ and printExprItem expr ~pos ~indentation =
     "Pexp_record(\n"
     ^ addIndentation (indentation + 1)
     ^ "fields:\n"
-    ^ (fields
-      |> List.map (fun ((Location.{txt} as loc), expr, _) ->
-             addIndentation (indentation + 2)
-             ^ (loc |> printLocDenominatorLoc ~pos)
-             ^ (Utils.flattenLongIdent txt |> ident |> str)
-             ^ ": "
-             ^ printExprItem expr ~pos ~indentation:(indentation + 2))
+    ^ (Ext_list.map fields (fun {lid; x = expr} ->
+           addIndentation (indentation + 2)
+           ^ (lid |> printLocDenominatorLoc ~pos)
+           ^ (Utils.flattenLongIdent lid.txt |> ident |> str)
+           ^ ": "
+           ^ printExprItem expr ~pos ~indentation:(indentation + 2))
       |> String.concat "\n")
     ^ "\n" ^ addIndentation indentation ^ ")"
   | Pexp_tuple exprs ->

analysis/src/Hint.ml

@@ -44,7 +44,7 @@ let inlay ~path ~pos ~maxLength ~debug =
     match pat.ppat_desc with
     | Ppat_tuple pl -> pl |> List.iter processPattern
     | Ppat_record (fields, _) ->
-      fields |> List.iter (fun (_, p, _) -> processPattern p)
+      Ext_list.iter fields (fun {x = p} -> processPattern p)
     | Ppat_array fields -> fields |> List.iter processPattern
     | Ppat_var {loc} -> push loc Type
     | _ -> ()

analysis/src/Hover.ml

@@ -1,5 +1,7 @@
 open SharedTypes
 
+module StringSet = Set.Make (String)
+
 let showModuleTopLevel ~docstring ~isType ~name (topLevel : Module.item list) =
   let contents =
     topLevel
@@ -115,7 +117,18 @@ let expandTypes ~file ~package ~supportsMarkdownLinks typ =
       ],
       `InlineType )
   | all ->
+    let typesSeen = ref StringSet.empty in
+    let typeId ~(env : QueryEnv.t) ~name =
+      env.file.moduleName :: List.rev (name :: env.pathRev) |> String.concat "."
+    in
     ( all
+      (* Don't produce duplicate type definitions for recursive types *)
+      |> List.filter (fun {env; name} ->
+             let typeId = typeId ~env ~name in
+             if StringSet.mem typeId !typesSeen then false
+             else (
+               typesSeen := StringSet.add typeId !typesSeen;
+               true))
       |> List.map (fun {decl; env; loc; path} ->
              let linkToTypeDefinitionStr =
                if

analysis/src/SemanticTokens.ml

@@ -223,9 +223,8 @@ let command ~debug ~emitter ~path =
       (* Don't emit true or false *)
       Ast_iterator.default_iterator.pat iterator p
     | Ppat_record (cases, _) ->
-      cases
-      |> List.iter (fun (label, _, _) ->
-             emitter |> emitRecordLabel ~label ~debug);
+      Ext_list.iter cases (fun {lid = label} ->
+          emitter |> emitRecordLabel ~label ~debug);
       Ast_iterator.default_iterator.pat iterator p
     | Ppat_construct (name, _) ->
       emitter |> emitVariant ~name ~debug;
@@ -320,12 +319,11 @@ let command ~debug ~emitter ~path =
       emitter |> emitFromLoc ~loc ~type_:Operator;
       Ast_iterator.default_iterator.expr iterator e
     | Pexp_record (cases, _) ->
-      cases
-      |> List.filter_map (fun ((label : Longident.t Location.loc), _, _) ->
-             match label.txt with
-             | Longident.Lident s when not (Utils.isFirstCharUppercase s) ->
-               Some label
-             | _ -> None)
+      Ext_list.filter_map cases (fun {lid} ->
+          match lid.txt with
+          | Longident.Lident s when not (Utils.isFirstCharUppercase s) ->
+            Some lid
+          | _ -> None)
       |> List.iter (fun label -> emitter |> emitRecordLabel ~label ~debug);
       Ast_iterator.default_iterator.expr iterator e
     | Pexp_field (_, label) | Pexp_setfield (_, label, _) ->

analysis/src/SignatureHelp.ml

@@ -629,10 +629,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                   fields
                   |> List.find_map
                        (fun
-                         (({loc; txt}, expr, _) :
-                           Longident.t Location.loc
-                           * Parsetree.expression
-                           * bool)
+                         ({lid = {loc; txt}; x = expr} :
+                           Parsetree.expression Parsetree.record_element)
                        ->
                          if
                            posBeforeCursor >= Pos.ofLexing loc.loc_start
@@ -673,8 +671,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                   fields
                   |> List.find_map
                        (fun
-                         (({loc; txt}, pat, _) :
-                           Longident.t Location.loc * Parsetree.pattern * bool)
+                         ({lid = {loc; txt}; x = pat} :
+                           Parsetree.pattern Parsetree.record_element)
                        ->
                          if
                            posBeforeCursor >= Pos.ofLexing loc.loc_start

analysis/src/Xform.ml

@@ -69,10 +69,10 @@ module IfThenElse = struct
       | None -> None
       | Some patList -> Some (mkPat (Ppat_tuple patList)))
     | Pexp_record (items, None) -> (
-      let itemToPat (x, e, o) =
+      let itemToPat {Parsetree.lid; x = e; opt} =
         match expToPat e with
         | None -> None
-        | Some p -> Some (x, p, o)
+        | Some p -> Some {Parsetree.lid; x = p; opt}
       in
       match listToPat ~itemToPat items with
       | None -> None