this repo has no description
Simplify findlib_index to flat list of META paths
Replace the two-field format (meta_files + universes) with a single
"metas" field containing all META paths for the dependency closure.
- Remove recursive universe loading from findlibish.ml
- Each package's findlib_index now lists all transitive META paths
- opam_all builds correct META paths using ocamlfind metadata
- Fixes incorrect path generation for subpackages (e.g., base.shadow_stdlib)
This simplifies client loading: one fetch gets all needed META paths,
no recursive findlib_index resolution required.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+67
-78
+44
-26
bin/jtw.ml
+44
-26
bin/jtw.ml
···
186
186
Util.cp meta_file dest)
187
187
meta_rels;
188
188
189
-
(* Generate findlib_index as JSON with packages and deps fields *)
190
-
let packages_json =
189
+
(* Generate findlib_index as JSON with metas field *)
190
+
let metas_json =
191
191
List.map
192
192
(fun (meta_file, d) ->
193
193
let file = Fpath.filename meta_file in
···
195
195
`String (Fpath.to_string rel_path))
196
196
meta_rels
197
197
in
198
-
let deps_json = List.map (fun d -> `String d) dep_paths in
199
-
let findlib_json =
200
-
`Assoc [("packages", `List packages_json); ("deps", `List deps_json)]
201
-
in
198
+
(* TODO: dep_paths should also contribute META paths once we have full universe info *)
199
+
let _ = dep_paths in
200
+
let findlib_json = `Assoc [("metas", `List metas_json)] in
202
201
Out_channel.with_open_bin
203
202
Fpath.(output_dir / "findlib_index" |> to_string)
204
203
(fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json));
···
275
274
`Ok ()
276
275
277
276
(** Generate a single package's universe directory.
278
-
Returns the relative path for use in the root index. *)
277
+
Returns (pkg_path, meta_path) where meta_path is the full path to META
278
+
relative to the output_dir root. *)
279
279
let generate_package_universe ~switch ~output_dir ~findlib_dir ~pkg ~pkg_deps =
280
280
(* Use package name as directory path *)
281
281
let pkg_path = pkg in
···
377
377
| Error _ -> ())
378
378
all_pkg_dirs;
379
379
380
-
(* Generate findlib_index with deps *)
381
-
let packages_json = [`String Fpath.(v "lib" // meta_rel / "META" |> to_string)] in
382
-
let deps_json = List.map (fun d -> `String d) pkg_deps in
383
-
let findlib_json = `Assoc [("packages", `List packages_json); ("deps", `List deps_json)] in
384
-
Out_channel.with_open_bin Fpath.(pkg_output_dir / "findlib_index" |> to_string)
385
-
(fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json));
386
-
387
-
pkg_path
380
+
(* Return pkg_path and the META path relative to pkg_path *)
381
+
let local_meta_path = Fpath.(v "lib" // meta_rel / "META" |> to_string) in
382
+
(pkg_path, local_meta_path, pkg_deps)
388
383
389
384
let opam_all verbose output_dir_str switch libraries no_worker =
390
385
Opam.switch := switch;
···
420
415
Hashtbl.add dep_map pkg deps)
421
416
all_packages;
422
417
423
-
(* Generate each package *)
424
-
let pkg_paths = List.map (fun pkg ->
418
+
(* Generate each package and collect results *)
419
+
let pkg_results = List.map (fun pkg ->
425
420
Format.eprintf "Generating %s...\n%!" pkg;
426
421
let pkg_deps = Hashtbl.find dep_map pkg in
427
-
(* Deps are package names, which are also the paths in our simple scheme *)
428
-
let dep_paths = pkg_deps in
429
-
generate_package_universe ~switch ~output_dir ~findlib_dir ~pkg ~pkg_deps:dep_paths)
422
+
generate_package_universe ~switch ~output_dir ~findlib_dir ~pkg ~pkg_deps)
430
423
all_packages
431
424
in
432
425
433
-
(* Generate root findlib_index *)
434
-
let root_index = `Assoc [
435
-
("packages", `List []);
436
-
("deps", `List (List.map (fun p -> `String p) pkg_paths))
437
-
] in
426
+
(* Build a map from package name to full META path *)
427
+
let meta_path_map = Hashtbl.create 64 in
428
+
List.iter (fun (pkg_path, local_meta_path, _deps) ->
429
+
let full_meta_path = pkg_path ^ "/" ^ local_meta_path in
430
+
Hashtbl.add meta_path_map pkg_path full_meta_path)
431
+
pkg_results;
432
+
433
+
(* Generate findlib_index for each package with correct META paths *)
434
+
List.iter (fun (pkg_path, local_meta_path, deps) ->
435
+
let this_meta = pkg_path ^ "/" ^ local_meta_path in
436
+
let dep_metas = List.filter_map (fun dep ->
437
+
match Hashtbl.find_opt meta_path_map dep with
438
+
| Some path -> Some path
439
+
| None ->
440
+
Format.eprintf "Warning: no META path found for dep %s\n%!" dep;
441
+
None)
442
+
deps
443
+
in
444
+
let all_metas = this_meta :: dep_metas in
445
+
let findlib_json = `Assoc [("metas", `List (List.map (fun s -> `String s) all_metas))] in
446
+
Out_channel.with_open_bin Fpath.(output_dir / pkg_path / "findlib_index" |> to_string)
447
+
(fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json)))
448
+
pkg_results;
449
+
450
+
(* Generate root findlib_index with all META paths *)
451
+
let all_metas = List.map (fun (pkg_path, local_meta_path, _) ->
452
+
pkg_path ^ "/" ^ local_meta_path)
453
+
pkg_results
454
+
in
455
+
let root_index = `Assoc [("metas", `List (List.map (fun s -> `String s) all_metas))] in
438
456
Out_channel.with_open_bin Fpath.(output_dir / "findlib_index" |> to_string)
439
457
(fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string root_index));
440
458
441
-
Format.eprintf "Generated root findlib_index with %d packages\n%!" (List.length pkg_paths);
459
+
Format.eprintf "Generated root findlib_index with %d META files\n%!" (List.length pkg_results);
442
460
443
461
(* Generate worker.js if requested *)
444
462
let () = if no_worker then () else Mk_backend.mk switch output_dir in
+23
-52
lib/findlibish.ml
+23
-52
lib/findlibish.ml
···
126
126
let (let*) = Lwt.bind
127
127
128
128
(** Parse a findlib_index file (JSON or legacy text format) and return
129
-
the list of package paths and dependency universe paths *)
129
+
the list of META file paths.
130
+
131
+
JSON format: [{"metas": ["path/to/META", ...]}]
132
+
133
+
The paths are absolute from the URL root and include universe hashes,
134
+
e.g., ["abc123/lib/cmdliner/META", "def456/lib/astring/META"] *)
130
135
let parse_findlib_index content =
131
136
(* Try JSON format first *)
132
137
try
133
138
let json = Yojson.Safe.from_string content in
134
139
let open Yojson.Safe.Util in
135
-
let packages = json |> member "packages" |> to_list |> List.map to_string in
136
-
let deps = json |> member "deps" |> to_list |> List.map to_string in
137
-
(packages, deps)
140
+
json |> member "metas" |> to_list |> List.map to_string
138
141
with _ ->
139
142
(* Fall back to legacy whitespace-separated format *)
140
-
let packages = Astring.String.fields ~empty:false content in
141
-
(packages, [])
143
+
Astring.String.fields ~empty:false content
142
144
143
145
(** Load a single META file and parse it into a library *)
144
146
let load_meta async_get meta_path =
···
173
175
Jslib.log "Failed to parse uri: %s" m;
174
176
Lwt.return_none
175
177
176
-
(** Resolve a relative path against a base URL's directory *)
177
-
let resolve_url_relative ~base relative =
178
-
match Angstrom.parse_string ~consume:All Uri.Parser.uri_reference base with
179
-
| Ok base_uri ->
180
-
let base_path = Uri.path base_uri in
181
-
let base_dir = Fpath.(v base_path |> parent |> to_string) in
182
-
let resolved = Filename.concat base_dir relative in
183
-
Uri.with_path base_uri resolved |> Uri.to_string
184
-
| Error _ -> relative
185
-
186
-
(** Resolve a path from the URL root (for dependency universes) *)
178
+
(** Resolve a path from the URL root *)
187
179
let resolve_url_from_root ~base path =
188
180
match Angstrom.parse_string ~consume:All Uri.Parser.uri_reference base with
189
181
| Ok base_uri ->
···
193
185
194
186
let init (async_get : string -> (string, [>`Msg of string]) result Lwt.t) findlib_index : t Lwt.t =
195
187
Jslib.log "Initializing findlib";
196
-
(* Track visited universes to avoid infinite loops *)
197
-
let visited = Hashtbl.create 16 in
198
-
let rec load_universe index_url =
199
-
if Hashtbl.mem visited index_url then
188
+
let* findlib_txt = async_get findlib_index in
189
+
match findlib_txt with
190
+
| Error (`Msg m) ->
191
+
Jslib.log "Error fetching findlib index %s: %s" findlib_index m;
200
192
Lwt.return []
201
-
else begin
202
-
Hashtbl.add visited index_url ();
203
-
let* findlib_txt = async_get index_url in
204
-
match findlib_txt with
205
-
| Error (`Msg m) ->
206
-
Jslib.log "Error fetching findlib index %s: %s" index_url m;
207
-
Lwt.return []
208
-
| Ok content ->
209
-
let packages, deps = parse_findlib_index content in
210
-
Jslib.log "Loaded universe %s: %d packages, %d deps" index_url
211
-
(List.length packages) (List.length deps);
212
-
(* Resolve package paths relative to the index URL's directory *)
213
-
let resolved_packages =
214
-
List.map (fun p -> resolve_url_relative ~base:index_url p) packages
215
-
in
216
-
(* Load META files from this universe *)
217
-
let* local_libs =
218
-
Lwt_list.filter_map_p (load_meta async_get) resolved_packages
219
-
in
220
-
(* Recursively load dependency universes from root paths *)
221
-
let dep_index_urls =
222
-
List.map (fun dep ->
223
-
resolve_url_from_root ~base:index_url (Filename.concat dep "findlib_index"))
224
-
deps
225
-
in
226
-
let* dep_libs = Lwt_list.map_p load_universe dep_index_urls in
227
-
Lwt.return (local_libs @ List.flatten dep_libs)
228
-
end
229
-
in
230
-
let* all_libs = load_universe findlib_index in
231
-
Lwt.return (flatten_libs all_libs)
193
+
| Ok content ->
194
+
let metas = parse_findlib_index content in
195
+
Jslib.log "Loaded findlib_index %s: %d META files" findlib_index (List.length metas);
196
+
(* Resolve META paths from URL root *)
197
+
let resolved_metas =
198
+
List.map (fun p -> resolve_url_from_root ~base:findlib_index p) metas
199
+
in
200
+
(* Load all META files *)
201
+
let* libs = Lwt_list.filter_map_p (load_meta async_get) resolved_metas in
202
+
Lwt.return (flatten_libs libs)
232
203
233
204
let require ~import_scripts sync_get cmi_only v packages =
234
205
let rec require dcss package :