add syndoc command

ocaml-lsp-server/src/hover_req.ml

@@ -193,9 +193,15 @@ let hover_at_cursor parsetree (`Logical (cursor_line, cursor_col)) =
   in
   !result
 
-let format_type_enclosing ~syntax ~markdown ~typ ~doc =
+let print_dividers sections = String.concat ~sep:"\n---\n" sections
+
+let format_as_code_block ~highlighter strings =
+  sprintf "```%s\n%s\n```" highlighter (String.concat ~sep:" " strings)
+
+let format_type_enclosing ~syntax ~markdown ~typ ~doc
+    ~(syntax_doc : Query_protocol.syntax_doc_result option) =
   (* TODO for vscode, we should just use the language id. But that will not work
-     for all editors *)
+      for all editors *)
   let syntax_doc =
     Option.map syntax_doc ~f:(fun syntax_doc ->
         sprintf
@@ -206,29 +212,29 @@ let format_type_enclosing ~syntax ~markdown ~typ ~doc =
   in
   `MarkupContent
     (if markdown then
-       let value =
-         let markdown_name = Document.Syntax.markdown_name syntax in
-         let type_info = Some (format_as_code_block ~highlighter:markdown_name [ typ ]) in
-         let doc =
-           Option.map doc ~f:(fun doc ->
-               match Doc_to_md.translate doc with
-               | Raw d -> d
-               | Markdown d -> d)
-         in
-         print_dividers (List.filter_opt [ type_info; syntax_doc; doc ])
-       in
-       { MarkupContent.value; kind = MarkupKind.Markdown }
-     else
-       let value =
-         print_dividers (List.filter_opt [ Some typ; syntax_doc; doc ])
-       in
-       { MarkupContent.value; kind = MarkupKind.PlainText })
+        let value =
+          let markdown_name = Document.Syntax.markdown_name syntax in
+          let type_info = Some (format_as_code_block ~highlighter:markdown_name [ typ ]) in
+          let doc =
+            Option.map doc ~f:(fun doc ->
+                match Doc_to_md.translate doc with
+                | Raw d -> d
+                | Markdown d -> d)
+          in
+          print_dividers (List.filter_opt [ type_info; syntax_doc; doc ])
+        in
+        { MarkupContent.value; kind = MarkupKind.Markdown }
+      else
+        let value =
+          print_dividers (List.filter_opt [ Some typ; syntax_doc; doc ])
+        in
+        { MarkupContent.value; kind = MarkupKind.PlainText })
 
 let format_ppx_expansion ~ppx ~expansion =
   let value = sprintf "(* ppx %s expansion *)\n%s" ppx expansion in
   `MarkedString { Lsp.Types.MarkedString.value; language = Some "ocaml" }
 
-let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t)
+let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) ~with_syntax_doc
     ~merlin ~mode ~uri ~position =
   let state = Server.state server in
   let verbosity =
@@ -257,11 +263,11 @@ let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t)
       v
   in
   let* type_enclosing =
-    Document.Merlin.type_enclosing merlin (Position.logical position) verbosity
+    Document.Merlin.type_enclosing merlin (Position.logical position) verbosity ~with_syntax_doc
   in
   match type_enclosing with
   | None -> Fiber.return None
-  | Some { Document.Merlin.loc; typ; doc = documentation } ->
+  | Some { Document.Merlin.loc; typ; doc = documentation; syntax_doc } ->
     let syntax = Document.syntax doc in
     let* typ =
       (* We ask Ocamlformat to format this type *)
@@ -293,7 +299,7 @@ let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t)
           client_capabilities
           ~field:(fun td -> Option.map td.hover ~f:(fun h -> h.contentFormat))
       in
-      format_type_enclosing ~syntax ~markdown ~typ ~doc:documentation
+      format_type_enclosing ~syntax ~markdown ~typ ~doc:documentation ~syntax_doc
     in
     let range = Range.of_loc loc in
     let hover = Hover.create ~contents ~range () in
@@ -416,7 +422,12 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode =
         match hover_at_cursor parsetree (Position.logical position) with
         | None -> Fiber.return None
         | Some `Type_enclosing ->
-          type_enclosing_hover ~server ~doc ~merlin ~mode ~uri ~position
+          let with_syntax_doc =
+            match state.configuration.data.syntax_documentation with
+            | Some { enable = true } -> true
+            | Some _ | None -> false
+          in
+          type_enclosing_hover ~server ~doc ~merlin ~mode ~uri ~position ~with_syntax_doc
         | Some ((`Ppx_expr _ | `Ppx_typedef_attr _) as ppx_kind) -> (
           let+ ppx_parsetree =
             Document.Merlin.with_pipeline_exn
@@ -428,4 +439,4 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode =
           | `Ppx_expr (expr, ppx) ->
             ppx_expression_hover ~ppx_parsetree ~expr ~ppx
           | `Ppx_typedef_attr (decl, attr) ->
-            typedef_attribute_hover ~ppx_parsetree ~decl ~attr)))
+            typedef_attribute_hover ~ppx_parsetree ~decl ~attr)))

ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml

@@ -116,7 +116,7 @@ let%expect_test "syntax doc should print" =
   let source = {ocaml|
 type t = ..
 |ocaml} in
-  let position = create_postion 1 9 in
+  let position = create_postion 1 5 in
   let req client =
     let* () = change_config client activate_syntax_doc in
     let* resp = hover_req client position in