Merge pull request #350 from NeoKaios/feat/show-documentation-on-hover

Show documentation comment on variable hover

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## [0.1.4] Next release
 
 ### Added
+- Show documentation comments on hover information [#350](https://github.com/OCamlPro/superbol-studio-oss/pull/350)
 - Completion for more grammar constructs [#322](https://github.com/OCamlPro/superbol-studio-oss/pull/322)
 - Support for LSP request `textDocument/codeLens` [#349](https://github.com/OCamlPro/superbol-studio-oss/pull/349)
 - Show display example of `NUMERIC-EDITED` data on hover [#337](https://github.com/OCamlPro/superbol-studio-oss/pull/337)

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,30 @@ let handle_semtoks_full,
 
 (** {3 Hover} *)
 
+let doc_of_datadef ~rev_comments ~filename data_def =
+  let open Cobol_preproc.Text in
+  let loc = Cobol_data.Item.def_loc data_def in
+  let def_filename = (fst @@ Cobol_common.Srcloc.as_lexloc loc).pos_fname in
+  if not (String.equal filename def_filename) (** def is in copybook *)
+  then ""
+  else
+    let def_range = Lsp_position.range_of_srcloc_in ~filename loc in
+    let (inline, full_line) =
+      List.fold_left begin fun acc { comment_loc; comment_kind; comment_contents } ->
+        let com_range = Lsp_position.range_of_lexloc comment_loc in
+        if def_range.start.line = com_range.start.line
+        then (Some comment_contents, snd acc)
+        else if def_range.start.line = com_range.start.line + 1
+             && comment_kind == `Line
+        then (fst acc, Some comment_contents)
+        else acc
+      end (None, None) rev_comments
+    in
+    match inline, full_line with
+    | Some comment, _ -> "\n---\n" ^ String.sub comment 2 (String.length comment - 2)
+    | None, Some comment -> "\n---\n" ^ String.sub comment 1 (String.length comment - 1)
+    | _ -> ""
+
 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 +491,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) ~rev_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 +503,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 = doc_of_datadef ~rev_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 +561,9 @@ 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; _ }; _ } 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 ~rev_comments,
             preproc_info_on_hover ~filename position pplog with
       | None, None ->
           None

test/lsp/lsp_hover.ml

@@ -1141,3 +1141,116 @@ 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 only inline comment
+      * val2 only line 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 12, character 18):
+    __rootdir__/prog.cob:13.17-13.23:
+      10         * val2 only line comment
+      11            02 VAL-2 PIC X.
+      12          PROCEDURE DIVISION.
+      13 >          DISPLAY STRUCT VAL-1 VAL-2.
+    ----                    ^^^^^^
+      14            STOP RUN.
+      15
+    ```cobol
+    STRUCT
+    ```
+    Group of 2 subfields
+    Size: 16 bits
+    ---
+     inline comment
+    (line 12, character 25):
+    __rootdir__/prog.cob:13.24-13.29:
+      10         * val2 only line comment
+      11            02 VAL-2 PIC X.
+      12          PROCEDURE DIVISION.
+      13 >          DISPLAY STRUCT VAL-1 VAL-2.
+    ----                           ^^^^^
+      14            STOP RUN.
+      15
+    ```cobol
+    VAL-1 IN STRUCT
+    ```
+    ```cobol
+    PIC X USAGE DISPLAY
+    ```
+    ALPHANUMERIC(1)
+    ---
+     val1 only inline comment
+    (line 12, character 31):
+    __rootdir__/prog.cob:13.30-13.35:
+      10         * val2 only line comment
+      11            02 VAL-2 PIC X.
+      12          PROCEDURE DIVISION.
+      13 >          DISPLAY STRUCT VAL-1 VAL-2.
+    ----                                 ^^^^^
+      14            STOP RUN.
+      15
+    ```cobol
+    VAL-2 IN STRUCT
+    ```
+    ```cobol
+    PIC X USAGE DISPLAY
+    ```
+    ALPHANUMERIC(1)
+    ---
+     val2 only line comment |}];;
+
+
+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) |}]