550 preview

.github/workflows/build-and-test.yml

@@ -45,11 +45,11 @@ jobs:
       - name: Set-up OCaml
         uses: ocaml/setup-ocaml@v3
         with:
-          ocaml-compiler: "5.4"
+          ocaml-compiler: "5.5"
 
       # Remove this pin once a compatible version of Merlin has been released
       - name: Pin dev Merlin
-        run: opam --cli=2.1 pin --with-version=5.6-504 https://github.com/voodoos/merlin.git#main
+        run: opam --cli=2.1 pin --with-version=5.7-505~preview https://github.com/voodoos/merlin.git#505
 
       - name: Build and install dependencies
         run: opam install .
@@ -81,7 +81,7 @@ jobs:
       - name: Set-up OCaml
         uses: ocaml/setup-ocaml@v3
         with:
-          ocaml-compiler: "5.4"
+          ocaml-compiler: "5.5"
 
       - name: Set git user
         run: |
@@ -90,7 +90,7 @@ jobs:
 
       # Remove this pin once a compatible version of Merlin has been released
       - name: Pin dev Merlin
-        run: opam --cli=2.1 pin --with-version=5.6-504 https://github.com/voodoos/merlin.git#main
+        run: opam --cli=2.1 pin --with-version=5.7-505~preview https://github.com/voodoos/merlin.git#505
 
       - name: Install dependencies
         run: |

dune-project

@@ -51,12 +51,12 @@ possible and does not make any assumptions about IO.
   (jsonrpc (= :version))
   (re (>= 1.5.0))
   (ppx_yojson_conv_lib (>= "v0.14"))
-  (dune-rpc (>= 3.4.0))
+  (dune-rpc (>= 3.22.0))
   (chrome-trace (>= 3.3.0))
   dyn
   stdune
   (fiber (and (>= 3.1.1) (< 4.0.0)))
-  (ocaml (and (>= 5.4) (< 5.5)))
+  (ocaml (and (>= 5.5) (< 5.6)))
   xdg
   ordering
   dune-build-info
@@ -70,7 +70,7 @@ possible and does not make any assumptions about IO.
   (csexp (>= 1.5))
   (ocamlformat-rpc-lib (>= 0.21.0))
   (odoc :with-doc)
-  (merlin-lib (and (>= 5.6) (< 5.7)))
+  (merlin-lib (= 5.7-505~preview))
   (ocaml-index :post)
   (ppx_yojson_conv :with-dev-setup)))
 

ocaml-lsp-server.opam

@@ -26,12 +26,12 @@ depends: [
   "jsonrpc" {= version}
   "re" {>= "1.5.0"}
   "ppx_yojson_conv_lib" {>= "v0.14"}
-  "dune-rpc" {>= "3.4.0"}
+  "dune-rpc" {>= "3.22.0"}
   "chrome-trace" {>= "3.3.0"}
   "dyn"
   "stdune"
   "fiber" {>= "3.1.1" & < "4.0.0"}
-  "ocaml" {>= "5.4" & < "5.5"}
+  "ocaml" {>= "5.5" & < "5.6"}
   "xdg"
   "ordering"
   "dune-build-info"
@@ -45,7 +45,7 @@ depends: [
   "csexp" {>= "1.5"}
   "ocamlformat-rpc-lib" {>= "0.21.0"}
   "odoc" {with-doc}
-  "merlin-lib" {>= "5.6" & < "5.7"}
+  "merlin-lib" {= "5.7-505~preview"}
   "ocaml-index" {post}
   "ppx_yojson_conv" {with-dev-setup}
 ]

ocaml-lsp-server/src/code_actions/action_extract.ml

@@ -70,10 +70,7 @@ let tightest_enclosing_binder_position typedtree range =
       match expr.exp_desc with
       | Texp_let (_, _, body)
       | Texp_while (_, body)
-      | Texp_for (_, _, _, _, _, body)
-      | Texp_letmodule (_, _, _, _, body)
-      | Texp_letexception (_, body)
-      | Texp_open (_, body) -> found_if_expr_contains body
+      | Texp_for (_, _, _, _, _, body)  -> found_if_expr_contains body
       | Texp_letop { body; _ } -> found_if_case_contains [ body ]
       | Texp_function (_, Tfunction_cases { cases; _ }) -> found_if_case_contains cases
       | Texp_match _ ->

ocaml-lsp-server/src/dune.ml

@@ -31,8 +31,9 @@ module Chan : sig
   type t
 
   val create : Lev_fiber_csexp.Session.t -> t
-  val write : t -> Csexp.t list option -> unit Fiber.t
+  val write : t -> Csexp.t list -> unit Fiber.t
   val read : t -> Csexp.t option Fiber.t
+  val close : t -> unit Fiber.t
   val stop : t -> unit Fiber.t
   val run : t -> unit Fiber.t
 end = struct
@@ -43,16 +44,13 @@ end = struct
     ; finished : unit Fiber.Ivar.t
     }
 
