Example of displayed value on hover of NUMERIC-EDITED variables

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## [0.1.4] Next release
 
 ### Added
+- Show display example of `NUMERIC-EDITED` data on hover [#337](https://github.com/OCamlPro/superbol-studio-oss/pull/337)
 - Support for dump and listing files, along with a task attribute for outputting the latter [#347](https://github.com/OCamlPro/superbol-studio-oss/pull/347)
 - Improved information shown on completion [#336](https://github.com/OCamlPro/superbol-studio-oss/pull/336)
 - Configuration flag for caching in storage provided by Visual Studio Code [#167](https://github.com/OCamlPro/superbol-studio-oss/pull/167)

src/lsp/cobol_data/data_picture.ml

@@ -122,7 +122,6 @@ module TYPES = struct
   and special_insertion =
     {
       special_insertion_offset: int;
-      special_insertion_length: int;
     }
 
   and fixed_insertion =
@@ -325,14 +324,13 @@ let data_size: category -> int = function
 
 let edited_size: category -> int =
   let simple_insertion_size { simple_insertion_symbols = symbols; _ } =
-    symbols.symbol_occurences
-  and special_insertion_size { special_insertion_length = n; _ } = n in
+    symbols.symbol_occurences in
   let simple_insertions_size =
     List.fold_left (fun s i -> s + simple_insertion_size i) 0
   and basic_editions_size basics =
     List.fold_left begin fun s -> function
       | SimpleInsertion i -> s + simple_insertion_size i
-      | SpecialInsertion i -> s + special_insertion_size i
+      | SpecialInsertion _
       | FixedInsertion _ -> s + 1
     end 0 basics
   in
@@ -561,10 +559,9 @@ let append category ~after_v ({ symbol; symbol_occurences = n } as symbols) =
              Ok (numeric ~with_sign ~editions digits scale)
          | Error () -> error)
     | _ -> error
-  and append_special_insertion offset = function
+  and append_special_insertion special_insertion_offset = function
     | FixedNum { digits; scale; with_sign; editions } ->
-        let special = SpecialInsertion { special_insertion_offset = offset;
-                                         special_insertion_length = n } in
+        let special = SpecialInsertion { special_insertion_offset } in
         Ok (numeric ~with_sign digits scale
               ~editions:{ editions with basics = special :: editions.basics })
     | _ -> error
@@ -767,12 +764,11 @@ let char_order_checker_for_pic_string config =
 (* Maybe not in ISO/IEC 2014: Z/CS *)
 let mutual_exclusions =
   SymbolsMap.of_seq @@ List.to_seq [
-    CS, Symbols.singleton Z;
     DecimalSep, Symbols.of_list [P; V];
     P, Symbols.singleton DecimalSep;
     Star, Symbols.singleton Z;
     V, Symbols.singleton DecimalSep;
-    Z, Symbols.of_list [Star; CS];
+    Z, Symbols.singleton Star;
   ]
 
 type exp_sequence_state =

src/lsp/cobol_data/data_picture.mli

@@ -40,6 +40,9 @@ module TYPES: sig
     | Z
     | Zero
 
+  val pp_symbol: symbol Pretty.printer
+  val pp_symbol_cobolized: symbol Pretty.printer
+
   type symbols =
     {
       symbol: symbol;
@@ -102,7 +105,6 @@ module TYPES: sig
   and special_insertion =
     {
       special_insertion_offset: int;
-      special_insertion_length: int;
     }
 
   and fixed_insertion =

src/lsp/cobol_lsp/cobol_lsp.ml

@@ -36,6 +36,7 @@ module INTERNAL = struct
   module Document = Lsp_document
   module Server = Lsp_server
   module Loop = Lsp_server_loop
+  module Picture_interp = Lsp_picture_interp
   module Request = Lsp_request.INTERNAL
   module Utils = Lsp_utils
   module Debug = Lsp_debug

src/lsp/cobol_lsp/lsp_data_info_printer.ml

@@ -25,16 +25,42 @@ let pp_cobol_block: _ Fmt.t -> _ Fmt.t = fun pp ->
 
 (* usage *)
 
+let max_value digits scale =
+  let s = "123456789123456789123456789123456789" in
+  let whole = (digits - scale) in
+  let scale = if scale < 0 then 0 else scale in
+  let whole_part = Str.string_before s whole in
+  let decimal_part = Str.string_before (Str.string_after s whole) scale in
+  float_of_string (whole_part ^ "." ^ decimal_part)
+
+let nbsp_repl = Str.global_replace (Str.regexp " ") " " (* <- utf8 nbsp *)
+
+let pp_example_of ppf (picture: Cobol_data.Picture.t) =
+  try
+    match picture.category with
+    | FixedNum { digits; scale; _ } ->
+      let max = max_value digits scale in
+      let max_str =
+        if Float.is_integer max
+        then string_of_int (int_of_float max)
+        else string_of_float max in
+      Fmt.pf ppf "\n\n*e.g,* [`%s`] (0), [`%s`] (%s)"
+        (Lsp_picture_interp.example_of ~picture 0. |> nbsp_repl)
+        (Lsp_picture_interp.example_of ~picture max |> nbsp_repl)
+        max_str
+    | _ -> ()
+
+  with Invalid_argument _ -> ()
+
 let pp_usage: usage Pretty.printer =
   let pp_usage_with_picture ppf name (picture: Cobol_data.Picture.t) =
-    Fmt.(
-      pp_cobol_block (fun ppf _ ->
-        pf ppf "PIC %a USAGE %s"
-        Cobol_data.Picture.pp_picture_symbols picture.pic
-        name)
-      ++ const string "\n\n"
-      ++ const Cobol_data.Picture.pp_category picture.category)
-    ppf ()
+    Fmt.pf ppf "%a\n\n%a%a"
+      (pp_cobol_block (fun ppf _ ->
+           Fmt.pf ppf "PIC %a USAGE %s"
+             Cobol_data.Picture.pp_picture_symbols picture.pic
+             name)) ()
+      Cobol_data.Picture.pp_category picture.category
+      pp_example_of picture
   and pp_usage_with_sign ppf name signed =
     pp_cobol_block Fmt.(any "USAGE " ++ any name ++ any (if signed then " SIGNED" else " UNSIGNED"))
     ppf ()

src/lsp/cobol_lsp/lsp_picture_interp.ml

@@ -0,0 +1,202 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                        SuperBOL OSS Studio                             *)
+(*                                                                        *)
+(*  Copyright (c) 2022-2023 OCamlPro SAS                                  *)
+(*                                                                        *)
+(* All rights reserved.                                                   *)
+(* This source code is licensed under the GNU Affero General Public       *)
+(* License version 3 found in the LICENSE.md file in the root directory   *)
+(* of this source tree.                                                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Cobol_data.Picture
+open TYPES
+
+
+let simple_insertion_char_of ~symbol =
+  match symbol with
+  | B -> ' '
+  | Zero -> '0'
+  | Slant -> '/'
+  | DecimalSep -> '.'
+  | GroupingSep -> ','
+  | _ -> Pretty.invalid_arg
+           "Not a simple insertion symbol '%a'"
+           pp_symbol symbol
+
+let fixed_insertion_str_of ~symbol ~is_negative =
+  match symbol with
+  | CS -> "$"
+  | Plus | Minus when is_negative -> "-"
+  | Plus -> "+"
+  | Minus -> " "
+  | CR | DB when not is_negative -> "  "
+  | CR -> "CR"
+  | DB -> "DB"
+  | _ -> Pretty.invalid_arg
+           "Not a fixed insertion symbol '%a'"
+           pp_symbol_cobolized symbol
+
+let do_basic_edit_on ~is_negative basic s =
+  let (offset, insertion) =
+    match basic with
+    | SimpleInsertion
+        { simple_insertion_symbols = { symbol_occurences = n; symbol };
+          simple_insertion_offset = offset } ->
+      offset, String.make n @@ simple_insertion_char_of ~symbol
+    | SpecialInsertion { special_insertion_offset = offset } ->
+      offset, "."
+    | FixedInsertion { fixed_insertion_symbol = symbol; fixed_insertion_offset = offset } ->
+      offset, fixed_insertion_str_of ~symbol ~is_negative
+  in
+  Str.string_before s offset
+  ^ insertion
+  ^ Str.string_after s offset
+
+let all_repl_indexes_from ~ranges s digits =
+  let indexes =
+    ranges
+    |> List.rev_map begin fun { floating_range_offset = offset;
+                                floating_range_length = len } ->
+      List.init len (fun i -> offset + i)
+    end
+    |> List.flatten |> List.sort Int.compare
+  in
+  let is_only_repl_char = List.length indexes >= digits in
+  let min_index = List.hd indexes in
+  let (_, (all_indexes, all_zero)) = String.fold_left
+      begin fun ((idx, (acc_repl, should_continue_repl)) as acc) ch ->
+        if not should_continue_repl then acc else
+        if List.mem idx indexes
+        then (idx+1,
+              if ch == '0'
+              then (idx::acc_repl, true)
+              else (acc_repl, false))
+        else
+        if min_index < idx && List.mem ch [' '; ',']
+        then (idx+1, (idx::acc_repl, true))
+        else (idx+1, (acc_repl, should_continue_repl))
+      end (0, ([], true)) s
+  in all_indexes, all_zero && is_only_repl_char
+
+let do_floatedit_n_zerorepl_on digits is_negative
+    symbol ranges s =
+  if ranges == [] then s else
+    let floating_last_ch = match symbol with
+      | Plus | Minus when is_negative -> '-'
+      | Plus -> '+'
+      | Minus -> ' '
+      | CS -> '$'
+      | Z -> ' '
+      | Star -> '*'
+      | _ -> Pretty.invalid_arg
+               "Floating edit or zero replacement symbol '%a' is invalid"
+               pp_symbol_cobolized symbol
+    in
+    let repl_ch = match symbol with
+      | Minus | Plus | CS | Z -> ' '
+      | Star -> '*'
+      | _ -> Pretty.invalid_arg
+               "Floating edit or zero replacement symbol '%a' is invalid"
+               pp_symbol_cobolized symbol
+    in
+    let repl_str = String.make 1 repl_ch in
+    let all_repl_indexes, repl_everything =
+      all_repl_indexes_from ~ranges s digits in
+    if repl_everything
+    then
+      String.map begin fun ch ->
+        if ch == '.' && symbol == Star
+        then '.'
+        else repl_ch
+      end s
+    else
+      let (_, _, last_repl_idx, res) = String.fold_left
+          begin fun (i, after_decimal_point, last_repl_idx, res) ch ->
+            let orig_str = String.make 1 ch in
+            if after_decimal_point
+            then (i+1, after_decimal_point, last_repl_idx, res ^ orig_str)
+            else
+            if ch == '.'
+            then (i+1, true, last_repl_idx, res ^ ".")
+            else
+            if List.mem i all_repl_indexes
+            then (i+1, after_decimal_point, i, res ^ repl_str)
+            else (i+1, after_decimal_point, last_repl_idx, res ^ orig_str)
+          end (0, false, -1, "") s
+      in
+      String.mapi begin fun i ch ->
+        if i == last_repl_idx
+        then floating_last_ch
+        else ch
+      end
+        res
+
+let rec edit_basics ~is_negative basics s =
+  match basics with
+  | [] -> s
+  | hd::tl ->
+    do_basic_edit_on ~is_negative hd s
+    |> edit_basics ~is_negative tl
+
+let simple_example_of ~digits ~scale ~with_dot value =
+  let str_val = string_of_float (Float.abs value) in
+  let i = String.index str_val '.' in
+  let whole_part = Str.string_before str_val i in
+  let whole_len = String.length whole_part in
+  let floating_part = Str.string_after str_val (i+1) in
+  let required_len = digits - scale in
+  (String.init required_len
+     (fun i ->
+        if i < required_len - whole_len
+        then '0'
+        else whole_part.[i - (required_len - whole_len)])
+   )
+  ^ (if scale > 0
+     then
+       (if with_dot then "." else "")
+       ^ String.init scale
+         (fun i ->
+            if i < String.length floating_part
+            then floating_part.[i]
+            else '0')
+     else "")
+
+let example_of ~picture value =
+  if List.exists (fun { symbol; _ } -> symbol == P) picture.pic
+  then raise @@ Invalid_argument "No example with P yet" (* /!\ scale can be negative: PIC 9P *)
+  else
+    match picture.category with
+    | Alphabetic _ | Boolean _ | National _ | Alphanumeric _ -> ""
+    | FloatNum _ -> raise @@ Invalid_argument "No example for floatnum yet"
+    | FixedNum { digits; scale; with_sign; _ }
+      when not @@ is_edited picture  ->
+      (if with_sign then "+" else "")
+      ^ simple_example_of ~digits ~scale ~with_dot:true value
+    | FixedNum { digits; scale; with_sign;
+                 editions = { basics; floating; zerorepl } } ->
+      ignore (with_sign);
+      let is_negative = value < 0. in
+      let edit_zerorepl = Option.fold ~none:Fun.id
+          ~some:(fun { zero_replacement_symbol = symbol;
+                       zero_replacement_ranges = ranges } ->
+                  do_floatedit_n_zerorepl_on digits is_negative symbol ranges)
+          zerorepl in
+      let edit_floating = Option.fold ~none:Fun.id
+          ~some:(fun { floating_insertion_symbol = symbol;
+                       floating_insertion_ranges = ranges } ->
+                  do_floatedit_n_zerorepl_on digits is_negative symbol ranges)
+          floating in
+      try
+        (if Option.is_some floating
+         then "0"
+         else "")
+        ^ simple_example_of ~digits ~scale ~with_dot:false value
+        |> edit_basics ~is_negative:(value < 0.) basics
+        |> edit_zerorepl
+        |> edit_floating
+      with Invalid_argument e ->
+        Pretty.invalid_arg
+          "Unable to build example of picture, error '%s'" e

test/cobol_parsing/test_picture_parsing.ml

@@ -328,8 +328,7 @@ module Pictures = struct
                           simple_insertion_offset = 0 };
         SimpleInsertion { simple_insertion_symbols = comma 1;
                           simple_insertion_offset = 5 };
-        SpecialInsertion { special_insertion_offset = 9;
-                           special_insertion_length = 1 } ]
+        SpecialInsertion { special_insertion_offset = 9 } ]
     in
     { category = fixednum 9 3 ~basics;
       pic = [comma 2; nine 3; comma 1; nine 3; dot 1; nine 3] }
@@ -361,8 +360,7 @@ module Pictures = struct
     and basics =
       [ SimpleInsertion { simple_insertion_symbols = comma 1;
                           simple_insertion_offset = 3 };
-        SpecialInsertion { special_insertion_offset = 7;
-                           special_insertion_length = 1 } ]
+        SpecialInsertion { special_insertion_offset = 7 } ]
     in
     { category = fixednum 9 3 ~basics ~zerorepl;
       pic = [z 3; comma 1; z 3; dot 1; z 3] }
@@ -413,8 +411,7 @@ module Pictures = struct
     let basics =
       [ SimpleInsertion { simple_insertion_symbols = comma 1;
                           simple_insertion_offset = 3 };
-        SpecialInsertion { special_insertion_offset = 7;
-                           special_insertion_length = 1 } ]
+        SpecialInsertion { special_insertion_offset = 7 } ]
     in
     { category = floatnum 9 3 3 ~basics;
       pic = [nine 3; comma 1; nine 3; dot 1; nine 3; e 1; plus 1; nine 3] }
@@ -446,8 +443,7 @@ module Pictures = struct
 
   let pic_ppvpp =
     let basics =
-      [ SpecialInsertion { special_insertion_offset = 2;
-                           special_insertion_length = 1 } ]
+      [ SpecialInsertion { special_insertion_offset = 2 } ]
     and floating =
       { floating_insertion_symbol = Plus;
         floating_insertion_ranges = [{ floating_range_offset = 0;