Skip to content

Commit 5845a27

Browse files
azzsalazzsal
authored
Add fine grained diff of arrow type exprs (#143)
* Fix types in diff module * Update text diff to handle printing of tuple type exprs diffs * Format * Add diffing of arrow types * Add change log * Fix test description * Format * Minor fixes * Fix test * Minor fix * Minor fix
1 parent 4d73a03 commit 5845a27

File tree

8 files changed

+429
-118
lines changed

8 files changed

+429
-118
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
- Add `--plain` flag to `api-diff` to use text markers for inline highlighting.
1414
Can be used when the output doesn't support colors (#136, @azzsal)
1515
- Add fine-grained diff of tuple types (#139, @azzsal)
16+
- Add fine-grained diff of arrow types (#140, @azzsal)
1617

1718
### Changed
1819

‎lib/diff.ml‎

Lines changed: 96 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,28 @@
11
type type_expr =
22
| Tuple of tuple
3+
| Arrow of arrow
34
| Atomic of Types.type_expr Stddiff.atomic_modification
45

56
and tuple = (Types.type_expr, type_expr) Stddiff.List.t
67

8+
and arrow = {
9+
arg_label :
10+
( arg_label option,
11+
(arg_label, arg_label_diff) Stddiff.Option.t )
12+
Stddiff.maybe_changed;
13+
arg_type : (Types.type_expr, type_expr) Stddiff.maybe_changed;
14+
return_type : (Types.type_expr, type_expr) Stddiff.maybe_changed;
15+
}
16+
17+
and arg_label = Labelled_arg of string | Optional_arg of string
18+
19+
and arg_label_diff = {
20+
name : (string, string Stddiff.atomic_modification) Stddiff.maybe_changed;
21+
arg_optional : (bool, arg_optional) Stddiff.maybe_changed;
22+
}
23+
24+
and arg_optional = Added_opt_arg | Removed_opt_arg
25+
726
type type_modification = {
827
type_kind : (Types.type_decl_kind, type_kind) Stddiff.maybe_changed;
928
type_privacy : (Asttypes.private_flag, type_privacy) Stddiff.maybe_changed;
@@ -145,6 +164,16 @@ let rec type_expr ~typing_env ?(ref_params = []) ?(cur_params = []) reference
145164
match type_exprs with
146165
| Stddiff.Same _ -> Stddiff.Same reference
147166
| Changed change -> Changed (Tuple change))
167+
| ( Tarrow (ref_arg_label, ref_arg_type, ref_return_type, _),
168+
Tarrow (cur_arg_label, cur_arg_type, cur_return_type, _) ) -> (
169+
let arrow =
170+
arrow ~typing_env ~ref_params ~cur_params
171+
~reference:(ref_arg_label, ref_arg_type, ref_return_type)
172+
~current:(cur_arg_label, cur_arg_type, cur_return_type)
173+
in
174+
match arrow with
175+
| Stddiff.Same _ -> Stddiff.Same reference
176+
| Changed change -> Changed (Arrow change))
148177
| _ ->
149178
let normed_ref, normed_cur =
150179
Normalize.type_params_arity ~reference:ref_params ~current:cur_params
@@ -168,6 +197,73 @@ and type_exprs ~typing_env ~ref_params ~cur_params ~reference ~current =
168197
type_expr ~typing_env ~ref_params ~cur_params ref cur)
169198
~reference ~current
170199

200+
and arrow ~typing_env ~ref_params ~cur_params ~reference ~current =
201+
let unwrap_optional_arg lbl typ =
202+
match lbl with
203+
| Asttypes.Nolabel | Labelled _ -> typ
204+
| Optional _ -> (
205+
match Types.get_desc typ with
206+
| Tconstr (_, [ te ], _) -> te
207+
| _ -> assert false)
208+
in
209+
let ref_arg_label, ref_arg_type, ref_return_type = reference in
210+
let cur_arg_label, cur_arg_type, cur_return_type = current in
211+
let arg_label = arg_label ~reference:ref_arg_label ~current:cur_arg_label in
212+
let arg_type =
213+
type_expr ~typing_env ~ref_params ~cur_params
214+
(unwrap_optional_arg ref_arg_label ref_arg_type)
215+
(unwrap_optional_arg cur_arg_label cur_arg_type)
216+
in
217+
let return_type =
218+
type_expr ~typing_env ~ref_params ~cur_params ref_return_type
219+
cur_return_type
220+
in
221+
match (arg_label, arg_type, return_type) with
222+
| Stddiff.Same _, Same _, Same _ -> Same reference
223+
| _ -> Changed { arg_label; arg_type; return_type }
224+
225+
and arg_label ~reference ~current =
226+
let open Stddiff in
227+
let convert = function
228+
| Asttypes.Nolabel -> None
229+
| Labelled name -> Some (Labelled_arg name)
230+
| Optional name -> Some (Optional_arg name)
231+
in
232+
Option.diff
233+
~diff_one:(fun ref cur ->
234+
match (ref, cur) with
235+
| Labelled_arg ref_name, Labelled_arg cur_name ->
236+
if String.equal ref_name cur_name then Same (Labelled_arg ref_name)
237+
else
238+
Changed
239+
{
240+
name = Changed { reference = ref_name; current = cur_name };
241+
arg_optional = Same false;
242+
}
243+
| Labelled_arg ref_name, Optional_arg cur_name ->
244+
let name =
245+
if String.equal ref_name cur_name then Same ref_name
246+
else Changed { reference = ref_name; current = cur_name }
247+
in
248+
let arg_optional = Changed Added_opt_arg in
249+
Changed { name; arg_optional }
250+
| Optional_arg ref_name, Labelled_arg cur_name ->
251+
let name =
252+
if String.equal ref_name cur_name then Same ref_name
253+
else Changed { reference = ref_name; current = cur_name }
254+
in
255+
let arg_optional = Changed Removed_opt_arg in
256+
Changed { name; arg_optional }
257+
| Optional_arg ref_name, Optional_arg cur_name ->
258+
if String.equal ref_name cur_name then Same (Optional_arg ref_name)
259+
else
260+
Changed
261+
{
262+
name = Changed { reference = ref_name; current = cur_name };
263+
arg_optional = Same true;
264+
})
265+
~reference:(convert reference) ~current:(convert current)
266+
171267
let rec type_item ~typing_env ~name ~reference ~current =
172268
match (reference, current) with
173269
| None, None -> None

‎lib/diff.mli‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,28 @@
11
type type_expr =
22
| Tuple of tuple
3+
| Arrow of arrow
34
| Atomic of Types.type_expr Stddiff.atomic_modification
45

56
and tuple = (Types.type_expr, type_expr) Stddiff.List.t
67

8+
and arrow = {
9+
arg_label :
10+
( arg_label option,
11+
(arg_label, arg_label_diff) Stddiff.Option.t )
12+
Stddiff.maybe_changed;
13+
arg_type : (Types.type_expr, type_expr) Stddiff.maybe_changed;
14+
return_type : (Types.type_expr, type_expr) Stddiff.maybe_changed;
15+
}
16+
17+
and arg_label = Labelled_arg of string | Optional_arg of string
18+
19+
and arg_label_diff = {
20+
name : (string, string Stddiff.atomic_modification) Stddiff.maybe_changed;
21+
arg_optional : (bool, arg_optional) Stddiff.maybe_changed;
22+
}
23+
24+
and arg_optional = Added_opt_arg | Removed_opt_arg
25+
726
type type_modification = {
827
type_kind : (Types.type_decl_kind, type_kind) Stddiff.maybe_changed;
928
type_privacy : (Asttypes.private_flag, type_privacy) Stddiff.maybe_changed;

‎lib/text_diff.ml‎

Lines changed: 107 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -194,9 +194,7 @@ and process_type_header_diff name type_privacy_diff type_manifest_diff
194194
let type_name_hunk = Icommon (" " ^ name) in
195195
let equal_hunks = process_equal_sign_diff type_manifest_diff type_kind_diff in
196196
let type_privacy_hunks = process_privacy_diff type_privacy_diff in
197-
let type_manifest_hunks =
198-
process_manifest_diff ~paren:false type_manifest_diff
199-
in
197+
let type_manifest_hunks = process_manifest_diff type_manifest_diff in
200198
let type_header_hunks =
201199
if List.length equal_hunks = 2 then
202200
List.concat
@@ -340,16 +338,15 @@ and process_equal_sign_diff type_manifest_diff type_kind_diff =
340338
[ Iconflict { iorig = None; inew = Some " =" } ]
341339
| _ -> [ Icommon " =" ]
342340

343-
and process_manifest_diff ~paren manifest_diff =
341+
and process_manifest_diff manifest_diff =
344342
match manifest_diff with
345343
| Same None -> []
346344
| Same (Some te) -> [ Icommon (" " ^ type_expr_to_string te) ]
347345
| Changed (Added te) ->
348346
[ Iconflict { iorig = None; inew = Some (" " ^ type_expr_to_string te) } ]
349347
| Changed (Removed te) ->
350348
[ Iconflict { iorig = Some (" " ^ type_expr_to_string te); inew = None } ]
351-
| Changed (Modified te_diff) ->
352-
Icommon " " :: process_type_expr_diff ~paren te_diff
349+
| Changed (Modified te_diff) -> Icommon " " :: process_type_expr_diff te_diff
353350

354351
and process_type_kind_diff kind_diff =
355352
match kind_diff with
@@ -447,35 +444,112 @@ and process_cstr_diff name cstr_diff =
447444
let record_hunks = process_record_type_diff record_diff in
448445
Inline_hunks (Icommon (Printf.sprintf "| %s of " name) :: record_hunks)
449446
| Tuple_cstr tuple_diff ->
450-
let tuple_hunks = process_tuple_type_diff tuple_diff in
447+
let tuple_hunks = process_tuple_type_diff ~context:`None tuple_diff in
451448
Inline_hunks (Icommon (Printf.sprintf "| %s of " name) :: tuple_hunks)
452449
)
453450

454-
and process_tuple_type_diff diff =
451+
and process_tuple_type_diff ~context diff =
455452
let module S = Stddiff in
456-
List.mapi
457-
(fun i te_diff ->
458-
let star = if i > 0 then " * " else "" in
459-
match te_diff with
460-
| S.Same same_te ->
461-
[ Icommon (Printf.sprintf "%s%s" star (type_expr_to_string same_te)) ]
462-
| Changed (Stddiff.Added te) ->
463-
[
464-
Iconflict
465-
{ iorig = None; inew = Some (star ^ type_expr_to_string te) };
466-
]
467-
| Changed (Removed te) ->
468-
[
469-
Iconflict
470-
{ iorig = Some (star ^ type_expr_to_string te); inew = None };
471-
]
472-
| Changed (Modified te) ->
473-
let te_hunks = process_type_expr_diff ~paren:true te in
474-
if i > 0 then Icommon " * " :: te_hunks else te_hunks)
475-
diff
476-
|> List.concat
477-
478-
and process_type_expr_diff ?(paren = true) (diff : Diff.type_expr) :
453+
let tuple_hunks =
454+
List.mapi
455+
(fun i te_diff ->
456+
let star = if i > 0 then " * " else "" in
457+
match te_diff with
458+
| S.Same same_te ->
459+
[
460+
Icommon (Printf.sprintf "%s%s" star (type_expr_to_string same_te));
461+
]
462+
| Changed (Stddiff.Added te) ->
463+
[
464+
Iconflict
465+
{ iorig = None; inew = Some (star ^ type_expr_to_string te) };
466+
]
467+
| Changed (Removed te) ->
468+
[
469+
Iconflict
470+
{ iorig = Some (star ^ type_expr_to_string te); inew = None };
471+
]
472+
| Changed (Modified te) ->
473+
let te_hunks = process_type_expr_diff ~context:`Tuple te in
474+
if i > 0 then Icommon " * " :: te_hunks else te_hunks)
475+
diff
476+
|> List.concat
477+
in
478+
match context with
479+
| `Tuple -> parenthesize tuple_hunks
480+
| `None | `Larrow -> tuple_hunks
481+
482+
and process_arg_label_diff diff =
483+
let module S = Stddiff in
484+
let open Diff in
485+
let arg_label_to_string arg_label =
486+
let open Diff in
487+
match arg_label with
488+
| Labelled_arg name -> name ^ ":"
489+
| Optional_arg name -> "?" ^ name ^ ":"
490+
in
491+
match diff with
492+
| S.Same None -> []
493+
| Same (Some arg_label) -> [ Icommon (arg_label_to_string arg_label) ]
494+
| Changed (S.Added arg_label) ->
495+
[
496+
Iconflict { iorig = None; inew = Some (arg_label_to_string arg_label) };
497+
]
498+
| Changed (Removed arg_label) ->
499+
[
500+
Iconflict { iorig = Some (arg_label_to_string arg_label); inew = None };
501+
]
502+
| Changed (Modified diff) ->
503+
let name_ihunk =
504+
match diff.name with
505+
| Same name -> [ Icommon (name ^ ":") ]
506+
| Changed { reference; current } ->
507+
[
508+
Iconflict { iorig = Some reference; inew = Some current };
509+
Icommon ":";
510+
]
511+
in
512+
let optional_arg_ihunk =
513+
match diff.arg_optional with
514+
| Same true -> [ Icommon "?" ]
515+
| Same false -> []
516+
| Changed Added_opt_arg ->
517+
[ Iconflict { iorig = None; inew = Some "?" } ]
518+
| Changed Removed_opt_arg ->
519+
[ Iconflict { iorig = Some "?"; inew = None } ]
520+
in
521+
optional_arg_ihunk @ name_ihunk
522+
523+
and process_arrow_type_diff ~context arrow_diff =
524+
let open Diff in
525+
let module S = Stddiff in
526+
let arg_label_ihunks = process_arg_label_diff arrow_diff.arg_label in
527+
let arg_type_ihunks =
528+
match arrow_diff.arg_type with
529+
| Same type_expr -> [ Icommon (type_expr_to_string type_expr) ]
530+
| Changed type_expr -> process_type_expr_diff ~context:`Larrow type_expr
531+
in
532+
let return_type_ihunks =
533+
match arrow_diff.return_type with
534+
| Same type_expr -> [ Icommon (type_expr_to_string type_expr) ]
535+
| Changed type_expr -> process_type_expr_diff type_expr
536+
in
537+
let arrow_hunks =
538+
List.concat
539+
[
540+
arg_label_ihunks;
541+
arg_type_ihunks;
542+
[ Icommon " -> " ];
543+
return_type_ihunks;
544+
]
545+
in
546+
match context with
547+
| `Tuple | `Larrow -> parenthesize arrow_hunks
548+
| `None -> arrow_hunks
549+
550+
and parenthesize hunks = (Icommon "(" :: hunks) @ [ Icommon ")" ]
551+
552+
and process_type_expr_diff ?(context = `None) (diff : Diff.type_expr) :
479553
inline_hunk list =
480554
match diff with
481555
| Diff.Atomic { reference; current } ->
@@ -486,10 +560,8 @@ and process_type_expr_diff ?(paren = true) (diff : Diff.type_expr) :
486560
inew = Some (type_expr_to_string current);
487561
};
488562
]
489-
| Tuple tuple_diff ->
490-
let tuple_hunks = process_tuple_type_diff tuple_diff in
491-
if paren then (Icommon "(" :: tuple_hunks) @ [ Icommon ")" ]
492-
else tuple_hunks
563+
| Tuple tuple_diff -> process_tuple_type_diff ~context tuple_diff
564+
| Arrow arrow_diff -> process_arrow_type_diff ~context arrow_diff
493565

494566
and cstr_args_to_line cstr_args =
495567
match cstr_args with

0 commit comments

Comments
 (0)