Skip to content

Commit a86427c

Browse files
NchamJosephMuamNathanReb
NchamJosephMuam
and
NathanReb
authored
Add support for module types (#93)
* add support for module_types * lint * Update tests/api-watch/test_diff_modtpe_decl.ml Co-authored-by: Nathan Rebours <nathan.p.rebours@gmail.com> * remove redundant and add test for modtype removal --------- Co-authored-by: Nathan Rebours <nathan.p.rebours@gmail.com>
1 parent bc6c4a7 commit a86427c

File tree

8 files changed

+327
-62
lines changed

8 files changed

+327
-62
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44

55
- Add detection of modified type declarations
66
(#92, @azzsal)
7+
- Add support for module_type declarations (#93, @NchamJosephMuam)
78

89
### Changed
910

‎lib/diff.ml‎

Lines changed: 51 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -19,18 +19,30 @@ type type_ = {
1919

2020
type module_ = {
2121
mname : string;
22-
mdiff : (module_declaration, module_modification) t;
22+
mdiff : (module_declaration, signature_modification) t;
2323
}
2424

25-
and module_modification = Unsupported | Supported of sig_item list
26-
and sig_item = Value of value | Module of module_ | Type of type_
25+
and modtype = {
26+
mtname : string;
27+
mtdiff : (modtype_declaration, signature_modification) t;
28+
}
29+
30+
and signature_modification = Unsupported | Supported of sig_item list
31+
32+
and sig_item =
33+
| Value of value
34+
| Module of module_
35+
| Type of type_
36+
| Modtype of modtype
2737

28-
type item_type = Value_item | Module_item | Type_item [@@deriving ord]
38+
type item_type = Value_item | Module_item | Type_item | Modtype_item
39+
[@@deriving ord]
2940

3041
type sig_items =
3142
| Val of value_description
3243
| Mod of module_declaration
3344
| Typ of type_declaration * Ident.t
45+
| Modtype of modtype_declaration
3446

3547
module Sig_item_map = Map.Make (struct
3648
type t = item_type * string [@@deriving ord]
@@ -42,14 +54,16 @@ let extract_items items =
4254
match item with
4355
| Sig_module (id, _, mod_decl, _, _) ->
4456
Sig_item_map.add (Module_item, Ident.name id) (Mod mod_decl) tbl
57+
| Sig_modtype (id, mtd_decl, _) ->
58+
Sig_item_map.add (Modtype_item, Ident.name id) (Modtype mtd_decl) tbl
4559
| Sig_value (id, val_des, _) ->
4660
Sig_item_map.add (Value_item, Ident.name id) (Val val_des) tbl
4761
| Sig_type (id, type_decl, _, _) ->
4862
Sig_item_map.add (Type_item, Ident.name id) (Typ (type_decl, id)) tbl
4963
| _ -> tbl)
5064
Sig_item_map.empty items
5165

52-
let modtype_item ~loc ~typing_env ~name ~reference ~current =
66+
let module_type_fallback ~loc ~typing_env ~name ~reference ~current =
5367
let modtype_coercion1 () =
5468
Includemod.modtypes ~loc typing_env ~mark:Mark_both reference current
5569
in
@@ -121,7 +135,9 @@ let rec items ~reference ~current =
121135
| Module_item, reference, current ->
122136
module_item ~typing_env:env ~name ~reference ~current
123137
| Type_item, reference, current ->
124-
type_item ~typing_env:env ~name ~reference ~current)
138+
type_item ~typing_env:env ~name ~reference ~current
139+
| Modtype_item, reference, current ->
140+
module_type_item ~typing_env:env ~name ~reference ~current)
125141
ref_items curr_items
126142
|> Sig_item_map.bindings |> List.map snd
127143

@@ -136,13 +152,38 @@ and module_item ~typing_env ~name ~reference ~current =
136152
module_declaration ~typing_env ~name ~reference ~current
137153
| _ -> assert false
138154

155+
and module_type_item ~typing_env ~name ~reference ~current =
156+
match (reference, current) with
157+
| None, None -> None
158+
| None, Some (Modtype curr_mtd) ->
159+
Some (Modtype { mtname = name; mtdiff = Added curr_mtd })
160+
| Some (Modtype ref_mtd), None ->
161+
Some (Modtype { mtname = name; mtdiff = Removed ref_mtd })
162+
| Some (Modtype ref_mtd), Some (Modtype curr_mtd) ->
163+
modtype_declaration ~typing_env ~name ~reference:ref_mtd ~current:curr_mtd
164+
| _ -> assert false
165+
139166
and module_declaration ~typing_env ~name ~reference ~current =
140-
match (reference.md_type, current.md_type) with
167+
module_type ~typing_env ~name ~ref_module_type:reference.md_type
168+
~current_module_type:current.md_type ~reference_location:reference.md_loc
169+
170+
and modtype_declaration ~typing_env ~name ~reference ~current =
171+
match (reference.mtd_type, current.mtd_type) with
172+
| Some ref_sub, Some curr_sub ->
173+
module_type ~typing_env ~name ~ref_module_type:ref_sub
174+
~current_module_type:curr_sub ~reference_location:reference.mtd_loc
175+
| Some _, None | None, Some _ ->
176+
Some (Modtype { mtname = name; mtdiff = Modified Unsupported })
177+
| None, None -> None
178+
179+
and module_type ~typing_env ~name ~ref_module_type ~current_module_type
180+
~reference_location =
181+
match (ref_module_type, current_module_type) with
141182
| Mty_signature ref_submod, Mty_signature curr_submod ->
142183
signatures ~typing_env ~reference:ref_submod ~current:curr_submod
143184
|> Option.map (fun mdiff -> Module { mname = name; mdiff })
144185
| ref_modtype, curr_modtype ->
145-
modtype_item ~loc:reference.md_loc ~typing_env ~name
186+
module_type_fallback ~loc:reference_location ~typing_env ~name
146187
~reference:ref_modtype ~current:curr_modtype
147188

148189
and signatures ~typing_env ~reference ~current =
@@ -162,5 +203,5 @@ and signatures ~typing_env ~reference ~current =
162203

163204
let interface ~module_name ~reference ~current =
164205
let typing_env = Env.empty in
165-
signatures ~typing_env ~reference ~current
166-
|> Option.map (fun mdiff -> { mname = module_name; mdiff })
206+
let sig_out = signatures ~typing_env ~reference ~current in
207+
Option.map (fun mdiff -> { mname = module_name; mdiff }) sig_out

‎lib/diff.mli‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -14,11 +14,21 @@ type type_ = {
1414

1515
type module_ = {
1616
mname : string;
17-
mdiff : (Types.module_declaration, module_modification) t;
17+
mdiff : (Types.module_declaration, signature_modification) t;
1818
}
1919

20-
and module_modification = Unsupported | Supported of sig_item list
21-
and sig_item = Value of value | Module of module_ | Type of type_
20+
and modtype = {
21+
mtname : string;
22+
mtdiff : (Types.modtype_declaration, signature_modification) t;
23+
}
24+
25+
and signature_modification = Unsupported | Supported of sig_item list
26+
27+
and sig_item =
28+
| Value of value
29+
| Module of module_
30+
| Type of type_
31+
| Modtype of modtype
2232

2333
val interface :
2434
module_name:string ->

‎lib/text_diff.ml‎

Lines changed: 78 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,21 @@ let md_to_lines name md =
4141
let module_str = "module " ^ name ^ ": " ^ Buffer.contents buf in
4242
CCString.lines module_str
4343

44+
let mtd_to_lines name mtd =
45+
match mtd.mtd_type with
46+
| Some m ->
47+
let buf = Buffer.create 256 in
48+
let formatter = Format.formatter_of_buffer buf in
49+
Printtyp.modtype formatter m;
50+
Format.pp_print_flush formatter ();
51+
let module_type_str =
52+
"module type " ^ name ^ " = " ^ Buffer.contents buf
53+
in
54+
CCString.lines module_type_str
55+
| None ->
56+
let abstract_module_type_str = "module type " ^ name in
57+
CCString.lines abstract_module_type_str
58+
4459
let process_diff (diff : (_, _ Diff.atomic_modification) Diff.t) name to_lines =
4560
match diff with
4661
| Added item -> [ { orig = []; new_ = to_lines name item } ]
@@ -54,54 +69,69 @@ let process_value_diff (val_diff : Diff.value) =
5469
let process_type_diff (type_diff : Diff.type_) =
5570
process_diff type_diff.tdiff type_diff.tname td_to_lines
5671

57-
let from_diff (diff : Diff.module_) : t =
58-
let rec process_module_diff module_path (module_diff : Diff.module_) acc =
59-
match module_diff.mdiff with
60-
| Modified Unsupported ->
61-
String_map.add module_path
62-
[ { orig = []; new_ = [ "<unsupported change>" ] } ]
63-
acc
64-
| Added curr_md ->
65-
let diff =
66-
[ { orig = []; new_ = md_to_lines module_diff.mname curr_md } ]
67-
in
68-
String_map.update module_path
69-
(function
70-
| None -> Some diff | Some existing -> Some (existing @ diff))
71-
acc
72-
| Removed ref_md ->
73-
let diff =
74-
[ { orig = md_to_lines module_diff.mname ref_md; new_ = [] } ]
75-
in
76-
String_map.update module_path
77-
(function
78-
| None -> Some diff | Some existing -> Some (existing @ diff))
79-
acc
80-
| Modified (Supported changes) ->
81-
List.fold_left
82-
(fun acc' change ->
83-
match (change : Diff.sig_item) with
84-
| Value val_diff ->
85-
let diff = process_value_diff val_diff in
86-
String_map.update module_path
87-
(function
88-
| None -> Some diff | Some existing -> Some (existing @ diff))
89-
acc'
90-
| Type type_diff ->
91-
let diff = process_type_diff type_diff in
92-
String_map.update module_path
93-
(function
94-
| None -> Some diff | Some existing -> Some (existing @ diff))
95-
acc'
96-
| Module sub_module_diff ->
97-
let sub_module_path =
98-
match sub_module_diff.mdiff with
99-
| Modified _ -> module_path ^ "." ^ sub_module_diff.mname
100-
| Added _ | Removed _ -> module_path
101-
in
102-
process_module_diff sub_module_path sub_module_diff acc')
103-
acc changes
104-
in
72+
let rec process_sig_diff :
73+
type a. _ -> (string -> a -> string list) -> (a, _) Diff.t * _ -> _ -> _ =
74+
fun path to_lines ((diff : (a, _) Diff.t), name) acc ->
75+
match diff with
76+
| Added curr_mtd ->
77+
let diff = [ { orig = []; new_ = to_lines name curr_mtd } ] in
78+
String_map.update path
79+
(function None -> Some diff | Some existing -> Some (existing @ diff))
80+
acc
81+
| Removed ref_mtd ->
82+
let diff = [ { orig = to_lines name ref_mtd; new_ = [] } ] in
83+
String_map.update path
84+
(function None -> Some diff | Some existing -> Some (existing @ diff))
85+
acc
86+
| Modified Diff.Unsupported ->
87+
String_map.add path
88+
[ { orig = []; new_ = [ "<unsupported change>" ] } ]
89+
acc
90+
| Modified (Supported changes) -> signature_changes path changes acc
91+
92+
and process_module_type_diff module_path (module_type_diff : Diff.modtype) acc =
93+
process_sig_diff module_path mtd_to_lines
94+
(module_type_diff.mtdiff, module_type_diff.mtname)
95+
acc
96+
97+
and process_module_diff module_path (module_diff : Diff.module_) acc =
98+
process_sig_diff module_path md_to_lines
99+
(module_diff.mdiff, module_diff.mname)
100+
acc
101+
102+
and signature_changes module_path items acc =
103+
List.fold_left
104+
(fun acc' change ->
105+
match (change : Diff.sig_item) with
106+
| Value val_diff ->
107+
let diff = process_value_diff val_diff in
108+
String_map.update module_path
109+
(function
110+
| None -> Some diff | Some existing -> Some (existing @ diff))
111+
acc'
112+
| Type type_diff ->
113+
let diff = process_type_diff type_diff in
114+
String_map.update module_path
115+
(function
116+
| None -> Some diff | Some existing -> Some (existing @ diff))
117+
acc'
118+
| Module sub_module_diff ->
119+
let sub_module_path =
120+
match sub_module_diff.mdiff with
121+
| Modified _ -> module_path ^ "." ^ sub_module_diff.mname
122+
| Added _ | Removed _ -> module_path
123+
in
124+
process_module_diff sub_module_path sub_module_diff acc'
125+
| Modtype sub_module_type_diff ->
126+
let sub_module_path =
127+
match sub_module_type_diff.mtdiff with
128+
| Modified _ -> module_path ^ "." ^ sub_module_type_diff.mtname
129+
| Added _ | Removed _ -> module_path
130+
in
131+
process_module_type_diff sub_module_path sub_module_type_diff acc')
132+
acc items
133+
134+
and from_diff (diff : Diff.module_) : t =
105135
process_module_diff diff.mname diff String_map.empty
106136

107137
let gen_pp pp_diff fmt t =

‎tests/api-diff/module_type_test.t‎

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,107 @@
1+
# Tests for module type type modifications
2+
3+
Here we generate a `.mli` file with a module type:
4+
5+
$ cat > modtype_ref.mli << EOF
6+
> module type M = sig val x : int end
7+
>
8+
> EOF
9+
10+
We generate the .cmi file
11+
12+
$ ocamlc modtype_ref.mli
13+
14+
And now we run api-watcher on that same cmi file as both arguments,
15+
there should be no diff:
16+
17+
$ api-diff modtype_ref.cmi modtype_ref.cmi
18+
19+
### Adding a module type:
20+
21+
Generate a new .mli file with an additional module type
22+
$ cat > add_modtype.mli << EOF
23+
> module type M = sig val x : int end
24+
> module type P = sig val y : float end
25+
>
26+
> EOF
27+
28+
Compile the new .mli file to a .cmi file
29+
$ ocamlc add_modtype.mli
30+
31+
Run api-diff and check the output
32+
$ api-diff modtype_ref.cmi add_modtype.cmi
33+
diff module Add_modtype:
34+
+module type P = sig val y : float end
35+
36+
[1]
37+
38+
### Removing a module type:
39+
40+
Generate a new .mli file with the module type removed
41+
$ cat > remove_modtype.mli << EOF
42+
>
43+
> EOF
44+
45+
Compile the new .mli file to a .cmi file
46+
$ ocamlc remove_modtype.mli
47+
48+
Run api-diff and check the output
49+
$ api-diff modtype_ref.cmi remove_modtype.cmi
50+
diff module Remove_modtype:
51+
-module type M = sig val x : int end
52+
53+
[1]
54+
55+
### Modifying a module type:
56+
57+
Generate a new .mli file with the module type modified
58+
$ cat > modify_modtype.mli << EOF
59+
> module type M = sig val x : float end
60+
>
61+
> EOF
62+
63+
Compile the new .mli file to a .cmi file
64+
$ ocamlc modify_modtype.mli
65+
66+
Run api-diff and check the output
67+
$ api-diff modtype_ref.cmi modify_modtype.cmi
68+
diff module Modify_modtype.M:
69+
-val x : int
70+
+val x : float
71+
72+
[1]
73+
74+
75+
# Switching a module type from concrete to abstract
76+
77+
Generate a new .mli file with a concrete submodule type
78+
$ cat > conc_modtype.mli << EOF
79+
> module type M = sig val x : float end
80+
> module type P
81+
> EOF
82+
83+
Compile the new .mli file to a .cmi file
84+
$ ocamlc conc_modtype.mli
85+
86+
Generate a new .mli file with an abstract submodule type
87+
$ cat > abs_modtype.mli << EOF
88+
> module type M
89+
> module type P = sig val y : string end
90+
> module type N = sig val d : int end
91+
> EOF
92+
93+
Compile the modified .mli file to a .cmi file
94+
$ ocamlc abs_modtype.mli
95+
96+
Run api-diff and check the output
97+
$ api-diff conc_modtype.cmi abs_modtype.cmi
98+
diff module Abs_modtype:
99+
+module type N = sig val d : int end
100+
101+
diff module Abs_modtype.M:
102+
+<unsupported change>
103+
104+
diff module Abs_modtype.P:
105+
+<unsupported change>
106+
107+
[1]

0 commit comments

Comments
 (0)