OCaml implementation of PubGrub
anil.recoil.org
1(* Enhanced test for the PubGrub OCaml implementation with more complex examples *)
2
3(* Create a simple string-based package ID module *)
4module StringPackage = struct
5 type t = string
6 let compare = String.compare
7 let to_string s = s
8end
9
10(* Create a simple integer-based version module *)
11module IntVersion = struct
12 type t = int
13 let compare = Int.compare
14 let to_string = string_of_int
15end
16
17(* Create a simple range-based version set module *)
18module IntVersionRange = struct
19 type t = { min : int option; max : int option }
20 type version = int
21
22 let empty = { min = None; max = Some 0 }
23 let any = { min = None; max = None }
24 let singleton v = { min = Some v; max = Some v }
25
26 let union r1 r2 =
27 let min = match r1.min, r2.min with
28 | None, _ -> None
29 | _, None -> None
30 | Some v1, Some v2 -> Some (Int.min v1 v2)
31 in
32 let max = match r1.max, r2.max with
33 | None, _ -> None
34 | _, None -> None
35 | Some v1, Some v2 -> Some (Int.max v1 v2)
36 in
37 { min; max }
38
39 let intersection r1 r2 =
40 let min = match r1.min, r2.min with
41 | None, Some v -> Some v
42 | Some v, None -> Some v
43 | None, None -> None
44 | Some v1, Some v2 -> Some (Int.max v1 v2)
45 in
46 let max = match r1.max, r2.max with
47 | None, Some v -> Some v
48 | Some v, None -> Some v
49 | None, None -> None
50 | Some v1, Some v2 -> Some (Int.min v1 v2)
51 in
52 { min; max }
53
54 let complement r =
55 match r.min, r.max with
56 | None, None -> empty
57 | Some v, None -> { min = None; max = Some (v - 1) }
58 | None, Some v -> { min = Some (v + 1); max = None }
59 | Some v1, Some v2 ->
60 if v1 = v2 then
61 { min = None; max = Some (v1 - 1) }
62 else
63 { min = Some (v2 + 1); max = None }
64
65 let is_empty r =
66 match r.min, r.max with
67 | Some min, Some max -> min > max
68 | _ -> false
69
70 let contains v r =
71 match r.min, r.max with
72 | None, None -> true
73 | Some min, None -> v >= min
74 | None, Some max -> v <= max
75 | Some min, Some max -> v >= min && v <= max
76
77 let subset_of r1 r2 =
78 match r1.min, r1.max, r2.min, r2.max with
79 | _, _, None, None -> true (* Any set is a subset of the universal set *)
80 | Some min1, Some max1, Some min2, Some max2 -> min1 >= min2 && max1 <= max2
81 | Some min1, None, Some min2, _ -> min1 >= min2
82 | None, Some max1, _, Some max2 -> max1 <= max2
83 | None, None, _, _ -> false (* The universal set is not a subset of anything except itself *)
84 | _, _, Some _, None -> false
85 | _, _, None, Some _ -> false
86
87 let is_disjoint r1 r2 =
88 match r1.min, r1.max, r2.min, r2.max with
89 | Some min1, _, _, Some max2 -> min1 > max2
90 | _, Some max1, Some min2, _ -> max1 < min2
91 | _ -> false
92
93 let to_string r =
94 match r.min, r.max with
95 | None, None -> "any version"
96 | Some v, None -> Printf.sprintf ">= %d" v
97 | None, Some v -> Printf.sprintf "<= %d" v
98 | Some v1, Some v2 ->
99 if v1 = v2 then string_of_int v1
100 else Printf.sprintf "%d to %d" v1 v2
101end
102
103(* Create the solver *)
104module Solver = Pubgrub.Make(StringPackage)(IntVersion)(IntVersionRange)
105
106(* Create a simple dependency provider for our first example *)
107module SimpleProvider = struct
108 type package_id = StringPackage.t
109 type version = IntVersion.t
110 type version_set = IntVersionRange.t
111 type error = string
112
113 (* In-memory "database" of packages and dependencies *)
114 let dependencies = [
115 ("root", 1, [("a", { IntVersionRange.min = Some 1; max = Some 2 })]);
116 ("a", 1, [("b", { IntVersionRange.min = Some 1; max = Some 1 })]);
117 ("a", 2, [("b", { IntVersionRange.min = Some 2; max = Some 2 })]);
118 ("b", 1, []);
119 ("b", 2, []);
120 ]
121
122 let get_root_package () = "root"
123 let get_root_version () = 1
124
125 let available_versions pkg =
126 dependencies
127 |> List.filter (fun (p, _, _) -> p = pkg)
128 |> List.map (fun (_, v, _) -> v)
129 |> List.sort (fun a b -> - (IntVersion.compare a b)) (* Newest first *)
130
131 let get_dependencies pkg ver =
132 match List.find_opt (fun (p, v, _) -> p = pkg && v = ver) dependencies with
133 | Some (_, _, deps) -> Ok deps
134 | None ->
135 Error (Printf.sprintf "No dependencies found for %s %d" pkg ver)
136
137 let choose_version pkg range =
138 let versions = available_versions pkg in
139 List.find_opt (fun v -> IntVersionRange.contains v range) versions
140end
141
142(* Create a complex dependency provider based on Rust's doc_interface.rs example *)
143(* root depends on menu and icons, menu depends on dropdown, dropdown depends on icons *)
144module ComplexProvider = struct
145 type package_id = StringPackage.t
146 type version = IntVersion.t
147 type version_set = IntVersionRange.t
148 type error = string
149
150 (* In-memory "database" of packages and dependencies *)
151 let dependencies = [
152 ("root", 1, [
153 ("menu", IntVersionRange.any);
154 ("icons", IntVersionRange.any);
155 ]);
156 ("menu", 1, [
157 ("dropdown", IntVersionRange.any);
158 ]);
159 ("dropdown", 1, [
160 ("icons", IntVersionRange.any);
161 ]);
162 ("icons", 1, []);
163 ]
164
165 let get_root_package () = "root"
166 let get_root_version () = 1
167
168 let available_versions pkg =
169 dependencies
170 |> List.filter (fun (p, _, _) -> p = pkg)
171 |> List.map (fun (_, v, _) -> v)
172 |> List.sort (fun a b -> - (IntVersion.compare a b)) (* Newest first *)
173
174 let get_dependencies pkg ver =
175 match List.find_opt (fun (p, v, _) -> p = pkg && v = ver) dependencies with
176 | Some (_, _, deps) -> Ok deps
177 | None ->
178 Error (Printf.sprintf "No dependencies found for %s %d" pkg ver)
179
180 let choose_version pkg range =
181 let versions = available_versions pkg in
182 List.find_opt (fun v -> IntVersionRange.contains v range) versions
183end
184
185(* Create a conflict provider to test conflict resolution *)
186(* root depends on foo>=2 and bar>=2, foo@2 depends on bar=1, which creates a conflict *)
187module ConflictProvider = struct
188 type package_id = StringPackage.t
189 type version = IntVersion.t
190 type version_set = IntVersionRange.t
191 type error = string
192
193 (* In-memory "database" of packages and dependencies *)
194 let dependencies = [
195 ("root", 1, [
196 ("foo", { IntVersionRange.min = Some 2; max = None });
197 ("bar", { IntVersionRange.min = Some 2; max = None });
198 ]);
199 ("foo", 1, []);
200 ("foo", 2, [
201 ("bar", { IntVersionRange.min = Some 1; max = Some 1 });
202 ]);
203 ("bar", 1, []);
204 ("bar", 2, []);
205 ]
206
207 let get_root_package () = "root"
208 let get_root_version () = 1
209
210 let available_versions pkg =
211 dependencies
212 |> List.filter (fun (p, _, _) -> p = pkg)
213 |> List.map (fun (_, v, _) -> v)
214 |> List.sort (fun a b -> - (IntVersion.compare a b)) (* Newest first *)
215
216 let get_dependencies pkg ver =
217 match List.find_opt (fun (p, v, _) -> p = pkg && v = ver) dependencies with
218 | Some (_, _, deps) -> Ok deps
219 | None ->
220 Error (Printf.sprintf "No dependencies found for %s %d" pkg ver)
221
222 let choose_version pkg range =
223 let versions = available_versions pkg in
224 List.find_opt (fun v -> IntVersionRange.contains v range) versions
225end
226
227(* Create more complex provider inspired by another Rust example *)
228(* More complex diamond dependency example *)
229module DiamondProvider = struct
230 type package_id = StringPackage.t
231 type version = IntVersion.t
232 type version_set = IntVersionRange.t
233 type error = string
234
235 (* In-memory "database" of packages and dependencies *)
236 let dependencies = [
237 ("root", 1, [
238 ("a", IntVersionRange.any);
239 ("c", IntVersionRange.any);
240 ]);
241 ("a", 1, [
242 ("b", { IntVersionRange.min = Some 1; max = Some 1 });
243 ]);
244 ("a", 2, [
245 ("b", { IntVersionRange.min = Some 2; max = Some 2 });
246 ]);
247 ("b", 1, []);
248 ("b", 2, []);
249 ("c", 1, [
250 ("b", { IntVersionRange.min = Some 1; max = Some 1 });
251 ]);
252 ("c", 2, [
253 ("b", { IntVersionRange.min = Some 2; max = Some 2 });
254 ]);
255 ]
256
257 let get_root_package () = "root"
258 let get_root_version () = 1
259
260 let available_versions pkg =
261 dependencies
262 |> List.filter (fun (p, _, _) -> p = pkg)
263 |> List.map (fun (_, v, _) -> v)
264 |> List.sort (fun a b -> - (IntVersion.compare a b)) (* Newest first *)
265
266 let get_dependencies pkg ver =
267 match List.find_opt (fun (p, v, _) -> p = pkg && v = ver) dependencies with
268 | Some (_, _, deps) -> Ok deps
269 | None ->
270 Error (Printf.sprintf "No dependencies found for %s %d" pkg ver)
271
272 let choose_version pkg range =
273 let versions = available_versions pkg in
274 List.find_opt (fun v -> IntVersionRange.contains v range) versions
275end
276
277(* Helper function to print a solution *)
278let print_solution = function
279 | Ok solution ->
280 Printf.printf "Solution found with %d packages:\n" (List.length solution);
281 List.iter (fun (pkg, ver) ->
282 Printf.printf " %s @ %d\n" pkg ver
283 ) solution;
284 true
285 | Error err ->
286 Printf.printf "Error: %s\n" (Solver.explain_error err);
287 false
288
289(* Run the tests *)
290let run_tests () =
291 Printf.printf "\n=== Simple Test ===\n";
292 let simple_result = Solver.solve (module SimpleProvider) Pubgrub.default_config in
293 let simple_passed = print_solution simple_result in
294
295 Printf.printf "\n=== Complex Test ===\n";
296 let complex_result = Solver.solve (module ComplexProvider) Pubgrub.default_config in
297 let complex_passed = print_solution complex_result in
298
299 Printf.printf "\n=== Conflict Test ===\n";
300 let conflict_result = Solver.solve (module ConflictProvider) Pubgrub.default_config in
301 let conflict_passed = not (print_solution conflict_result) in
302
303 Printf.printf "\n=== Diamond Dependency Test ===\n";
304 let diamond_result = Solver.solve (module DiamondProvider) Pubgrub.default_config in
305 let diamond_passed = print_solution diamond_result in
306
307 Printf.printf "\n=== Test Results ===\n";
308 Printf.printf "Simple test: %s\n" (if simple_passed then "PASSED" else "FAILED");
309 Printf.printf "Complex test: %s\n" (if complex_passed then "PASSED" else "FAILED");
310 Printf.printf "Conflict test: %s\n" (if conflict_passed then "PASSED" else "FAILED");
311 Printf.printf "Diamond test: %s\n" (if diamond_passed then "PASSED" else "FAILED");
312
313 let all_passed = simple_passed && complex_passed && conflict_passed && diamond_passed in
314 if all_passed then
315 Printf.printf "\nAll tests passed!\n"
316 else
317 Printf.printf "\nSome tests failed.\n"
318
319(* Run all the tests *)
320let () = run_tests ()