Skip to content

Commit b0de235

Browse files
azzsalazzsal
authored
Add type kind, privacy and manifest changes to type declaration diff representation (#120)
* Improve diffing of type declarations * Update Text_diff module to handle the new diff rep. * Update type declaration diff to have more explicit type kind diff * Add tests for type declaration kind tests * Refine type decl diff representation and add more tests * Update type declaration diff to handle private type abbreviations * Add tests for type privacy modification and print them * Update type declaration diff to include type manifest diff * Print textual diffs of type manifests --incomplete * Update tests * Fix printing of modifed types --incomplete * Polish Diff module * Update tests * Update tests, Diff and Text_diff module --incomplete * Update printing of modified types --incomplete * Update printing of modified types --incomplete * Fix printing of abstract types * Update tests * Finalize printing of modified types * Add changelog entry * Minor fixes * Fix printing of abstract types * Minor fixes * Minor fixes * Minor fixes * Remove extra lines in tests
1 parent 7f6368b commit b0de235

File tree

9 files changed

+547
-166
lines changed

9 files changed

+547
-166
lines changed

‎CHANGES.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,8 @@
1313

1414
- Improve diff representation of modified record types (#109, @azzsal)
1515
- Improve diff representation of modified variant types (#111, @azzsal)
16+
- Improve the diff representation of type declarations with more fine grained diffing of
17+
type kind, type privacy and type manifest (#120, @azzsal)
1618

1719
### Deprecated
1820

‎lib/diff.ml‎

Lines changed: 101 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,25 @@ type value = {
1414

1515
type type_ = { tname : string; tdiff : (type_declaration, type_modification) t }
1616

17-
and type_modification =
18-
| Record_diff of record_field list
19-
| Variant_diff of constructor_ list
20-
| Atomic of type_declaration atomic_modification
17+
and type_modification = {
18+
type_kind : (Types.type_decl_kind, type_kind) maybe_changed;
19+
type_privacy : (Asttypes.private_flag, type_privacy) maybe_changed;
20+
type_manifest :
21+
( type_expr option,
22+
(type_expr, type_expr atomic_modification) t )
23+
maybe_changed;
24+
}
25+
26+
and ('same, 'different) maybe_changed =
27+
| Same of 'same
28+
| Different of 'different
29+
30+
and type_privacy = Added_p | Removed_p
31+
32+
and type_kind =
33+
| Record_tk of record_field list
34+
| Variant_tk of constructor_ list
35+
| Atomic_tk of type_decl_kind atomic_modification
2136

2237
and record_field = {
2338
rname : string;
@@ -35,7 +50,7 @@ and constructor_modification =
3550
| Atomic_c of constructor_declaration atomic_modification
3651

3752
and tuple_component =
38-
(type_expr, (type_expr, type_expr atomic_modification) t) Either.t
53+
(type_expr, (type_expr, type_expr atomic_modification) t) maybe_changed
3954

4055
type class_ = {
4156
cname : string;
@@ -112,6 +127,10 @@ let module_type_fallback ~loc ~typing_env ~name ~reference ~current =
112127
| exception Includemod.Error _ ->
113128
Some (Module { mname = name; mdiff = Modified Unsupported })
114129

130+
let type_expr typing_env reference current =
131+
if Ctype.does_match typing_env reference current then None
132+
else Some (Modified { reference; current })
133+
115134
let extract_lbls lbls =
116135
List.fold_left
117136
(fun map lbl -> String_map.add (Ident.name lbl.ld_id) lbl map)
@@ -129,54 +148,67 @@ let rec type_item ~typing_env ~name ~reference ~current =
129148
Some (Type { tname = name; tdiff = Removed reference })
130149
| None, Some (current, _) ->
131150
Some (Type { tname = name; tdiff = Added current })
132-
| Some (reference, refId), Some (current, curId) -> (
133-
let type_coercion1 () =
134-
Includecore.type_declarations ~loc:current.type_loc typing_env
135-
~mark:false name current (Pident curId) reference
151+
| Some (reference, _), Some (current, _) ->
152+
type_decls ~typing_env ~name ~reference ~current
153+
154+
and type_decls ~typing_env ~name ~reference ~current =
155+
let type_kind =
156+
type_kind ~typing_env ~ref_type_kind:reference.type_kind
157+
~cur_type_kind:current.type_kind
158+
in
159+
let type_privacy =
160+
type_privacy ~ref_type_privacy:reference.type_private
161+
~cur_type_privacy:current.type_private
162+
in
163+
let type_manifest =
164+
type_manifest ~typing_env ~ref_type_manifest:reference.type_manifest
165+
~cur_type_manifest:current.type_manifest
166+
in
167+
match { type_kind; type_privacy; type_manifest } with
168+
| { type_kind = Same _; type_privacy = Same _; type_manifest = Same _ } ->
169+
None
170+
| diff -> Some (Type { tname = name; tdiff = Modified diff })
171+
172+
and type_privacy ~ref_type_privacy ~cur_type_privacy =
173+
match (ref_type_privacy, cur_type_privacy) with
174+
| Asttypes.Public, Asttypes.Public -> Same Asttypes.Public
175+
| Asttypes.Public, Asttypes.Private -> Different Added_p
176+
| Asttypes.Private, Asttypes.Public -> Different Removed_p
177+
| Asttypes.Private, Asttypes.Private -> Same Asttypes.Private
178+
179+
and type_kind ~typing_env ~ref_type_kind ~cur_type_kind =
180+
match (ref_type_kind, cur_type_kind) with
181+
| (Type_record (ref_label_lst, _) as td), Type_record (cur_label_lst, _) -> (
182+
let changed_lbls =
183+
modified_record_type ~typing_env ~ref_label_lst ~cur_label_lst
136184
in
137-
let type_coercion2 () =
138-
Includecore.type_declarations ~loc:reference.type_loc typing_env
139-
~mark:false name reference (Pident refId) current
185+
match changed_lbls with
186+
| [] -> Same td
187+
| _ -> Different (Record_tk changed_lbls))
188+
| ( (Type_variant (ref_constructor_lst, _) as td),
189+
Type_variant (cur_constructor_lst, _) ) -> (
190+
let changed_constrs =
191+
modified_variant_type ~typing_env ~ref_constructor_lst
192+
~cur_constructor_lst
140193
in
141-
match (type_coercion1 (), type_coercion2 ()) with
142-
| None, None -> None
143-
| _, _ -> (
144-
match (reference.type_kind, current.type_kind) with
145-
| Type_record (ref_label_lst, _), Type_record (cur_label_lst, _) -> (
146-
let changed_lbls =
147-
modified_record_type ~typing_env ~ref_label_lst ~cur_label_lst
148-
in
149-
match changed_lbls with
150-
| [] -> None
151-
| _ ->
152-
Some
153-
(Type
154-
{
155-
tname = name;
156-
tdiff = Modified (Record_diff changed_lbls);
157-
}))
158-
| ( Type_variant (ref_constructor_lst, _),
159-
Type_variant (cur_constructor_lst, _) ) -> (
160-
let changed_constrs =
161-
modified_variant_type ~typing_env ~ref_constructor_lst
162-
~cur_constructor_lst
163-
in
164-
match changed_constrs with
165-
| [] -> None
166-
| _ ->
167-
Some
168-
(Type
169-
{
170-
tname = name;
171-
tdiff = Modified (Variant_diff changed_constrs);
172-
}))
173-
| _ ->
174-
Some
175-
(Type
176-
{
177-
tname = name;
178-
tdiff = Modified (Atomic { reference; current });
179-
})))
194+
match changed_constrs with
195+
| [] -> Same td
196+
| _ -> Different (Variant_tk changed_constrs))
197+
| (Type_abstract _ as td), Type_abstract _ -> Same td
198+
| (Type_open as td), Type_open -> Same td
199+
| ref_type_kind, cur_type_kind ->
200+
Different
201+
(Atomic_tk { reference = ref_type_kind; current = cur_type_kind })
202+
203+
and type_manifest ~typing_env ~ref_type_manifest ~cur_type_manifest =
204+
match (ref_type_manifest, cur_type_manifest) with
205+
| None, None -> Same None
206+
| Some t1, None -> Different (Removed t1)
207+
| None, Some t2 -> Different (Added t2)
208+
| Some t1, Some t2 -> (
209+
match type_expr typing_env t1 t2 with
210+
| None -> Same (Some t1)
211+
| Some diff -> Different diff)
180212

181213
and modified_variant_type ~typing_env ~ref_constructor_lst ~cur_constructor_lst
182214
=
@@ -186,8 +218,7 @@ and modified_variant_type ~typing_env ~ref_constructor_lst ~cur_constructor_lst
186218
let tuple_diff = modified_tuple_type ~typing_env type_lst1 type_lst2 in
187219
if
188220
List.for_all
189-
(fun t ->
190-
match t with Either.Left _ -> true | Either.Right _ -> false)
221+
(fun t -> match t with Same _ -> true | Different _ -> false)
191222
tuple_diff
192223
then None
193224
else Some { csname = name; csdiff = Modified (Tuple_c tuple_diff) }
@@ -219,8 +250,8 @@ and modified_variant_type ~typing_env ~ref_constructor_lst ~cur_constructor_lst
219250
in
220251
modified_cstrs
221252

222-
and diff_list (diff_one : 'a option -> 'a option -> ('a, 'diff) Either.t)
223-
(ref : 'a list) (curr : 'a list) : ('a, 'diff) Either.t list =
253+
and diff_list (diff_one : 'a option -> 'a option -> ('a, 'diff) maybe_changed)
254+
(ref : 'a list) (curr : 'a list) : ('a, 'diff) maybe_changed list =
224255
match (ref, curr) with
225256
| [], [] -> []
226257
| h1 :: t1, [] -> diff_one (Some h1) None :: diff_list diff_one t1 []
@@ -234,11 +265,12 @@ and modified_tuple_type ~typing_env (ref_tuple : type_expr list)
234265
(fun t1 t2 ->
235266
match (t1, t2) with
236267
| None, None -> assert false
237-
| Some t1, None -> Either.right (Removed t1)
238-
| None, Some t2 -> Either.right (Added t2)
239-
| Some t1, Some t2 ->
240-
if Ctype.does_match typing_env t1 t2 then Either.left t1
241-
else Either.right (Modified { reference = t1; current = t2 }))
268+
| Some t1, None -> Different (Removed t1)
269+
| None, Some t2 -> Different (Added t2)
270+
| Some t1, Some t2 -> (
271+
match type_expr typing_env t1 t2 with
272+
| None -> Same t1
273+
| Some diff -> Different diff))
242274
ref_tuple cur_tuple
243275

244276
and modified_record_type ~typing_env ~(ref_label_lst : label_declaration list)
@@ -252,14 +284,15 @@ and modified_record_type ~typing_env ~(ref_label_lst : label_declaration list)
252284
| None, None -> None
253285
| Some ref, None -> Some { rname = name; rdiff = Removed ref }
254286
| None, Some cur -> Some { rname = name; rdiff = Added cur }
255-
| Some ref, Some cur ->
256-
if Ctype.does_match typing_env ref.ld_type cur.ld_type then None
257-
else
258-
Some
259-
{
260-
rname = name;
261-
rdiff = Modified { reference = ref; current = cur };
262-
})
287+
| Some ref, Some cur -> (
288+
match type_expr typing_env ref.ld_type cur.ld_type with
289+
| None -> None
290+
| Some _ ->
291+
Some
292+
{
293+
rname = name;
294+
rdiff = Modified { reference = ref; current = cur };
295+
}))
263296
ref_lbls curr_lbls
264297
|> String_map.bindings |> List.map snd
265298
in

‎lib/diff.mli‎

Lines changed: 20 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -12,10 +12,25 @@ type type_ = {
1212
tdiff : (Types.type_declaration, type_modification) t;
1313
}
1414

15-
and type_modification =
16-
| Record_diff of record_field list
17-
| Variant_diff of constructor_ list
18-
| Atomic of Types.type_declaration atomic_modification
15+
and type_modification = {
16+
type_kind : (Types.type_decl_kind, type_kind) maybe_changed;
17+
type_privacy : (Asttypes.private_flag, type_privacy) maybe_changed;
18+
type_manifest :
19+
( Types.type_expr option,
20+
(Types.type_expr, Types.type_expr atomic_modification) t )
21+
maybe_changed;
22+
}
23+
24+
and ('same, 'different) maybe_changed =
25+
| Same of 'same
26+
| Different of 'different
27+
28+
and type_privacy = Added_p | Removed_p
29+
30+
and type_kind =
31+
| Record_tk of record_field list
32+
| Variant_tk of constructor_ list
33+
| Atomic_tk of Types.type_decl_kind atomic_modification
1934

2035
and record_field = {
2136
rname : string;
@@ -36,7 +51,7 @@ and constructor_modification =
3651
and tuple_component =
3752
( Types.type_expr,
3853
(Types.type_expr, Types.type_expr atomic_modification) t )
39-
Either.t
54+
maybe_changed
4055

4156
type class_ = {
4257
cname : string;

0 commit comments

Comments
 (0)