update

Author: d-kalinichenko

dune-project

@@ -1,7 +1,7 @@
 (lang dune 3.0)
 (using cinaps 1.0)
 (name lsp)
-(version "1.19.0+jst")
+(version "1.19.0+ox")
 
 (implicit_transitive_deps false)
 
@@ -71,8 +71,8 @@ possible and does not make any assumptions about IO.
   (csexp (>= 1.5))
   (ocamlformat-rpc-lib (>= 0.21.0))
   (odoc :with-doc)
-  (odoc-parser (= 2.0.0))
-  (merlin-lib (= "5.2.1-502+jst"))
+  (odoc-parser (= "3.1.0+ox"))
+  (merlin-lib (= "5.2.1-502+ox"))
   ppx_yojson_conv
   core_unix
   async

jsonrpc.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "1.19.0+jst"
+version: "1.19.0+ox"
 synopsis: "Jsonrpc protocol implemenation"
 description: "See https://www.jsonrpc.org/specification"
 maintainer: ["Rudi Grinberg <[email protected]>"]

lsp.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "1.19.0+jst"
+version: "1.19.0+ox"
 synopsis: "LSP protocol implementation in OCaml"
 description: """
 

ocaml-lsp-server.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "1.19.0+jst"
+version: "1.19.0+ox"
 synopsis: "LSP Server for OCaml"
 description: "An LSP server for OCaml."
 maintainer: ["Rudi Grinberg <[email protected]>"]
@@ -46,8 +46,8 @@ depends: [
   "csexp" {>= "1.5"}
   "ocamlformat-rpc-lib" {>= "0.21.0"}
   "odoc" {with-doc}
-  "odoc-parser" {= "2.0.0"}
-  "merlin-lib" {= "5.2.1-502+jst"}
+  "odoc-parser" {= "3.1.0+ox"}
+  "merlin-lib" {= "5.2.1-502+ox"}
   "ppx_yojson_conv"
   "core_unix"
   "async"

ocaml-lsp-server/src/action_add_rec.ml

@@ -6,7 +6,7 @@ let action_title = "Add missing `rec` keyword"
 let let_bound_vars bindings =
   List.filter_map bindings ~f:(fun vb ->
     match vb.Typedtree.vb_pat.pat_desc with
-    | Typedtree.Tpat_var (id, loc, _, _) -> Some (id, loc)
+    | Typedtree.Tpat_var (id, loc, _, _, _) -> Some (id, loc)
     | _ -> None)
 ;;
 

ocaml-lsp-server/src/action_inline.ml

@@ -66,7 +66,7 @@ let find_inline_task typedtree pos =
       match expr.exp_desc with
       | Texp_let
           ( Nonrecursive
-          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _, _); _ }
+          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _, _, _); _ }
               ; vb_expr = inlined_expr
               ; _
               }
@@ -81,7 +81,7 @@ let find_inline_task typedtree pos =
       match item.str_desc with
       | Tstr_value
           ( Nonrecursive
-          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _, _); _ }
+          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _, _, _); _ }
               ; vb_expr = inlined_expr
               ; _
               }
@@ -158,8 +158,8 @@ end = struct
     in
     let pat_iter (type k) (iter : I.iterator) (pat : k Typedtree.general_pattern) =
       match pat.pat_desc with
-      | Tpat_var (id, { loc; _ }, _, _) -> paths := Loc.Map.set !paths loc (Pident id)
-      | Tpat_alias (pat, id, { loc; _ }, _, _, _) ->
+      | Tpat_var (id, { loc; _ }, _, _, _) -> paths := Loc.Map.set !paths loc (Pident id)
+      | Tpat_alias (pat, id, { loc; _ }, _, _, _, _) ->
         paths := Loc.Map.set !paths loc (Pident id);
         I.default_iterator.pat iter pat
       | _ -> I.default_iterator.pat iter pat
@@ -209,7 +209,7 @@ let same_path paths (id : _ H.with_loc) (id' : _ H.with_loc) =
 
 let beta_reduce (paths : Paths.t) (app : Parsetree.expression) =
   let rec beta_reduce_arg body (pat : Parsetree.pattern) arg =
-    let with_let () = H.Exp.let_ Nonrecursive [ H.Vb.mk pat arg ] body in
+    let with_let () = H.Exp.let_ Immutable Nonrecursive [ H.Vb.mk pat arg ] body in
     let with_subst param = subst (same_path paths) arg param body in
     match pat.ppat_desc with
     | Ppat_any | Ppat_construct ({ txt = Lident "()"; _ }, _) ->

ocaml-lsp-server/src/action_mark_remove_unused.ml

@@ -75,7 +75,7 @@ let rec mark_value_unused_edit name contexts =
           (function
            | ( { loc = field_loc; _ }
              , _
-             , { pat_desc = Tpat_var (ident, _, _, _); pat_loc; _ } )
+             , { pat_desc = Tpat_var (ident, _, _, _, _); pat_loc; _ } )
              when Ident.name ident = name ->
              (* Special case for record shorthand *)
              if field_loc.loc_start = pat_loc.loc_start
@@ -97,7 +97,7 @@ let rec mark_value_unused_edit name contexts =
     (match m_field_edit with
      | Some e -> Some e
      | None -> mark_value_unused_edit name cs)
-  | Pattern { pat_desc = Tpat_var (ident, _, _, _); pat_loc = loc; _ } :: _ ->
+  | Pattern { pat_desc = Tpat_var (ident, _, _, _, _); pat_loc = loc; _ } :: _ ->
     if Ident.name ident = name
     then
       let+ start = Position.of_lexical_position loc.loc_start in
@@ -132,7 +132,7 @@ let enclosing_value_binding_range name =
         { exp_desc =
             Texp_let
               ( _
-              , [ { vb_pat = { pat_desc = Tpat_var (_, { txt = name'; _ }, _, _); _ }; _ }
+              , [ { vb_pat = { pat_desc = Tpat_var (_, { txt = name'; _ }, _, _, _); _ }; _ }
                 ]
               , { exp_loc = { loc_start = let_end; _ }; _ } )
         ; exp_loc = { loc_start = let_start; _ }

ocaml-lsp-server/src/call_hierarchy.ml

@@ -207,13 +207,13 @@ let handle_incoming ~log_info (server : State.t Server.t) params =
   let { CallHierarchyIncomingCallsParams.item; _ } = params in
   let { CallHierarchyItem.uri; range; _ } = item in
   let%bind.Fiber_option merlin_doc = get_merlin_doc state uri in
-  let* locs, _synced =
+  let* occurrences, _synced =
     Document.Merlin.dispatch_exn
       ~log_info
       merlin_doc
       (Occurrences (`Ident_at (Position.logical range.end_), `Project))
   in
-  List.map locs ~f:(fun (loc : Loc.t) -> loc.loc_start.pos_fname, loc)
+  List.map occurrences ~f:(fun { loc; is_stale = _ } -> loc.loc_start.pos_fname, loc)
   |> Base.List.Assoc.sort_and_group ~compare:Base.String.compare
   |> batched_parallel ~batch_size:40 ~f:(fun (fn_name, locs) ->
     (* Using Map to only open one doc and create one parsetree per file name. *)

ocaml-lsp-server/src/compl.ml

@@ -151,6 +151,7 @@ module Complete_by_prefix = struct
           ; desc = typ
           ; info = ""
           ; deprecated = false (* TODO this is wrong *)
+          ; ppx_template_generated = false
           })
     in
     (* we need to json-ify completion params to put them in completion item's

ocaml-lsp-server/src/doc_to_md.ml

@@ -106,6 +106,41 @@ let rec nestable_block_element_to_block
     in
     let meta = loc_to_meta location in
     Block.Paragraph (paragraph, meta)
+  | { value = `Table ((grid, alignment), _); location } ->
+    let meta = loc_to_meta location in
+    let cell
+        ((c, _) : Odoc_parser.Ast.nestable_block_element Odoc_parser.Ast.cell) =
+      let c = nestable_block_element_list_to_inlines c in
+      (c, (" ", " ") (* Initial and trailing blanks *))
+    in
+    let header_row
+        (row : Odoc_parser.Ast.nestable_block_element Odoc_parser.Ast.row) =
+      let row = List.map ~f:cell row in
+      ((`Header row, Meta.none), "")
+    in
+    let data_row
+        (row : Odoc_parser.Ast.nestable_block_element Odoc_parser.Ast.row) =
+      let row = List.map ~f:cell row in
+      ((`Data row, Meta.none), "")
+    in
+    let alignment_row =
+      match alignment with
+      | None -> []
+      | Some alignment ->
+        let alignment =
+          List.map
+            ~f:(fun x -> ((x, 1 (* nb of separator *)), Meta.none))
+            alignment
+        in
+        [ ((`Sep alignment, Meta.none), "") ]
+    in
+    let rows =
+      match grid with
+      | [] -> assert false
+      | h :: t -> (header_row h :: alignment_row) @ List.map ~f:data_row t
+    in
+    let tbl = Block.Table.make rows in
+    Block.Ext_table (tbl, meta)
   | { value = `List (kind, style, xs); location } ->
     let l =
       let list_items =
@@ -148,22 +183,27 @@ let rec nestable_block_element_to_block
     in
     let meta = loc_to_meta location in
     Block.List (l, meta)
-  | { value = `Code_block (metadata, { value = code; location = code_loc }); location } ->
+  | { value = `Code_block { meta = metadata; delimiter = _; content = { value = code; location = code_loc }; output }; location } ->
     let meta = loc_to_meta location in
     let main_block =
       let code_block =
         let info_string =
           match metadata with
           | None -> Some ("ocaml", loc_to_meta code_loc)
-          | Some ({ value = lang; location = lang_log }, _env) ->
+          | Some { language = { value = lang; location = lang_log }; tags = _ } ->
             Some (lang, loc_to_meta lang_log)
         in
         let block_line = Block_line.list_of_string code in
         Block.Code_block.make ?info_string block_line
       in
       Block.Code_block (code_block, meta)
     in
-    Block.Blocks ([ main_block ], meta)
+    let output_block =
+      match output with
+      | None -> []
+      | Some output -> [nestable_block_element_list_to_block output]
+    in
+    Block.Blocks ( main_block :: output_block , meta)
   | { value = `Verbatim code; location } ->
     let code_block =
       let info_string = Some ("verb", Meta.none) in
@@ -179,6 +219,75 @@ let rec nestable_block_element_to_block
     in
     let meta = loc_to_meta location in
     Block.Ext_math_block (code_block, meta)
+  | { value = `Media _; location } ->
+    let meta = loc_to_meta location in
+    let p = Block.Paragraph.make (Inline.Text ("(media)", meta)) in
+    Block.Paragraph (p, meta)
+
+and nestable_block_element_to_inlines
+    (nestable :
+      Odoc_parser.Ast.nestable_block_element Odoc_parser.Loc.with_location) =
+  match nestable with
+  | { value = `Paragraph text; location = _ } ->
+    inline_element_list_to_inlines text
+  | { value = `Table ((grid, _), _); location } ->
+    let meta = loc_to_meta location in
+    let cell
+        ((c, _) : Odoc_parser.Ast.nestable_block_element Odoc_parser.Ast.cell) =
+      nestable_block_element_list_to_inlines c
+    in
+    let row (row : Odoc_parser.Ast.nestable_block_element Odoc_parser.Ast.row) =
+      let sep = Inline.Text (" | ", Meta.none) in
+      sep :: List.concat_map ~f:(fun c -> [ cell c; sep ]) row
+    in
+    let rows = List.concat_map ~f:row grid in
+    Inline.Inlines (rows, meta)
+  | { value = `List (_, _, xs); location } ->
+    let meta = loc_to_meta location in
+    let item i = nestable_block_element_list_to_inlines i in
+    let items =
+      let sep = Inline.Text (" - ", Meta.none) in
+      List.concat_map ~f:(fun i -> [ sep; item i ]) xs
+    in
+    Inline.Inlines (items, meta)
+  | { value = `Modules modules; location } ->
+    let meta = loc_to_meta location in
+    let s = List.map ~f:(fun x -> x.Odoc_parser.Loc.value) modules in
+    Inline.Text ("modules: " ^ String.concat ~sep:" " s, meta)
+  | { value =
+        `Code_block
+          { meta = _
+          ; delimiter = _
+          ; content = { value = code; location = code_loc }
+          ; output = _
+          }
+    ; location
+    } ->
+    let meta = loc_to_meta location in
+    let meta_code = loc_to_meta code_loc in
+    let code_span =
+      Inline.Code_span.make ~backtick_count:1 [ ("", (code, meta_code)) ]
+    in
+    Inline.Code_span (code_span, meta)
+  | { value = `Verbatim code; location } ->
+    let meta = loc_to_meta location in
+    let code_span =
+      Inline.Code_span.make ~backtick_count:1 [ ("", (code, Meta.none)) ]
+    in
+    Inline.Code_span (code_span, meta)
+  | { value = `Math_block code; location } ->
+    let meta = loc_to_meta location in
+    let code_span =
+      Inline.Math_span.make ~display:true [ ("", (code, Meta.none)) ]
+    in
+    Inline.Ext_math_span (code_span, meta)
+  | { value = `Media _; location } ->
+    let meta = loc_to_meta location in
+    Inline.Text ("(media)", meta)
+
+and nestable_block_element_list_to_inlines l =
+  let inlines = List.map ~f:nestable_block_element_to_inlines l in
+  Inline.Inlines (inlines, Meta.none)
 
 and nestable_block_element_list_to_block nestables =
   let blocks = List.map ~f:nestable_block_element_to_block nestables in
@@ -276,6 +385,19 @@ let tag_to_block ~meta (tag : Odoc_parser.Ast.tag) =
   | `Inline -> format_tag_empty "@inline"
   | `Open -> format_tag_empty "@open"
   | `Closed -> format_tag_empty "@closed"
+  | `Hidden -> format_tag_empty "@hidden"
+  | `Order_category oc ->
+    let block = nestable_block_element_list_to_block oc in
+    format_tag_block "@order_category" block
+  | `Short_title oc ->
+    let block = nestable_block_element_list_to_block oc in
+    format_tag_block "@short_title" block
+  | `Toc_status oc ->
+    let block = nestable_block_element_list_to_block oc in
+    format_tag_block "@toc_status" block
+  | `Children_order oc ->
+    let block = nestable_block_element_list_to_block oc in
+    format_tag_block "@children_order" block
 ;;
 
 let rec block_element_to_block
@@ -293,7 +415,7 @@ let rec block_element_to_block
     let meta = loc_to_meta location in
     tag_to_block ~meta t
   | { value =
-        `Paragraph _ | `List _ | `Modules _ | `Code_block _ | `Verbatim _ | `Math_block _
+        `Paragraph _ | `List _ | `Modules _ | `Code_block _ | `Verbatim _ | `Table _ | `Math_block _ | `Media _
     ; location = _
     } as nestable -> nestable_block_element_to_block nestable