Skip to content

Commit

Permalink
Merge pull request #337 from NeoKaios/feat/pic-example-on-hover
Browse files Browse the repository at this point in the history
Example of displayed value on hover of `NUMERIC-EDITED` variables
  • Loading branch information
nberth authored Aug 8, 2024
2 parents e15eab4 + f60f2f5 commit 4b3926a
Show file tree
Hide file tree
Showing 9 changed files with 357 additions and 32 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
14 changes: 5 additions & 9 deletions src/lsp/cobol_data/data_picture.ml
Original file line number Diff line number Diff line change
Expand Up @@ -122,7 +122,6 @@ module TYPES = struct
and special_insertion =
{
special_insertion_offset: int;
special_insertion_length: int;
}

and fixed_insertion =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
4 changes: 3 additions & 1 deletion src/lsp/cobol_data/data_picture.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -102,7 +105,6 @@ module TYPES: sig
and special_insertion =
{
special_insertion_offset: int;
special_insertion_length: int;
}

and fixed_insertion =
Expand Down
1 change: 1 addition & 0 deletions src/lsp/cobol_lsp/cobol_lsp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
42 changes: 34 additions & 8 deletions src/lsp/cobol_lsp/lsp_data_info_printer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand Down
202 changes: 202 additions & 0 deletions src/lsp/cobol_lsp/lsp_picture_interp.ml
Original file line number Diff line number Diff line change
@@ -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
12 changes: 4 additions & 8 deletions test/cobol_parsing/test_picture_parsing.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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] }
Expand Down Expand Up @@ -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] }
Expand Down Expand Up @@ -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] }
Expand Down Expand Up @@ -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;
Expand Down
Loading

0 comments on commit 4b3926a

Please sign in to comment.