-  let stop t =
+  let close t =
     let+ () = Fiber.return () in
     Lev_fiber_csexp.Session.close t.session
   ;;
 
-  let write t sexp =
-    match sexp with
-    | None -> stop t
-    | Some sexp -> Lev_fiber_csexp.Session.write t.session sexp
-  ;;
+  let stop = close
+  let write t sexp = Lev_fiber_csexp.Session.write t.session sexp
 
   let read t =
     let* read = Lev_fiber_csexp.Session.read t.session in
@@ -80,6 +78,12 @@ module Client =
         let stream = Fiber.Stream.In.create t in
         Fiber.Stream.In.parallel_iter stream ~f
       ;;
+
+      let collect_errors f =
+        let open Fiber.O in
+        let+ res = Fiber.collect_errors f in
+        Result.map_error res ~f:(List.map ~f:(fun (exn: Exn_with_backtrace.t) -> exn.exn))
+      ;;
     end)
     (Chan)
 
@@ -470,10 +474,10 @@ end = struct
            Fiber.Ivar.fill finish ())
         ; (let init =
              let id =
-               Drpc.Id.make
+               Drpc.Request.Id.make
                  (List [ Atom "ocamllsp"; Atom (Int.to_string (Id.to_int running.id)) ])
              in
-             Drpc.Initialize.create ~id
+             Drpc.Request.Initialize.create ~id
            in
            let where =
              match where with

ocaml-lsp-server/src/folding_range.ml

@@ -191,19 +191,18 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       | Pexp_for _
       | Pexp_object _
       | Pexp_pack _
-      | Pexp_letmodule _ ->
+      | Pexp_struct_item ({pstr_desc = Pstr_module _; _}, _) ->
         Range.of_loc expr.pexp_loc |> push;
         Ast_iterator.default_iterator.expr self expr
       | Pexp_extension _
       | Pexp_let _
-      | Pexp_open _
       | Pexp_poly _
       | Pexp_sequence _
       | Pexp_constraint _
       | Pexp_function _
+      | Pexp_struct_item _
       | Pexp_newtype _
       | Pexp_lazy _
-      | Pexp_letexception _
       | Pexp_tuple _
       | Pexp_construct _
       | Pexp_ident _

ocaml-lsp-server/src/semantic_highlighting.ml

@@ -395,6 +395,7 @@ end = struct
       | Ptyp_package _
       | Ptyp_object _
       | Ptyp_tuple _
+      | Ptyp_functor _
       | Ptyp_open _ -> `Default_iterator
     in
     match iter with
@@ -468,7 +469,7 @@ end = struct
         (self : Ast_iterator.iterator)
         ({ ptype_name
          ; ptype_params
-         ; ptype_cstrs
+         ; ptype_constraints
          ; ptype_kind
          ; ptype_private = _
          ; ptype_manifest
@@ -491,16 +492,20 @@ end = struct
     add_token
       ptype_name.loc
       (match ptype_kind with
-       | Parsetree.Ptype_abstract | Ptype_open -> Token_type.of_builtin Type
+       | Parsetree.Ptype_abstract
+       | Ptype_open
+       | Ptype_external _ -> Token_type.of_builtin Type
        | Ptype_variant _ -> Token_type.of_builtin Enum
        | Ptype_record _ -> Token_type.of_builtin Struct)
       (Token_modifiers_set.singleton Declaration);
-    List.iter ptype_cstrs ~f:(fun (ct0, ct1, (_ : Loc.t)) ->
+    List.iter ptype_constraints ~f:(fun (ct0, ct1, (_ : Loc.t)) ->
       self.typ self ct0;
       self.typ self ct1);
     Option.iter ptype_manifest ~f:(fun ct -> self.typ self ct);
     (match ptype_kind with
-     | Parsetree.Ptype_abstract | Parsetree.Ptype_open -> ()
+     | Parsetree.Ptype_abstract
+     | Parsetree.Ptype_open
+     | Parsetree.Ptype_external _ -> ()
      | Ptype_variant cds ->
        List.iter cds ~f:(fun cd -> self.constructor_declaration self cd)
      | Ptype_record lds -> List.iter lds ~f:(fun ld -> self.label_declaration self ld));
@@ -603,12 +608,6 @@ end = struct
         add_token t.loc (Token_type.of_builtin TypeParameter) Token_modifiers_set.empty;
         self.expr self e;
         `Custom_iterator
-      | Pexp_letmodule (name, me, e) ->
-        add_token name.loc Token_type.module_ Token_modifiers_set.empty;
-        self.module_expr self me;
-        (* ^ handle function applications like this *)
-        self.expr self e;
-        `Custom_iterator
       | Pexp_constant c ->
         const pexp_loc c;
         `Custom_iterator
@@ -637,6 +636,13 @@ end = struct
             then self.expr self pbop_exp);
         self.expr self body;
         `Custom_iterator
+      | Pexp_struct_item
+          ({pstr_desc = Pstr_module
+                {pmb_name = name; pmb_expr = me; _ }; _}, e) ->
+        add_token name.loc Token_type.module_ Token_modifiers_set.empty;
+        self.module_expr self me;
+        self.expr self e;
+        `Custom_iterator
       | Pexp_unreachable -> `Custom_iterator
       | Pexp_array _
       | Pexp_ifthenelse (_, _, _)
@@ -645,11 +651,10 @@ end = struct
       | Pexp_coerce (_, _, _)
       | Pexp_setinstvar (_, _)
       | Pexp_override _
-      | Pexp_letexception (_, _)
       | Pexp_assert _ | Pexp_lazy _
       | Pexp_poly (_, _)
       | Pexp_object _ | Pexp_pack _
-      | Pexp_open (_, _)
+      | Pexp_struct_item _ (* TODO: Handle module case for struct item *)
       | Pexp_extension _ -> `Default_iterator
     with
     | `Default_iterator -> Ast_iterator.default_iterator.expr self exp
@@ -695,7 +700,7 @@ end = struct
         lident lid Token_type.module_ ();
         self.pat self p;
         `Custom_iterator
-      | Ppat_unpack m ->
+      | Ppat_unpack (m, _) ->
         Option.iter m.txt ~f:(fun _ ->
           add_token m.loc Token_type.module_ Token_modifiers_set.empty);
         `Custom_iterator
@@ -790,7 +795,7 @@ end = struct
        | Ptyp_alias (_, _)
        | Ptyp_variant (_, _, _)
        | Ptyp_poly (_, _)
-       | Ptyp_tuple _ | Ptyp_any | Ptyp_var _ | Ptyp_open _ ->
+       | Ptyp_tuple _ | Ptyp_any | Ptyp_var _ | Ptyp_open _ | Ptyp_functor _ ->
          Token_type.of_builtin Variable)
       (Token_modifiers_set.singleton Declaration);
     self.typ self pval_type;