jon.recoil.org
this repo has no description
1let dynamic_cmis_to_json ~cma_units (dcs : Js_top_worker.Impl.dynamic_cmis) =
2 let base = [
3 ("dcs_url", `String dcs.dcs_url);
4 ("dcs_toplevel_modules", `List (List.map (fun s -> `String s) dcs.dcs_toplevel_modules));
5 ("dcs_file_prefixes", `List (List.map (fun s -> `String s) dcs.dcs_file_prefixes));
6 ("dcs_module_crcs", `Assoc (List.map (fun (k, v) -> (k, `String v)) dcs.dcs_module_crcs));
7 ] in
8 let fields = match cma_units with
9 | [] -> base
10 | units ->
11 let cma_units_json = `Assoc (List.map (fun (archive, mods) ->
12 (archive, `List (List.map (fun m -> `String m) mods))) units)
13 in
14 base @ [("cma_units", cma_units_json)]
15 in
16 `Assoc fields
17
18(** Read the self-CRC from a .cmi file. Returns the hex digest of the
19 compilation unit's interface, or None if the file can't be read. *)
20let cmi_self_crc cmi_path =
21 try
22 let cmi = Cmi_format.read_cmi (Fpath.to_string cmi_path) in
23 let crcs = cmi.Cmi_format.cmi_crcs in
24 if Array.length crcs > 0 then
25 match Import_info.crc crcs.(0) with
26 | Some crc -> Some (Digest.to_hex crc)
27 | None -> None
28 else None
29 with _ -> None
30
31(** For a list of toplevel module names and the directory containing their
32 .cmi files, return a (module_name, hex_crc) association list. *)
33let read_module_crcs dir modules =
34 List.filter_map (fun modname ->
35 let cmi_path = Fpath.(dir / (String.uncapitalize_ascii modname ^ ".cmi")) in
36 match cmi_self_crc cmi_path with
37 | Some crc -> Some (modname, crc)
38 | None -> None)
39 modules
40
41(** Try to relativize a path against findlib_dir. If the result contains
42 ".." (indicating the path is in a different tree), fall back to extracting
43 the path components after "lib" directory. *)
44let relativize_or_fallback ~findlib_dir path =
45 (* First try standard relativize *)
46 let rel = match Fpath.relativize ~root:findlib_dir path with
47 | Some rel -> rel
48 | None -> path (* shouldn't happen for absolute paths, but fallback *)
49 in
50 (* If the result contains "..", use fallback instead *)
51 let segs = Fpath.segs rel in
52 if List.mem ".." segs then begin
53 (* Fallback: use path components after "lib" directory *)
54 let path_segs = Fpath.segs path in
55 let rec find_after_lib = function
56 | [] -> Fpath.v (Fpath.basename path)
57 | "lib" :: rest -> Fpath.v (String.concat Fpath.dir_sep rest)
58 | _ :: rest -> find_after_lib rest
59 in
60 find_after_lib path_segs
61 end else
62 rel
63
64(** Extract implementation unit names from a .cma archive using ocamlobjinfo. *)
65let cma_unit_names ?switch archive =
66 let base_cmd = match switch with
67 | None -> Bos.Cmd.(v "ocamlobjinfo")
68 | Some s -> Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "ocamlobjinfo")
69 in
70 let cmd = Bos.Cmd.(base_cmd % Fpath.to_string archive) in
71 let lines = Util.lines_of_process cmd in
72 List.filter_map (fun line ->
73 match Astring.String.cut ~sep:"Unit name: " line with
74 | Some ("", name) -> Some (String.trim name)
75 | _ -> None)
76 lines
77
78(** Per-directory CMA unit names, collected during archive compilation
79 and embedded into dynamic_cmis.json. Maps source directory path to
80 a list of (archive_basename, unit_names) pairs. *)
81let cma_units_by_dir : (string, (string * string list) list) Hashtbl.t =
82 Hashtbl.create 16
83
84let record_cma_units dir archive_basename units =
85 let key = Fpath.to_string dir in
86 let existing = match Hashtbl.find_opt cma_units_by_dir key with
87 | Some l -> l
88 | None -> []
89 in
90 Hashtbl.replace cma_units_by_dir key ((archive_basename, units) :: existing)
91
92let cmi_files dir =
93 Bos.OS.Dir.fold_contents ~traverse:`None ~elements:`Files
94 (fun path acc ->
95 if Fpath.has_ext ".cmi" path then Fpath.filename path :: acc else acc)
96 [] dir
97
98let gen_cmis ?path_prefix cmis =
99 let gen_one (dir, cmis) =
100 let all_cmis =
101 List.map (fun s -> String.sub s 0 (String.length s - 4)) cmis
102 in
103 let hidden, non_hidden =
104 List.partition (fun x -> Astring.String.is_infix ~affix:"__" x) all_cmis
105 in
106 let prefixes =
107 List.filter_map
108 (fun x ->
109 match Astring.String.cuts ~sep:"__" x with
110 | x :: _ -> Some (x ^ "__")
111 | _ -> None)
112 hidden
113 in
114 let prefixes = Util.StringSet.(of_list prefixes |> to_list) in
115 let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in
116 let d = relativize_or_fallback ~findlib_dir dir in
117 (* Include path_prefix in dcs_url so it's correct relative to HTTP root *)
118 let dcs_url_path = match path_prefix with
119 | Some prefix -> Fpath.(v prefix / "lib" // d)
120 | None -> Fpath.(v "lib" // d)
121 in
122 let toplevel_modules = List.map String.capitalize_ascii non_hidden in
123 let dcs =
124 {
125 Js_top_worker.Impl.dcs_url = Fpath.to_string dcs_url_path;
126 dcs_toplevel_modules = toplevel_modules;
127 dcs_file_prefixes = prefixes;
128 dcs_module_crcs = read_module_crcs dir toplevel_modules;
129 dcs_cma_units = [];
130 }
131 in
132 let cma_units = match Hashtbl.find_opt cma_units_by_dir (Fpath.to_string dir) with
133 | Some units -> units
134 | None -> []
135 in
136 ( dir,
137 Yojson.Safe.to_string (dynamic_cmis_to_json ~cma_units dcs) )
138 in
139 List.map gen_one cmis
140
141(** Read dependency paths from a file (one path per line) *)
142let read_deps_file path =
143 match Bos.OS.File.read_lines (Fpath.v path) with
144 | Ok lines -> List.filter (fun s -> String.length s > 0) lines
145 | Error (`Msg m) ->
146 Format.eprintf "Warning: Failed to read deps file %s: %s\n%!" path m;
147 []
148
149let copy_extra_files output_dir files =
150 List.iter (fun src ->
151 let src = Fpath.v src in
152 let dst = Fpath.(output_dir / Fpath.filename src) in
153 Util.cp src dst;
154 Format.eprintf "Copied %a to %a\n%!" Fpath.pp src Fpath.pp dst)
155 files
156
157let opam verbose output_dir_str switch libraries no_worker path deps_file extra_files =
158 Opam.switch := switch;
159 (* When --path is specified, only compile the specified libraries (no deps) *)
160 let libraries_with_deps, libraries_only =
161 match Ocamlfind.deps libraries with
162 | Ok l ->
163 let all = Util.StringSet.of_list ("stdlib" :: l) in
164 (* In --path mode, don't auto-add stdlib - only include requested libs *)
165 let only = Util.StringSet.of_list libraries in
166 (all, only)
167 | Error (`Msg m) ->
168 Format.eprintf "Failed to find libs: %s\n%!" m;
169 failwith ("Bad libs: " ^ m)
170 in
171 (* In path mode, only compile the specified packages *)
172 let libraries = if path <> None then libraries_only else libraries_with_deps in
173 (* Read dependency paths from file if specified *)
174 let dep_paths = match deps_file with
175 | Some f -> read_deps_file f
176 | None -> []
177 in
178 Eio_main.run @@ fun env ->
179 Eio.Switch.run @@ fun sw ->
180 if verbose then Logs.set_level (Some Logs.Debug) else Logs.set_level None;
181 Logs.set_reporter (Logs_fmt.reporter ());
182 let () = Worker_pool.start_workers env sw 16 in
183 Logs.debug (fun m ->
184 m "Libraries: %a"
185 (Fmt.list ~sep:Fmt.comma Fmt.string)
186 (Util.StringSet.elements libraries));
187 (* output_dir is always from -o; --path is a subdirectory within it *)
188 let base_output_dir = Fpath.v output_dir_str in
189 let output_dir =
190 match path with
191 | Some p -> Fpath.(base_output_dir // v p)
192 | None -> base_output_dir
193 in
194 let meta_files =
195 List.map
196 (fun lib -> Ocamlfind.meta_file lib)
197 (Util.StringSet.elements libraries)
198 |> Util.StringSet.of_list
199 in
200 let cmi_dirs =
201 match Ocamlfind.deps (Util.StringSet.to_list libraries) with
202 | Ok libs ->
203 let dirs =
204 List.filter_map
205 (fun lib ->
206 match Ocamlfind.get_dir lib with Ok x -> Some x | _ -> None)
207 libs
208 in
209 dirs
210 | Error (`Msg m) ->
211 Format.eprintf "Failed to find libs: %s\n%!" m;
212 []
213 in
214 Format.eprintf "cmi_dirs: %a\n%!" (Fmt.list ~sep:Fmt.comma Fpath.pp) cmi_dirs;
215 (* In --path mode, only include cmi dirs from specified libraries and their
216 subpackages, not external dependencies *)
217 let cmi_dirs_to_copy =
218 if path <> None then
219 let lib_dirs =
220 List.filter_map
221 (fun lib ->
222 match Ocamlfind.get_dir lib with Ok x -> Some x | _ -> None)
223 (Util.StringSet.to_list libraries)
224 in
225 (* Filter cmi_dirs to include directories that are equal to or subdirectories
226 of lib_dirs. This includes subpackages like base.base_internalhash_types.
227 We check that the relative path doesn't start with ".." *)
228 List.filter
229 (fun dir ->
230 List.exists
231 (fun lib_dir ->
232 Fpath.equal dir lib_dir ||
233 match Fpath.relativize ~root:lib_dir dir with
234 | Some rel ->
235 let segs = Fpath.segs rel in
236 (match segs with
237 | ".." :: _ -> false (* Goes outside lib_dir *)
238 | _ -> true)
239 | None -> false)
240 lib_dirs)
241 cmi_dirs
242 else
243 cmi_dirs
244 in
245 let cmis =
246 List.fold_left
247 (fun acc dir ->
248 match cmi_files dir with
249 | Ok files -> (dir, files) :: acc
250 | Error _ -> acc)
251 [] cmi_dirs_to_copy
252 in
253 let ( let* ) = Result.bind in
254
255 let _ =
256 let* _ = Bos.OS.Dir.create output_dir in
257 let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in
258
259 List.iter
260 (fun (dir, files) ->
261 let d = relativize_or_fallback ~findlib_dir dir in
262 List.iter
263 (fun f ->
264 let dest_dir = Fpath.(output_dir / "lib" // d) in
265 let dest = Fpath.(dest_dir / f) in
266 let _ = Bos.OS.Dir.create ~path:true dest_dir in
267 match Bos.OS.File.exists dest with
268 | Ok true -> ()
269 | Ok false -> Util.cp Fpath.(dir / f) dest
270 | Error _ -> failwith "file exists failed")
271 files)
272 cmis;
273
274 let meta_rels =
275 Util.StringSet.fold
276 (fun meta_file acc ->
277 let meta_file = Fpath.v meta_file in
278 let d = relativize_or_fallback ~findlib_dir meta_file |> Fpath.parent in
279 (meta_file, d) :: acc)
280 meta_files []
281 in
282
283 List.iter
284 (fun (meta_file, d) ->
285 let dest = Fpath.(output_dir / "lib" // d) in
286 let _ = Bos.OS.Dir.create dest in
287 Util.cp meta_file dest)
288 meta_rels;
289
290 (* Generate findlib_index as JSON with metas field *)
291 let metas_json =
292 List.map
293 (fun (meta_file, d) ->
294 let file = Fpath.filename meta_file in
295 let rel_path = Fpath.(v "lib" // d / file) in
296 `String (Fpath.to_string rel_path))
297 meta_rels
298 in
299 (* TODO: dep_paths should also contribute META paths once we have full universe info *)
300 let _ = dep_paths in
301 let compiler_field =
302 if no_worker then []
303 else [("compiler", `Assoc [("worker_url", `String "worker.js")])]
304 in
305 let findlib_json = `Assoc (("meta_files", `List metas_json) :: compiler_field) in
306 Out_channel.with_open_bin
307 Fpath.(output_dir / "findlib_index.json" |> to_string)
308 (fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json));
309
310 (* Compile archives for each library AND its subpackages *)
311 Util.StringSet.iter
312 (fun lib ->
313 (* Get subpackages (e.g., base.base_internalhash_types for base) *)
314 let sub_libs = Ocamlfind.sub_libraries lib in
315 let all_libs = Util.StringSet.add lib sub_libs in
316 Util.StringSet.iter
317 (fun sub_lib ->
318 match Ocamlfind.get_dir sub_lib with
319 | Error _ -> ()
320 | Ok dir ->
321 let archives = Ocamlfind.archives sub_lib in
322 let archives = List.map (fun x -> Fpath.(dir / x)) archives in
323 let d = relativize_or_fallback ~findlib_dir dir in
324 let dest = Fpath.(output_dir / "lib" // d) in
325 let (_ : (bool, _) result) = Bos.OS.Dir.create dest in
326 let compile_archive archive =
327 let output = Fpath.(dest / (Fpath.filename archive ^ ".js")) in
328 let js_runtime = Ocamlfind.jsoo_runtime sub_lib in
329 let js_files =
330 List.map (fun f -> Fpath.(dir / f |> to_string)) js_runtime
331 in
332 let base_cmd =
333 match switch with
334 | None -> Bos.Cmd.(v "js_of_ocaml")
335 | Some s ->
336 Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "js_of_ocaml")
337 in
338 let cmd =
339 Bos.Cmd.(
340 base_cmd % "compile" % "--toplevel" % "--include-runtime"
341 % "--effects=disabled")
342 in
343 let cmd = List.fold_left (fun c f -> Bos.Cmd.(c % f)) cmd js_files in
344 let cmd =
345 Bos.Cmd.(cmd % Fpath.to_string archive % "-o" % Fpath.to_string output)
346 in
347 ignore (Util.lines_of_process cmd);
348 (* Record CMA unit names for embedding in dynamic_cmis.json *)
349 let units = cma_unit_names ?switch archive in
350 record_cma_units dir (Fpath.filename archive) units
351 in
352 List.iter compile_archive archives)
353 all_libs)
354 libraries;
355
356 (* Format.eprintf "@[<hov 2>dir: %a [%a]@]\n%!" Fpath.pp dir (Fmt.list ~sep:Fmt.sp Fmt.string) files) cmis; *)
357 Ok ()
358 in
359 let init_cmis = gen_cmis ?path_prefix:path cmis in
360 List.iter
361 (fun (dir, dcs) ->
362 let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in
363 let d = Fpath.relativize ~root:findlib_dir dir in
364 match d with
365 | None ->
366 Format.eprintf "Failed to relativize %a wrt %a\n%!" Fpath.pp dir
367 Fpath.pp findlib_dir
368 | Some dir ->
369 Format.eprintf "Generating %a\n%!" Fpath.pp dir;
370 let dir = Fpath.(output_dir / "lib" // dir) in
371 let _ = Bos.OS.Dir.create dir in
372 let oc = open_out Fpath.(dir / "dynamic_cmis.json" |> to_string) in
373 Printf.fprintf oc "%s" dcs;
374 close_out oc)
375 init_cmis;
376 Format.eprintf "Number of cmis: %d\n%!" (List.length init_cmis);
377
378 let () =
379 if no_worker then () else Mk_backend.mk switch output_dir
380 in
381 copy_extra_files output_dir extra_files;
382
383 `Ok ()
384
385(** Generate a single package's universe directory.
386 Returns (pkg_path, meta_path) where meta_path is the full path to META
387 relative to the output_dir root. *)
388let generate_package_universe ~switch ~output_dir ~findlib_dir ~pkg ~pkg_deps =
389 (* Use package name as directory path *)
390 let pkg_path = pkg in
391 let pkg_output_dir = Fpath.(output_dir / pkg_path) in
392 let _ = Bos.OS.Dir.create ~path:true pkg_output_dir in
393
394 (* Get the package's directory and copy cmi files *)
395 let pkg_dir = match Ocamlfind.get_dir pkg with
396 | Ok d -> d
397 | Error _ -> failwith ("Cannot find package: " ^ pkg)
398 in
399
400 (* Also include subpackages (directories under pkg_dir) *)
401 let all_pkg_dirs =
402 let sub_libs = Ocamlfind.sub_libraries pkg in
403 Util.StringSet.fold (fun sub acc ->
404 match Ocamlfind.get_dir sub with
405 | Ok d -> d :: acc
406 | Error _ -> acc)
407 sub_libs [pkg_dir]
408 |> List.sort_uniq Fpath.compare
409 in
410
411 (* Copy cmi files *)
412 List.iter (fun dir ->
413 match cmi_files dir with
414 | Ok files ->
415 let d = relativize_or_fallback ~findlib_dir dir in
416 List.iter (fun f ->
417 let dest_dir = Fpath.(pkg_output_dir / "lib" // d) in
418 let dest = Fpath.(dest_dir / f) in
419 let _ = Bos.OS.Dir.create ~path:true dest_dir in
420 match Bos.OS.File.exists dest with
421 | Ok true -> ()
422 | Ok false -> Util.cp Fpath.(dir / f) dest
423 | Error _ -> ())
424 files
425 | Error _ -> ())
426 all_pkg_dirs;
427
428 (* Copy META file *)
429 let meta_file = Fpath.v (Ocamlfind.meta_file pkg) in
430 let meta_rel = relativize_or_fallback ~findlib_dir meta_file |> Fpath.parent in
431 let meta_dest = Fpath.(pkg_output_dir / "lib" // meta_rel) in
432 let _ = Bos.OS.Dir.create ~path:true meta_dest in
433 Util.cp meta_file meta_dest;
434
435 (* Compile archives for main package and all subpackages *)
436 let sub_libs = Ocamlfind.sub_libraries pkg in
437 let all_libs = Util.StringSet.add pkg sub_libs in
438 Util.StringSet.iter (fun lib ->
439 match Ocamlfind.get_dir lib with
440 | Error _ -> ()
441 | Ok lib_dir ->
442 let archives = Ocamlfind.archives lib in
443 let archives = List.map (fun x -> Fpath.(lib_dir / x)) archives in
444 let d = relativize_or_fallback ~findlib_dir lib_dir in
445 let dest = Fpath.(pkg_output_dir / "lib" // d) in
446 let _ = Bos.OS.Dir.create ~path:true dest in
447 List.iter (fun archive ->
448 let output = Fpath.(dest / (Fpath.filename archive ^ ".js")) in
449 let js_runtime = Ocamlfind.jsoo_runtime lib in
450 let js_files = List.map (fun f -> Fpath.(lib_dir / f |> to_string)) js_runtime in
451 let base_cmd = match switch with
452 | None -> Bos.Cmd.(v "js_of_ocaml")
453 | Some s -> Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "js_of_ocaml")
454 in
455 let cmd = Bos.Cmd.(base_cmd % "compile" % "--toplevel" % "--include-runtime" % "--effects=disabled") in
456 let cmd = List.fold_left (fun c f -> Bos.Cmd.(c % f)) cmd js_files in
457 let cmd = Bos.Cmd.(cmd % Fpath.to_string archive % "-o" % Fpath.to_string output) in
458 ignore (Util.lines_of_process cmd);
459 (* Record CMA unit names for embedding in dynamic_cmis.json *)
460 let units = cma_unit_names ?switch archive in
461 record_cma_units lib_dir (Fpath.filename archive) units)
462 archives)
463 all_libs;
464
465 (* Generate dynamic_cmis.json for each directory *)
466 List.iter (fun dir ->
467 match cmi_files dir with
468 | Ok files ->
469 let all_cmis = List.map (fun s -> String.sub s 0 (String.length s - 4)) files in
470 let hidden, non_hidden = List.partition (fun x -> Astring.String.is_infix ~affix:"__" x) all_cmis in
471 let prefixes = List.filter_map (fun x ->
472 match Astring.String.cuts ~sep:"__" x with
473 | x :: _ -> Some (x ^ "__")
474 | _ -> None) hidden in
475 let prefixes = Util.StringSet.(of_list prefixes |> to_list) in
476 let d = relativize_or_fallback ~findlib_dir dir in
477 (* dcs_url is relative to the package's own findlib_index.json *)
478 let toplevel_modules = List.map String.capitalize_ascii non_hidden in
479 let dcs = {
480 Js_top_worker.Impl.dcs_url = Fpath.(v "lib" // d |> to_string);
481 dcs_toplevel_modules = toplevel_modules;
482 dcs_file_prefixes = prefixes;
483 dcs_module_crcs = read_module_crcs dir toplevel_modules;
484 dcs_cma_units = [];
485 } in
486 let cma_units = match Hashtbl.find_opt cma_units_by_dir (Fpath.to_string dir) with
487 | Some units -> units
488 | None -> []
489 in
490 let dcs_json = Yojson.Safe.to_string (dynamic_cmis_to_json ~cma_units dcs) in
491 let dcs_dir = Fpath.(pkg_output_dir / "lib" // d) in
492 let _ = Bos.OS.Dir.create ~path:true dcs_dir in
493 let oc = open_out Fpath.(dcs_dir / "dynamic_cmis.json" |> to_string) in
494 Printf.fprintf oc "%s" dcs_json;
495 close_out oc
496 | Error _ -> ())
497 all_pkg_dirs;
498
499 (* Return pkg_path and the META path relative to pkg_path *)
500 let local_meta_path = Fpath.(v "lib" // meta_rel / "META" |> to_string) in
501 (pkg_path, local_meta_path, pkg_deps)
502
503let opam_all verbose output_dir_str switch libraries no_worker all_pkgs extra_files =
504 Opam.switch := switch;
505
506 (* Get all packages and their dependencies *)
507 let all_packages =
508 if all_pkgs then
509 (* Build all installed packages *)
510 Ocamlfind.all ()
511 else if libraries = [] then
512 (* No packages specified, just stdlib *)
513 ["stdlib"]
514 else
515 match Ocamlfind.deps libraries with
516 | Ok l -> "stdlib" :: l
517 | Error (`Msg m) -> failwith ("Failed to find libs: " ^ m)
518 in
519
520 (* Remove duplicates and sort *)
521 let all_packages = Util.StringSet.(of_list all_packages |> to_list) in
522
523 Format.eprintf "Generating universes for %d packages\n%!" (List.length all_packages);
524
525 Eio_main.run @@ fun env ->
526 Eio.Switch.run @@ fun sw ->
527 if verbose then Logs.set_level (Some Logs.Debug) else Logs.set_level None;
528 Logs.set_reporter (Logs_fmt.reporter ());
529 let () = Worker_pool.start_workers env sw 16 in
530
531 let output_dir = Fpath.v output_dir_str in
532 let _ = Bos.OS.Dir.create ~path:true output_dir in
533 let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in
534
535 (* Build dependency map: package -> list of dependency packages.
536 Stdlib is implicitly required by everything, so add it for all
537 non-stdlib packages even if ocamlfind doesn't list it. *)
538 let dep_map = Hashtbl.create 64 in
539 let all_packages_set = Util.StringSet.of_list all_packages in
540 List.iter (fun pkg ->
541 let deps = match Ocamlfind.deps [pkg] with
542 | Ok l -> List.filter (fun d -> d <> pkg) l
543 | Error _ -> []
544 in
545 (* Add stdlib as implicit dependency for non-stdlib packages *)
546 let deps =
547 if pkg <> "stdlib" && not (List.mem "stdlib" deps)
548 && Util.StringSet.mem "stdlib" all_packages_set
549 then "stdlib" :: deps
550 else deps
551 in
552 Hashtbl.add dep_map pkg deps)
553 all_packages;
554
555 (* Generate each package and collect results *)
556 let pkg_results = List.map (fun pkg ->
557 Format.eprintf "Generating %s...\n%!" pkg;
558 let pkg_deps = Hashtbl.find dep_map pkg in
559 generate_package_universe ~switch ~output_dir ~findlib_dir ~pkg ~pkg_deps)
560 all_packages
561 in
562
563 (* Build a map from package name to full META path *)
564 let meta_path_map = Hashtbl.create 64 in
565 List.iter (fun (pkg_path, local_meta_path, _deps) ->
566 let full_meta_path = pkg_path ^ "/" ^ local_meta_path in
567 Hashtbl.add meta_path_map pkg_path full_meta_path)
568 pkg_results;
569
570 (* Generate findlib_index for each package.
571 - meta_files: only this package's own META (relative to its own dir)
572 - universes: relative paths to dependency package dirs (e.g., "../stdlib") *)
573 List.iter (fun (pkg_path, local_meta_path, deps) ->
574 let dep_universes = List.filter_map (fun dep ->
575 if Hashtbl.mem meta_path_map dep then
576 Some ("../" ^ dep)
577 else begin
578 Format.eprintf "Warning: no universe found for dep %s\n%!" dep;
579 None
580 end)
581 deps
582 in
583 let fields = [("meta_files", `List [`String local_meta_path])] in
584 let fields = if dep_universes = [] then fields
585 else fields @ [("universes", `List (List.map (fun s -> `String s) dep_universes))] in
586 let findlib_json = `Assoc fields in
587 Out_channel.with_open_bin Fpath.(output_dir / pkg_path / "findlib_index.json" |> to_string)
588 (fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json)))
589 pkg_results;
590
591 (* Generate root findlib_index.json with all META paths *)
592 let all_metas = List.map (fun (pkg_path, local_meta_path, _) ->
593 pkg_path ^ "/" ^ local_meta_path)
594 pkg_results
595 in
596 let compiler_field =
597 if no_worker then []
598 else [("compiler", `Assoc [("worker_url", `String "worker.js")])]
599 in
600 let root_index = `Assoc (("meta_files", `List (List.map (fun s -> `String s) all_metas)) :: compiler_field) in
601 Out_channel.with_open_bin Fpath.(output_dir / "findlib_index.json" |> to_string)
602 (fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string root_index));
603
604 Format.eprintf "Generated root findlib_index.json with %d META files\n%!" (List.length pkg_results);
605
606 (* Generate worker.js if requested *)
607 let () = if no_worker then () else Mk_backend.mk switch output_dir in
608 copy_extra_files output_dir extra_files;
609
610 `Ok ()
611
612open Cmdliner
613
614let opam_cmd =
615 let libraries = Arg.(value & pos_all string [] & info [] ~docv:"LIB") in
616 let output_dir =
617 let doc =
618 "Output directory in which to put all outputs. This should be the root \
619 directory of the HTTP server. Ignored when --path is specified."
620 in
621 Arg.(value & opt string "html" & info [ "o"; "output" ] ~doc)
622 in
623 let verbose =
624 let doc = "Enable verbose logging" in
625 Arg.(value & flag & info [ "v"; "verbose" ] ~doc) in
626 let no_worker =
627 let doc = "Do not create worker.js" in
628 Arg.(value & flag & info [ "no-worker" ] ~doc)
629 in
630 let switch =
631 let doc = "Opam switch to use" in
632 Arg.(value & opt (some string) None & info [ "switch" ] ~doc)
633 in
634 let path =
635 let doc =
636 "Full output path for this package (e.g., universes/abc123/base/v0.17.1/). \
637 When specified, only the named packages are compiled (not dependencies)."
638 in
639 Arg.(value & opt (some string) None & info [ "path" ] ~doc)
640 in
641 let deps_file =
642 let doc =
643 "File containing dependency paths, one per line. Each path should be \
644 relative to the HTTP root (e.g., universes/xyz789/sexplib0/v0.17.0/)."
645 in
646 Arg.(value & opt (some string) None & info [ "deps-file" ] ~doc)
647 in
648 let extra_files =
649 let doc =
650 "Copy file into the output directory (e.g., --copy-file /path/to/x-ocaml.js). \
651 May be repeated."
652 in
653 Arg.(value & opt_all string [] & info [ "copy-file" ] ~doc)
654 in
655 let info = Cmd.info "opam" ~doc:"Generate opam files" in
656 Cmd.v info
657 Term.(ret (const opam $ verbose $ output_dir $ switch $ libraries $ no_worker $ path $ deps_file $ extra_files))
658
659let opam_all_cmd =
660 let libraries = Arg.(value & pos_all string [] & info [] ~docv:"LIB") in
661 let output_dir =
662 let doc =
663 "Output directory for all universes. Each package gets its own subdirectory."
664 in
665 Arg.(value & opt string "html" & info [ "o"; "output" ] ~doc)
666 in
667 let verbose =
668 let doc = "Enable verbose logging" in
669 Arg.(value & flag & info [ "v"; "verbose" ] ~doc)
670 in
671 let no_worker =
672 let doc = "Do not create worker.js" in
673 Arg.(value & flag & info [ "no-worker" ] ~doc)
674 in
675 let switch =
676 let doc = "Opam switch to use" in
677 Arg.(value & opt (some string) None & info [ "switch" ] ~doc)
678 in
679 let all_pkgs =
680 let doc = "Build all installed packages (from ocamlfind list)" in
681 Arg.(value & flag & info [ "all" ] ~doc)
682 in
683 let extra_files =
684 let doc =
685 "Copy file into the output directory (e.g., --copy-file /path/to/x-ocaml.js). \
686 May be repeated."
687 in
688 Arg.(value & opt_all string [] & info [ "copy-file" ] ~doc)
689 in
690 let info = Cmd.info "opam-all" ~doc:"Generate universes for all packages and their dependencies" in
691 Cmd.v info
692 Term.(ret (const opam_all $ verbose $ output_dir $ switch $ libraries $ no_worker $ all_pkgs $ extra_files))
693
694let main_cmd =
695 let doc = "An odoc notebook tool" in
696 let info = Cmd.info "odoc-notebook" ~version:"%%VERSION%%" ~doc in
697 let default = Term.(ret (const (`Help (`Pager, None)))) in
698 Cmd.group info ~default [ opam_cmd; opam_all_cmd ]
699
700let () = exit (Cmd.eval main_cmd)