feat: show doc comments on hover

src/lsp/cobol_lsp/lsp_data_info_printer.ml

@@ -249,10 +249,10 @@ let pp_record_renaming': record_renaming with_loc Pretty.printer = fun ppf ->
 
 let pp_data_definition ppf = function
   | Data_field { def; _ } ->
-      Fmt.const pp_field_definition' def ppf ()
+      pp_field_definition' ppf def
   | Data_renaming { def; _ } ->
-      Fmt.const pp_record_renaming' def ppf ()
+      pp_record_renaming' ppf def
   | Data_condition { def; field; _ } ->
       Fmt.pf ppf "%a\n\n%a" pp_condition_name ~&def pp_field_definition ~&field
   | Table_index { table; _ } ->
-      Fmt.const pp_table_definition' table ppf ()
+      pp_table_definition' ppf table

src/lsp/cobol_lsp/lsp_request.ml

@@ -454,6 +454,23 @@ let handle_semtoks_full,
 
 (** {3 Hover} *)
 
+let documetation_of_datadef ~(comments: Cobol_preproc.Text.comments) ~filename data_def =
+  let loc = Cobol_data.Item.def_loc data_def in
+  let def_range = Lsp_position.range_of_srcloc_in ~filename loc in
+  let comments = List.rev @@
+    List.filter_map begin fun ({ comment_loc; comment_kind; comment_contents }: Cobol_preproc.Text.comment) ->
+      let com_range = Lsp_position.range_of_lexloc comment_loc in
+      if def_range.start.line = com_range.start.line
+      || def_range.start.line = com_range.start.line + 1
+         && comment_kind ==  `Line
+      then Some comment_contents
+      else None
+    end comments in
+  if List.length comments == 0
+  then ""
+  else Pretty.to_string "\n```cobol\n%a\n```"
+      Fmt.(list ~sep:(any "\n") string) comments
+
 let lookup_data_definition_for_hover cu_name element_at_pos group =
   let { payload = cu; _ } = CUs.find_by_name cu_name group in
   let named_data_defs = cu.unit_data.data_items.named in
@@ -467,7 +484,7 @@ let lookup_data_definition_for_hover cu_name element_at_pos group =
   with Cobol_unit.Qualmap.Ambiguous _ -> raise Not_found
 
 let data_definition_on_hover
-    ?(always_show_hover_text_in_data_div = false)
+    ?(always_show_hover_text_in_data_div = false) ~comments
     ~uri position Cobol_typeck.Outputs.{ group; _ } =
   let filename = Lsp.Uri.to_path uri in
   match Lsp_lookup.element_at_position ~uri position group with
@@ -479,11 +496,12 @@ let data_definition_on_hover
       try
         let data_def, hover_loc
           = lookup_data_definition_for_hover cu_name ele_at_pos group in
+        let doc_comments = documetation_of_datadef ~comments ~filename data_def in
         if always_show_hover_text_in_data_div ||
            not (Lsp_position.is_in_srcloc ~filename position @@
                 Cobol_data.Item.def_loc data_def)
-        then Some (Pretty.to_string
-                     "%a" Lsp_data_info_printer.pp_data_definition data_def,
+        then Some (Pretty.to_string "%a%s"
+                     Lsp_data_info_printer.pp_data_definition data_def doc_comments,
                    hover_loc)
         else None
       with Not_found ->
@@ -536,9 +554,11 @@ let handle_hover ?always_show_hover_text_in_data_div
     registry HoverParams.{ textDocument = doc; position; _ } =
   let filename = Lsp.Uri.to_path doc.uri in
   try_with_main_document_data registry doc
-    ~f:begin fun ~doc:{ artifacts = { pplog; _ }; _ } checked_doc ->
+    ~f:begin fun
+      ~doc:{ artifacts = { pplog; rev_comments = comments; _ }; _ }
+      checked_doc ->
       match data_definition_on_hover ~uri:doc.uri position checked_doc
-              ?always_show_hover_text_in_data_div,
+              ?always_show_hover_text_in_data_div ~comments,
             preproc_info_on_hover ~filename position pplog with
       | None, None ->
           None

test/lsp/lsp_hover.ml

@@ -1141,3 +1141,120 @@ let%expect_test "hover-typedef-communication-section" =
     Hovering nothing worthy
     (line 10, character 17):
     Hovering nothing worthy |}];;
+
+let%expect_test "hover-comment" =
+  let { projdir; end_with_postproc }, server = make_lsp_project () in
+  print_hovered server ~projdir @@ extract_position_markers {cobol|
+>>source format is fixed
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+      * full line comment
+       01 STRUCT. *> inline comment
+         02 VAL-1 PIC X. *> val1 inline comment
+         02 VAL-2 PIC X.
+       PROCEDURE DIVISION.
+         DISPLAY S_|_TRUCT V_|_AL-1 V_|_AL-2.
+         STOP RUN.
+    |cobol};
+  end_with_postproc [%expect.output];
+  [%expect {|
+    {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
+    (line 11, character 18):
+    __rootdir__/prog.cob:12.17-12.23:
+       9            02 VAL-1 PIC X. *> val1 inline comment
+      10            02 VAL-2 PIC X.
+      11          PROCEDURE DIVISION.
+      12 >          DISPLAY STRUCT VAL-1 VAL-2.
+    ----                    ^^^^^^
+      13            STOP RUN.
+      14
+    ```cobol
+    STRUCT
+    ```
+    Group of 2 subfields
+    Size: 16 bits
+    ```cobol
+    * full line comment
+    *> inline comment
+    ```
+    (line 11, character 25):
+    __rootdir__/prog.cob:12.24-12.29:
+       9            02 VAL-1 PIC X. *> val1 inline comment
+      10            02 VAL-2 PIC X.
+      11          PROCEDURE DIVISION.
+      12 >          DISPLAY STRUCT VAL-1 VAL-2.
+    ----                           ^^^^^
+      13            STOP RUN.
+      14
+    ```cobol
+    VAL-1 IN STRUCT
+    ```
+    ```cobol
+    PIC X USAGE DISPLAY
+    ```
+    ALPHANUMERIC(1)
+    ```cobol
+    *> val1 inline comment
+    ```
+    (line 11, character 31):
+    __rootdir__/prog.cob:12.30-12.35:
+       9            02 VAL-1 PIC X. *> val1 inline comment
+      10            02 VAL-2 PIC X.
+      11          PROCEDURE DIVISION.
+      12 >          DISPLAY STRUCT VAL-1 VAL-2.
+    ----                                 ^^^^^
+      13            STOP RUN.
+      14
+    ```cobol
+    VAL-2 IN STRUCT
+    ```
+    ```cobol
+    PIC X USAGE DISPLAY
+    ```
+    ALPHANUMERIC(1) |}];;
+
+
+let%expect_test "hover-comment-copy" =
+  let { projdir; end_with_postproc }, server = make_lsp_project () in
+  let server,    _ = add_cobol_doc server ~projdir "lib.cpy" {cobol|
+      * copy full line comment
+       01 FIELD PIC X. *> copy inline comment
+  |cobol} in
+  print_hovered server ~projdir @@ extract_position_markers {cobol|
+  >>source format is fixed
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+      * full line comment
+       COPY lib. *> inline comment
+       PROCEDURE DIVISION.
+          DISPLAY F_|_IELD
+          STOP RUN.
+    |cobol};
+  end_with_postproc [%expect.output];
+  [%expect {|
+    {"params":{"diagnostics":[],"uri":"file://__rootdir__/lib.cpy"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
+    {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
+    (line 9, character 19):
+    __rootdir__/prog.cob:10.18-10.23:
+       7         * full line comment
+       8          COPY lib. *> inline comment
+       9          PROCEDURE DIVISION.
+      10 >           DISPLAY FIELD
+    ----                     ^^^^^
+      11             STOP RUN.
+      12
+    ```cobol
+    FIELD
+    ```
+    ```cobol
+    PIC X USAGE DISPLAY
+    ```
+    ALPHANUMERIC(1)
+    ```cobol
+    * full line comment
+    *> inline comment
+    ``` |}]