Update 4.14 branch with master

CHANGES.md

@@ -1,3 +1,29 @@
+# Unreleased
+
+## Features
+
+- Make `code-lens` for nested let bindings configurable (#1567)
+- Add support for `.mlx` files, including formatting via `ocamlformat-mlx` and most OCaml LSP features (diagnostics, code actions, hover, etc.) (#1528)
+
+## Fixes
+
+- Improve precision of collected metrics timestamps. (#1565)
+- Fallback on `.merlin` configuration if no `dune-project` file is found and if
+  `dot-merlin-reader` is installed. (#1563, fixes #1522)
+
+# 1.24.0
+
+## Features
+
+- Support for OCaml 5.4 (#1559)
+
+# 1.23.1
+
+## Fixes
+
+- Fix hover on method calls not showing the type. (#1553, fixes #1552)
+- Fix error on opening `.mll` files (#1557)
+
 # 1.21.0
 
 ## Features
@@ -21,6 +47,7 @@
 - More precise diagnostics in the event of a failed identifier search (`Definition_query`) (#1518)
 
 - Remove `ocamlformat` application after `destruct` (that remove some useful parenthesis) (#1519)
+- Make compatible with Yojson 3.x by removing `Tuple` and `Variant` (#1534)
 
 - Add a new server option `standardHover`, that can be used by clients to
   disable the default hover provider.  When `standardHover = false`

dune-project

@@ -31,7 +31,7 @@ possible and does not make any assumptions about IO.
 ")
  (depends
   (jsonrpc (= :version))
-  (yojson (< 3.0.0))
+  yojson
   (ppx_yojson_conv_lib (>= "v0.14"))
   (cinaps :with-test)
   (ppx_expect (and (>= v0.15.0) (< 0.17.0) :with-test))
@@ -45,7 +45,7 @@ possible and does not make any assumptions about IO.
  (synopsis "LSP Server for OCaml")
  (description "An LSP server for OCaml.")
  (depends
-  (yojson (< 3.0.0))
+  yojson
   (base (>= v0.16.0))
   (lsp (= :version))
   (jsonrpc (= :version))
@@ -75,8 +75,9 @@ possible and does not make any assumptions about IO.
 
 (package
  (name jsonrpc)
- (synopsis "Jsonrpc protocol implemenation")
+ (synopsis "Jsonrpc protocol implementation")
  (description "See https://www.jsonrpc.org/specification")
  (depends
+  yojson
   (ocaml (>= 4.08))
   (odoc :with-doc)))

jsonrpc.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-synopsis: "Jsonrpc protocol implemenation"
+synopsis: "Jsonrpc protocol implementation"
 description: "See https://www.jsonrpc.org/specification"
 maintainer: ["Rudi Grinberg <[email protected]>"]
 authors: [
@@ -20,6 +20,7 @@ homepage: "https://github.com/ocaml/ocaml-lsp"
 bug-reports: "https://github.com/ocaml/ocaml-lsp/issues"
 depends: [
   "dune" {>= "3.0"}
+  "yojson"
   "ocaml" {>= "4.08"}
   "odoc" {with-doc}
 ]

jsonrpc/src/dune

@@ -1,4 +1,5 @@
 (library
  (public_name jsonrpc)
+ (libraries yojson)
  (instrumentation
   (backend bisect_ppx)))

jsonrpc/src/import.ml

@@ -9,18 +9,7 @@ module Option = struct
 end
 
 module Json = struct
-  type t =
-    [ `Assoc of (string * t) list
-    | `Bool of bool
-    | `Float of float
-    | `Int of int
-    | `Intlit of string
-    | `List of t list
-    | `Null
-    | `String of string
-    | `Tuple of t list
-    | `Variant of string * t option
-    ]
+  type t = Yojson.Safe.t
 
   exception Of_json of (string * t)
 

jsonrpc/src/jsonrpc.mli

@@ -1,18 +1,7 @@
 (** Jsonrpc implementation *)
 
 module Json : sig
-  type t =
-    [ `Assoc of (string * t) list
-    | `Bool of bool
-    | `Float of float
-    | `Int of int
-    | `Intlit of string
-    | `List of t list
-    | `Null
-    | `String of string
-    | `Tuple of t list
-    | `Variant of string * t option
-    ]
+  type t = Yojson.Safe.t
 
   (** Raised when conversions from json fail *)
   exception Of_json of (string * t)

lsp-fiber/src/import.ml

@@ -64,11 +64,11 @@ module Json = struct
     | `Bool f -> Bool f
     | `Assoc o -> Record (List.map o ~f:(fun (k, v) -> k, to_dyn v))
     | `List l -> List (List.map l ~f:to_dyn)
-    | `Tuple args -> Tuple (List.map args ~f:to_dyn)
     | `Null -> Dyn.Variant ("Null", [])
-    | `Variant (name, Some arg) -> Variant (name, [ to_dyn arg ])
-    | `Variant (name, None) -> Variant (name, [])
     | `Intlit s -> String s
+    | _ -> Dyn.Variant ("Unsupported", [])
+    (* This last case is unused with Yojson >= 3 *)
+  [@@warning "-11"]
   ;;
 end
 

lsp.opam

@@ -25,7 +25,7 @@ bug-reports: "https://github.com/ocaml/ocaml-lsp/issues"
 depends: [
   "dune" {>= "3.0"}
   "jsonrpc" {= version}
-  "yojson" {< "3.0.0"}
+  "yojson"
   "ppx_yojson_conv_lib" {>= "v0.14"}
   "cinaps" {with-test}
   "ppx_expect" {>= "v0.15.0" & < "0.17.0" & with-test}

lsp/bin/cinaps.ml

@@ -7,7 +7,7 @@ let preprocess_metamodel =
     method! or_ path (types : Metamodel.type_ list) =
       match
         List.filter_map types ~f:(function
-          | Literal (Record []) -> None
+          | Metamodel.Literal (Record []) -> None
           | _ as t -> Some (self#type_ path t))
       with
       | [] -> assert false
@@ -17,10 +17,13 @@ let preprocess_metamodel =
          | Top (Alias s) when s.name = "TextDocumentContentChangeEvent" ->
            let t =
              let union_fields l1 l2 ~f =
-               let of_map =
-                 String.Map.of_list_map_exn ~f:(fun (x : Metamodel.property) -> x.name, x)
+               let of_map xs =
+                 List.map xs ~f:(fun (x : Metamodel.property) -> x.name, x)
+                 |> String.Map.of_list
                in
-               String.Map.merge (of_map l1) (of_map l2) ~f |> String.Map.values
+               String.Map.merge (of_map l1) (of_map l2) ~f
+               |> String.Map.bindings
+               |> List.map ~f:snd
              in
              union_fields f1 f2 ~f:(fun k t1 t2 ->
                if k = "text"
@@ -81,8 +84,9 @@ let expand_superclasses db (m : Metamodel.t) =
   let structures =
     let uniquify_fields fields =
       List.fold_left fields ~init:String.Map.empty ~f:(fun acc (f : Metamodel.property) ->
-        String.Map.set acc f.name f)
-      |> String.Map.values
+        String.Map.add acc ~key:f.name ~data:f)
+      |> String.Map.bindings
+      |> List.map ~f:snd
     in
     let rec fields_of_type (t : Metamodel.type_) =
       match t with

lsp/bin/dune

@@ -3,7 +3,7 @@
 (test
  (name test_metamodel)
  (modules test_metamodel)
- (libraries stdune yojson lsp_gen)
+ (libraries yojson lsp_gen)
  (deps metamodel/metaModel.json)
  (action
   (run ./test_metamodel.exe %{deps})))
@@ -13,4 +13,4 @@
  (instrumentation
   (backend bisect_ppx))
  (modules :standard \ test_metamodel)
- (libraries stdune dyn pp yojson))
+ (libraries dyn pp yojson))

lsp/bin/import.ml

@@ -1,13 +1,70 @@
-include struct
-  open Stdune
-  module List = List
-  module Id = Id
-  module String = String
-  module Code_error = Code_error
-  module Comparable = Comparable
-  module Top_closure = Top_closure
-  module Poly = Poly
-  module Option = Option
-
-  let sprintf = sprintf
+let sprintf = Printf.sprintf
+
+module Option = struct
+  include Option
+
+  let map t ~f = Option.map f t
+
+  let value_exn = function
+    | None -> assert false
+    | Some s -> s
+  ;;
+end
+
+module List = struct
+  include ListLabels
+
+  type ('a, 'b) skip_or_either =
+    | Skip
+    | Left of 'a
+    | Right of 'b
+
+  let rev_filter_partition_map =
+    let rec loop l accl accr ~f =
+      match l with
+      | [] -> accl, accr
+      | x :: l ->
+        (match f x with
+         | Skip -> loop l accl accr ~f
+         | Left y -> loop l (y :: accl) accr ~f
+         | Right y -> loop l accl (y :: accr) ~f)
+    in
+    fun l ~f -> loop l [] [] ~f
+  ;;
+
+  let filter_partition_map l ~f =
+    let l, r = rev_filter_partition_map l ~f in
+    rev l, rev r
+  ;;
+end
+
+module String = struct
+  include StringLabels
+
+  let to_dyn = Dyn.string
+
+  module Map = struct
+    include MoreLabels.Map.Make (String)
+
+    let of_list_reducei xs ~f =
+      List.fold_left xs ~init:empty ~f:(fun map (k, v) ->
+        update map ~key:k ~f:(function
+          | None -> Some v
+          | Some v' -> Some (f k v v')))
+    ;;
+
+    let of_list_map_exn xs ~f = List.map xs ~f |> of_list
+    let union_exn x y = union ~f:(fun _ _ _ -> assert false) x y
+  end
+end
+
+module Code_error = struct
+  let raise name data =
+    invalid_arg (sprintf "%s %s" name (Dyn.to_string (Dyn.record data)))
+  ;;
+end
+
+module Poly = struct
+  let equal = Stdlib.( = )
+  let compare = Stdlib.compare
 end

lsp/bin/metamodel/metamodel.ml

@@ -1,4 +1,4 @@
-open Stdune
+open Import
 
 type doc =
   { since : string option
@@ -113,7 +113,7 @@ let fields = function
 ;;
 
 let field ?default (name : string) p fields =
-  match List.assoc fields name with
+  match List.assoc_opt name fields with
   | Some f -> p f
   | None ->
     (match default with
@@ -122,7 +122,7 @@ let field ?default (name : string) p fields =
 ;;
 
 let field_o name p fields =
-  match List.assoc fields name with
+  match List.assoc_opt name fields with
   | None -> None
   | Some f -> Some (p f)
 ;;
@@ -137,7 +137,7 @@ let literal lit json = if not (Poly.equal json lit) then error "unexpected liter
 let enum variants json =
   match json with
   | `String s ->
-    (match List.assoc variants s with
+    (match List.assoc_opt s variants with
      | None -> error "not a valid enum value" json
      | Some v -> v)
   | _ -> error "not a valid enum value" json
@@ -370,7 +370,7 @@ module Entity = struct
       String.Map.union_exn structures enumerations |> String.Map.union_exn typeAliases
     ;;
 
-    let find t x = String.Map.find_exn t x
+    let find t x = String.Map.find x t
   end
 end
 

lsp/bin/ocaml/json_gen.ml

@@ -34,7 +34,7 @@ let json_error_pat msg =
 ;;
 
 let is_json_constr (constr : Type.constr) =
-  List.mem [ "String"; "Int"; "Bool" ] constr.name ~equal:String.equal
+  List.mem ~set:[ "String"; "Int"; "Bool" ] constr.name
 ;;
 
 module Name = struct

lsp/bin/ocaml/ml.ml

@@ -409,7 +409,7 @@ module Expr = struct
 
   let pp_constr f { tag; poly; args } =
     let tag =
-      let tag = String.capitalize tag in
+      let tag = String.capitalize_ascii tag in
       Pp.verbatim (if poly then "`" ^ tag else tag)
     in
     match args with