[Folding ranges]: support more AST nodes (#692)

* test(folding range): add test for Pexp_letop * feat(folding range): traverse letop body * test(folding range): add test for Pexp_newtype * feat(folding range): traverse Pexp_newtype * test(folding range): add test for type_extension * feat(folding range): add support for type_extension * test(folding range): add test for Pexp_while * feat(folding range): add support for Pexp_while * test(folding range): add test for Pexp_for * feat(folding range): add support for Pexp_for * test(folding range): add test for Pexp_object * feat(folding range): add support for Pexp_object * test(folding range): add test for Pexp_pack * feat(folding range): add support for Pexp_pack * test(folding range): add test for Pexp_letmodule * feat(folding range): add support for Pexp_letmodule * test(folding range): add test for Pexp_lazy * feat(folding range): add support for Pexp_lazy * test(folding range): add test for Pexp_letexception * feat(folding range): add support for Pexp_letexception * add changes entry * test(folding range): add test for value_description * feat(folding range): add support for value_description * test(folding range): add test for Pstr_extension * feat(folding range): add support for Pstr_extension * test(folding range): add test for class_type_field * feat(folding range): add support for class_type_field * test(folding range): add test for class_description * feat(folding range): add support for class_description * test(folding range): add test for class_expr * feat(folding range): add support for class_expr * test(folding range): add test for class_type * feat(folding range): add support for class_type * test(folding range): add test for Pmod_functor and Pmod_structure * feat(folding range): add support for Pmod_functor and Pmod_structure * test(folding range): add test for Pmty_functor and Pmty_signature * feat(folding range): add support for Pmty_functor and Pmty_signature * traverses more nodes
ocaml · Jun 13, 2022 · fa64091 · fa64091
1 parent 5fdb9b9
commit fa64091
Show file tree

Hide file tree

Showing 3 changed files with 915 additions and 117 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -7,6 +7,8 @@
   configuration in `.merlin` files rather than calling `dune ocaml-merlin`.
   (#705)
 
+- Support folding more ranges (#692)
+
 # 1.11.6
 
 ## Fixes

diff --git a/ocaml-lsp-server/src/folding_range.ml b/ocaml-lsp-server/src/folding_range.ml
@@ -16,6 +16,17 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
         (typ_decl : Parsetree.type_declaration) =
       Range.of_loc typ_decl.ptype_loc |> push
     in
+    let type_extension (_self : Ast_iterator.iterator)
+        (typ_ext : Parsetree.type_extension) =
+      let loc = typ_ext.ptyext_path.loc in
+      let last_constr = List.last typ_ext.ptyext_constructors in
+      let loc =
+        match last_constr with
+        | None -> loc
+        | Some { pext_loc; _ } -> { loc with loc_end = pext_loc.loc_end }
+      in
+      Range.of_loc loc |> push
+    in
 
     let module_type_declaration (self : Ast_iterator.iterator)
         (mod_typ_decl : Parsetree.module_type_declaration) =
@@ -27,13 +38,16 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
     let module_type (self : Ast_iterator.iterator)
         (module_type : Parsetree.module_type) =
       match module_type.pmty_desc with
-      | Pmty_signature signature -> self.signature self signature
+      | Pmty_signature _ | Pmty_functor _ ->
+        let range = Range.of_loc module_type.pmty_loc in
+        push range;
+        Ast_iterator.default_iterator.module_type self module_type
       | Pmty_ident _
-      | Pmty_functor _
       | Pmty_with _
       | Pmty_typeof _
       | Pmty_extension _
-      | Pmty_alias _ -> ()
+      | Pmty_alias _ ->
+        Ast_iterator.default_iterator.module_type self module_type
     in
 
     let module_declaration (self : Ast_iterator.iterator)
@@ -43,24 +57,63 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       self.module_type self module_declaration.pmd_type
     in
 
+    let module_expr (self : Ast_iterator.iterator)
+        (module_expr : Parsetree.module_expr) =
+      match module_expr.pmod_desc with
+      | Parsetree.Pmod_functor (_, _) | Parsetree.Pmod_structure _ ->
+        let range = Range.of_loc module_expr.pmod_loc in
+        push range;
+        Ast_iterator.default_iterator.module_expr self module_expr
+      | Parsetree.Pmod_ident _
+      | Parsetree.Pmod_apply (_, _)
+      | Parsetree.Pmod_constraint (_, _)
+      | Parsetree.Pmod_unpack _ | Parsetree.Pmod_extension _ ->
+        Ast_iterator.default_iterator.module_expr self module_expr
+      | Parsetree.Pmod_hole -> ()
+    in
+
     let class_declaration (self : Ast_iterator.iterator)
         (class_decl : Parsetree.class_declaration) =
       class_decl.Parsetree.pci_loc |> Range.of_loc |> push;
       self.class_expr self class_decl.pci_expr
     in
 
+    let class_description (self : Ast_iterator.iterator)
+        (class_desc : Parsetree.class_description) =
+      class_desc.pci_loc |> Range.of_loc |> push;
+      self.class_type self class_desc.pci_expr
+    in
+
+    let class_expr (self : Ast_iterator.iterator)
+        (class_expr : Parsetree.class_expr) =
+      class_expr.pcl_loc |> Range.of_loc |> push;
+      Ast_iterator.default_iterator.class_expr self class_expr
+    in
+
     let class_field (self : Ast_iterator.iterator)
         (class_field : Parsetree.class_field) =
       Range.of_loc class_field.pcf_loc |> push;
       Ast_iterator.default_iterator.class_field self class_field
     in
 
+    let class_type (self : Ast_iterator.iterator)
+        (class_type : Parsetree.class_type) =
+      Range.of_loc class_type.pcty_loc |> push;
+      Ast_iterator.default_iterator.class_type self class_type
+    in
+
     let class_type_declaration (self : Ast_iterator.iterator)
         (class_type_decl : Parsetree.class_type_declaration) =
       Range.of_loc class_type_decl.pci_loc |> push;
       Ast_iterator.default_iterator.class_type_declaration self class_type_decl
     in
 
+    let class_type_field (self : Ast_iterator.iterator)
+        (class_type_field : Parsetree.class_type_field) =
+      Range.of_loc class_type_field.pctf_loc |> push;
+      Ast_iterator.default_iterator.class_type_field self class_type_field
+    in
+
     let value_binding (self : Ast_iterator.iterator)
         (value_binding : Parsetree.value_binding) =
       let range = Range.of_loc value_binding.pvb_loc in
@@ -85,7 +138,7 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       self.expr self c.pc_rhs
     in
 
-    let pat (_self : Ast_iterator.iterator) (p : Parsetree.pattern) =
+    let pat (self : Ast_iterator.iterator) (p : Parsetree.pattern) =
       let open Parsetree in
       match p.ppat_desc with
       | Ppat_record (bdgs, _) ->
@@ -109,22 +162,12 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       | Ppat_unpack _
       | Ppat_exception _
       | Ppat_extension _
-      | Ppat_open _ -> () (* TODO *)
-      | Ppat_any -> ()
+      | Ppat_open _
+      | Ppat_any -> Ast_iterator.default_iterator.pat self p
     in
 
     let expr (self : Ast_iterator.iterator) (expr : Parsetree.expression) =
       match expr.pexp_desc with
-      | Pexp_extension _
-      | Pexp_let _
-      | Pexp_open _
-      | Pexp_fun _
-      | Pexp_poly _
-      | Pexp_sequence _
-      | Pexp_ifthenelse _
-      | Pexp_constraint _
-      | Pexp_function _
-      | Pexp_construct _ -> Ast_iterator.default_iterator.expr self expr
       | Pexp_try (e, cases) | Pexp_match (e, cases) ->
         Range.of_loc expr.pexp_loc |> push;
         self.expr self e;
@@ -134,39 +177,49 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
            expression. See: https://github.com/ocaml/ocaml/pull/10682 *)
         let range = Range.of_loc letop.let_.pbop_loc in
         push range;
-        self.expr self letop.let_.pbop_exp
+        Ast_iterator.default_iterator.expr self expr
       | Pexp_record (bdgs, old_record) ->
         Range.of_loc expr.pexp_loc |> push;
         Option.iter old_record ~f:(self.expr self);
         List.iter bdgs ~f:(fun (lident, expr) ->
             let lident_range = Range.of_loc lident.Asttypes.loc in
             let expr_range = Range.of_loc expr.Parsetree.pexp_loc in
             push { Range.start = lident_range.end_; end_ = expr_range.end_ })
-      | Pexp_apply _ ->
+      | Pexp_apply _
+      | Pexp_while _
+      | Pexp_for _
+      | Pexp_object _
+      | Pexp_pack _
+      | Pexp_letmodule _ ->
         Range.of_loc expr.pexp_loc |> push;
         Ast_iterator.default_iterator.expr self expr
+      | Pexp_extension _
+      | Pexp_let _
+      | Pexp_open _
+      | Pexp_fun _
+      | Pexp_poly _
+      | Pexp_sequence _
+      | Pexp_ifthenelse _
+      | Pexp_constraint _
+      | Pexp_function _
+      | Pexp_newtype _
+      | Pexp_lazy _
+      | Pexp_letexception _
+      | Pexp_tuple _
+      | Pexp_construct _
       | Pexp_ident _
       | Pexp_constant _
-      | Pexp_tuple _
       | Pexp_variant _
       | Pexp_field _
       | Pexp_setfield _
       | Pexp_array _
-      | Pexp_while _
-      | Pexp_for _
       | Pexp_coerce _
       | Pexp_send _
       | Pexp_new _
       | Pexp_setinstvar _
       | Pexp_override _
-      | Pexp_letmodule _
-      | Pexp_letexception _
       | Pexp_assert _
-      | Pexp_lazy _
-      | Pexp_object _
-      | Pexp_newtype _
-      | Pexp_pack _
-      | Pexp_unreachable
+      | Pexp_unreachable -> Ast_iterator.default_iterator.expr self expr
       | Pexp_hole -> ()
     in
 
@@ -182,6 +235,11 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       self.module_expr self open_decl.popen_expr
     in
 
+    let value_description (_self : Ast_iterator.iterator)
+        (value_desc : Parsetree.value_description) =
+      Range.of_loc value_desc.pval_loc |> push
+    in
+
     let structure_item self structure_item =
       match structure_item.Parsetree.pstr_desc with
       | Pstr_value _
@@ -191,33 +249,40 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       | Pstr_module _
       | Pstr_eval _
       | Pstr_recmodule _
-      | Pstr_extension _
       | Pstr_class_type _
+      | Pstr_typext _
       | Pstr_open _ ->
         Ast_iterator.default_iterator.structure_item self structure_item
-      | Pstr_primitive _
-      | Pstr_typext _
-      | Pstr_exception _
-      | Pstr_include _
-      | Pstr_attribute _ -> ()
+      | Pstr_extension _ ->
+        Range.of_loc structure_item.pstr_loc |> push;
+        Ast_iterator.default_iterator.structure_item self structure_item
+      | Pstr_primitive _ | Pstr_exception _ | Pstr_include _ | Pstr_attribute _
+        -> ()
     in
 
     { Ast_iterator.default_iterator with
       case
     ; class_declaration
+    ; class_description
+    ; class_expr
     ; class_field
+    ; class_type
     ; class_type_declaration
+    ; class_type_field
     ; expr
     ; extension
     ; module_binding
     ; module_declaration
+    ; module_expr
     ; module_type
     ; module_type_declaration
     ; open_declaration
     ; pat
     ; structure_item
     ; type_declaration
+    ; type_extension
     ; value_binding
+    ; value_description
     }
   in
   let () =