@@ -8,32 +8,32 @@ let rec drill_through_tlink_and_tsubst t =
8
8
match t.desc with
9
9
| Tlink t
10
10
| Tsubst t -> drill_through_tlink_and_tsubst t
11
- | t -> t
11
+ | _ -> t
12
12
13
13
let is_weak_type_after_drilling t =
14
14
match drill_through_tlink_and_tsubst t with
15
- | Tvar _ -> true
15
+ | { desc = Tvar _ } -> true
16
16
| _ -> false
17
17
18
18
let component_spec_weak_type_variables t =
19
19
match drill_through_tlink_and_tsubst t with
20
20
(* ReasonReact <=0.3.4 *)
21
- | Tconstr (
21
+ | {desc = Tconstr (
22
22
Pdot ((Pident {name = " ReasonReact" }), " componentSpec" , _),
23
23
[state; _initial_state; retained_props; _initial_retained_props; action],
24
24
_
25
- ) ->
25
+ )} ->
26
26
(
27
27
state |> is_weak_type_after_drilling,
28
28
retained_props |> is_weak_type_after_drilling,
29
29
action |> is_weak_type_after_drilling
30
30
)
31
31
(* future ReasonReact version with retainedProps removed *)
32
- | Tconstr (
32
+ | {desc = Tconstr (
33
33
Pdot ((Pident {name = " ReasonReact" }), " componentSpec" , _),
34
34
[state; _initial_state; action],
35
35
_
36
- ) ->
36
+ )} ->
37
37
(
38
38
state |> is_weak_type_after_drilling,
39
39
false ,
@@ -57,31 +57,73 @@ let component_spec_weak_type_variables_in_module_type (mty : Types.module_type)
57
57
)
58
58
| _ -> []
59
59
60
- (* recursively drill down the types (first item is the type alias, if any. Second is the content of the alias) *)
61
- let rec get_to_bottom_of_aliases f = function
62
- | (_alias1 , type1 ) :: (_alias2 , type2 ) :: rest ->
63
- begin match get_to_bottom_of_aliases f rest with
64
- | false -> f (type1, type2)
65
- | true -> true
66
- end
60
+ (* `trace` is a funny data structure. It's an always even list of tuples. This error:
61
+ this is foo (aliased as array(int)), wanted bar (aliased as array(string))
62
+ the incompatible part: int vs string
63
+ gives the following `trace` data structure:
64
+ [
65
+ (foo, array(int)),
66
+ (bar, array(string)),
67
+ (_, int),
68
+ (_, string)
69
+ ]
70
+ *)
71
+ (* recursively walk the trace from right to left, calling f and checking if f matches part of the trace *)
72
+ let check_each_trace_chunk_bottom_up f = fun t ->
73
+ let t_flipped = List. rev t in
74
+ let rec check f = function
75
+ (* we flipped the trace, so instead of [t1, t2, t3, t4, ...] it's [t4, t3, ...] *)
76
+ | (_alias2 , type2 ) :: (_alias1 , type1 ) :: rest ->
77
+ if f (type1, type2) then true
78
+ else check f rest
67
79
| _ -> false
80
+ in
81
+ check f t_flipped
68
82
69
- let state_escape_scope = get_to_bottom_of_aliases (function
83
+
84
+ let state_escape_scope = check_each_trace_chunk_bottom_up (function
70
85
(* https ://github.com/BuckleScript/ocaml/blob/ddf5a739cc0978dab5e553443825791ba7b0cef9/typing/printtyp.ml?#L1348 * )
71
86
(* so apparently that's the logic for detecting "the constructor out of scope" error *)
72
87
| ({desc = Tconstr (p, _, _)}, {desc = Tvar _; level})
73
88
when level < Path. binding_time p -> true
74
89
| _ -> false
75
90
)
76
91
77
- let is_array_wanted_reactElement = get_to_bottom_of_aliases (function
78
- | ({desc = Tconstr (path1, _, _)}, {desc = Tconstr (path2, _, _)})
79
- when Path. last path1 = " array" && Path. last path2 = " reactElement" -> true
92
+ let trace_both_component_spec = check_each_trace_chunk_bottom_up (function
93
+ | ({desc = Tconstr (
94
+ (Pdot ((Pident {name = " ReasonReact" }), " componentSpec" , _)),
95
+ ([state1; _; _; _; action1] | [state1; _; action1]),
96
+ _
97
+ )},
98
+ {desc = Tconstr (
99
+ (Pdot ((Pident {name = " ReasonReact" }), " componentSpec" , _)),
100
+ ([state2; _; _; _; action2] | [state2; _; action2]),
101
+ _
102
+ )})
103
+ -> true
80
104
| _ -> false
81
105
)
82
106
83
- let is_componentSpec_wanted_reactElement = get_to_bottom_of_aliases (function
84
- | ({desc = Tconstr (path1, _, _)}, {desc = Tconstr (path2, _, _)})
85
- when Path. last path1 = " componentSpec" && Path. last path2 = " reactElement" -> true
107
+ let is_array_wanted_react_element = check_each_trace_chunk_bottom_up (function
108
+ | ({desc = Tconstr (path1, _, _)},
109
+ {desc = Tconstr (
110
+ (Pdot ((Pident {name = " ReasonReact" }), " reactElement" , _)),
111
+ _,
112
+ _
113
+ )}) when Path. last path1 = " array" -> true
114
+ | _ -> false
115
+ )
116
+
117
+ let is_component_spec_wanted_react_element = check_each_trace_chunk_bottom_up (function
118
+ | ({desc = Tconstr (
119
+ (Pdot ((Pident {name = " ReasonReact" }), " componentSpec" , _)),
120
+ ([state1; _; _; _; action1] | [state1; _; action1]),
121
+ _
122
+ )},
123
+ {desc = Tconstr (
124
+ (Pdot ((Pident {name = " ReasonReact" }), " reactElement" , _)),
125
+ _,
126
+ _
127
+ )}) -> true
86
128
| _ -> false
87
129
)
0 commit comments