+1 -1

day10/bin/dummy.ml

reviewed

··· 39 39 let doc_layer_hash ~t:_ ~build_hash:_ ~dep_doc_hashes:_ ~ocaml_version:_ ~blessed:_ ~compiler_layers:_ = "" 40 40 41 41 (* Documentation generation not supported in dummy container *) 42 42 - let generate_docs ~t:_ ~build_layer_dir:_ ~doc_layer_dir:_ ~dep_doc_hashes:_ ~pkg:_ ~installed_libs:_ ~installed_docs:_ ~phase:_ ~ocaml_version:_ ~compiler_layers:_ = None 42 42 + let generate_docs ~t:_ ~build_layer_dir:_ ~doc_layer_dir:_ ~dep_doc_hashes:_ ~pkg:_ ~installed_libs:_ ~installed_docs:_ ~phase:_ ~blessed:_ ~ocaml_version:_ ~compiler_layers:_ = None 43 43 44 44 let jtw_layer_hash ~t:_ ~build_hash:_ ~ocaml_version:_ ~compiler_layers:_ = "" 45 45

+1 -1

day10/bin/freebsd.ml

reviewed

··· 258 258 let doc_layer_hash ~t:_ ~build_hash:_ ~dep_doc_hashes:_ ~ocaml_version:_ ~blessed:_ ~compiler_layers:_ = "" 259 259 260 260 (* Documentation generation not supported on FreeBSD *) 261 261 - let generate_docs ~t:_ ~build_layer_dir:_ ~doc_layer_dir:_ ~dep_doc_hashes:_ ~pkg:_ ~installed_libs:_ ~installed_docs:_ ~phase:_ ~ocaml_version:_ ~compiler_layers:_ = None 261 261 + let generate_docs ~t:_ ~build_layer_dir:_ ~doc_layer_dir:_ ~dep_doc_hashes:_ ~pkg:_ ~installed_libs:_ ~installed_docs:_ ~phase:_ ~blessed:_ ~ocaml_version:_ ~compiler_layers:_ = None 262 262 263 263 let jtw_layer_hash ~t:_ ~build_hash:_ ~ocaml_version:_ ~compiler_layers:_ = "" 264 264

+22 -7

day10/bin/linux.ml

reviewed

··· 702 702 ]) 703 703 end 704 704 in 705 705 + (* Copy compiler layers' fs/ (for ocamlobjinfo and other compiler tools needed by odoc_driver) *) 706 706 + let () = 707 707 + List.iter 708 708 + (fun layer_name -> 709 709 + let layer_fs = Path.(config.dir / os_key / layer_name / "fs") in 710 710 + if Sys.file_exists layer_fs then 711 711 + ignore 712 712 + (Os.sudo ~stderr:"/dev/null" 713 713 + [ 714 714 + "cp"; 715 715 + "-n"; 716 716 + "--archive"; 717 717 + "--no-dereference"; 718 718 + "--recursive"; 719 719 + "--link"; 720 720 + "--no-target-directory"; 721 721 + layer_fs; 722 722 + lowerdir; 723 723 + ])) 724 724 + compiler_layers 725 725 + in 705 726 (* Copy dependency doc layers' fs/ (these contain compile/ output with .odoc files) *) 706 727 let doc_tool_hashes = [ Doc_tools.get_odoc_hash ~config ~ocaml_version ~compiler_layers; Doc_tools.get_driver_hash ~config ~compiler_layers ] in 707 728 let () = ··· 1111 1132 else run_jtw_worker_in_container ~t ~dep_build_hashes ~ocaml_version ~solution_packages ~compiler_layers 1112 1133 | None -> (1, "") 1113 1134 1114 1114 - let generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase ~ocaml_version ~compiler_layers = 1135 1135 + let generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase ~blessed ~ocaml_version ~compiler_layers = 1115 1136 let config = t.config in 1116 1137 if not config.with_doc then None 1117 1138 else ··· 1164 1185 let prep_dir = Path.(doc_layer_dir / "prep") in 1165 1186 if Sys.file_exists prep_dir then 1166 1187 ignore (Os.sudo [ "chown"; "-R"; uid_gid; prep_dir ]); 1167 1167 - (* Determine blessing status from pre-computed map *) 1168 1168 - let blessed = 1169 1169 - match config.blessed_map with 1170 1170 - | Some map -> Blessing.is_blessed map pkg 1171 1171 - | None -> false 1172 1172 - in 1173 1188 (* Determine HTML output directory - use shared if specified, else per-layer *) 1174 1189 let final_html_output_dir = match config.html_output with 1175 1190 | Some dir -> dir

+693 -882

day10/bin/main.ml

reviewed

··· 307 307 Day10_lib.History.append ~packages_dir ~pkg_str entry 308 308 end 309 309 310 310 - (** Case-insensitive substring search. Thread-safe (no global state). *) 311 311 - let contains_substring_ci ~pattern text = 312 312 - let pat = String.lowercase_ascii pattern in 313 313 - let pat_len = String.length pat in 314 314 - let text_len = String.length text in 315 315 - if pat_len > text_len then false 316 316 - else 317 317 - let rec check i = 318 318 - if i > text_len - pat_len then false 319 319 - else if String.lowercase_ascii (String.sub text i pat_len) = pat then true 320 320 - else check (i + 1) 321 321 - in 322 322 - check 0 323 323 - 324 324 - (** Check if any substring in the list appears in the text (case-insensitive). *) 325 325 - let matches_any patterns text = 326 326 - List.exists (fun pat -> contains_substring_ci ~pattern:pat text) patterns 327 327 - 328 328 - (** Extract the compiler version from a layer.json's deps list. 329 329 - Looks for packages starting with "ocaml-base-compiler" or "ocaml-variants". *) 330 330 - let extract_compiler_from_deps json = 331 331 - let open Yojson.Safe.Util in 332 332 - let deps = try json |> member "deps" |> to_list |> List.map to_string with _ -> [] in 333 333 - let compiler_pkg = List.find_opt (fun dep -> 334 334 - let name = try String.sub dep 0 (String.index dep '.') with Not_found -> dep in 335 335 - name = "ocaml-base-compiler" || name = "ocaml-variants" 336 336 - ) deps in 337 337 - match compiler_pkg with 338 338 - | Some pkg -> 339 339 - (try String.sub pkg (String.index pkg '.' + 1) (String.length pkg - String.index pkg '.' - 1) 340 340 - with Not_found -> pkg) 341 341 - | None -> "" 310 310 + let matches_any = Day10_lib.Batch_util.matches_any 311 311 + let extract_compiler_from_deps = Day10_lib.Batch_util.extract_compiler_from_deps 342 312 343 313 (** Classify a build failure by scanning the build log for known patterns. *) 344 314 let classify_build_failure build_log_path = ··· 346 316 try Os.read_from_file build_log_path 347 317 with _ -> "" 348 318 in 349 349 - let transient_patterns = [ 350 350 - "No space left on device"; 351 351 - "Connection timed out"; 352 352 - "Could not resolve host"; 353 353 - "Temporary failure in name resolution"; 354 354 - "Network is unreachable"; 355 355 - ] in 356 356 - let depext_patterns = [ 357 357 - "Unable to locate package"; 358 358 - "is not available"; 359 359 - "unmet dependencies"; 360 360 - "dpkg: dependency problems"; 361 361 - ] in 362 362 - if matches_any transient_patterns log_content then 363 363 - ("failure", "transient_failure", Some "Transient infrastructure failure detected in build log") 364 364 - else if matches_any depext_patterns log_content then 365 365 - ("failure", "depext_unavailable", Some "Missing system dependency detected in build log") 366 366 - else 367 367 - ("failure", "build_failure", None) 319 319 + Day10_lib.Batch_util.classify_build_log log_content 368 320 369 321 let print_build_result = function 370 322 | Solution _ -> () ··· 481 433 else S.Doc_compile_only 482 434 in 483 435 let doc_result = 484 484 - Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir:target_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase ~ocaml_version ~compiler_layers 436 436 + Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir:target_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase ~blessed ~ocaml_version ~compiler_layers 485 437 in 486 438 Util.save_doc_layer_info ?doc_result (Path.(target_dir / "layer.json")) pkg ~build_hash:build_layer_name ~dep_doc_hashes; 487 439 (* Cache disk usage for fast reporting *) ··· 647 599 ) 648 600 else 649 601 650 650 - (* Track packages that need deferred doc linking (have post deps) *) 651 651 - let deferred_doc_link = ref [] in 652 652 - 653 602 (* Track compiler build layers - captured after compiler package builds successfully. 654 603 Tool layers (doc-driver, doc-odoc, jtw-tools) stack on these to avoid 655 604 recompiling the OCaml compiler from scratch. *) ··· 691 640 let dep_doc_hashes = List.filter_map (fun p -> OpamPackage.Map.find_opt p dm) ordered_deps in 692 641 (match doc_layer t pkg build_layer_name dep_doc_hashes ~ocaml_version ~compiler_layers:!compiler_layers () with 693 642 | Some doc_name -> 694 694 - (* Track packages with extra link deps (post deps + x-extra-doc-deps) for deferred doc linking *) 695 695 - let opamfile = Util.opam_file config.opam_repositories pkg in 696 696 - (match opamfile with 697 697 - | Some opam when not (OpamPackage.Name.Set.is_empty (get_extra_link_deps opam)) -> 698 698 - deferred_doc_link := (pkg, build_layer_name, doc_name) :: !deferred_doc_link 699 699 - | _ -> ()); 700 643 (r, OpamPackage.Map.add pkg doc_name dm) 701 644 | None -> 702 645 (* Doc generation failed - treat as failure when --with-doc *) ··· 732 675 ([], OpamPackage.Map.empty, OpamPackage.Map.empty) ordered_installation 733 676 in 734 677 735 735 - (* Run deferred doc link phase for packages with extra link deps (post deps + x-extra-doc-deps) *) 736 736 - let () = 737 737 - if config.with_doc && not (List.is_empty !deferred_doc_link) then begin 738 738 - let os_key = Config.os_key ~config in 739 739 - (* Build a map of package name to package in solution for looking up x-extra-doc-deps *) 740 740 - let solution_by_name = 741 741 - OpamPackage.Map.fold (fun pkg _ acc -> 742 742 - OpamPackage.Name.Map.add (OpamPackage.name pkg) pkg acc 743 743 - ) doc_map OpamPackage.Name.Map.empty 744 744 - in 745 745 - List.iter (fun (pkg, build_layer_name, doc_layer_name) -> 746 746 - let build_layer_dir = Path.(config.dir / os_key / build_layer_name) in 747 747 - let doc_layer_dir = Path.(config.dir / os_key / doc_layer_name) in 748 748 - (* Get updated dep_doc_hashes including post deps now available *) 749 749 - let ordered_deps = extract_dag dependencies pkg |> topological_sort |> List.rev |> List.tl in 750 750 - let base_dep_doc_hashes = List.filter_map (fun p -> OpamPackage.Map.find_opt p doc_map) ordered_deps in 751 751 - (* Also include x-extra-doc-deps doc hashes *) 752 752 - let opamfile = Util.opam_file config.opam_repositories pkg in 753 753 - let extra_doc_dep_hashes = match opamfile with 754 754 - | None -> [] 755 755 - | Some opam -> 756 756 - let extra_doc_deps = Odoc_gen.get_extra_doc_deps opam in 757 757 - if not (OpamPackage.Name.Set.is_empty extra_doc_deps) then 758 758 - Os.log "deferred_doc_link: %s has x-extra-doc-deps: [%s]" 759 759 - (OpamPackage.to_string pkg) 760 760 - (OpamPackage.Name.Set.to_string extra_doc_deps); 761 761 - OpamPackage.Name.Set.fold (fun name acc -> 762 762 - match OpamPackage.Name.Map.find_opt name solution_by_name with 763 763 - | Some extra_pkg -> 764 764 - (match OpamPackage.Map.find_opt extra_pkg doc_map with 765 765 - | Some doc_hash -> 766 766 - Os.log "deferred_doc_link: including doc hash for %s -> %s" 767 767 - (OpamPackage.to_string extra_pkg) doc_hash; 768 768 - doc_hash :: acc 769 769 - | None -> 770 770 - Os.log "deferred_doc_link: warning - %s has no doc layer" 771 771 - (OpamPackage.to_string extra_pkg); 772 772 - acc) 773 773 - | None -> 774 774 - Os.log "deferred_doc_link: warning - x-extra-doc-dep %s not in solution" 775 775 - (OpamPackage.Name.to_string name); 776 776 - acc 777 777 - ) extra_doc_deps [] 778 778 - in 779 779 - let dep_doc_hashes = base_dep_doc_hashes @ extra_doc_dep_hashes in 780 780 - let build_layer_json = Path.(build_layer_dir / "layer.json") in 781 781 - let installed_libs = Util.load_layer_info_installed_libs build_layer_json in 782 782 - let installed_docs = Util.load_layer_info_installed_docs build_layer_json in 783 783 - Option.iter (fun ocaml_version -> 784 784 - let _doc_result = 785 785 - Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase:S.Doc_link_only ~ocaml_version ~compiler_layers:!compiler_layers 786 786 - in 787 787 - ()) ocaml_version 788 788 - ) !deferred_doc_link 789 789 - end 790 790 - in 791 791 - 792 678 (* Prune layers if requested *) 793 679 let () = 794 680 if config.prune_layers then begin ··· 970 856 in 971 857 print_build_result (List.hd results) 972 858 973 973 - let run_ci (config : Config.t) = 974 974 - let package = OpamPackage.of_string (config.package ^ ".dev") in 975 975 - let results = build config package in 976 976 - output config results 977 977 - 978 978 - let run_health_check (config : Config.t) = 979 979 - let package = OpamPackage.of_string config.package in 980 980 - let results = build config package in 981 981 - output config results 982 982 - 983 983 - let run_health_check_multi (config : Config.t) package_arg = 984 984 - let () = match Local_repo.validate config.local_repos with 985 985 - | Ok () -> () 986 986 - | Error msg -> failwith msg 987 987 - in 988 988 - match package_arg.[0] = '@' with 989 989 - | false -> 990 990 - (* Single package: use paths as-is (files, not directories) *) 991 991 - let config = { config with package = package_arg } in 992 992 - run_health_check config 993 993 - | true -> 994 994 - let filename = String.sub package_arg 1 (String.length package_arg - 1) in 995 995 - let packages = Json_packages.read_packages filename in 996 996 - (* Multiple packages: treat paths as directories *) 997 997 - let () = Option.iter (fun path -> Os.mkdir ~parents:true path) config.json in 998 998 - let () = Option.iter (fun path -> Os.mkdir ~parents:true path) config.md in 999 999 - let () = Option.iter (fun path -> Os.mkdir ~parents:true path) config.dot in 1000 1000 - let run_with_package pkg_name = 1001 1001 - let json = Option.map (fun path -> Path.(path / pkg_name ^ ".json")) config.json in 1002 1002 - let md = Option.map (fun path -> Path.(path / pkg_name ^ ".md")) config.md in 1003 1003 - let dot = Option.map (fun path -> Path.(path / pkg_name ^ ".dot")) config.dot in 1004 1004 - let config = { config with package = pkg_name; json; md; dot } in 1005 1005 - run_health_check config 1006 1006 - in 1007 1007 - match config.fork with 1008 1008 - | Some 1 1009 1009 - | None -> List.iter run_with_package packages 1010 1010 - | Some n -> Os.fork ~np:n run_with_package packages 1011 1011 - 1012 859 (** Run deferred doc link pass for packages with x-extra-doc-deps across all built packages. 1013 1013 - This is used in batch mode after all targets are built, to link packages whose 860 860 + This is used after targets are built, to link packages whose 1014 861 x-extra-doc-deps were not available during the initial doc generation. *) 1015 862 let run_global_deferred_doc_link ?(doc_layers : (string * string) list option) (config : Config.t) = 1016 863 if not config.with_doc then () ··· 1134 981 | Some ocaml_version -> 1135 982 Os.log "global_deferred_doc_link: Running link-only for %s with %d dep hashes" 1136 983 (OpamPackage.to_string pkg) (List.length dep_doc_hashes); 984 984 + let blessed = match config.blessed_map with 985 985 + | Some map -> Blessing.is_blessed map pkg 986 986 + | None -> false 987 987 + in 1137 988 let _doc_result = 1138 1138 - Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase:S.Doc_link_only ~ocaml_version ~compiler_layers:[] 989 989 + Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg ~installed_libs ~installed_docs ~phase:S.Doc_link_only ~blessed ~ocaml_version ~compiler_layers:[] 1139 990 in 1140 991 () 1141 992 ) packages_to_relink 1142 993 end 1143 994 end 1144 995 996 996 + let run_ci (config : Config.t) = 997 997 + let package = OpamPackage.of_string (config.package ^ ".dev") in 998 998 + let results = build config package in 999 999 + run_global_deferred_doc_link config; 1000 1000 + output config results 1001 1001 + 1002 1002 + let run_health_check (config : Config.t) = 1003 1003 + let package = OpamPackage.of_string config.package in 1004 1004 + let results = build config package in 1005 1005 + run_global_deferred_doc_link config; 1006 1006 + output config results 1007 1007 + 1008 1008 + let run_health_check_multi (config : Config.t) package_arg = 1009 1009 + let () = match Local_repo.validate config.local_repos with 1010 1010 + | Ok () -> () 1011 1011 + | Error msg -> failwith msg 1012 1012 + in 1013 1013 + match package_arg.[0] = '@' with 1014 1014 + | false -> 1015 1015 + (* Single package: use paths as-is (files, not directories) *) 1016 1016 + let config = { config with package = package_arg } in 1017 1017 + run_health_check config 1018 1018 + | true -> 1019 1019 + let filename = String.sub package_arg 1 (String.length package_arg - 1) in 1020 1020 + let packages = Json_packages.read_packages filename in 1021 1021 + (* Multiple packages: treat paths as directories *) 1022 1022 + let () = Option.iter (fun path -> Os.mkdir ~parents:true path) config.json in 1023 1023 + let () = Option.iter (fun path -> Os.mkdir ~parents:true path) config.md in 1024 1024 + let () = Option.iter (fun path -> Os.mkdir ~parents:true path) config.dot in 1025 1025 + let run_with_package pkg_name = 1026 1026 + let json = Option.map (fun path -> Path.(path / pkg_name ^ ".json")) config.json in 1027 1027 + let md = Option.map (fun path -> Path.(path / pkg_name ^ ".md")) config.md in 1028 1028 + let dot = Option.map (fun path -> Path.(path / pkg_name ^ ".dot")) config.dot in 1029 1029 + let config = { config with package = pkg_name; json; md; dot } in 1030 1030 + run_health_check config 1031 1031 + in 1032 1032 + match config.fork with 1033 1033 + | Some 1 1034 1034 + | None -> List.iter run_with_package packages 1035 1035 + | Some n -> Os.fork ~np:n run_with_package packages 1036 1036 + 1145 1037 (** Collect all layer names that should be kept based on ALL cached solutions. 1146 1038 Scans every solution file under solutions/<opam-repo-sha>/<package>.json 1147 1039 to build the full set of referenced packages, not just the current batch. *) ··· 1469 1361 reap_one () 1470 1362 done 1471 1363 1364 1364 + (** Produce batch summary: record build/doc results in history, write universes, 1365 1365 + generate status.json, and print summary to stdout. *) 1366 1366 + let print_batch_summary ~(config : Config.t) ~solutions ~blessing_maps 1367 1367 + ~num_packages ~total_failed ~run_info 1368 1368 + ?(per_solution_hashes : (OpamPackage.t list * (string, string) Hashtbl.t) list option) 1369 1369 + ?(doc_layers : (string * string) list option) () = 1370 1370 + let os_key = Config.os_key ~config in 1371 1371 + let layer_dir = Path.(config.dir / os_key) in 1372 1372 + let packages_dir = Path.(config.dir / os_key / "packages") in 1373 1373 + let run_id = Day10_lib.Run_log.get_id run_info in 1374 1374 + let build_success = ref 0 in 1375 1375 + let build_fail = ref 0 in 1376 1376 + let build_dep_fail = ref 0 in 1377 1377 + let doc_success = ref 0 in 1378 1378 + let doc_fail = ref 0 in 1379 1379 + let failures = ref [] in 1380 1380 + let layer_cache : (string, (string * int * string * Yojson.Safe.t) option) Hashtbl.t = Hashtbl.create 256 in 1381 1381 + let lookup_build_layer name = 1382 1382 + match Hashtbl.find_opt layer_cache name with 1383 1383 + | Some cached -> cached 1384 1384 + | None -> 1385 1385 + let result = 1386 1386 + let layer_json_path = Path.(layer_dir / name / "layer.json") in 1387 1387 + if Sys.file_exists layer_json_path then 1388 1388 + try 1389 1389 + let json = Yojson.Safe.from_file layer_json_path in 1390 1390 + let open Yojson.Safe.Util in 1391 1391 + let pkg_name = json |> member "package" |> to_string in 1392 1392 + let exit_status = json |> member "exit_status" |> to_int_option |> Option.value ~default:(-1) in 1393 1393 + let compiler = extract_compiler_from_deps json in 1394 1394 + Some (pkg_name, exit_status, compiler, json) 1395 1395 + with _ -> None 1396 1396 + else None 1397 1397 + in 1398 1398 + Hashtbl.replace layer_cache name result; 1399 1399 + result 1400 1400 + in 1401 1401 + let doc_cache : (string, (string * Yojson.Safe.t) option) Hashtbl.t = Hashtbl.create 256 in 1402 1402 + let lookup_doc_layer name = 1403 1403 + match Hashtbl.find_opt doc_cache name with 1404 1404 + | Some cached -> cached 1405 1405 + | None -> 1406 1406 + let result = 1407 1407 + let layer_json_path = Path.(layer_dir / name / "layer.json") in 1408 1408 + if Sys.file_exists layer_json_path then 1409 1409 + try 1410 1410 + let json = Yojson.Safe.from_file layer_json_path in 1411 1411 + let open Yojson.Safe.Util in 1412 1412 + let pkg_name = json |> member "package" |> to_string in 1413 1413 + Some (pkg_name, json) 1414 1414 + with _ -> None 1415 1415 + else None 1416 1416 + in 1417 1417 + Hashtbl.replace doc_cache name result; 1418 1418 + result 1419 1419 + in 1420 1420 + let built_packages = Hashtbl.create 64 in 1421 1421 + let _build_layer_info = Hashtbl.create 64 in 1422 1422 + let processed = Hashtbl.create 4096 in 1423 1423 + let solution_info = match per_solution_hashes with 1424 1424 + | Some hashes -> 1425 1425 + List.map2 (fun (target, solution) (ordered, pkg_hashes) -> 1426 1426 + (target, solution, ordered, pkg_hashes) 1427 1427 + ) solutions hashes 1428 1428 + | None -> 1429 1429 + let t_for_hash = Container.init ~config in 1430 1430 + List.map (fun (target, solution) -> 1431 1431 + let ordered = topological_sort solution in 1432 1432 + let dependencies = pkg_deps solution ordered in 1433 1433 + let pkg_hashes = Hashtbl.create (List.length ordered) in 1434 1434 + List.iter (fun pkg -> 1435 1435 + let ordered_deps = extract_dag dependencies pkg |> topological_sort |> List.rev |> List.tl in 1436 1436 + let hash = cached_layer_hash_global ~t:t_for_hash (pkg :: ordered_deps) in 1437 1437 + Hashtbl.replace pkg_hashes (OpamPackage.to_string pkg) ("build-" ^ hash) 1438 1438 + ) ordered; 1439 1439 + (target, solution, ordered, pkg_hashes) 1440 1440 + ) solutions 1441 1441 + in 1442 1442 + List.iter (fun (target, _solution, ordered, pkg_hashes) -> 1443 1443 + let bless_map = List.find_opt (fun (t, _) -> 1444 1444 + OpamPackage.equal t target 1445 1445 + ) blessing_maps in 1446 1446 + List.iter (fun pkg -> 1447 1447 + let pkg_str = OpamPackage.to_string pkg in 1448 1448 + let build_layer_name = Hashtbl.find pkg_hashes pkg_str in 1449 1449 + let is_blessed = match bless_map with 1450 1450 + | Some (_, map) -> Blessing.is_blessed map pkg 1451 1451 + | None -> false 1452 1452 + in 1453 1453 + let key = (pkg_str, build_layer_name) in 1454 1454 + match lookup_build_layer build_layer_name with 1455 1455 + | Some (_, exit_status, compiler, _json) when exit_status >= 0 -> 1456 1456 + Hashtbl.replace built_packages pkg_str true; 1457 1457 + Hashtbl.replace _build_layer_info pkg_str (build_layer_name, exit_status, compiler); 1458 1458 + if not (Hashtbl.mem processed key) then begin 1459 1459 + Hashtbl.replace processed key true; 1460 1460 + if exit_status = 0 then begin 1461 1461 + incr build_success; 1462 1462 + let build_log = Path.(layer_dir / build_layer_name / "build.log") in 1463 1463 + Day10_lib.Run_log.add_build_log run_info ~package:pkg_str ~source_log:build_log; 1464 1464 + record_build_result ~packages_dir ~run_id ~pkg_str 1465 1465 + ~build_hash:build_layer_name ~compiler ~blessed:is_blessed 1466 1466 + ~status:"success" ~category:"success" () 1467 1467 + end else begin 1468 1468 + incr build_fail; 1469 1469 + failures := (pkg_str, Printf.sprintf "build exit code %d" exit_status) :: !failures; 1470 1470 + let build_log = Path.(layer_dir / build_layer_name / "build.log") in 1471 1471 + Day10_lib.Run_log.add_build_log run_info ~package:pkg_str ~source_log:build_log; 1472 1472 + let (status, category, error) = classify_build_failure build_log in 1473 1473 + record_build_result ~packages_dir ~run_id ~pkg_str 1474 1474 + ~build_hash:build_layer_name ~compiler ~blessed:is_blessed 1475 1475 + ~status ~category ?error () 1476 1476 + end 1477 1477 + end 1478 1478 + | _ -> () 1479 1479 + ) ordered; 1480 1480 + ) solution_info; 1481 1481 + let process_doc_layer name = 1482 1482 + match lookup_doc_layer name with 1483 1483 + | Some (pkg_name, json) -> 1484 1484 + let open Yojson.Safe.Util in 1485 1485 + let doc = json |> member "doc" in 1486 1486 + if doc <> `Null then begin 1487 1487 + let blessed = doc |> member "blessed" |> to_bool_option |> Option.value ~default:false in 1488 1488 + let status = doc |> member "status" |> to_string_option |> Option.value ~default:"" in 1489 1489 + let layer_hash = String.sub name 4 (String.length name - 4) in 1490 1490 + let doc_log = Path.(layer_dir / name / "odoc-voodoo-all.log") in 1491 1491 + Day10_lib.Run_log.add_doc_log run_info ~package:pkg_name ~source_log:doc_log ~layer_hash (); 1492 1492 + if status = "success" then begin 1493 1493 + incr doc_success; 1494 1494 + record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1495 1495 + ~build_hash:name ~compiler:"" ~blessed 1496 1496 + ~status:"success" ~category:"success" () 1497 1497 + end else begin 1498 1498 + incr doc_fail; 1499 1499 + let error_msg = doc |> member "error" |> to_string_option |> Option.value ~default:"unknown error" in 1500 1500 + failures := (pkg_name, Printf.sprintf "doc: %s" error_msg) :: !failures; 1501 1501 + let doc_category = 1502 1502 + if matches_any ["link"] (String.lowercase_ascii error_msg) then 1503 1503 + "doc_link_failure" 1504 1504 + else 1505 1505 + "doc_compile_failure" 1506 1506 + in 1507 1507 + record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1508 1508 + ~build_hash:name ~compiler:"" ~blessed 1509 1509 + ~status:"failure" ~category:doc_category 1510 1510 + ~error:error_msg () 1511 1511 + end 1512 1512 + end 1513 1513 + | None -> () 1514 1514 + in 1515 1515 + (match doc_layers with 1516 1516 + | Some layers -> 1517 1517 + let seen = Hashtbl.create (List.length layers) in 1518 1518 + List.iter (fun (_pkg_str, doc_name) -> 1519 1519 + if not (Hashtbl.mem seen doc_name) then begin 1520 1520 + Hashtbl.replace seen doc_name true; 1521 1521 + process_doc_layer doc_name 1522 1522 + end 1523 1523 + ) layers 1524 1524 + | None -> 1525 1525 + let run_start_time = Day10_lib.Run_log.get_start_time run_info in 1526 1526 + (try 1527 1527 + Sys.readdir layer_dir |> Array.iter (fun name -> 1528 1528 + if String.length name > 4 && String.sub name 0 4 = "doc-" then begin 1529 1529 + let layer_json_path = Path.(layer_dir / name / "layer.json") in 1530 1530 + let dominated = try 1531 1531 + let stat = Unix.stat layer_json_path in 1532 1532 + stat.Unix.st_mtime >= run_start_time 1533 1533 + with _ -> false in 1534 1534 + if dominated then process_doc_layer name 1535 1535 + end 1536 1536 + ) 1537 1537 + with _ -> ())); 1538 1538 + let root_failure_cache : (string, (string * string) option) Hashtbl.t = Hashtbl.create 256 in 1539 1539 + let rec find_root_failure solution pkg_hashes pkg visited = 1540 1540 + let pkg_str = OpamPackage.to_string pkg in 1541 1541 + let build_hash = try Hashtbl.find pkg_hashes pkg_str with Not_found -> "" in 1542 1542 + if build_hash = "" then None 1543 1543 + else 1544 1544 + match Hashtbl.find_opt root_failure_cache build_hash with 1545 1545 + | Some cached -> cached 1546 1546 + | None -> 1547 1547 + if OpamPackage.Set.mem pkg visited then None 1548 1548 + else 1549 1549 + let visited = OpamPackage.Set.add pkg visited in 1550 1550 + let result = match lookup_build_layer build_hash with 1551 1551 + | Some (_, exit_status, _, _) when exit_status <> 0 -> 1552 1552 + Some (pkg_str, build_hash) 1553 1553 + | Some _ -> None 1554 1554 + | None -> 1555 1555 + let dep_pkgs = try OpamPackage.Set.elements (OpamPackage.Map.find pkg solution) with Not_found -> [] in 1556 1556 + List.find_map (fun dep -> find_root_failure solution pkg_hashes dep visited) dep_pkgs 1557 1557 + in 1558 1558 + if result <> None then 1559 1559 + Hashtbl.replace root_failure_cache build_hash result; 1560 1560 + result 1561 1561 + in 1562 1562 + List.iter (fun (target, solution, _ordered, pkg_hashes) -> 1563 1563 + let bless_map = List.find_opt (fun (t, _) -> 1564 1564 + OpamPackage.equal t target 1565 1565 + ) blessing_maps in 1566 1566 + OpamPackage.Map.iter (fun pkg _deps -> 1567 1567 + let pkg_str = OpamPackage.to_string pkg in 1568 1568 + if not (Hashtbl.mem built_packages pkg_str) then begin 1569 1569 + let build_hash = Hashtbl.find pkg_hashes pkg_str in 1570 1570 + if not (Hashtbl.mem processed (pkg_str, build_hash)) then begin 1571 1571 + Hashtbl.replace processed (pkg_str, build_hash) true; 1572 1572 + let failed_dep_info = find_root_failure solution pkg_hashes pkg OpamPackage.Set.empty in 1573 1573 + let failed_dep, failed_dep_hash = match failed_dep_info with 1574 1574 + | Some (dep, hash) -> (Some dep, Some hash) 1575 1575 + | None -> (None, None) 1576 1576 + in 1577 1577 + let is_blessed = match bless_map with 1578 1578 + | Some (_, map) -> Blessing.is_blessed map pkg 1579 1579 + | None -> false 1580 1580 + in 1581 1581 + incr build_dep_fail; 1582 1582 + record_build_result ~packages_dir ~run_id ~pkg_str 1583 1583 + ~build_hash ~compiler:"" ~blessed:is_blessed 1584 1584 + ~status:"failure" ~category:"dependency_failure" 1585 1585 + ?failed_dep ?failed_dep_hash () 1586 1586 + end 1587 1587 + end 1588 1588 + ) solution 1589 1589 + ) solution_info; 1590 1590 + let universes_dir = Path.(layer_dir / "universes") in 1591 1591 + (try Unix.mkdir universes_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); 1592 1592 + let universe_hashes_written = Hashtbl.create 64 in 1593 1593 + List.iter (fun (_target, _solution, ordered, pkg_hashes) -> 1594 1594 + let build_hashes = List.filter_map (fun pkg -> 1595 1595 + Hashtbl.find_opt pkg_hashes (OpamPackage.to_string pkg) 1596 1596 + ) ordered in 1597 1597 + let universe_hash = Odoc_gen.compute_universe_hash build_hashes in 1598 1598 + if not (Hashtbl.mem universe_hashes_written universe_hash) then begin 1599 1599 + Hashtbl.replace universe_hashes_written universe_hash true; 1600 1600 + let universe_file = Path.(universes_dir / universe_hash ^ ".json") in 1601 1601 + if not (Sys.file_exists universe_file) then begin 1602 1602 + let pkg_list = List.map (fun pkg -> 1603 1603 + `String (OpamPackage.to_string pkg) 1604 1604 + ) ordered in 1605 1605 + let json = `Assoc [ 1606 1606 + ("universe_hash", `String universe_hash); 1607 1607 + ("packages", `List pkg_list); 1608 1608 + ("package_count", `Int (List.length ordered)); 1609 1609 + ] in 1610 1610 + let tmp = universe_file ^ ".tmp" in 1611 1611 + let oc = open_out tmp in 1612 1612 + Fun.protect ~finally:(fun () -> close_out oc) (fun () -> 1613 1613 + output_string oc (Yojson.Safe.pretty_to_string json); 1614 1614 + output_char oc '\n'); 1615 1615 + Sys.rename tmp universe_file 1616 1616 + end 1617 1617 + end 1618 1618 + ) solution_info; 1619 1619 + Printf.printf " Universes written: %d\n%!" (Hashtbl.length universe_hashes_written); 1620 1620 + let html_versions = match config.html_output with 1621 1621 + | None -> 0 1622 1622 + | Some html_dir -> 1623 1623 + let p_dir = Path.(html_dir / "p") in 1624 1624 + if Sys.file_exists p_dir then 1625 1625 + try 1626 1626 + Sys.readdir p_dir |> Array.fold_left (fun acc pkg_name -> 1627 1627 + let pkg_dir = Path.(p_dir / pkg_name) in 1628 1628 + if Sys.is_directory pkg_dir then 1629 1629 + acc + (try Array.length (Sys.readdir pkg_dir) with _ -> 0) 1630 1630 + else acc 1631 1631 + ) 0 1632 1632 + with _ -> 0 1633 1633 + else 0 1634 1634 + in 1635 1635 + let _summary = Day10_lib.Run_log.finish_run run_info 1636 1636 + ~targets_requested:num_packages 1637 1637 + ~solutions_found:(List.length solutions) 1638 1638 + ~build_success:!build_success 1639 1639 + ~build_failed:!build_fail 1640 1640 + ~doc_success:!doc_success 1641 1641 + ~doc_failed:!doc_fail 1642 1642 + ~doc_skipped:0 1643 1643 + ~failures:!failures 1644 1644 + in 1645 1645 + Printf.printf "\nBatch summary:\n%!"; 1646 1646 + Printf.printf " Targets requested: %d\n%!" num_packages; 1647 1647 + Printf.printf " Solutions found: %d (failed to solve: %d)\n%!" (List.length solutions) total_failed; 1648 1648 + Printf.printf " Build layers: %d success, %d failed, %d dep-failed\n%!" !build_success !build_fail !build_dep_fail; 1649 1649 + Printf.printf " Doc layers: %d success, %d failed\n%!" !doc_success !doc_fail; 1650 1650 + Printf.printf " HTML versions: %d\n%!" html_versions; 1651 1651 + let previous = Day10_lib.Status_index.read ~dir:(Path.(config.dir / os_key)) in 1652 1652 + let status = Day10_lib.Status_index.generate ~packages_dir ~run_id ~previous in 1653 1653 + Day10_lib.Status_index.write ~dir:(Path.(config.dir / os_key)) status; 1654 1654 + if status.changes <> [] then begin 1655 1655 + Printf.printf "\nStatus changes:\n%!"; 1656 1656 + List.iter (fun (c : Day10_lib.Status_index.change) -> 1657 1657 + let marker = if c.to_status = "success" then "+" else "-" in 1658 1658 + let blessed_marker = if c.blessed then " [blessed]" else "" in 1659 1659 + Printf.printf " %s %-40s %s → %s%s\n%!" 1660 1660 + marker c.package c.from_status c.to_status blessed_marker 1661 1661 + ) status.changes 1662 1662 + end; 1663 1663 + if status.new_packages <> [] then 1664 1664 + Printf.printf " New packages: %d\n%!" (List.length status.new_packages) 1665 1665 + 1666 1666 + (** Build per-solution JTW workers and assemble JTW output. 1667 1667 + Shared between sequential and fork batch paths. *) 1668 1668 + let assemble_jtw_output ~config ~solutions ~blessing_maps = 1669 1669 + match config.Config.with_jtw, config.jtw_output with 1670 1670 + | true, Some jtw_output -> 1671 1671 + Printf.printf "Phase 4: Building per-solution workers and assembling JTW output...\n%!"; 1672 1672 + let t = Container.init ~config in 1673 1673 + let os_key = Config.os_key ~config in 1674 1674 + let jtw_solutions = List.filter_map (fun (target, solution) -> 1675 1675 + match extract_ocaml_version solution with 1676 1676 + | None -> 1677 1677 + Printf.printf " Warning: no OCaml version for %s, skipping\n%!" 1678 1678 + (OpamPackage.to_string target); 1679 1679 + None 1680 1680 + | Some ocaml_version -> 1681 1681 + let ordered = List.map fst (OpamPackage.Map.bindings solution) in 1682 1682 + let dep_build_hashes = List.filter_map (fun pkg -> 1683 1683 + let pkg_str = OpamPackage.to_string pkg in 1684 1684 + let pkg_dir = Path.(config.dir / os_key / "packages" / pkg_str) in 1685 1685 + if Sys.file_exists pkg_dir then 1686 1686 + try 1687 1687 + Sys.readdir pkg_dir |> Array.to_list 1688 1688 + |> List.find_opt (fun name -> String.length name > 6 && String.sub name 0 6 = "build-") 1689 1689 + with _ -> None 1690 1690 + else None 1691 1691 + ) ordered in 1692 1692 + let unique_hashes = List.sort_uniq String.compare dep_build_hashes in 1693 1693 + let solution_packages = List.map OpamPackage.to_string ordered in 1694 1694 + Printf.printf " Building worker.js for %s (%d build layers)...\n%!" 1695 1695 + (OpamPackage.to_string target) (List.length unique_hashes); 1696 1696 + let status, worker_output_dir = 1697 1697 + Container.build_solution_worker ~t ~dep_build_hashes:unique_hashes ~ocaml_version ~solution_packages ~compiler_layers:[] 1698 1698 + in 1699 1699 + if status = 0 && worker_output_dir <> "" && Sys.file_exists Path.(worker_output_dir / "worker.js") then 1700 1700 + Some (target, solution, ocaml_version, worker_output_dir) 1701 1701 + else begin 1702 1702 + Printf.printf " Warning: worker build failed for %s (status=%d), skipping\n%!" 1703 1703 + (OpamPackage.to_string target) status; 1704 1704 + None 1705 1705 + end 1706 1706 + ) solutions in 1707 1707 + if jtw_solutions <> [] then 1708 1708 + Jtw_gen.assemble_jtw_output ~config ~jtw_output ~solutions:jtw_solutions ~blessed_maps:blessing_maps 1709 1709 + else 1710 1710 + Printf.printf " Warning: no solutions with working worker.js, skipping JTW assembly\n%!" 1711 1711 + | _ -> () 1712 1712 + 1713 1713 + (** Phase 3b: Generate doc and jtw layers for successfully built packages (fork path). 1714 1714 + Uses fork-based parallel execution with DAG dependency ordering. 1715 1715 + Returns the list of (pkg_str, doc_layer_name) pairs produced. *) 1716 1716 + let run_fork_doc_layers ~(config : Config.t) ~np ~dag_nodes ~solutions ~per_solution_hashes 1717 1717 + ~blessing_maps ~build_success_set ~node_by_hash ~packages_dir ~run_id = 1718 1718 + let fork_doc_layers = ref [] in 1719 1719 + if config.with_doc || config.with_jtw then begin 1720 1720 + let phase_label = 1721 1721 + match config.with_doc, config.with_jtw with 1722 1722 + | true, true -> "doc + jtw" 1723 1723 + | true, false -> "doc" 1724 1724 + | false, true -> "jtw" 1725 1725 + | false, false -> "" 1726 1726 + in 1727 1727 + Printf.printf "[Phase 3b] Generating %s layers...\n%!" phase_label; 1728 1728 + let os_key = Config.os_key ~config in 1729 1729 + let compiler_layers = 1730 1730 + let ocaml_version_opt = List.find_map (fun (_target, solution) -> 1731 1731 + extract_ocaml_version solution 1732 1732 + ) solutions in 1733 1733 + match ocaml_version_opt with 1734 1734 + | None -> [] 1735 1735 + | Some ov -> 1736 1736 + let ov_str = OpamPackage.to_string ov in 1737 1737 + match List.find_opt (fun (n : build_node) -> 1738 1738 + OpamPackage.to_string n.pkg = ov_str 1739 1739 + ) dag_nodes with 1740 1740 + | Some node -> 1741 1741 + if Hashtbl.find_opt build_success_set node.build_hash = Some true then 1742 1742 + node.dep_build_hashes @ [ node.build_hash ] 1743 1743 + else [] 1744 1744 + | None -> [] 1745 1745 + in 1746 1746 + let doc_generated = ref 0 in 1747 1747 + let doc_failed = ref 0 in 1748 1748 + let jtw_generated = ref 0 in 1749 1749 + let last_reported = ref 0 in 1750 1750 + let blessed_by_build_hash : (string, bool) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 1751 1751 + List.iter2 (fun (target, _solution) (ordered, pkg_to_hash) -> 1752 1752 + let bless_map = List.find_opt (fun (t, _) -> 1753 1753 + OpamPackage.equal t target 1754 1754 + ) blessing_maps in 1755 1755 + match bless_map with 1756 1756 + | None -> () 1757 1757 + | Some (_, bmap) -> 1758 1758 + List.iter (fun pkg -> 1759 1759 + let pkg_str = OpamPackage.to_string pkg in 1760 1760 + match Hashtbl.find_opt pkg_to_hash pkg_str with 1761 1761 + | None -> () 1762 1762 + | Some build_hash -> 1763 1763 + if not (Hashtbl.mem blessed_by_build_hash build_hash) then 1764 1764 + Hashtbl.replace blessed_by_build_hash build_hash 1765 1765 + (Blessing.is_blessed bmap pkg) 1766 1766 + ) ordered 1767 1767 + ) solutions per_solution_hashes; 1768 1768 + let t = Container.init ~config in 1769 1769 + let ocaml_version = List.find_map (fun (_target, solution) -> 1770 1770 + extract_ocaml_version solution 1771 1771 + ) solutions in 1772 1772 + let doc_map_ht : (string, string) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 1773 1773 + let doc_nodes = List.filter (fun (node : build_node) -> 1774 1774 + Hashtbl.find_opt build_success_set node.build_hash = Some true 1775 1775 + ) dag_nodes in 1776 1776 + let doc_node_of_hash : (string, build_node) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 1777 1777 + List.iter (fun (n : build_node) -> Hashtbl.replace doc_node_of_hash n.build_hash n) doc_nodes; 1778 1778 + let doc_remaining : (string, int) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 1779 1779 + let doc_rdeps : (string, string list) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 1780 1780 + List.iter (fun (node : build_node) -> 1781 1781 + let count = List.fold_left (fun acc dep_hash -> 1782 1782 + if Hashtbl.mem doc_node_of_hash dep_hash then begin 1783 1783 + let existing = try Hashtbl.find doc_rdeps dep_hash with Not_found -> [] in 1784 1784 + Hashtbl.replace doc_rdeps dep_hash (node.build_hash :: existing); 1785 1785 + acc + 1 1786 1786 + end else acc 1787 1787 + ) 0 node.dep_build_hashes in 1788 1788 + Hashtbl.replace doc_remaining node.build_hash count 1789 1789 + ) doc_nodes; 1790 1790 + let doc_ready = Queue.create () in 1791 1791 + List.iter (fun (node : build_node) -> 1792 1792 + if Hashtbl.find doc_remaining node.build_hash = 0 then 1793 1793 + Queue.push node doc_ready 1794 1794 + ) doc_nodes; 1795 1795 + let doc_running : (int, string * string option) Hashtbl.t = Hashtbl.create np in 1796 1796 + let doc_completed : (string, bool) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 1797 1797 + let doc_total = List.length doc_nodes in 1798 1798 + let doc_completed_count = ref 0 in 1799 1799 + let promote_doc_dependents hash = 1800 1800 + List.iter (fun dep_hash -> 1801 1801 + let count = Hashtbl.find doc_remaining dep_hash - 1 in 1802 1802 + Hashtbl.replace doc_remaining dep_hash count; 1803 1803 + if count = 0 then 1804 1804 + Queue.push (Hashtbl.find doc_node_of_hash dep_hash) doc_ready 1805 1805 + ) (try Hashtbl.find doc_rdeps hash with Not_found -> []) 1806 1806 + in 1807 1807 + let complete_doc_node hash success doc_layer_name_opt = 1808 1808 + Hashtbl.replace doc_completed hash success; 1809 1809 + incr doc_completed_count; 1810 1810 + (match doc_layer_name_opt with 1811 1811 + | Some doc_name when success -> 1812 1812 + Hashtbl.replace doc_map_ht hash doc_name; 1813 1813 + incr doc_generated; 1814 1814 + let node = Hashtbl.find doc_node_of_hash hash in 1815 1815 + let pkg_str = OpamPackage.to_string node.pkg in 1816 1816 + record_build_result ~packages_dir ~run_id ~pkg_str 1817 1817 + ~build_hash:doc_name ~compiler:"" ~blessed:false 1818 1818 + ~status:"success" ~category:"success" () 1819 1819 + | Some doc_name -> 1820 1820 + incr doc_failed; 1821 1821 + let node = Hashtbl.find doc_node_of_hash hash in 1822 1822 + let pkg_str = OpamPackage.to_string node.pkg in 1823 1823 + let doc_layer_json = Path.(config.dir / os_key / doc_name / "layer.json") in 1824 1824 + let error_msg = 1825 1825 + if Sys.file_exists doc_layer_json then 1826 1826 + try 1827 1827 + let json = Yojson.Safe.from_file doc_layer_json in 1828 1828 + let open Yojson.Safe.Util in 1829 1829 + json |> member "doc" |> member "error" |> to_string_option 1830 1830 + |> Option.value ~default:"unknown error" 1831 1831 + with _ -> "unknown error" 1832 1832 + else "no layer.json" 1833 1833 + in 1834 1834 + record_build_result ~packages_dir ~run_id ~pkg_str 1835 1835 + ~build_hash:doc_name ~compiler:"" ~blessed:false 1836 1836 + ~status:"failure" ~category:"doc_compile_failure" 1837 1837 + ~error:error_msg () 1838 1838 + | None -> incr doc_failed); 1839 1839 + let count = !doc_generated + !doc_failed in 1840 1840 + if count - !last_reported >= 25 || !doc_completed_count = doc_total then begin 1841 1841 + Printf.printf "\r%-60s\r" ""; 1842 1842 + Printf.printf "[Phase 3b] %d/%d layers (%d doc ok, %d failed)%!" 1843 1843 + count doc_total !doc_generated !doc_failed; 1844 1844 + last_reported := count 1845 1845 + end; 1846 1846 + promote_doc_dependents hash 1847 1847 + in 1848 1848 + let reap_doc () = 1849 1849 + let rec waitpid_eintr () = 1850 1850 + try Unix.waitpid [] (-1) 1851 1851 + with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_eintr () 1852 1852 + in 1853 1853 + let pid, status = waitpid_eintr () in 1854 1854 + let exit_code = match status with Unix.WEXITED c -> c | _ -> 1 in 1855 1855 + match Hashtbl.find_opt doc_running pid with 1856 1856 + | Some (hash, doc_name_opt) -> 1857 1857 + Hashtbl.remove doc_running pid; 1858 1858 + complete_doc_node hash (exit_code = 0) doc_name_opt 1859 1859 + | None -> () 1860 1860 + in 1861 1861 + while !doc_completed_count < doc_total do 1862 1862 + while Hashtbl.length doc_running < np && not (Queue.is_empty doc_ready) do 1863 1863 + let node = Queue.pop doc_ready in 1864 1864 + let blessed = match Hashtbl.find_opt blessed_by_build_hash node.build_hash with 1865 1865 + | Some b -> b | None -> false in 1866 1866 + let dep_doc_hashes = List.filter_map (fun dep_hash -> 1867 1867 + Hashtbl.find_opt doc_map_ht dep_hash 1868 1868 + ) node.dep_build_hashes in 1869 1869 + let doc_layer_name = 1870 1870 + if config.with_doc then 1871 1871 + match ocaml_version with 1872 1872 + | Some ov -> 1873 1873 + let doc_hash = Container.doc_layer_hash ~t ~build_hash:node.build_hash ~dep_doc_hashes ~ocaml_version:ov ~blessed ~compiler_layers in 1874 1874 + Some ("doc-" ^ doc_hash) 1875 1875 + | None -> None 1876 1876 + else None 1877 1877 + in 1878 1878 + let cached = 1879 1879 + match doc_layer_name with 1880 1880 + | Some name -> 1881 1881 + let doc_layer_json = Path.(config.dir / os_key / name / "layer.json") in 1882 1882 + Sys.file_exists doc_layer_json && not (Util.load_layer_info_doc_failed doc_layer_json) 1883 1883 + | None -> true 1884 1884 + in 1885 1885 + if cached then 1886 1886 + complete_doc_node node.build_hash true doc_layer_name 1887 1887 + else begin 1888 1888 + Os.log "doc_exec: MISS %s (%s) — building" (OpamPackage.to_string node.pkg) (match doc_layer_name with Some n -> n | None -> "none"); 1889 1889 + match Unix.fork () with 1890 1890 + | 0 -> 1891 1891 + Random.init (Unix.getpid () lxor int_of_float (Unix.gettimeofday () *. 1000000.)); 1892 1892 + let success = 1893 1893 + try 1894 1894 + let result = 1895 1895 + if config.with_doc then 1896 1896 + doc_layer t node.pkg node.build_hash dep_doc_hashes ~ocaml_version ~compiler_layers ~blessed () 1897 1897 + else Some "no-doc" 1898 1898 + in 1899 1899 + if config.with_jtw then begin 1900 1900 + let dep_build_hashes = List.filter (fun dep_hash -> 1901 1901 + let lj = Path.(config.dir / os_key / dep_hash / "layer.json") in 1902 1902 + Sys.file_exists lj && Util.load_layer_info_exit_status lj = 0 1903 1903 + ) node.dep_build_hashes in 1904 1904 + ignore (jtw_layer t node.pkg node.build_hash dep_build_hashes ~ocaml_version ~compiler_layers) 1905 1905 + end; 1906 1906 + result <> None 1907 1907 + with _ -> false 1908 1908 + in 1909 1909 + Unix._exit (if success then 0 else 1) 1910 1910 + | child_pid -> 1911 1911 + Hashtbl.replace doc_running child_pid (node.build_hash, doc_layer_name) 1912 1912 + end 1913 1913 + done; 1914 1914 + if Hashtbl.length doc_running > 0 then 1915 1915 + reap_doc () 1916 1916 + else if Queue.is_empty doc_ready && !doc_completed_count < doc_total then begin 1917 1917 + Printf.eprintf "Doc executor: deadlock detected (%d/%d completed)\n%!" 1918 1918 + !doc_completed_count doc_total; 1919 1919 + List.iter (fun (node : build_node) -> 1920 1920 + if not (Hashtbl.mem doc_completed node.build_hash) then 1921 1921 + complete_doc_node node.build_hash false None 1922 1922 + ) doc_nodes 1923 1923 + end 1924 1924 + done; 1925 1925 + while Hashtbl.length doc_running > 0 do reap_doc () done; 1926 1926 + let doc_map = Hashtbl.fold (fun build_hash doc_name acc -> 1927 1927 + match Hashtbl.find_opt node_by_hash build_hash with 1928 1928 + | Some node -> OpamPackage.Map.add node.pkg doc_name acc 1929 1929 + | None -> acc 1930 1930 + ) doc_map_ht OpamPackage.Map.empty in 1931 1931 + if config.with_doc then begin 1932 1932 + let doc_map_by_name = 1933 1933 + OpamPackage.Map.fold (fun pkg doc_name acc -> 1934 1934 + OpamPackage.Name.Map.add (OpamPackage.name pkg) (pkg, doc_name) acc 1935 1935 + ) doc_map OpamPackage.Name.Map.empty 1936 1936 + in 1937 1937 + List.iter (fun (node : build_node) -> 1938 1938 + let opamfile = Util.opam_file config.opam_repositories node.pkg in 1939 1939 + let has_extra = match opamfile with 1940 1940 + | None -> false 1941 1941 + | Some opam -> not (OpamPackage.Name.Set.is_empty (get_extra_link_deps opam)) 1942 1942 + in 1943 1943 + if has_extra then 1944 1944 + match OpamPackage.Map.find_opt node.pkg doc_map with 1945 1945 + | Some doc_layer_name -> 1946 1946 + let doc_layer_dir = Path.(config.dir / os_key / doc_layer_name) in 1947 1947 + let link_log = Path.(doc_layer_dir / "odoc-voodoo-link-and-gen.log") in 1948 1948 + let already_linked = 1949 1949 + Sys.file_exists link_log && 1950 1950 + (try (Unix.stat link_log).Unix.st_size > 0 with _ -> false) 1951 1951 + in 1952 1952 + if not already_linked then begin 1953 1953 + let build_layer_dir = Path.(config.dir / os_key / node.build_hash) in 1954 1954 + let dep_doc_hashes = List.filter_map (fun dep_hash -> 1955 1955 + Hashtbl.find_opt doc_map_ht dep_hash 1956 1956 + ) node.dep_build_hashes in 1957 1957 + let extra_doc_dep_hashes = match opamfile with 1958 1958 + | None -> [] 1959 1959 + | Some opam -> 1960 1960 + OpamPackage.Name.Set.fold (fun name acc -> 1961 1961 + match OpamPackage.Name.Map.find_opt name doc_map_by_name with 1962 1962 + | Some (_pkg, doc_hash) -> doc_hash :: acc 1963 1963 + | None -> acc 1964 1964 + ) (Odoc_gen.get_extra_doc_deps opam) [] 1965 1965 + in 1966 1966 + let dep_doc_hashes = dep_doc_hashes @ extra_doc_dep_hashes in 1967 1967 + let build_layer_json = Path.(build_layer_dir / "layer.json") in 1968 1968 + let installed_libs = Util.load_layer_info_installed_libs build_layer_json in 1969 1969 + let installed_docs = Util.load_layer_info_installed_docs build_layer_json in 1970 1970 + let blessed = match config.blessed_map with 1971 1971 + | Some map -> Blessing.is_blessed map node.pkg 1972 1972 + | None -> false 1973 1973 + in 1974 1974 + Option.iter (fun ocaml_version -> 1975 1975 + ignore (Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg:node.pkg ~installed_libs ~installed_docs ~phase:S.Doc_link_only ~blessed ~ocaml_version ~compiler_layers) 1976 1976 + ) ocaml_version 1977 1977 + end 1978 1978 + | None -> () 1979 1979 + ) dag_nodes 1980 1980 + end; 1981 1981 + Container.deinit ~t; 1982 1982 + Printf.printf "\r%-60s\r" ""; 1983 1983 + if config.with_doc then begin 1984 1984 + Printf.printf "[Phase 3b] Doc layers: %d ok, %d failed\n%!" !doc_generated !doc_failed; 1985 1985 + fork_doc_layers := OpamPackage.Map.fold (fun pkg doc_name acc -> 1986 1986 + (OpamPackage.to_string pkg, doc_name) :: acc 1987 1987 + ) doc_map [] 1988 1988 + end; 1989 1989 + if config.with_jtw then 1990 1990 + Printf.printf "[Phase 3b] JTW layers: %d generated\n%!" !jtw_generated 1991 1991 + end; 1992 1992 + !fork_doc_layers 1993 1993 + 1472 1994 let run_batch (config : Config.t) package_arg = 1473 1995 let () = match Local_repo.validate config.local_repos with 1474 1996 | Ok () -> () ··· 1779 2301 let items = List.filter_map (fun (target, _solution) -> 1780 2302 List.find_opt (fun (t, _) -> OpamPackage.equal t target) blessing_maps 1781 2303 ) solutions in 1782 1782 - let print_batch_summary ?(per_solution_hashes : (OpamPackage.t list * (string, string) Hashtbl.t) list option) ?(doc_layers : (string * string) list option) () = 1783 1783 - let os_key = Config.os_key ~config in 1784 1784 - let layer_dir = Path.(config.dir / os_key) in 1785 1785 - let packages_dir = Path.(config.dir / os_key / "packages") in 1786 1786 - let run_id = Day10_lib.Run_log.get_id run_info in 1787 1787 - let build_success = ref 0 in 1788 1788 - let build_fail = ref 0 in 1789 1789 - let build_dep_fail = ref 0 in 1790 1790 - let doc_success = ref 0 in 1791 1791 - let doc_fail = ref 0 in 1792 1792 - let failures = ref [] in 1793 1793 - (* Lazy layer index: only reads layer.json when needed for a specific hash *) 1794 1794 - let layer_cache : (string, (string * int * string * Yojson.Safe.t) option) Hashtbl.t = Hashtbl.create 256 in 1795 1795 - let lookup_build_layer name = 1796 1796 - match Hashtbl.find_opt layer_cache name with 1797 1797 - | Some cached -> cached 1798 1798 - | None -> 1799 1799 - let result = 1800 1800 - let layer_json_path = Path.(layer_dir / name / "layer.json") in 1801 1801 - if Sys.file_exists layer_json_path then 1802 1802 - try 1803 1803 - let json = Yojson.Safe.from_file layer_json_path in 1804 1804 - let open Yojson.Safe.Util in 1805 1805 - let pkg_name = json |> member "package" |> to_string in 1806 1806 - let exit_status = json |> member "exit_status" |> to_int_option |> Option.value ~default:(-1) in 1807 1807 - let compiler = extract_compiler_from_deps json in 1808 1808 - Some (pkg_name, exit_status, compiler, json) 1809 1809 - with _ -> None 1810 1810 - else None 1811 1811 - in 1812 1812 - Hashtbl.replace layer_cache name result; 1813 1813 - result 1814 1814 - in 1815 1815 - let doc_cache : (string, (string * Yojson.Safe.t) option) Hashtbl.t = Hashtbl.create 256 in 1816 1816 - let lookup_doc_layer name = 1817 1817 - match Hashtbl.find_opt doc_cache name with 1818 1818 - | Some cached -> cached 1819 1819 - | None -> 1820 1820 - let result = 1821 1821 - let layer_json_path = Path.(layer_dir / name / "layer.json") in 1822 1822 - if Sys.file_exists layer_json_path then 1823 1823 - try 1824 1824 - let json = Yojson.Safe.from_file layer_json_path in 1825 1825 - let open Yojson.Safe.Util in 1826 1826 - let pkg_name = json |> member "package" |> to_string in 1827 1827 - Some (pkg_name, json) 1828 1828 - with _ -> None 1829 1829 - else None 1830 1830 - in 1831 1831 - Hashtbl.replace doc_cache name result; 1832 1832 - result 1833 1833 - in 1834 1834 - (* Track which packages have build layers, for detecting dependency failures *) 1835 1835 - let built_packages = Hashtbl.create 64 in 1836 1836 - (* Track per-package build layer exit status and compiler, for dep failure reporting *) 1837 1837 - let build_layer_info = Hashtbl.create 64 in 1838 1838 - (* Track which (pkg, build_hash) pairs we've already processed *) 1839 1839 - let processed = Hashtbl.create 4096 in 1840 1840 - (* Precompute per-solution data: topological order, pkg->build_hash mapping. 1841 1841 - When per_solution_hashes is provided (fork path), use those directly. 1842 1842 - Otherwise compute from scratch (non-fork path). *) 1843 1843 - let solution_info = match per_solution_hashes with 1844 1844 - | Some hashes -> 1845 1845 - List.map2 (fun (target, solution) (ordered, pkg_hashes) -> 1846 1846 - (target, solution, ordered, pkg_hashes) 1847 1847 - ) solutions hashes 1848 1848 - | None -> 1849 1849 - let t_for_hash = Container.init ~config in 1850 1850 - List.map (fun (target, solution) -> 1851 1851 - let ordered = topological_sort solution in 1852 1852 - let dependencies = pkg_deps solution ordered in 1853 1853 - let pkg_hashes = Hashtbl.create (List.length ordered) in 1854 1854 - List.iter (fun pkg -> 1855 1855 - let ordered_deps = extract_dag dependencies pkg |> topological_sort |> List.rev |> List.tl in 1856 1856 - let hash = cached_layer_hash_global ~t:t_for_hash (pkg :: ordered_deps) in 1857 1857 - Hashtbl.replace pkg_hashes (OpamPackage.to_string pkg) ("build-" ^ hash) 1858 1858 - ) ordered; 1859 1859 - (target, solution, ordered, pkg_hashes) 1860 1860 - ) solutions 1861 1861 - in 1862 1862 - (* Iterate over solutions: for each target, look up build hashes and results. 1863 1863 - Use blessing maps to correctly assign blessed status. *) 1864 1864 - List.iter (fun (target, _solution, ordered, pkg_hashes) -> 1865 1865 - let bless_map = List.find_opt (fun (t, _) -> 1866 1866 - OpamPackage.equal t target 1867 1867 - ) blessing_maps in 1868 1868 - List.iter (fun pkg -> 1869 1869 - let pkg_str = OpamPackage.to_string pkg in 1870 1870 - let build_layer_name = Hashtbl.find pkg_hashes pkg_str in 1871 1871 - let is_blessed = match bless_map with 1872 1872 - | Some (_, map) -> Blessing.is_blessed map pkg 1873 1873 - | None -> false 1874 1874 - in 1875 1875 - let key = (pkg_str, build_layer_name) in 1876 1876 - (* Look up this layer on demand *) 1877 1877 - match lookup_build_layer build_layer_name with 1878 1878 - | Some (_, exit_status, compiler, _json) when exit_status >= 0 -> 1879 1879 - Hashtbl.replace built_packages pkg_str true; 1880 1880 - Hashtbl.replace build_layer_info pkg_str (build_layer_name, exit_status, compiler); 1881 1881 - if not (Hashtbl.mem processed key) then begin 1882 1882 - Hashtbl.replace processed key true; 1883 1883 - if exit_status = 0 then begin 1884 1884 - incr build_success; 1885 1885 - let build_log = Path.(layer_dir / build_layer_name / "build.log") in 1886 1886 - Day10_lib.Run_log.add_build_log run_info ~package:pkg_str ~source_log:build_log; 1887 1887 - record_build_result ~packages_dir ~run_id ~pkg_str 1888 1888 - ~build_hash:build_layer_name ~compiler ~blessed:is_blessed 1889 1889 - ~status:"success" ~category:"success" () 1890 1890 - end else begin 1891 1891 - incr build_fail; 1892 1892 - failures := (pkg_str, Printf.sprintf "build exit code %d" exit_status) :: !failures; 1893 1893 - let build_log = Path.(layer_dir / build_layer_name / "build.log") in 1894 1894 - Day10_lib.Run_log.add_build_log run_info ~package:pkg_str ~source_log:build_log; 1895 1895 - let (status, category, error) = classify_build_failure build_log in 1896 1896 - record_build_result ~packages_dir ~run_id ~pkg_str 1897 1897 - ~build_hash:build_layer_name ~compiler ~blessed:is_blessed 1898 1898 - ~status ~category ?error () 1899 1899 - end 1900 1900 - end 1901 1901 - | _ -> 1902 1902 - (* Layer doesn't exist or is a skeleton (exit_status = -1) — dep failure, handled in next loop *) 1903 1903 - () 1904 1904 - ) ordered; 1905 1905 - ) solution_info; 1906 1906 - (* Process doc layers. 1907 1907 - When doc_layers is provided (fork path), iterate those directly. 1908 1908 - Otherwise scan doc-* directories modified during this run. *) 1909 1909 - let process_doc_layer name = 1910 1910 - match lookup_doc_layer name with 1911 1911 - | Some (pkg_name, json) -> 1912 1912 - let open Yojson.Safe.Util in 1913 1913 - let doc = json |> member "doc" in 1914 1914 - if doc <> `Null then begin 1915 1915 - let blessed = doc |> member "blessed" |> to_bool_option |> Option.value ~default:false in 1916 1916 - let status = doc |> member "status" |> to_string_option |> Option.value ~default:"" in 1917 1917 - let layer_hash = String.sub name 4 (String.length name - 4) in 1918 1918 - let doc_log = Path.(layer_dir / name / "odoc-voodoo-all.log") in 1919 1919 - Day10_lib.Run_log.add_doc_log run_info ~package:pkg_name ~source_log:doc_log ~layer_hash (); 1920 1920 - if status = "success" then begin 1921 1921 - incr doc_success; 1922 1922 - record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1923 1923 - ~build_hash:name ~compiler:"" ~blessed 1924 1924 - ~status:"success" ~category:"success" () 1925 1925 - end else begin 1926 1926 - incr doc_fail; 1927 1927 - let error_msg = doc |> member "error" |> to_string_option |> Option.value ~default:"unknown error" in 1928 1928 - failures := (pkg_name, Printf.sprintf "doc: %s" error_msg) :: !failures; 1929 1929 - let doc_category = 1930 1930 - if matches_any ["link"] (String.lowercase_ascii error_msg) then 1931 1931 - "doc_link_failure" 1932 1932 - else 1933 1933 - "doc_compile_failure" 1934 1934 - in 1935 1935 - record_build_result ~packages_dir ~run_id ~pkg_str:pkg_name 1936 1936 - ~build_hash:name ~compiler:"" ~blessed 1937 1937 - ~status:"failure" ~category:doc_category 1938 1938 - ~error:error_msg () 1939 1939 - end 1940 1940 - end 1941 1941 - | None -> () 1942 1942 - in 1943 1943 - (match doc_layers with 1944 1944 - | Some layers -> 1945 1945 - (* Fork path: we know exactly which doc layers were produced *) 1946 1946 - let seen = Hashtbl.create (List.length layers) in 1947 1947 - List.iter (fun (_pkg_str, doc_name) -> 1948 1948 - if not (Hashtbl.mem seen doc_name) then begin 1949 1949 - Hashtbl.replace seen doc_name true; 1950 1950 - process_doc_layer doc_name 1951 1951 - end 1952 1952 - ) layers 1953 1953 - | None -> 1954 1954 - (* Sequential path: scan doc-* directories modified during this run *) 1955 1955 - let run_start_time = Day10_lib.Run_log.get_start_time run_info in 1956 1956 - (try 1957 1957 - Sys.readdir layer_dir |> Array.iter (fun name -> 1958 1958 - if String.length name > 4 && String.sub name 0 4 = "doc-" then begin 1959 1959 - let layer_json_path = Path.(layer_dir / name / "layer.json") in 1960 1960 - let dominated = try 1961 1961 - let stat = Unix.stat layer_json_path in 1962 1962 - stat.Unix.st_mtime >= run_start_time 1963 1963 - with _ -> false in 1964 1964 - if dominated then process_doc_layer name 1965 1965 - end 1966 1966 - ) 1967 1967 - with _ -> ())); 1968 1968 - (* Record dependency failures: packages in solutions that have no build layer. 1969 1969 - Walk the dependency graph to find the root cause — the first dep that 1970 1970 - actually failed to build (has a build layer with non-zero exit). *) 1971 1971 - (* Cache: build_hash -> root failure info (keyed by build_hash since same package 1972 1972 - can have different hashes/outcomes in different solutions) *) 1973 1973 - let root_failure_cache : (string, (string * string) option) Hashtbl.t = Hashtbl.create 256 in 1974 1974 - let rec find_root_failure solution pkg_hashes pkg visited = 1975 1975 - let pkg_str = OpamPackage.to_string pkg in 1976 1976 - let build_hash = try Hashtbl.find pkg_hashes pkg_str with Not_found -> "" in 1977 1977 - if build_hash = "" then None 1978 1978 - else 1979 1979 - match Hashtbl.find_opt root_failure_cache build_hash with 1980 1980 - | Some cached -> cached 1981 1981 - | None -> 1982 1982 - if OpamPackage.Set.mem pkg visited then None 1983 1983 - else 1984 1984 - let visited = OpamPackage.Set.add pkg visited in 1985 1985 - let result = match lookup_build_layer build_hash with 1986 1986 - | Some (_, exit_status, _, _) when exit_status <> 0 -> 1987 1987 - Some (pkg_str, build_hash) 1988 1988 - | Some _ -> 1989 1989 - None (* This dep succeeded, not the cause *) 1990 1990 - | None -> 1991 1991 - (* No layer = dep-failure, walk deps to find root *) 1992 1992 - let dep_pkgs = try OpamPackage.Set.elements (OpamPackage.Map.find pkg solution) with Not_found -> [] in 1993 1993 - List.find_map (fun dep -> find_root_failure solution pkg_hashes dep visited) dep_pkgs 1994 1994 - in 1995 1995 - (* Only cache positive results — None may resolve via a different path *) 1996 1996 - if result <> None then 1997 1997 - Hashtbl.replace root_failure_cache build_hash result; 1998 1998 - result 1999 1999 - in 2000 2000 - List.iter (fun (target, solution, _ordered, pkg_hashes) -> 2001 2001 - let bless_map = List.find_opt (fun (t, _) -> 2002 2002 - OpamPackage.equal t target 2003 2003 - ) blessing_maps in 2004 2004 - OpamPackage.Map.iter (fun pkg _deps -> 2005 2005 - let pkg_str = OpamPackage.to_string pkg in 2006 2006 - if not (Hashtbl.mem built_packages pkg_str) then begin 2007 2007 - let build_hash = Hashtbl.find pkg_hashes pkg_str in 2008 2008 - (* Skip if already recorded this exact (pkg, hash) pair *) 2009 2009 - if not (Hashtbl.mem processed (pkg_str, build_hash)) then begin 2010 2010 - Hashtbl.replace processed (pkg_str, build_hash) true; 2011 2011 - let failed_dep_info = find_root_failure solution pkg_hashes pkg OpamPackage.Set.empty in 2012 2012 - let failed_dep, failed_dep_hash = match failed_dep_info with 2013 2013 - | Some (dep, hash) -> (Some dep, Some hash) 2014 2014 - | None -> (None, None) 2015 2015 - in 2016 2016 - let is_blessed = match bless_map with 2017 2017 - | Some (_, map) -> Blessing.is_blessed map pkg 2018 2018 - | None -> false 2019 2019 - in 2020 2020 - incr build_dep_fail; 2021 2021 - record_build_result ~packages_dir ~run_id ~pkg_str 2022 2022 - ~build_hash ~compiler:"" ~blessed:is_blessed 2023 2023 - ~status:"failure" ~category:"dependency_failure" 2024 2024 - ?failed_dep ?failed_dep_hash () 2025 2025 - end 2026 2026 - end 2027 2027 - ) solution 2028 2028 - ) solution_info; 2029 2029 - (* Write universe JSON files: for each target/solution, compute universe hash 2030 2030 - and write a file listing the packages in that universe *) 2031 2031 - let universes_dir = Path.(layer_dir / "universes") in 2032 2032 - (try Unix.mkdir universes_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); 2033 2033 - let universe_hashes_written = Hashtbl.create 64 in 2034 2034 - List.iter (fun (_target, _solution, ordered, pkg_hashes) -> 2035 2035 - (* Look up build hashes from precomputed mapping *) 2036 2036 - let build_hashes = List.filter_map (fun pkg -> 2037 2037 - Hashtbl.find_opt pkg_hashes (OpamPackage.to_string pkg) 2038 2038 - ) ordered in 2039 2039 - let universe_hash = Odoc_gen.compute_universe_hash build_hashes in 2040 2040 - if not (Hashtbl.mem universe_hashes_written universe_hash) then begin 2041 2041 - Hashtbl.replace universe_hashes_written universe_hash true; 2042 2042 - let universe_file = Path.(universes_dir / universe_hash ^ ".json") in 2043 2043 - if not (Sys.file_exists universe_file) then begin 2044 2044 - let pkg_list = List.map (fun pkg -> 2045 2045 - `String (OpamPackage.to_string pkg) 2046 2046 - ) ordered in 2047 2047 - let json = `Assoc [ 2048 2048 - ("universe_hash", `String universe_hash); 2049 2049 - ("packages", `List pkg_list); 2050 2050 - ("package_count", `Int (List.length ordered)); 2051 2051 - ] in 2052 2052 - let tmp = universe_file ^ ".tmp" in 2053 2053 - let oc = open_out tmp in 2054 2054 - Fun.protect ~finally:(fun () -> close_out oc) (fun () -> 2055 2055 - output_string oc (Yojson.Safe.pretty_to_string json); 2056 2056 - output_char oc '\n'); 2057 2057 - Sys.rename tmp universe_file 2058 2058 - end (* if not exists *) 2059 2059 - end 2060 2060 - ) solution_info; 2061 2061 - Printf.printf " Universes written: %d\n%!" (Hashtbl.length universe_hashes_written); 2062 2062 - let html_versions = match config.html_output with 2063 2063 - | None -> 0 2064 2064 - | Some html_dir -> 2065 2065 - let p_dir = Path.(html_dir / "p") in 2066 2066 - if Sys.file_exists p_dir then 2067 2067 - try 2068 2068 - Sys.readdir p_dir |> Array.fold_left (fun acc pkg_name -> 2069 2069 - let pkg_dir = Path.(p_dir / pkg_name) in 2070 2070 - if Sys.is_directory pkg_dir then 2071 2071 - acc + (try Array.length (Sys.readdir pkg_dir) with _ -> 0) 2072 2072 - else acc 2073 2073 - ) 0 2074 2074 - with _ -> 0 2075 2075 - else 0 2076 2076 - in 2077 2077 - (* Write run summary *) 2078 2078 - let _summary = Day10_lib.Run_log.finish_run run_info 2079 2079 - ~targets_requested:(List.length packages) 2080 2080 - ~solutions_found:(List.length solutions) 2081 2081 - ~build_success:!build_success 2082 2082 - ~build_failed:!build_fail 2083 2083 - ~doc_success:!doc_success 2084 2084 - ~doc_failed:!doc_fail 2085 2085 - ~doc_skipped:0 (* TODO: track skipped docs *) 2086 2086 - ~failures:!failures 2087 2087 - in 2088 2088 - Printf.printf "\nBatch summary:\n%!"; 2089 2089 - Printf.printf " Targets requested: %d\n%!" (List.length packages); 2090 2090 - Printf.printf " Solutions found: %d (failed to solve: %d)\n%!" (List.length solutions) total_failed; 2091 2091 - Printf.printf " Build layers: %d success, %d failed, %d dep-failed\n%!" !build_success !build_fail !build_dep_fail; 2092 2092 - Printf.printf " Doc layers: %d success, %d failed\n%!" !doc_success !doc_fail; 2093 2093 - Printf.printf " HTML versions: %d\n%!" html_versions; 2094 2094 - (* Generate status.json *) 2095 2095 - let previous = Day10_lib.Status_index.read ~dir:(Path.(config.dir / os_key)) in 2096 2096 - let status = Day10_lib.Status_index.generate ~packages_dir ~run_id ~previous in 2097 2097 - Day10_lib.Status_index.write ~dir:(Path.(config.dir / os_key)) status; 2098 2098 - (* Print changes summary *) 2099 2099 - if status.changes <> [] then begin 2100 2100 - Printf.printf "\nStatus changes:\n%!"; 2101 2101 - List.iter (fun (c : Day10_lib.Status_index.change) -> 2102 2102 - let marker = if c.to_status = "success" then "+" else "-" in 2103 2103 - let blessed_marker = if c.blessed then " [blessed]" else "" in 2104 2104 - Printf.printf " %s %-40s %s → %s%s\n%!" 2105 2105 - marker c.package c.from_status c.to_status blessed_marker 2106 2106 - ) status.changes 2107 2107 - end; 2108 2108 - if status.new_packages <> [] then 2109 2109 - Printf.printf " New packages: %d\n%!" (List.length status.new_packages) 2110 2110 - in 2111 2304 match config.fork with 2112 2305 | Some 1 | None -> 2113 2306 let build_count = ref 0 in ··· 2120 2313 ) items; 2121 2314 (* Run global deferred doc link pass for x-extra-doc-deps (non-fork path) *) 2122 2315 run_global_deferred_doc_link config; 2123 2123 - (* Assemble JTW output if enabled *) 2124 2124 - (match config.with_jtw, config.jtw_output with 2125 2125 - | true, Some jtw_output -> 2126 2126 - Printf.printf "Phase 4: Building per-solution workers and assembling JTW output...\n%!"; 2127 2127 - let t = Container.init ~config in 2128 2128 - let os_key = Config.os_key ~config in 2129 2129 - let jtw_solutions = List.filter_map (fun (target, solution) -> 2130 2130 - match extract_ocaml_version solution with 2131 2131 - | None -> 2132 2132 - Printf.printf " Warning: no OCaml version for %s, skipping\n%!" 2133 2133 - (OpamPackage.to_string target); 2134 2134 - None 2135 2135 - | Some ocaml_version -> 2136 2136 - (* Collect all build layer hashes for packages in this solution *) 2137 2137 - let ordered = List.map fst (OpamPackage.Map.bindings solution) in 2138 2138 - let dep_build_hashes = List.filter_map (fun pkg -> 2139 2139 - let pkg_str = OpamPackage.to_string pkg in 2140 2140 - let pkg_dir = Path.(config.dir / os_key / "packages" / pkg_str) in 2141 2141 - if Sys.file_exists pkg_dir then 2142 2142 - try 2143 2143 - Sys.readdir pkg_dir |> Array.to_list 2144 2144 - |> List.find_opt (fun name -> String.length name > 6 && String.sub name 0 6 = "build-") 2145 2145 - with _ -> None 2146 2146 - else None 2147 2147 - ) ordered in 2148 2148 - let unique_hashes = List.sort_uniq String.compare dep_build_hashes in 2149 2149 - let solution_packages = List.map OpamPackage.to_string ordered in 2150 2150 - Printf.printf " Building worker.js for %s (%d build layers)...\n%!" 2151 2151 - (OpamPackage.to_string target) (List.length unique_hashes); 2152 2152 - let status, worker_output_dir = 2153 2153 - Container.build_solution_worker ~t ~dep_build_hashes:unique_hashes ~ocaml_version ~solution_packages ~compiler_layers:[] 2154 2154 - in 2155 2155 - if status = 0 && worker_output_dir <> "" && Sys.file_exists Path.(worker_output_dir / "worker.js") then 2156 2156 - Some (target, solution, ocaml_version, worker_output_dir) 2157 2157 - else begin 2158 2158 - Printf.printf " Warning: worker build failed for %s (status=%d), skipping\n%!" 2159 2159 - (OpamPackage.to_string target) status; 2160 2160 - None 2161 2161 - end 2162 2162 - ) solutions in 2163 2163 - if jtw_solutions <> [] then 2164 2164 - Jtw_gen.assemble_jtw_output ~config ~jtw_output ~solutions:jtw_solutions ~blessed_maps:blessing_maps 2165 2165 - else 2166 2166 - Printf.printf " Warning: no solutions with working worker.js, skipping JTW assembly\n%!" 2167 2167 - | _ -> ()); 2168 2168 - (* Update progress: entering GC phase *) 2316 2316 + assemble_jtw_output ~config ~solutions ~blessing_maps; 2169 2317 progress_ref := Day10_lib.Progress.set_phase !progress_ref Day10_lib.Progress.Gc; 2170 2318 Day10_lib.Progress.write ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) !progress_ref; 2171 2171 - (* Run garbage collection *) 2172 2319 run_gc ~config ~solutions (); 2173 2173 - print_batch_summary (); 2174 2174 - (* Delete progress.json - summary.json takes over *) 2320 2320 + print_batch_summary ~config ~solutions ~blessing_maps 2321 2321 + ~num_packages:(List.length packages) ~total_failed ~run_info (); 2175 2322 Day10_lib.Progress.delete ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) 2176 2323 | Some n -> 2177 2324 Printf.printf " Building global DAG...\n%!"; ··· 2224 2371 execute_dag ~np:n ~on_complete ~on_cascade ~cache_dir:config.dir ~os_key dag_nodes build_one; 2225 2372 Container.deinit ~t; 2226 2373 Printf.printf "\n%!"; 2227 2227 - let fork_doc_layers = ref [] in 2228 2228 - (* Phase 3b: Generate doc and jtw layers for successful builds. 2229 2229 - The DAG executor only runs build_layer, so doc/jtw generation must happen 2230 2230 - as a separate pass. Process each solution in topological order so that 2231 2231 - dep_doc_hashes are available when processing each package. *) 2232 2232 - if config.with_doc || config.with_jtw then begin 2233 2233 - let phase_label = 2234 2234 - match config.with_doc, config.with_jtw with 2235 2235 - | true, true -> "doc + jtw" 2236 2236 - | true, false -> "doc" 2237 2237 - | false, true -> "jtw" 2238 2238 - | false, false -> "" 2239 2239 - in 2240 2240 - Printf.printf "[Phase 3b] Generating %s layers...\n%!" phase_label; 2241 2241 - (* Compute compiler_layers from the DAG nodes: find the compiler package 2242 2242 - and use its dep_build_hashes + its own build_hash *) 2243 2243 - let compiler_layers = 2244 2244 - let ocaml_version_opt = List.find_map (fun (_target, solution) -> 2245 2245 - extract_ocaml_version solution 2246 2246 - ) solutions in 2247 2247 - match ocaml_version_opt with 2248 2248 - | None -> [] 2249 2249 - | Some ov -> 2250 2250 - let ov_str = OpamPackage.to_string ov in 2251 2251 - match List.find_opt (fun (n : build_node) -> 2252 2252 - OpamPackage.to_string n.pkg = ov_str 2253 2253 - ) dag_nodes with 2254 2254 - | Some node -> 2255 2255 - if Hashtbl.find_opt build_success_set node.build_hash = Some true then 2256 2256 - node.dep_build_hashes @ [ node.build_hash ] 2257 2257 - else [] 2258 2258 - | None -> [] 2259 2259 - in 2260 2260 - (* Iterate over unique DAG nodes (already deduplicated) rather than per-solution. 2261 2261 - Since blessed status is a function of the build hash within a run, 2262 2262 - each DAG node gets a single deterministic doc/jtw layer. *) 2263 2263 - let doc_generated = ref 0 in 2264 2264 - let doc_failed = ref 0 in 2265 2265 - let jtw_generated = ref 0 in 2266 2266 - let last_reported = ref 0 in 2267 2267 - (* Build blessed status per build_hash by correlating per_solution_hashes 2268 2268 - with blessing_maps. For a given build hash, the blessed determination is 2269 2269 - the same across all solutions (same deps → same universe hash). *) 2270 2270 - let blessed_by_build_hash : (string, bool) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 2271 2271 - List.iter2 (fun (target, _solution) (ordered, pkg_to_hash) -> 2272 2272 - let bless_map = List.find_opt (fun (t, _) -> 2273 2273 - OpamPackage.equal t target 2274 2274 - ) blessing_maps in 2275 2275 - match bless_map with 2276 2276 - | None -> () 2277 2277 - | Some (_, bmap) -> 2278 2278 - List.iter (fun pkg -> 2279 2279 - let pkg_str = OpamPackage.to_string pkg in 2280 2280 - match Hashtbl.find_opt pkg_to_hash pkg_str with 2281 2281 - | None -> () 2282 2282 - | Some build_hash -> 2283 2283 - if not (Hashtbl.mem blessed_by_build_hash build_hash) then 2284 2284 - Hashtbl.replace blessed_by_build_hash build_hash 2285 2285 - (Blessing.is_blessed bmap pkg) 2286 2286 - ) ordered 2287 2287 - ) solutions per_solution_hashes; 2288 2288 - let t = Container.init ~config in 2289 2289 - let ocaml_version = List.find_map (fun (_target, solution) -> 2290 2290 - extract_ocaml_version solution 2291 2291 - ) solutions in 2292 2292 - (* Parallel doc/jtw layer generation using fork-based executor. 2293 2293 - Same DAG dependency structure as the build phase: a node's doc hash 2294 2294 - depends on its deps' doc hashes, so we process in dependency order 2295 2295 - with up to n workers. *) 2296 2296 - (* doc_map: build_hash -> doc_layer_name (populated as nodes complete) *) 2297 2297 - let doc_map_ht : (string, string) Hashtbl.t = Hashtbl.create (List.length dag_nodes) in 2298 2298 - (* Filter to nodes with successful builds (using Phase 3 results, no I/O) *) 2299 2299 - let doc_nodes = List.filter (fun (node : build_node) -> 2300 2300 - Hashtbl.find_opt build_success_set node.build_hash = Some true 2301 2301 - ) dag_nodes in 2302 2302 - (* Remaining dep count and reverse deps (same structure as execute_dag) *) 2303 2303 - let doc_node_of_hash : (string, build_node) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2304 2304 - List.iter (fun (n : build_node) -> Hashtbl.replace doc_node_of_hash n.build_hash n) doc_nodes; 2305 2305 - let doc_remaining : (string, int) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2306 2306 - let doc_rdeps : (string, string list) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2307 2307 - List.iter (fun (node : build_node) -> 2308 2308 - let count = List.fold_left (fun acc dep_hash -> 2309 2309 - if Hashtbl.mem doc_node_of_hash dep_hash then begin 2310 2310 - let existing = try Hashtbl.find doc_rdeps dep_hash with Not_found -> [] in 2311 2311 - Hashtbl.replace doc_rdeps dep_hash (node.build_hash :: existing); 2312 2312 - acc + 1 2313 2313 - end else acc 2314 2314 - ) 0 node.dep_build_hashes in 2315 2315 - Hashtbl.replace doc_remaining node.build_hash count 2316 2316 - ) doc_nodes; 2317 2317 - let doc_ready = Queue.create () in 2318 2318 - List.iter (fun (node : build_node) -> 2319 2319 - if Hashtbl.find doc_remaining node.build_hash = 0 then 2320 2320 - Queue.push node doc_ready 2321 2321 - ) doc_nodes; 2322 2322 - (* running: pid -> (build_hash, doc_layer_name option) *) 2323 2323 - let doc_running : (int, string * string option) Hashtbl.t = Hashtbl.create n in 2324 2324 - let doc_completed : (string, bool) Hashtbl.t = Hashtbl.create (List.length doc_nodes) in 2325 2325 - let doc_total = List.length doc_nodes in 2326 2326 - let doc_completed_count = ref 0 in 2327 2327 - let promote_doc_dependents hash = 2328 2328 - List.iter (fun dep_hash -> 2329 2329 - let count = Hashtbl.find doc_remaining dep_hash - 1 in 2330 2330 - Hashtbl.replace doc_remaining dep_hash count; 2331 2331 - if count = 0 then 2332 2332 - Queue.push (Hashtbl.find doc_node_of_hash dep_hash) doc_ready 2333 2333 - ) (try Hashtbl.find doc_rdeps hash with Not_found -> []) 2334 2334 - in 2335 2335 - let complete_doc_node hash success doc_layer_name_opt = 2336 2336 - Hashtbl.replace doc_completed hash success; 2337 2337 - incr doc_completed_count; 2338 2338 - (match doc_layer_name_opt with 2339 2339 - | Some doc_name when success -> 2340 2340 - Hashtbl.replace doc_map_ht hash doc_name; 2341 2341 - incr doc_generated; 2342 2342 - let node = Hashtbl.find doc_node_of_hash hash in 2343 2343 - let pkg_str = OpamPackage.to_string node.pkg in 2344 2344 - record_build_result ~packages_dir ~run_id ~pkg_str 2345 2345 - ~build_hash:doc_name ~compiler:"" ~blessed:false 2346 2346 - ~status:"success" ~category:"success" () 2347 2347 - | Some doc_name -> 2348 2348 - incr doc_failed; 2349 2349 - let node = Hashtbl.find doc_node_of_hash hash in 2350 2350 - let pkg_str = OpamPackage.to_string node.pkg in 2351 2351 - let doc_layer_json = Path.(config.dir / os_key / doc_name / "layer.json") in 2352 2352 - let error_msg = 2353 2353 - if Sys.file_exists doc_layer_json then 2354 2354 - try 2355 2355 - let json = Yojson.Safe.from_file doc_layer_json in 2356 2356 - let open Yojson.Safe.Util in 2357 2357 - json |> member "doc" |> member "error" |> to_string_option 2358 2358 - |> Option.value ~default:"unknown error" 2359 2359 - with _ -> "unknown error" 2360 2360 - else "no layer.json" 2361 2361 - in 2362 2362 - record_build_result ~packages_dir ~run_id ~pkg_str 2363 2363 - ~build_hash:doc_name ~compiler:"" ~blessed:false 2364 2364 - ~status:"failure" ~category:"doc_compile_failure" 2365 2365 - ~error:error_msg () 2366 2366 - | None -> incr doc_failed); 2367 2367 - let count = !doc_generated + !doc_failed in 2368 2368 - if count - !last_reported >= 25 || !doc_completed_count = doc_total then begin 2369 2369 - Printf.printf "\r%-60s\r" ""; 2370 2370 - Printf.printf "[Phase 3b] %d/%d layers (%d doc ok, %d failed)%!" 2371 2371 - count doc_total !doc_generated !doc_failed; 2372 2372 - last_reported := count 2373 2373 - end; 2374 2374 - promote_doc_dependents hash 2375 2375 - in 2376 2376 - let reap_doc () = 2377 2377 - let rec waitpid_eintr () = 2378 2378 - try Unix.waitpid [] (-1) 2379 2379 - with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_eintr () 2380 2380 - in 2381 2381 - let pid, status = waitpid_eintr () in 2382 2382 - let exit_code = match status with Unix.WEXITED c -> c | _ -> 1 in 2383 2383 - match Hashtbl.find_opt doc_running pid with 2384 2384 - | Some (hash, doc_name_opt) -> 2385 2385 - Hashtbl.remove doc_running pid; 2386 2386 - complete_doc_node hash (exit_code = 0) doc_name_opt 2387 2387 - | None -> () 2388 2388 - in 2389 2389 - while !doc_completed_count < doc_total do 2390 2390 - while Hashtbl.length doc_running < n && not (Queue.is_empty doc_ready) do 2391 2391 - let node = Queue.pop doc_ready in 2392 2392 - let blessed = match Hashtbl.find_opt blessed_by_build_hash node.build_hash with 2393 2393 - | Some b -> b | None -> false in 2394 2394 - let dep_doc_hashes = List.filter_map (fun dep_hash -> 2395 2395 - Hashtbl.find_opt doc_map_ht dep_hash 2396 2396 - ) node.dep_build_hashes in 2397 2397 - (* Compute doc hash in parent so we know the layer name. 2398 2398 - Must use Container.doc_layer_hash to guarantee consistency with 2399 2399 - what doc_layer computes in the child process. *) 2400 2400 - let doc_layer_name = 2401 2401 - if config.with_doc then 2402 2402 - match ocaml_version with 2403 2403 - | Some ov -> 2404 2404 - let doc_hash = Container.doc_layer_hash ~t ~build_hash:node.build_hash ~dep_doc_hashes ~ocaml_version:ov ~blessed ~compiler_layers in 2405 2405 - Some ("doc-" ^ doc_hash) 2406 2406 - | None -> None 2407 2407 - else None 2408 2408 - in 2409 2409 - (* Check if doc layer already exists (cache hit) *) 2410 2410 - let cached = 2411 2411 - match doc_layer_name with 2412 2412 - | Some name -> 2413 2413 - let doc_layer_json = Path.(config.dir / os_key / name / "layer.json") in 2414 2414 - Sys.file_exists doc_layer_json && not (Util.load_layer_info_doc_failed doc_layer_json) 2415 2415 - | None -> true (* no doc to build *) 2416 2416 - in 2417 2417 - if cached then 2418 2418 - complete_doc_node node.build_hash true doc_layer_name 2419 2419 - else begin 2420 2420 - Os.log "doc_exec: MISS %s (%s) — building" (OpamPackage.to_string node.pkg) (match doc_layer_name with Some n -> n | None -> "none"); 2421 2421 - match Unix.fork () with 2422 2422 - | 0 -> 2423 2423 - Random.init (Unix.getpid () lxor int_of_float (Unix.gettimeofday () *. 1000000.)); 2424 2424 - let success = 2425 2425 - try 2426 2426 - let result = 2427 2427 - if config.with_doc then 2428 2428 - doc_layer t node.pkg node.build_hash dep_doc_hashes ~ocaml_version ~compiler_layers ~blessed () 2429 2429 - else Some "no-doc" 2430 2430 - in 2431 2431 - (* Also do jtw in the child while we're here *) 2432 2432 - if config.with_jtw then begin 2433 2433 - let dep_build_hashes = List.filter (fun dep_hash -> 2434 2434 - let lj = Path.(config.dir / os_key / dep_hash / "layer.json") in 2435 2435 - Sys.file_exists lj && Util.load_layer_info_exit_status lj = 0 2436 2436 - ) node.dep_build_hashes in 2437 2437 - ignore (jtw_layer t node.pkg node.build_hash dep_build_hashes ~ocaml_version ~compiler_layers) 2438 2438 - end; 2439 2439 - result <> None 2440 2440 - with _ -> false 2441 2441 - in 2442 2442 - Unix._exit (if success then 0 else 1) 2443 2443 - | child_pid -> 2444 2444 - Hashtbl.replace doc_running child_pid (node.build_hash, doc_layer_name) 2445 2445 - end 2446 2446 - done; 2447 2447 - if Hashtbl.length doc_running > 0 then 2448 2448 - reap_doc () 2449 2449 - else if Queue.is_empty doc_ready && !doc_completed_count < doc_total then begin 2450 2450 - Printf.eprintf "Doc executor: deadlock detected (%d/%d completed)\n%!" 2451 2451 - !doc_completed_count doc_total; 2452 2452 - List.iter (fun (node : build_node) -> 2453 2453 - if not (Hashtbl.mem doc_completed node.build_hash) then 2454 2454 - complete_doc_node node.build_hash false None 2455 2455 - ) doc_nodes 2456 2456 - end 2457 2457 - done; 2458 2458 - while Hashtbl.length doc_running > 0 do reap_doc () done; 2459 2459 - (* Convert build_hash -> doc_name to OpamPackage -> doc_name for deferred link pass *) 2460 2460 - let doc_map = Hashtbl.fold (fun build_hash doc_name acc -> 2461 2461 - match Hashtbl.find_opt node_by_hash build_hash with 2462 2462 - | Some node -> OpamPackage.Map.add node.pkg doc_name acc 2463 2463 - | None -> acc 2464 2464 - ) doc_map_ht OpamPackage.Map.empty in 2465 2465 - (* Deferred doc link pass: packages with post deps or x-extra-doc-deps 2466 2466 - got Doc_compile_only above. Now run the link+HTML phase. *) 2467 2467 - if config.with_doc then begin 2468 2468 - let doc_map_by_name = 2469 2469 - OpamPackage.Map.fold (fun pkg doc_name acc -> 2470 2470 - OpamPackage.Name.Map.add (OpamPackage.name pkg) (pkg, doc_name) acc 2471 2471 - ) doc_map OpamPackage.Name.Map.empty 2472 2472 - in 2473 2473 - List.iter (fun (node : build_node) -> 2474 2474 - let opamfile = Util.opam_file config.opam_repositories node.pkg in 2475 2475 - let has_extra = match opamfile with 2476 2476 - | None -> false 2477 2477 - | Some opam -> not (OpamPackage.Name.Set.is_empty (get_extra_link_deps opam)) 2478 2478 - in 2479 2479 - if has_extra then 2480 2480 - match OpamPackage.Map.find_opt node.pkg doc_map with 2481 2481 - | Some doc_layer_name -> 2482 2482 - let doc_layer_dir = Path.(config.dir / os_key / doc_layer_name) in 2483 2483 - let link_log = Path.(doc_layer_dir / "odoc-voodoo-link-and-gen.log") in 2484 2484 - let already_linked = 2485 2485 - Sys.file_exists link_log && 2486 2486 - (try (Unix.stat link_log).Unix.st_size > 0 with _ -> false) 2487 2487 - in 2488 2488 - if not already_linked then begin 2489 2489 - let build_layer_dir = Path.(config.dir / os_key / node.build_hash) in 2490 2490 - let dep_doc_hashes = List.filter_map (fun dep_hash -> 2491 2491 - Hashtbl.find_opt doc_map_ht dep_hash 2492 2492 - ) node.dep_build_hashes in 2493 2493 - let extra_doc_dep_hashes = match opamfile with 2494 2494 - | None -> [] 2495 2495 - | Some opam -> 2496 2496 - OpamPackage.Name.Set.fold (fun name acc -> 2497 2497 - match OpamPackage.Name.Map.find_opt name doc_map_by_name with 2498 2498 - | Some (_pkg, doc_hash) -> doc_hash :: acc 2499 2499 - | None -> acc 2500 2500 - ) (Odoc_gen.get_extra_doc_deps opam) [] 2501 2501 - in 2502 2502 - let dep_doc_hashes = dep_doc_hashes @ extra_doc_dep_hashes in 2503 2503 - let build_layer_json = Path.(build_layer_dir / "layer.json") in 2504 2504 - let installed_libs = Util.load_layer_info_installed_libs build_layer_json in 2505 2505 - let installed_docs = Util.load_layer_info_installed_docs build_layer_json in 2506 2506 - Option.iter (fun ocaml_version -> 2507 2507 - ignore (Container.generate_docs ~t ~build_layer_dir ~doc_layer_dir ~dep_doc_hashes ~pkg:node.pkg ~installed_libs ~installed_docs ~phase:S.Doc_link_only ~ocaml_version ~compiler_layers) 2508 2508 - ) ocaml_version 2509 2509 - end 2510 2510 - | None -> () 2511 2511 - ) dag_nodes 2512 2512 - end; 2513 2513 - Container.deinit ~t; 2514 2514 - Printf.printf "\r%-60s\r" ""; 2515 2515 - if config.with_doc then begin 2516 2516 - Printf.printf "[Phase 3b] Doc layers: %d ok, %d failed\n%!" !doc_generated !doc_failed; 2517 2517 - fork_doc_layers := OpamPackage.Map.fold (fun pkg doc_name acc -> 2518 2518 - (OpamPackage.to_string pkg, doc_name) :: acc 2519 2519 - ) doc_map [] 2520 2520 - end; 2521 2521 - if config.with_jtw then 2522 2522 - Printf.printf "[Phase 3b] JTW layers: %d generated\n%!" !jtw_generated 2523 2523 - end; 2374 2374 + let fork_doc_layers = 2375 2375 + run_fork_doc_layers ~config ~np:n ~dag_nodes ~solutions ~per_solution_hashes 2376 2376 + ~blessing_maps ~build_success_set ~node_by_hash ~packages_dir ~run_id 2377 2377 + in 2524 2378 (* Run global deferred doc link pass for x-extra-doc-deps (fork path) *) 2525 2525 - run_global_deferred_doc_link ~doc_layers:!fork_doc_layers config; 2526 2526 - (* Assemble JTW output if enabled *) 2527 2527 - (match config.with_jtw, config.jtw_output with 2528 2528 - | true, Some jtw_output -> 2529 2529 - Printf.printf "Phase 4: Building per-solution workers and assembling JTW output...\n%!"; 2530 2530 - let t = Container.init ~config in 2531 2531 - let os_key = Config.os_key ~config in 2532 2532 - let jtw_solutions = List.filter_map (fun (target, solution) -> 2533 2533 - match extract_ocaml_version solution with 2534 2534 - | None -> 2535 2535 - Printf.printf " Warning: no OCaml version for %s, skipping\n%!" 2536 2536 - (OpamPackage.to_string target); 2537 2537 - None 2538 2538 - | Some ocaml_version -> 2539 2539 - let ordered = List.map fst (OpamPackage.Map.bindings solution) in 2540 2540 - let dep_build_hashes = List.filter_map (fun pkg -> 2541 2541 - let pkg_str = OpamPackage.to_string pkg in 2542 2542 - let pkg_dir = Path.(config.dir / os_key / "packages" / pkg_str) in 2543 2543 - if Sys.file_exists pkg_dir then 2544 2544 - try 2545 2545 - Sys.readdir pkg_dir |> Array.to_list 2546 2546 - |> List.find_opt (fun name -> String.length name > 6 && String.sub name 0 6 = "build-") 2547 2547 - with _ -> None 2548 2548 - else None 2549 2549 - ) ordered in 2550 2550 - let unique_hashes = List.sort_uniq String.compare dep_build_hashes in 2551 2551 - let solution_packages = List.map OpamPackage.to_string ordered in 2552 2552 - Printf.printf " Building worker.js for %s (%d build layers)...\n%!" 2553 2553 - (OpamPackage.to_string target) (List.length unique_hashes); 2554 2554 - let status, worker_output_dir = 2555 2555 - Container.build_solution_worker ~t ~dep_build_hashes:unique_hashes ~ocaml_version ~solution_packages ~compiler_layers:[] 2556 2556 - in 2557 2557 - if status = 0 && worker_output_dir <> "" && Sys.file_exists Path.(worker_output_dir / "worker.js") then 2558 2558 - Some (target, solution, ocaml_version, worker_output_dir) 2559 2559 - else begin 2560 2560 - Printf.printf " Warning: worker build failed for %s (status=%d), skipping\n%!" 2561 2561 - (OpamPackage.to_string target) status; 2562 2562 - None 2563 2563 - end 2564 2564 - ) solutions in 2565 2565 - if jtw_solutions <> [] then 2566 2566 - Jtw_gen.assemble_jtw_output ~config ~jtw_output ~solutions:jtw_solutions ~blessed_maps:blessing_maps 2567 2567 - else 2568 2568 - Printf.printf " Warning: no solutions with working worker.js, skipping JTW assembly\n%!" 2569 2569 - | _ -> ()); 2570 2570 - (* Update progress: entering GC phase *) 2379 2379 + run_global_deferred_doc_link ~doc_layers:fork_doc_layers config; 2380 2380 + assemble_jtw_output ~config ~solutions ~blessing_maps; 2571 2381 progress_ref := Day10_lib.Progress.set_phase !progress_ref Day10_lib.Progress.Gc; 2572 2382 Day10_lib.Progress.write ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) !progress_ref; 2573 2573 - (* Run garbage collection — must scan all cached solutions, not just current batch *) 2574 2383 run_gc ~config ~solutions (); 2575 2575 - print_batch_summary ~per_solution_hashes ~doc_layers:!fork_doc_layers (); 2384 2384 + print_batch_summary ~config ~solutions ~blessing_maps 2385 2385 + ~num_packages:(List.length packages) ~total_failed ~run_info 2386 2386 + ~per_solution_hashes ~doc_layers:fork_doc_layers (); 2576 2387 (* Delete progress.json - summary.json takes over *) 2577 2388 Day10_lib.Progress.delete ~run_dir:(Day10_lib.Run_log.get_run_dir run_info) 2578 2389

+1 -1

day10/bin/odoc_gen.ml

reviewed

··· 213 213 MONITOR_PID=$! 214 214 215 215 echo "=== Running odoc_driver_voodoo for %s ===" 216 216 - odoc_driver_voodoo %s --odoc-dir /home/opam/compile --html-dir /html --actions %s -j 1 -v %s --odoc %s --odoc-md %s 216 216 + odoc_driver_voodoo %s --odoc-dir /home/opam/compile --html-dir /html --actions %s -j $(nproc) -v %s --odoc %s --odoc-md %s 217 217 RESULT=$? 218 218 219 219 # Check prep files after odoc_driver_voodoo

+1

day10/bin/s.ml

reviewed

··· 50 50 installed_libs:string list -> 51 51 installed_docs:string list -> 52 52 phase:doc_phase -> 53 53 + blessed:bool -> 53 54 ocaml_version:OpamPackage.t -> 54 55 compiler_layers:string list -> 55 56 Yojson.Safe.t option

+1 -1

day10/bin/windows.ml

reviewed

··· 182 182 let doc_layer_hash ~t:_ ~build_hash:_ ~dep_doc_hashes:_ ~ocaml_version:_ ~blessed:_ ~compiler_layers:_ = "" 183 183 184 184 (* Documentation generation not supported on Windows *) 185 185 - let generate_docs ~t:_ ~build_layer_dir:_ ~doc_layer_dir:_ ~dep_doc_hashes:_ ~pkg:_ ~installed_libs:_ ~installed_docs:_ ~phase:_ ~ocaml_version:_ ~compiler_layers:_ = None 185 185 + let generate_docs ~t:_ ~build_layer_dir:_ ~doc_layer_dir:_ ~dep_doc_hashes:_ ~pkg:_ ~installed_libs:_ ~installed_docs:_ ~phase:_ ~blessed:_ ~ocaml_version:_ ~compiler_layers:_ = None 186 186 187 187 let jtw_layer_hash ~t:_ ~build_hash:_ ~ocaml_version:_ ~compiler_layers:_ = "" 188 188

+58

day10/lib/batch_util.ml

reviewed

··· 1 1 + (** Pure utility functions for batch processing. 2 2 + No opam dependencies — operates on strings and JSON only. *) 3 3 + 4 4 + (** Case-insensitive substring search. *) 5 5 + let contains_substring_ci ~pattern text = 6 6 + let pat = String.lowercase_ascii pattern in 7 7 + let pat_len = String.length pat in 8 8 + let text_len = String.length text in 9 9 + if pat_len > text_len then false 10 10 + else 11 11 + let rec check i = 12 12 + if i > text_len - pat_len then false 13 13 + else if String.lowercase_ascii (String.sub text i pat_len) = pat then true 14 14 + else check (i + 1) 15 15 + in 16 16 + check 0 17 17 + 18 18 + (** Check if any substring in the list appears in the text (case-insensitive). *) 19 19 + let matches_any patterns text = 20 20 + List.exists (fun pat -> contains_substring_ci ~pattern:pat text) patterns 21 21 + 22 22 + (** Extract the compiler version from a layer.json's deps list. 23 23 + Looks for packages starting with "ocaml-base-compiler" or "ocaml-variants". *) 24 24 + let extract_compiler_from_deps json = 25 25 + let open Yojson.Safe.Util in 26 26 + let deps = try json |> member "deps" |> to_list |> List.map to_string with _ -> [] in 27 27 + let compiler_pkg = List.find_opt (fun dep -> 28 28 + let name = try String.sub dep 0 (String.index dep '.') with Not_found -> dep in 29 29 + name = "ocaml-base-compiler" || name = "ocaml-variants" 30 30 + ) deps in 31 31 + match compiler_pkg with 32 32 + | Some pkg -> 33 33 + (try String.sub pkg (String.index pkg '.' + 1) (String.length pkg - String.index pkg '.' - 1) 34 34 + with Not_found -> pkg) 35 35 + | None -> "" 36 36 + 37 37 + (** Classify a build failure by scanning log content for known patterns. 38 38 + Returns (status, category, error option). *) 39 39 + let classify_build_log log_content = 40 40 + let transient_patterns = [ 41 41 + "No space left on device"; 42 42 + "Connection timed out"; 43 43 + "Could not resolve host"; 44 44 + "Temporary failure in name resolution"; 45 45 + "Network is unreachable"; 46 46 + ] in 47 47 + let depext_patterns = [ 48 48 + "Unable to locate package"; 49 49 + "is not available"; 50 50 + "unmet dependencies"; 51 51 + "dpkg: dependency problems"; 52 52 + ] in 53 53 + if matches_any transient_patterns log_content then 54 54 + ("failure", "transient_failure", Some "Transient infrastructure failure detected in build log") 55 55 + else if matches_any depext_patterns log_content then 56 56 + ("failure", "depext_unavailable", Some "Missing system dependency detected in build log") 57 57 + else 58 58 + ("failure", "build_failure", None)

+1 -1

day10/lib/dune

reviewed

··· 2 2 (name day10_lib) 3 3 (enabled_if (>= %{ocaml_version} 5.3.0)) 4 4 (libraries unix str yojson) 5 5 - (modules atomic_swap build_lock gc history notify progress run_log status_index)) 5 5 + (modules atomic_swap batch_util build_lock gc history notify progress run_log status_index))

+18 -1

day11/batch/targets.ml

reviewed

··· 24 24 | None -> None 25 25 ) all_names 26 26 27 27 + let find_all_versions git_packages = 28 28 + let all_names = Day11_solver.Git_packages.all_names git_packages in 29 29 + let compiler_names = Day11_layer.Opamh.compiler_packages in 30 30 + let all_names = List.filter (fun name -> 31 31 + not (List.mem name compiler_names) 32 32 + ) all_names in 33 33 + List.concat_map (fun name -> 34 34 + let versions = Day11_solver.Git_packages.get_versions git_packages name in 35 35 + OpamPackage.Version.Map.fold (fun v _opam acc -> 36 36 + OpamPackage.create name v :: acc 37 37 + ) versions [] 38 38 + |> List.rev 39 39 + ) all_names 40 40 + 27 41 let load_package_list filename = 28 42 let json = Yojson.Safe.from_file filename in 29 43 let open Yojson.Safe.Util in ··· 49 63 |> List.rev in 50 64 List.map (fun (v, _) -> OpamPackage.create n v) candidates 51 65 52 52 - let resolve ?(small = false) git_packages target = 66 66 + let resolve ?(small = false) ?(all_versions = false) git_packages target = 53 67 match target with 54 68 | None when small -> 55 69 Printf.printf "Using small universe (%d packages)...\n%!" ··· 59 73 | v :: _ -> Some v 60 74 | [] -> None 61 75 ) small_universe 76 76 + | None when all_versions -> 77 77 + Printf.printf "Finding all package versions...\n%!"; 78 78 + find_all_versions git_packages 62 79 | None -> 63 80 Printf.printf "Finding all latest package versions...\n%!"; 64 81 find_latest_versions git_packages

+9 -2

day11/batch/targets.mli

reviewed

··· 14 14 (** [pick_latest_version packages name] returns all non-avoid versions 15 15 of [name] from newest to oldest. Used for retry on solve failure. *) 16 16 17 17 + val find_all_versions : 18 18 + Day11_solver.Git_packages.t -> OpamPackage.t list 19 19 + (** All versions of all non-compiler packages. *) 20 20 + 17 21 val resolve : 18 22 ?small:bool -> 23 23 + ?all_versions:bool -> 19 24 Day11_solver.Git_packages.t -> 20 25 string option -> 21 26 OpamPackage.t list 22 22 - (** [resolve ?small packages target] resolves the target specification 23 23 - to a list of packages. *) 27 27 + (** [resolve ?small ?all_versions packages target] resolves the target 28 28 + specification to a list of packages. When [all_versions] is true 29 29 + and no target is given, returns all versions instead of just the 30 30 + latest. *)

+1 -11

day11/benchmark/benchmark.ml

reviewed

··· 79 79 time "Compute blessings (50 solutions)" (fun () -> 80 80 Day11_batch.Blessing.compute_blessings solutions) in 81 81 82 82 - (* 6. Doc DAG *) 83 83 - let compiles = 84 84 - time "Doc compile DAG" (fun () -> 85 85 - Day11_build.Dag.doc_compile_dag nodes) in 86 86 - Printf.printf " → %d compile nodes\n%!" (List.length compiles); 87 87 - let _links = 88 88 - time "Doc link DAG" (fun () -> 89 89 - Day11_build.Dag.doc_link_dag ~blessing_maps:_blessing_maps 90 90 - ~solutions compiles) in 91 91 - 92 92 - (* 7. Build with warm cache (if available) *) 82 82 + (* 6. Build with warm cache (if available) *) 93 83 Eio_main.run @@ fun env -> 94 84 let env = (env :> Eio_unix.Stdenv.base) in 95 85 let scratch_cache = Fpath.v "/tmp/day11-scratch-cache" in

+46 -33

day11/bin/cmd_batch.ml

reviewed

··· 27 27 28 28 let run cache_dir opam_repositories np arch os_distribution os_version 29 29 with_doc ocaml_version_str odoc_repo jtw_repo patches_dir opam_build_repo 30 30 - solve_only dry_run rebuild_failed rebuild_base small_universe 30 30 + solve_only dry_run rebuild_failed rebuild_base small_universe all_versions 31 31 extra_pins driver_compiler_str target = 32 32 cleanup_stale_mounts (); 33 33 let cache_dir = Common.fpath cache_dir in ··· 36 36 let driver_compiler = OpamPackage.of_string driver_compiler_str in 37 37 let git_packages, repos_with_shas, opam_env = 38 38 Common.setup_solver opam_repositories in 39 39 - let targets = Day11_batch.Targets.resolve ~small:small_universe git_packages target in 39 39 + let targets = Day11_batch.Targets.resolve ~small:small_universe ~all_versions git_packages target in 40 40 Printf.printf "Targets: %d packages\n%!" (List.length targets); 41 41 (match ocaml_version with 42 42 | Some v -> Printf.printf "Compiler: %s\n%!" (OpamPackage.to_string v) ··· 282 282 (* Bless *) 283 283 let blessing_maps = Day11_batch.Blessing.compute_blessings solutions in 284 284 (* Build function for the unified DAG *) 285 285 + let packages_dir = Fpath.(os_dir / "packages") in 285 286 let build_one node = 286 287 match Day11_build.Build_layer.build env benv ?patches 287 288 ~mounts:[repo_mount] node () with 288 288 - | Day11_build.Types.Success _ -> true 289 289 + | Day11_build.Types.Success _ -> 290 290 + let pkg_str = OpamPackage.to_string node.pkg in 291 291 + let layer_name = Day11_layer.Layer_type.build_dir_name node in 292 292 + ignore (Day11_layer.Package_symlinks.ensure_layer_symlink 293 293 + ~packages_dir ~pkg_str ~layer_name); 294 294 + true 289 295 | _ -> false 290 296 in 291 291 - (* Write run summary — maps each layer hash to its package + status *) 297 297 + (* Build + Docs (unified pipeline when --with-doc) *) 298 298 + if with_doc then begin 299 299 + Day11_doc.Generate.build_tools_and_run env benv ~np ~os_dir 300 300 + ~packages:git_packages ~opam_env ~mounts:[repo_mount] 301 301 + ~driver_compiler ~odoc_repo ~build_one 302 302 + ~opam_repositories 303 303 + ~nodes ~solutions ~blessing_maps 304 304 + end 305 305 + else begin 306 306 + (* Build only — no docs *) 307 307 + Day11_build.Dag_executor.execute env ~np 308 308 + ~on_complete:(fun ~total ~completed ~failed node success -> 309 309 + if not success then 310 310 + Printf.printf "[%d/%d, %d failed] FAIL: %s\n%!" 311 311 + completed total failed (OpamPackage.to_string node.pkg) 312 312 + else if completed mod 100 = 0 then 313 313 + Printf.printf "[%d/%d, %d failed] %s\n%!" 314 314 + completed total failed (OpamPackage.to_string node.pkg)) 315 315 + ~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ()) 316 316 + nodes build_one 317 317 + end; 318 318 + (* JTW *) 319 319 + (match jtw_repo with 320 320 + | Some dir -> 321 321 + let output = Fpath.to_string Fpath.(cache_dir / "jtw-output") in 322 322 + Day11_jtw.Build_tools.build_and_run env benv ~np ~os_dir 323 323 + ~packages:git_packages ~opam_env ~mounts:[repo_mount] 324 324 + ~extra_repo_dirs:extra_pins ~repo_dir:dir ~output 325 325 + ~nodes ~solutions 326 326 + | None -> ()); 327 327 + (* Write run summary — maps each layer hash to its package + status. 328 328 + Written after builds so layer.json files exist on disk. *) 292 329 let runs_dir = Fpath.(cache_dir / "runs") in 293 330 Bos.OS.Dir.create ~path:true runs_dir |> ignore; 294 331 let timestamp = Day11_layer.Layer_meta.now_iso8601 () in ··· 317 354 ] in 318 355 let run_file = Fpath.(runs_dir / (timestamp ^ ".json")) in 319 356 ignore (Bos.OS.File.write run_file (Yojson.Safe.pretty_to_string run_json)); 320 320 - (* Build + Docs (unified pipeline when --with-doc) *) 321 321 - if with_doc then 322 322 - Day11_doc.Generate.build_tools_and_run env benv ~np ~os_dir 323 323 - ~packages:git_packages ~opam_env ~mounts:[repo_mount] 324 324 - ~driver_compiler ~odoc_repo ~build_one 325 325 - ~opam_repositories 326 326 - ~nodes ~solutions ~blessing_maps 327 327 - else begin 328 328 - (* Build only — no docs *) 329 329 - Day11_build.Dag_executor.execute env ~np 330 330 - ~on_complete:(fun ~total ~completed ~failed node success -> 331 331 - if not success then 332 332 - Printf.printf "[%d/%d, %d failed] FAIL: %s\n%!" 333 333 - completed total failed (OpamPackage.to_string node.pkg) 334 334 - else if completed mod 100 = 0 then 335 335 - Printf.printf "[%d/%d, %d failed] %s\n%!" 336 336 - completed total failed (OpamPackage.to_string node.pkg)) 337 337 - ~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ()) 338 338 - nodes build_one 339 339 - end; 340 340 - (* JTW *) 341 341 - (match jtw_repo with 342 342 - | Some dir -> 343 343 - let output = Fpath.to_string Fpath.(cache_dir / "jtw-output") in 344 344 - Day11_jtw.Build_tools.build_and_run env benv ~np ~os_dir 345 345 - ~packages:git_packages ~opam_env ~mounts:[repo_mount] 346 346 - ~extra_repo_dirs:extra_pins ~repo_dir:dir ~output 347 347 - ~nodes ~solutions 348 348 - | None -> ()); 349 357 0 350 358 end 351 359 ··· 368 376 let small_universe_term = 369 377 let doc = "Build only ~20 core packages instead of all" in 370 378 Arg.(value & flag & info [ "small-universe" ] ~doc) 379 379 + 380 380 + let all_versions_term = 381 381 + let doc = "Build all versions of each package, not just the latest" in 382 382 + Arg.(value & flag & info [ "all-versions" ] ~doc) 371 383 372 384 let with_doc_term = 373 385 let doc = "Generate documentation" in ··· 405 417 $ odoc_repo_term $ jtw_repo_term $ Common.patches_dir_term 406 418 $ Common.opam_build_repo_term $ solve_only_term $ dry_run_term 407 419 $ rebuild_failed_term $ rebuild_base_term $ small_universe_term 420 420 + $ all_versions_term 408 421 $ extra_pin_term $ driver_compiler_term $ target_term) in 409 422 Cmd.v info term

+41 -5

day11/bin/cmd_log.ml

reviewed

··· 2 2 3 3 open Cmdliner 4 4 5 5 - let run os_dir layer = 5 5 + let resolve_layer os_dir arg = 6 6 + (* If it looks like a layer dir name (starts with "build-") and exists, use it *) 7 7 + let layer_dir = Fpath.(os_dir / arg) in 8 8 + if Bos.OS.Dir.exists layer_dir |> Result.get_ok then 9 9 + Some arg 10 10 + else begin 11 11 + (* Try to look up as a package name in the packages dir *) 12 12 + let packages_dir = Fpath.(os_dir / "packages") in 13 13 + let symlinks = Day11_layer.Scan.list_package_symlinks 14 14 + ~exclude:["blessed-build"; "blessed-docs"; "history.jsonl"] 15 15 + packages_dir arg in 16 16 + match symlinks with 17 17 + | [] -> None 18 18 + | links -> 19 19 + (* Pick the most recent layer (last alphabetically, since build-<hash> 20 20 + names are stable but we want the latest symlink by mtime) *) 21 21 + let ranked = List.filter_map (fun (name, _target) -> 22 22 + let path = Fpath.(packages_dir / arg / name) in 23 23 + try 24 24 + let stat = Unix.stat (Fpath.to_string path) in 25 25 + Some (name, stat.Unix.st_mtime) 26 26 + with Unix.Unix_error _ -> None 27 27 + ) links in 28 28 + let sorted = List.sort (fun (_, t1) (_, t2) -> 29 29 + compare t2 t1) ranked in 30 30 + match sorted with 31 31 + | (name, _) :: _ -> Some name 32 32 + | [] -> None 33 33 + end 34 34 + 35 35 + let run os_dir arg = 6 36 let os_dir = Common.fpath os_dir in 37 37 + let layer = match resolve_layer os_dir arg with 38 38 + | Some l -> l 39 39 + | None -> 40 40 + Printf.eprintf "No layer or package found for %s\n" arg; 41 41 + exit 1 42 42 + in 7 43 let layer_dir = Fpath.(os_dir / layer) in 8 44 (* Try layer.log first (build), then odoc-voodoo-all.log (doc) *) 9 45 let log_file = ··· 22 58 | Ok content -> print_string content; 0 23 59 | Error (`Msg e) -> Printf.eprintf "%s\n" e; 1) 24 60 25 25 - let layer_term = 26 26 - Arg.(required & pos 0 (some string) None & info [] ~docv:"LAYER" 27 27 - ~doc:"Layer directory name (e.g. build-abc123)") 61 61 + let target_term = 62 62 + Arg.(required & pos 0 (some string) None & info [] ~docv:"TARGET" 63 63 + ~doc:"Layer directory name (e.g. build-abc123) or package name (e.g. astring.0.8.5)") 28 64 29 65 let cmd = 30 66 let info = Cmd.info "log" ~doc:"View build or doc log" in 31 31 - let term = Term.(const run $ Common.os_dir_term $ layer_term) in 67 67 + let term = Term.(const run $ Common.os_dir_term $ target_term) in 32 68 Cmd.v info term

+29 -4

day11/bin/cmd_query.ml

reviewed

··· 2 2 3 3 open Cmdliner 4 4 5 5 + let show_layers_from_symlinks ~os_dir ~packages_dir ~pkg_str = 6 6 + let symlinks = Day11_layer.Scan.list_package_symlinks 7 7 + ~exclude:["blessed-build"; "blessed-docs"; "history.jsonl"] 8 8 + packages_dir pkg_str in 9 9 + if symlinks = [] then begin 10 10 + Printf.printf "No layers for %s\n" pkg_str; 11 11 + 1 12 12 + end else begin 13 13 + Printf.printf "Layers for %s (%d):\n\n" pkg_str (List.length symlinks); 14 14 + List.iter (fun (name, _target) -> 15 15 + let layer_dir = Fpath.(os_dir / name) in 16 16 + let layer_json = Fpath.(layer_dir / "layer.json") in 17 17 + match Day11_layer.Layer_meta.load_build layer_json with 18 18 + | Ok meta -> 19 19 + let status = if meta.exit_status = 0 then "ok" 20 20 + else if meta.failed_dep <> None then "cascade" 21 21 + else "fail" in 22 22 + Printf.printf " %s status=%s created=%s\n" 23 23 + name status meta.created_at 24 24 + | Error _ -> 25 25 + Printf.printf " %s (no metadata)\n" name 26 26 + ) symlinks; 27 27 + 0 28 28 + end 29 29 + 5 30 let run os_dir package = 6 31 let os_dir = Common.fpath os_dir in 7 32 let packages_dir = Fpath.(os_dir / "packages") in 8 33 let entries = Day11_lib.History.read ~packages_dir ~pkg_str:package in 9 9 - if entries = [] then begin 10 10 - Printf.printf "No history for %s\n" package; 11 11 - 1 12 12 - end else begin 34 34 + if entries = [] then 35 35 + (* Fall back to showing layers discovered via symlinks *) 36 36 + show_layers_from_symlinks ~os_dir ~packages_dir ~pkg_str:package 37 37 + else begin 13 38 Printf.printf "History for %s (%d entries):\n\n" package 14 39 (List.length entries); 15 40 List.iter (fun (e : Day11_lib.History.entry) ->

+49 -4

day11/bin/cmd_report.ml

reviewed

··· 110 110 end 111 111 | None -> 112 112 pr "## Changes\n\nNo previous run to compare.\n\n"); 113 113 - (* Top blockers *) 113 113 + (* Top blockers — compute cascade block counts from failed_dep *) 114 114 pr "## Top Blockers\n\n"; 115 115 + let layers = latest_json |> member "layers" |> to_assoc in 116 116 + (* blocked_by.(dep) = list of packages blocked by dep *) 117 117 + let blocked_by : (string, string list) Hashtbl.t = Hashtbl.create 64 in 118 118 + List.iter (fun (_hash, entry) -> 119 119 + let pkg = entry |> member "package" |> to_string in 120 120 + let status = entry |> member "status" |> to_string in 121 121 + if status <> "ok" then 122 122 + match entry |> member "failed_dep" with 123 123 + | `String dep -> 124 124 + let prev = try Hashtbl.find blocked_by dep with Not_found -> [] in 125 125 + if not (List.mem pkg prev) then 126 126 + Hashtbl.replace blocked_by dep (pkg :: prev) 127 127 + | _ -> () 128 128 + ) layers; 129 129 + (* For "sole" count: packages whose only failed_dep is this one *) 130 130 + let pkg_blockers : (string, string list) Hashtbl.t = Hashtbl.create 64 in 131 131 + List.iter (fun (_hash, entry) -> 132 132 + let pkg = entry |> member "package" |> to_string in 133 133 + let status = entry |> member "status" |> to_string in 134 134 + if status <> "ok" then 135 135 + match entry |> member "failed_dep" with 136 136 + | `String dep -> 137 137 + let prev = try Hashtbl.find pkg_blockers pkg with Not_found -> [] in 138 138 + if not (List.mem dep prev) then 139 139 + Hashtbl.replace pkg_blockers pkg (dep :: prev) 140 140 + | _ -> () 141 141 + ) layers; 142 142 + let sole_count : (string, int) Hashtbl.t = Hashtbl.create 64 in 143 143 + Hashtbl.iter (fun pkg deps -> 144 144 + match deps with 145 145 + | [single_dep] -> 146 146 + ignore pkg; 147 147 + let n = try Hashtbl.find sole_count single_dep with Not_found -> 0 in 148 148 + Hashtbl.replace sole_count single_dep (n + 1) 149 149 + | _ -> () 150 150 + ) pkg_blockers; 115 151 let fail_pkgs = Hashtbl.fold (fun pkg status acc -> 116 152 if status = "fail" then pkg :: acc else acc 117 153 ) latest_ps [] in 118 118 - let fail_pkgs = List.sort String.compare fail_pkgs in 154 154 + (* Sort by block count descending *) 155 155 + let fail_pkgs = List.sort (fun a b -> 156 156 + let ba = try List.length (Hashtbl.find blocked_by a) with Not_found -> 0 in 157 157 + let bb = try List.length (Hashtbl.find blocked_by b) with Not_found -> 0 in 158 158 + compare bb ba 159 159 + ) fail_pkgs in 119 160 pr "| Package | Blocks | Sole |\n"; 120 161 pr "|---------|--------|------|\n"; 121 121 - (* We don't have solution data here — just list the failures *) 122 162 List.iteri (fun i pkg -> 123 123 - if i < 20 then pr "| `%s` | ? | ? |\n" pkg 163 163 + if i < 20 then begin 164 164 + let blocks = try List.length (Hashtbl.find blocked_by pkg) 165 165 + with Not_found -> 0 in 166 166 + let sole = try Hashtbl.find sole_count pkg with Not_found -> 0 in 167 167 + pr "| `%s` | %d | %d |\n" pkg blocks sole 168 168 + end 124 169 ) fail_pkgs; 125 170 if List.length fail_pkgs > 20 then 126 171 pr "| ... | | |\n";

+9 -3

day11/bin/cmd_results.ml

reviewed

··· 49 49 | Error _ -> () 50 50 ) commit_dirs 51 51 | Error _ -> ()); 52 52 - Printf.printf "=== Solver Results ===\n"; 53 53 - Printf.printf " Solved: %d\n" (Hashtbl.length all_solutions); 54 54 - Printf.printf " Solve failed: %d\n\n" !n_solve_failures; 52 52 + Printf.printf "=== Solver Cache ===\n"; 53 53 + Printf.printf " Solutions cached: %d (across all solve passes)\n" 54 54 + (Hashtbl.length all_solutions); 55 55 + Printf.printf " Solve failed: %d\n\n" !n_solve_failures; 55 56 (* Load runs *) 56 57 let runs_dir = Fpath.(cache_dir / "runs") in 57 58 let load_run f = ··· 97 98 if s = "fail" then n + 1 else n) ps 0 in 98 99 let n_cascade = Hashtbl.fold (fun _ s n -> 99 100 if s = "cascade" then n + 1 else n) ps 0 in 101 101 + let n_target_solved = match latest_json |> member "solved" with 102 102 + | `Int n -> Some n | _ -> None in 100 103 Printf.printf "=== Build Results (run %s) ===\n" ts; 104 104 + (match n_target_solved with 105 105 + | Some n -> Printf.printf " Solved (targets): %d\n" n 106 106 + | None -> ()); 101 107 Printf.printf " Succeeded: %d\n" n_ok; 102 108 Printf.printf " Failed: %d\n" n_fail; 103 109 Printf.printf " Cascade: %d\n\n" n_cascade;

-46

day11/build/dag.ml

reviewed

··· 37 37 let all_nodes = Hashtbl.fold (fun _ node acc -> node :: acc) seen [] in 38 38 List.sort (fun (a : build) (b : build) -> 39 39 compare (List.length a.deps) (List.length b.deps)) all_nodes 40 40 - 41 41 - let doc_compile_dag builds = 42 42 - (* One compile node per build — no inter-doc deps *) 43 43 - let tbl : (string, doc_compile) Hashtbl.t = 44 44 - Hashtbl.create (List.length builds) in 45 45 - List.iter (fun (b : build) -> 46 46 - if not (Hashtbl.mem tbl b.hash) then 47 47 - Hashtbl.replace tbl b.hash { build = b } 48 48 - ) builds; 49 49 - Hashtbl.fold (fun _ c acc -> c :: acc) tbl [] 50 50 - 51 51 - let doc_link_dag ~blessing_maps ~solutions compiles = 52 52 - (* Index compiles by build hash *) 53 53 - let compile_of_build : (string, doc_compile) Hashtbl.t = 54 54 - Hashtbl.create (List.length compiles) in 55 55 - List.iter (fun (c : doc_compile) -> 56 56 - Hashtbl.replace compile_of_build c.build.hash c 57 57 - ) compiles; 58 58 - (* Compute rdeps: for each package, which packages depend on it *) 59 59 - let all_solutions = List.map snd solutions in 60 60 - let is_blessed (b : build) = 61 61 - List.exists (fun (_, map) -> 62 62 - match OpamPackage.Map.find_opt b.pkg map with 63 63 - | Some true -> true 64 64 - | _ -> false 65 65 - ) blessing_maps 66 66 - in 67 67 - List.filter_map (fun (c : doc_compile) -> 68 68 - let b = c.build in 69 69 - (* dep_compiles: compiled odocs of this package's deps *) 70 70 - let dep_compiles = List.filter_map (fun (dep : build) -> 71 71 - Hashtbl.find_opt compile_of_build dep.hash 72 72 - ) b.deps in 73 73 - (* rdep_compiles: compiled odocs of packages that depend on this one *) 74 74 - let rdeps = Day11_graph.Rdeps.find all_solutions b.pkg in 75 75 - let rdep_compiles = OpamPackage.Set.fold (fun rdep_pkg acc -> 76 76 - (* Find the build node for this rdep, then its compile *) 77 77 - let matching = List.filter_map (fun (c2 : doc_compile) -> 78 78 - if OpamPackage.equal c2.build.pkg rdep_pkg then Some c2 79 79 - else None 80 80 - ) compiles in 81 81 - matching @ acc 82 82 - ) rdeps [] in 83 83 - Some { compile = c; blessed = is_blessed b; 84 84 - dep_compiles; rdep_compiles } 85 85 - ) compiles

-15

day11/build/dag.mli

reviewed

··· 11 11 (** [build_dag cache ~base_hash solutions] builds a deduplicated 12 12 DAG of build nodes across all solutions. *) 13 13 14 14 - val doc_compile_dag : 15 15 - Day11_layer.Layer_type.build list -> 16 16 - Day11_layer.Layer_type.doc_compile list 17 17 - (** [doc_compile_dag builds] creates a compile node for each build 18 18 - node. Compile nodes have no inter-doc dependencies — they can 19 19 - all run in parallel once their build completes. *) 20 20 - 21 21 - val doc_link_dag : 22 22 - blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list -> 23 23 - solutions:(OpamPackage.t * Day11_graph.Graph.solution) list -> 24 24 - Day11_layer.Layer_type.doc_compile list -> 25 25 - Day11_layer.Layer_type.doc_link list 26 26 - (** [doc_link_dag ~blessing_maps ~solutions compiles] creates link 27 27 - nodes that reference compiled odocs of both deps and rdeps. 28 28 - Forward linking (rdeps) is what requires the compile/link split. *)

+9 -4

day11/build/run_in_layers.ml

reviewed

··· 69 69 if not use_merge then all_layer_fs_dirs 70 70 else begin 71 71 mkdir lower; 72 72 - timed_to (Printf.sprintf "stack.merge (%d build layers)" 73 73 - (List.length build_dirs)) t_merge (fun () -> 74 74 - Day11_layer.Stack.merge env ~layer_dirs:build_dirs ~target:lower) 75 75 - |> ignore; 72 72 + let merge_result = 73 73 + timed_to (Printf.sprintf "stack.merge (%d build layers)" 74 74 + (List.length build_dirs)) t_merge (fun () -> 75 75 + Day11_layer.Stack.merge env ~layer_dirs:build_dirs ~target:lower) 76 76 + in 77 77 + (match merge_result with 78 78 + | Ok () -> () 79 79 + | Error (`Msg e) -> 80 80 + Log.err (fun m -> m "stack.merge failed: %s" e)); 76 81 [ lower ] 77 82 end 78 83 in

-61

day11/build/test/test_build.ml

reviewed

··· 106 106 OpamPackage.to_string n.pkg) nodes in 107 107 Alcotest.(check (list string)) "topo order" [ "c.1"; "b.1" ] names 108 108 109 109 - let test_doc_compile_dag () = 110 110 - let find_opam p = 111 111 - make_find_opam {|opam-version: "2.0"|} p in 112 112 - let solution = 113 113 - OpamPackage.Map.empty 114 114 - |> OpamPackage.Map.add (pkg "c.1") OpamPackage.Set.empty 115 115 - |> OpamPackage.Map.add (pkg "b.1") 116 116 - (OpamPackage.Set.singleton (pkg "c.1")) 117 117 - in 118 118 - let cache = Hash_cache.create ~find_opam () in 119 119 - let builds = Dag.build_dag cache ~base_hash:"base" 120 120 - [ (pkg "b.1", solution) ] in 121 121 - let compiles = Dag.doc_compile_dag builds in 122 122 - Alcotest.(check int) "2 compile nodes" 2 (List.length compiles); 123 123 - (* Each compile points to its build *) 124 124 - List.iter (fun (c : Day11_layer.Layer_type.doc_compile) -> 125 125 - Alcotest.(check bool) "has build" true 126 126 - (OpamPackage.to_string c.build.pkg <> "") 127 127 - ) compiles 128 128 - 129 129 - let test_doc_link_dag () = 130 130 - let find_opam p = 131 131 - make_find_opam {|opam-version: "2.0"|} p in 132 132 - (* b depends on c *) 133 133 - let solution = 134 134 - OpamPackage.Map.empty 135 135 - |> OpamPackage.Map.add (pkg "c.1") OpamPackage.Set.empty 136 136 - |> OpamPackage.Map.add (pkg "b.1") 137 137 - (OpamPackage.Set.singleton (pkg "c.1")) 138 138 - in 139 139 - let solutions = [ (pkg "b.1", solution) ] in 140 140 - let cache = Hash_cache.create ~find_opam () in 141 141 - let builds = Dag.build_dag cache ~base_hash:"base" solutions in 142 142 - let compiles = Dag.doc_compile_dag builds in 143 143 - let blessing_map = 144 144 - OpamPackage.Map.empty 145 145 - |> OpamPackage.Map.add (pkg "b.1") true 146 146 - |> OpamPackage.Map.add (pkg "c.1") true 147 147 - in 148 148 - let links = Dag.doc_link_dag 149 149 - ~blessing_maps:[ (pkg "b.1", blessing_map) ] 150 150 - ~solutions compiles in 151 151 - Alcotest.(check int) "2 link nodes" 2 (List.length links); 152 152 - (* b's link should have c as a dep_compile *) 153 153 - let b_link = List.find (fun (d : Day11_layer.Layer_type.doc_link) -> 154 154 - OpamPackage.to_string d.compile.build.pkg = "b.1") links in 155 155 - Alcotest.(check int) "b has 1 dep_compile" 1 156 156 - (List.length b_link.dep_compiles); 157 157 - Alcotest.(check string) "dep is c" "c.1" 158 158 - (OpamPackage.to_string (List.hd b_link.dep_compiles).build.pkg); 159 159 - Alcotest.(check bool) "b blessed" true b_link.blessed; 160 160 - (* c's link should have b as an rdep_compile (forward linking!) *) 161 161 - let c_link = List.find (fun (d : Day11_layer.Layer_type.doc_link) -> 162 162 - OpamPackage.to_string d.compile.build.pkg = "c.1") links in 163 163 - Alcotest.(check int) "c has 1 rdep_compile" 1 164 164 - (List.length c_link.rdep_compiles); 165 165 - Alcotest.(check string) "rdep is b" "b.1" 166 166 - (OpamPackage.to_string (List.hd c_link.rdep_compiles).build.pkg) 167 167 - 168 109 (* ── Test registration ───────────────────────────────────────────── *) 169 110 170 111 let () = ··· 205 146 [ 206 147 Alcotest.test_case "empty" `Quick test_dag_empty; 207 148 Alcotest.test_case "single solution" `Quick test_dag_single_solution; 208 208 - Alcotest.test_case "doc compile dag" `Quick test_doc_compile_dag; 209 209 - Alcotest.test_case "doc link dag" `Quick test_doc_link_dag; 210 149 ] ); 211 150 ]

+10

day11/doc/doc_deps.ml

reviewed

··· 1 1 + let needs_separate_link ~compile_deps ~link_deps pkg = 2 2 + let compile_set = match OpamPackage.Map.find_opt pkg compile_deps with 3 3 + | Some deps -> deps 4 4 + | None -> OpamPackage.Set.empty 5 5 + in 6 6 + let link_set = match OpamPackage.Map.find_opt pkg link_deps with 7 7 + | Some deps -> deps 8 8 + | None -> OpamPackage.Set.empty 9 9 + in 10 10 + not (OpamPackage.Set.equal compile_set link_set)

+17

day11/doc/doc_deps.mli

reviewed

··· 1 1 + (** Determine whether a package needs separate compile and link phases. 2 2 + 3 3 + Given two dependency graphs from the same solve — one computed 4 4 + without [{post}] deps (compile graph) and one with [{post}] deps 5 5 + (link graph) — compare a package's deps in each. If they differ, 6 6 + the package needs separate compile and link phases for documentation; 7 7 + the link phase needs odoc output from the extra [{post}] deps that 8 8 + aren't available at compile time. *) 9 9 + 10 10 + val needs_separate_link : 11 11 + compile_deps:Day11_graph.Graph.solution -> 12 12 + link_deps:Day11_graph.Graph.solution -> 13 13 + OpamPackage.t -> 14 14 + bool 15 15 + (** [needs_separate_link ~compile_deps ~link_deps pkg] returns [true] 16 16 + when [pkg]'s dependencies differ between the compile graph (no 17 17 + [{post}] deps) and the link graph (with [{post}] deps). *)

+129 -76

day11/doc/generate.ml

reviewed

··· 105 105 result 106 106 107 107 let link_package env benv ~os_dir ~driver_tool ~odoc_tools 108 108 - ~blessing_maps ~find_odoc_tool ~compile_results ~pkg_universe 108 108 + ~blessing_maps ~find_odoc_tool ~compile_results 109 109 + ~build_hash ~universe_hashes 109 110 (node : build) = 110 110 - match Hashtbl.find_opt compile_results node.pkg with 111 111 + match Hashtbl.find_opt compile_results build_hash with 111 112 | None -> None 112 113 | Some compile_bl -> 113 114 match prepare_package ~os_dir ~driver_tool ~odoc_tools ··· 115 116 | None -> None 116 117 | Some (composite_tool_hash, universe, blessed, mounts, prep_dir) -> 117 118 let dep_compile_layers = 118 118 - match Hashtbl.find_opt pkg_universe node.pkg with 119 119 - | None -> [] 120 120 - | Some universe_pkgs -> 121 121 - OpamPackage.Set.fold (fun dep_pkg acc -> 122 122 - if OpamPackage.equal dep_pkg node.pkg then acc 123 123 - else match Hashtbl.find_opt compile_results dep_pkg with 124 124 - | Some bl -> bl :: acc 125 125 - | None -> acc 126 126 - ) universe_pkgs [] 119 119 + List.filter_map (fun dep_bh -> 120 120 + if String.equal dep_bh build_hash then None 121 121 + else Hashtbl.find_opt compile_results dep_bh 122 122 + ) universe_hashes 127 123 in 128 124 let dep_hashes = List.map (fun (bl : build) -> bl.hash) 129 125 dep_compile_layers in ··· 162 158 163 159 let run env benv ~np ~os_dir ~driver_tool ~odoc_tools 164 160 ~build_one ~nodes ~solutions ~blessing_maps = 165 165 - (* Map package -> compiler for odoc tool selection *) 166 166 - let pkg_compiler = Hashtbl.create 64 in 167 167 - List.iter (fun (_target, solution) -> 168 168 - match find_compiler solution with 169 169 - | None -> () 170 170 - | Some compiler -> 171 171 - OpamPackage.Map.iter (fun pkg _deps -> 172 172 - Hashtbl.replace pkg_compiler pkg compiler 173 173 - ) solution 174 174 - ) solutions; 175 175 - let find_odoc_tool pkg = 176 176 - match Hashtbl.find_opt pkg_compiler pkg with 161 161 + (* Derive compiler per build node by walking deps. 162 162 + Keyed by build hash (not package) because the same package can 163 163 + be built with different compilers in different solutions. *) 164 164 + let node_compiler : (string, OpamPackage.t) Hashtbl.t = 165 165 + Hashtbl.create (List.length nodes) in 166 166 + let rec derive_compiler (node : build) = 167 167 + match Hashtbl.find_opt node_compiler node.hash with 168 168 + | Some c -> Some c 169 169 + | None -> 170 170 + if List.exists (OpamPackage.Name.equal (OpamPackage.name node.pkg)) 171 171 + concrete_compiler_names then begin 172 172 + Hashtbl.replace node_compiler node.hash node.pkg; 173 173 + Some node.pkg 174 174 + end else 175 175 + let result = List.find_map (fun (dep : build) -> 176 176 + derive_compiler dep 177 177 + ) node.deps in 178 178 + (match result with 179 179 + | Some c -> Hashtbl.replace node_compiler node.hash c 180 180 + | None -> ()); 181 181 + result 182 182 + in 183 183 + List.iter (fun node -> ignore (derive_compiler node)) nodes; 184 184 + (* find_odoc_tool: given a build node hash, return the matching odoc tool *) 185 185 + let find_odoc_tool_for_hash build_hash = 186 186 + match Hashtbl.find_opt node_compiler build_hash with 177 187 | None -> None 178 188 | Some compiler -> 179 189 List.find_opt (fun (c, _) -> 180 190 OpamPackage.equal c compiler) odoc_tools 181 191 |> Option.map snd 182 192 in 183 183 - let pkg_universe : (OpamPackage.t, OpamPackage.Set.t) Hashtbl.t = 184 184 - Hashtbl.create 64 in 185 185 - List.iter (fun (_target, solution) -> 186 186 - let all_pkgs = OpamPackage.Map.fold (fun pkg _ acc -> 187 187 - OpamPackage.Set.add pkg acc 188 188 - ) solution OpamPackage.Set.empty in 189 189 - OpamPackage.Map.iter (fun pkg _ -> 190 190 - Hashtbl.replace pkg_universe pkg all_pkgs 191 191 - ) solution 192 192 - ) solutions; 193 193 + (* find_odoc_tool taking OpamPackage.t — needed by prepare/compile/link. 194 194 + Dispatched through a ref so we can set the current build context. *) 195 195 + let current_build_hash = ref "" in 196 196 + let find_odoc_tool _pkg = find_odoc_tool_for_hash !current_build_hash in 197 197 + (* Build hash -> build node index (O(1) instead of List.find) *) 198 198 + let build_by_hash : (string, build) Hashtbl.t = 199 199 + Hashtbl.create (List.length nodes) in 200 200 + List.iter (fun (node : build) -> 201 201 + Hashtbl.replace build_by_hash node.hash node 202 202 + ) nodes; 193 203 (* Build a unified compile+link DAG. 204 204 + All keyed by build hash so the same package built with different 205 205 + compilers gets separate compile/link nodes. 194 206 - compile(A) depends on build(A) and compile(A's build deps) 195 207 - link(A) depends on compile(X) for all X in A's solution *) 196 196 - let compile_nodes : (OpamPackage.t, build) Hashtbl.t = Hashtbl.create 64 in 208 208 + let compile_nodes : (string, build) Hashtbl.t = Hashtbl.create 64 in 197 209 let link_nodes_list = ref [] in 198 198 - (* Create compile nodes for every package with a matching odoc tool. 199 199 - Don't check installed_libs here — layers may not exist yet in a 200 200 - fresh cache. The compile callback checks at execution time. *) 210 210 + (* Create compile nodes for every build node with a matching odoc tool *) 201 211 List.iter (fun (node : build) -> 202 202 - if find_odoc_tool node.pkg <> None then begin 203 203 - let odoc_tool = Option.get (find_odoc_tool node.pkg) in 212 212 + match find_odoc_tool_for_hash node.hash with 213 213 + | None -> () 214 214 + | Some odoc_tool -> 204 215 let composite_tool_hash = Day11_layer.Hash.of_strings 205 216 [ driver_tool.hash; odoc_tool.hash ] in 206 217 let compile_hash = Day11_layer.Hash.of_strings 207 218 [ "compile"; node.hash; composite_tool_hash ] in 208 208 - let compile_deps = [ node ] in 209 219 let cn : build = { hash = compile_hash; pkg = node.pkg; 210 210 - deps = compile_deps } in 211 211 - Hashtbl.replace compile_nodes node.pkg cn 212 212 - end 220 220 + deps = [ node ] } in 221 221 + Hashtbl.replace compile_nodes node.hash cn 213 222 ) nodes; 214 223 (* Patch compile deps: each compile depends on its build deps' compiles *) 215 215 - Hashtbl.iter (fun pkg cn -> 216 216 - let build_node = List.find (fun (n : build) -> 217 217 - OpamPackage.equal n.pkg pkg) nodes in 224 224 + let compile_snapshot = Hashtbl.fold (fun k v acc -> (k, v) :: acc) 225 225 + compile_nodes [] in 226 226 + List.iter (fun (build_hash, cn) -> 227 227 + let build_node = Hashtbl.find build_by_hash build_hash in 218 228 let dep_compiles = List.filter_map (fun (dep : build) -> 219 219 - Hashtbl.find_opt compile_nodes dep.pkg 229 229 + Hashtbl.find_opt compile_nodes dep.hash 220 230 ) build_node.deps in 221 231 let patched : build = { cn with deps = cn.deps @ dep_compiles } in 222 222 - Hashtbl.replace compile_nodes pkg patched 223 223 - ) compile_nodes; 232 232 + Hashtbl.replace compile_nodes build_hash patched 233 233 + ) compile_snapshot; 234 234 + (* Build hash -> universe of build hashes (for link deps). 235 235 + For each solution, find the build node matching each package+compiler, 236 236 + then record which build hashes share a universe. *) 237 237 + let build_hash_universe : (string, string list) Hashtbl.t = 238 238 + Hashtbl.create 64 in 239 239 + List.iter (fun (_target, solution) -> 240 240 + let compiler = find_compiler solution in 241 241 + let bh_list = OpamPackage.Map.fold (fun pkg _deps acc -> 242 242 + (* Find the build node for this pkg whose compiler matches *) 243 243 + let found = Hashtbl.fold (fun bh (node : build) found -> 244 244 + match found with 245 245 + | Some _ -> found 246 246 + | None -> 247 247 + if OpamPackage.equal node.pkg pkg then 248 248 + match compiler, Hashtbl.find_opt node_compiler bh with 249 249 + | Some c, Some nc when OpamPackage.equal c nc -> Some bh 250 250 + | None, None -> Some bh 251 251 + | _ -> None 252 252 + else None 253 253 + ) build_by_hash None in 254 254 + match found with Some h -> h :: acc | None -> acc 255 255 + ) solution [] in 256 256 + List.iter (fun bh -> 257 257 + Hashtbl.replace build_hash_universe bh bh_list 258 258 + ) bh_list 259 259 + ) solutions; 224 260 (* Create link nodes — depend on all compiles in the solution *) 225 225 - Hashtbl.iter (fun pkg _cn -> 226 226 - let build_node = List.find (fun (n : build) -> 227 227 - OpamPackage.equal n.pkg pkg) nodes in 261 261 + Hashtbl.iter (fun build_hash _cn -> 262 262 + let build_node = Hashtbl.find build_by_hash build_hash in 228 263 let dep_compile_layers = 229 229 - match Hashtbl.find_opt pkg_universe pkg with 264 264 + match Hashtbl.find_opt build_hash_universe build_hash with 230 265 | None -> [] 231 231 - | Some universe_pkgs -> 232 232 - OpamPackage.Set.fold (fun dep_pkg acc -> 233 233 - match Hashtbl.find_opt compile_nodes dep_pkg with 234 234 - | Some bl -> bl :: acc 235 235 - | None -> acc 236 236 - ) universe_pkgs [] 266 266 + | Some universe_hashes -> 267 267 + List.filter_map (fun dep_bh -> 268 268 + Hashtbl.find_opt compile_nodes dep_bh 269 269 + ) universe_hashes 237 270 in 238 238 - let own_compile = Hashtbl.find compile_nodes pkg in 239 239 - let odoc_tool = Option.get (find_odoc_tool pkg) in 271 271 + let own_compile = Hashtbl.find compile_nodes build_hash in 272 272 + let odoc_tool = Option.get (find_odoc_tool_for_hash build_hash) in 240 273 let composite_tool_hash = Day11_layer.Hash.of_strings 241 274 [ driver_tool.hash; odoc_tool.hash ] in 242 275 let universe = Command.compute_universe_hash [ build_node.hash ] in ··· 245 278 let link_hash = Day11_layer.Hash.of_strings 246 279 ([ "link"; own_compile.hash; universe; composite_tool_hash ] 247 280 @ dep_hashes) in 248 248 - let ln : build = { hash = link_hash; pkg = pkg; 281 281 + let ln : build = { hash = link_hash; pkg = build_node.pkg; 249 282 deps = [ build_node; own_compile ] @ dep_compile_layers } in 250 283 link_nodes_list := ln :: !link_nodes_list 251 284 ) compile_nodes; ··· 253 286 let all_doc_nodes = nodes @ compile_list @ !link_nodes_list in 254 287 Printf.printf " Doc DAG: %d compile + %d link nodes\n%!" 255 288 (List.length compile_list) (List.length !link_nodes_list); 256 256 - (* Track results *) 257 257 - let compile_results : (OpamPackage.t, build) Hashtbl.t = Hashtbl.create 64 in 289 289 + (* Track results — keyed by build hash *) 290 290 + let compile_results : (string, build) Hashtbl.t = Hashtbl.create 64 in 258 291 let doc_count = Atomic.make 0 in 259 292 let doc_html = Atomic.make 0 in 293 293 + (* compile hash -> build hash, for dispatch *) 294 294 + let compile_to_build : (string, string) Hashtbl.t = Hashtbl.create 64 in 295 295 + List.iter (fun (build_hash, _cn) -> 296 296 + let cn = Hashtbl.find compile_nodes build_hash in 297 297 + Hashtbl.replace compile_to_build cn.hash build_hash 298 298 + ) compile_snapshot; 299 299 + let link_to_build : (string, string) Hashtbl.t = Hashtbl.create 64 in 300 300 + List.iter (fun (ln : build) -> 301 301 + (* link node's first dep is the build node *) 302 302 + match ln.deps with 303 303 + | build_node :: _ when Hashtbl.mem build_by_hash build_node.hash -> 304 304 + Hashtbl.replace link_to_build ln.hash build_node.hash 305 305 + | _ -> () 306 306 + ) !link_nodes_list; 260 307 (* Index for dispatch *) 261 308 let compile_set = Hashtbl.create 64 in 262 309 List.iter (fun (cn : build) -> Hashtbl.replace compile_set cn.hash cn) compile_list; 263 310 let link_set = Hashtbl.create 64 in 264 311 List.iter (fun (ln : build) -> Hashtbl.replace link_set ln.hash ln) !link_nodes_list; 265 265 - let node_of_pkg = Hashtbl.create 64 in 266 266 - List.iter (fun (n : build) -> Hashtbl.replace node_of_pkg n.pkg n) nodes; 267 312 (* Priority: link=2, compile=1, build=0 *) 268 313 let node_priority (n : build) = 269 314 if Hashtbl.mem link_set n.hash then 2 ··· 282 327 (fun node -> 283 328 if Hashtbl.mem compile_set node.hash then begin 284 329 (* Compile phase *) 285 285 - match Hashtbl.find_opt node_of_pkg node.pkg with 330 330 + match Hashtbl.find_opt compile_to_build node.hash with 286 331 | None -> true 287 287 - | Some build_node -> 288 288 - match compile_package env benv ~os_dir ~driver_tool ~odoc_tools 332 332 + | Some build_hash -> 333 333 + let build_node = Hashtbl.find build_by_hash build_hash in 334 334 + current_build_hash := build_hash; 335 335 + (match compile_package env benv ~os_dir ~driver_tool ~odoc_tools 289 336 ~blessing_maps ~find_odoc_tool build_node with 290 290 - | Some bl -> Hashtbl.replace compile_results node.pkg bl; true 291 291 - | None -> true 337 337 + | Some bl -> Hashtbl.replace compile_results build_hash bl; true 338 338 + | None -> true) 292 339 end else if Hashtbl.mem link_set node.hash then begin 293 340 (* Link phase *) 294 294 - match Hashtbl.find_opt node_of_pkg node.pkg with 341 341 + match Hashtbl.find_opt link_to_build node.hash with 295 342 | None -> true 296 296 - | Some build_node -> 297 297 - match link_package env benv ~os_dir ~driver_tool ~odoc_tools 298 298 - ~blessing_maps ~find_odoc_tool ~compile_results ~pkg_universe 343 343 + | Some build_hash -> 344 344 + let build_node = Hashtbl.find build_by_hash build_hash in 345 345 + current_build_hash := build_hash; 346 346 + let universe_hashes = 347 347 + match Hashtbl.find_opt build_hash_universe build_hash with 348 348 + | Some hs -> hs | None -> [] in 349 349 + (match link_package env benv ~os_dir ~driver_tool ~odoc_tools 350 350 + ~blessing_maps ~find_odoc_tool ~compile_results 351 351 + ~build_hash ~universe_hashes 299 352 build_node with 300 353 | Some n -> 301 354 Atomic.incr doc_count; 302 355 ignore (Atomic.fetch_and_add doc_html n); 303 356 true 304 304 - | None -> true 357 357 + | None -> true) 305 358 end else 306 359 (* Build node — delegate to the build callback *) 307 360 build_one node);

+74

day11/doc/odoc_store.ml

reviewed

··· 1 1 + type t = { 2 2 + root : Fpath.t; (* <os_dir>/odoc-store *) 3 3 + } 4 4 + 5 5 + type pkg_loc = { 6 6 + pkg : OpamPackage.t; 7 7 + universe : string; 8 8 + blessed : bool; 9 9 + } 10 10 + 11 11 + let create ~os_dir = 12 12 + let root = Fpath.(os_dir / "odoc-store") in 13 13 + ignore (Bos.OS.Dir.create ~path:true root); 14 14 + ignore (Bos.OS.Dir.create ~path:true Fpath.(root / "odoc-out")); 15 15 + ignore (Bos.OS.Dir.create ~path:true Fpath.(root / "html")); 16 16 + { root } 17 17 + 18 18 + let rel_path loc = 19 19 + let name = OpamPackage.Name.to_string (OpamPackage.name loc.pkg) in 20 20 + let version = OpamPackage.Version.to_string (OpamPackage.version loc.pkg) in 21 21 + if loc.blessed then 22 22 + Fpath.(v "p" / name / version) 23 23 + else 24 24 + Fpath.(v "u" / loc.universe / name / version) 25 25 + 26 26 + let odoc_out_dir t loc = 27 27 + Fpath.(t.root / "odoc-out" // rel_path loc) 28 28 + 29 29 + let html_dir t loc = 30 30 + Fpath.(t.root / "html" // rel_path loc) 31 31 + 32 32 + let container_odoc_out = "/home/opam/odoc-out" 33 33 + let container_html = "/home/opam/html" 34 34 + 35 35 + let compile_mounts t = 36 36 + let odoc_mount = Day11_container.Mount.bind_rw 37 37 + ~src:(Fpath.to_string Fpath.(t.root / "odoc-out")) 38 38 + container_odoc_out in 39 39 + ([odoc_mount], Fpath.(t.root / "odoc-out")) 40 40 + 41 41 + let link_mounts t = 42 42 + let odoc_mount = Day11_container.Mount.bind_rw 43 43 + ~src:(Fpath.to_string Fpath.(t.root / "odoc-out")) 44 44 + container_odoc_out in 45 45 + let html_mount = Day11_container.Mount.bind_rw 46 46 + ~src:(Fpath.to_string Fpath.(t.root / "html")) 47 47 + container_html in 48 48 + ([odoc_mount; html_mount], Fpath.(t.root / "html")) 49 49 + 50 50 + let commit_compile t loc = 51 51 + let target = odoc_out_dir t loc in 52 52 + if not (Bos.OS.Dir.exists target |> Result.get_ok) then 53 53 + Printf.printf " warning: compile output not found at %s\n%!" 54 54 + (Fpath.to_string target) 55 55 + 56 56 + let commit_link t loc = 57 57 + let target = html_dir t loc in 58 58 + if not (Bos.OS.Dir.exists target |> Result.get_ok) then 59 59 + Printf.printf " warning: link output not found at %s\n%!" 60 60 + (Fpath.to_string target) 61 61 + 62 62 + let cleanup_compile t loc = 63 63 + let target = odoc_out_dir t loc in 64 64 + ignore (Bos.OS.Dir.delete ~recurse:true target) 65 65 + 66 66 + let cleanup_link t loc = 67 67 + let target = html_dir t loc in 68 68 + ignore (Bos.OS.Dir.delete ~recurse:true target) 69 69 + 70 70 + let is_compiled t loc = 71 71 + Bos.OS.Dir.exists (odoc_out_dir t loc) |> Result.get_ok 72 72 + 73 73 + let is_linked t loc = 74 74 + Bos.OS.Dir.exists (html_dir t loc) |> Result.get_ok

+68

day11/doc/odoc_store.mli

reviewed

··· 1 1 + (** Shared store for odoc output, replacing layer stacking for doc phases. 2 2 + 3 3 + Compile phases write [.odoc] files to the store; downstream compiles 4 4 + and link phases read them via the mounted directory. HTML output from 5 5 + link goes to a separate directory in the store. 6 6 + 7 7 + The entire [odoc-out/] directory is mounted into containers (RW for 8 8 + compile, RO for link). Each package writes to its own 9 9 + [p/<Name>/<version>/] subdirectory — concurrent containers are safe. 10 10 + 11 11 + On failure, the caller uses {!cleanup_compile} or {!cleanup_link} 12 12 + to remove partial output. *) 13 13 + 14 14 + type t 15 15 + (** The store, rooted at [{os_dir}/odoc-store/]. *) 16 16 + 17 17 + type pkg_loc = { 18 18 + pkg : OpamPackage.t; 19 19 + universe : string; 20 20 + blessed : bool; 21 21 + } 22 22 + (** Location info for a package. Determines the path prefix: 23 23 + blessed uses [p/<Name>/<version>/], non-blessed uses 24 24 + [u/<universe>/<Name>/<version>/]. *) 25 25 + 26 26 + val create : os_dir:Fpath.t -> t 27 27 + (** Create or open a store under [os_dir]. Creates the root directory 28 28 + and [odoc-out/] and [html/] subdirectories if they do not exist. *) 29 29 + 30 30 + val rel_path : pkg_loc -> Fpath.t 31 31 + (** The relative path fragment for a package location. 32 32 + E.g. [p/astring/0.8.5] or [u/abc123/astring/0.8.5]. *) 33 33 + 34 34 + val compile_mounts : t -> Day11_container.Mount.t list * Fpath.t 35 35 + (** [compile_mounts store] returns [(mounts, odoc_out_root)]. 36 36 + 37 37 + Mounts the store's [odoc-out/] directory RW at 38 38 + [/home/opam/odoc-out/] inside the container. Each package writes 39 39 + to its own [odoc-out/<rel_path>/] subdirectory — concurrent 40 40 + containers are safe. *) 41 41 + 42 42 + val link_mounts : t -> Day11_container.Mount.t list * Fpath.t 43 43 + (** [link_mounts store] returns [(mounts, html_root)]. 44 44 + 45 45 + Mounts the store's [odoc-out/] RW (for reading [.odoc] and writing 46 46 + [.odocl] files) and [html/] RW (for writing HTML output). *) 47 47 + 48 48 + val commit_compile : t -> pkg_loc -> unit 49 49 + (** Verify that the compile output landed in the store. With whole-dir 50 50 + mounting, output is written directly — this is a consistency check. *) 51 51 + 52 52 + val commit_link : t -> pkg_loc -> unit 53 53 + (** Verify that the link output landed in the store. *) 54 54 + 55 55 + val cleanup_compile : t -> pkg_loc -> unit 56 56 + (** Remove a package's [odoc-out] subdirectory on failure. *) 57 57 + 58 58 + val cleanup_link : t -> pkg_loc -> unit 59 59 + (** Remove a package's [html] subdirectory on failure. *) 60 60 + 61 61 + val html_dir : t -> pkg_loc -> Fpath.t 62 62 + (** Path to a package's HTML output directory in the store. *) 63 63 + 64 64 + val is_compiled : t -> pkg_loc -> bool 65 65 + (** [true] if the package's [odoc-out] dir exists in the store. *) 66 66 + 67 67 + val is_linked : t -> pkg_loc -> bool 68 68 + (** [true] if the package's [html] dir exists in the store. *)

-3

day11/doc/phase.ml

reviewed

··· 1 1 type doc_phase = Doc_all | Doc_compile_only | Doc_link_only 2 2 3 3 - type doc_compile = Day11_layer.Layer_type.doc_compile 4 4 - type doc_link = Day11_layer.Layer_type.doc_link 5 5 - 6 3 type doc_result = 7 4 | Doc_success of { html_path : string; blessed : bool } 8 5 | Doc_skipped

-3

day11/doc/phase.mli

reviewed

··· 13 13 val doc_result_to_yojson : doc_result -> Yojson.Safe.t 14 14 val doc_result_of_yojson : Yojson.Safe.t -> (doc_result, string) result 15 15 val phase_to_string : doc_phase -> string 16 16 - 17 17 - type doc_compile = Day11_layer.Layer_type.doc_compile 18 18 - type doc_link = Day11_layer.Layer_type.doc_link

+2 -2

day11/doc/test/dune

reviewed

··· 10 10 11 11 (executable 12 12 (name test_generate_docs) 13 13 - (libraries day11_build day11_container day11_exec day11_layer day11_solver 14 14 - day11_test_util 13 13 + (libraries day11_build day11_container day11_doc day11_exec day11_layer 14 14 + day11_solver day11_test_util 15 15 alcotest astring bos eio_main fpath opam-format)) 16 16 17 17 (executable

+212

day11/doc/test/test_doc.ml

reviewed

··· 297 297 let compilers = Generate.unique_compilers [] in 298 298 Alcotest.(check int) "empty" 0 (List.length compilers) 299 299 300 300 + (* ── Doc_deps tests ──────────────────────────────────────────────── *) 301 301 + 302 302 + (* Helper: build a solution map from a list of (pkg, [dep; dep; ...]) *) 303 303 + let make_solution entries = 304 304 + List.fold_left (fun acc (p, deps) -> 305 305 + OpamPackage.Map.add (pkg p) 306 306 + (OpamPackage.Set.of_list (List.map pkg deps)) acc 307 307 + ) OpamPackage.Map.empty entries 308 308 + 309 309 + (* No {post} deps anywhere — compile and link graphs identical. 310 310 + Every package can use --actions all. *) 311 311 + let test_doc_deps_no_post () = 312 312 + let deps = make_solution [ 313 313 + ("fmt.0.11.0", ["ocaml.5.4.1"; "dune.3.21.1"]); 314 314 + ("dune.3.21.1", ["ocaml.5.4.1"]); 315 315 + ("ocaml.5.4.1", []); 316 316 + ] in 317 317 + Alcotest.(check bool) "fmt: single phase" false 318 318 + (Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps 319 319 + (pkg "fmt.0.11.0")); 320 320 + Alcotest.(check bool) "dune: single phase" false 321 321 + (Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps 322 322 + (pkg "dune.3.21.1")) 323 323 + 324 324 + (* Package has a {post} dep — link graph has an extra dep that the 325 325 + compile graph doesn't. That package needs separate phases. *) 326 326 + let test_doc_deps_with_post_dep () = 327 327 + let compile_deps = make_solution [ 328 328 + ("odoc.3.1.0", ["ocaml.5.4.1"; "dune.3.21.1"]); 329 329 + ("dune.3.21.1", ["ocaml.5.4.1"]); 330 330 + ("ocaml.5.4.1", []); 331 331 + ] in 332 332 + let link_deps = make_solution [ 333 333 + ("odoc.3.1.0", ["ocaml.5.4.1"; "dune.3.21.1"; "odoc-parser.3.0.0"]); 334 334 + ("dune.3.21.1", ["ocaml.5.4.1"]); 335 335 + ("ocaml.5.4.1", []); 336 336 + ] in 337 337 + Alcotest.(check bool) "odoc: needs separate" true 338 338 + (Doc_deps.needs_separate_link ~compile_deps ~link_deps 339 339 + (pkg "odoc.3.1.0")); 340 340 + Alcotest.(check bool) "dune: single phase" false 341 341 + (Doc_deps.needs_separate_link ~compile_deps ~link_deps 342 342 + (pkg "dune.3.21.1")) 343 343 + 344 344 + (* Package not in either graph — no deps to compare, single phase. *) 345 345 + let test_doc_deps_absent_pkg () = 346 346 + let deps = make_solution [ 347 347 + ("fmt.0.11.0", ["ocaml.5.4.1"]); 348 348 + ("ocaml.5.4.1", []); 349 349 + ] in 350 350 + Alcotest.(check bool) "absent: single phase" false 351 351 + (Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps 352 352 + (pkg "unknown-pkg.1.0")) 353 353 + 354 354 + (* Single package, no deps in either graph *) 355 355 + let test_doc_deps_leaf () = 356 356 + let deps = make_solution [ 357 357 + ("astring.0.8.5", []); 358 358 + ] in 359 359 + Alcotest.(check bool) "leaf: single phase" false 360 360 + (Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps 361 361 + (pkg "astring.0.8.5")) 362 362 + 363 363 + (* Multiple packages in a solution, only the one with {post} deps 364 364 + needs separate phases — the others are unaffected. *) 365 365 + let test_doc_deps_mixed () = 366 366 + let compile_deps = make_solution [ 367 367 + ("yojson.2.2.2", ["ocaml.5.4.1"; "dune.3.21.1"]); 368 368 + ("ppx_yojson.1.3.0", ["ocaml.5.4.1"; "dune.3.21.1"; "yojson.2.2.2"]); 369 369 + ("dune.3.21.1", ["ocaml.5.4.1"]); 370 370 + ("ocaml.5.4.1", []); 371 371 + ] in 372 372 + let link_deps = make_solution [ 373 373 + ("yojson.2.2.2", ["ocaml.5.4.1"; "dune.3.21.1"]); 374 374 + ("ppx_yojson.1.3.0", ["ocaml.5.4.1"; "dune.3.21.1"; "yojson.2.2.2"; 375 375 + "ppxlib.0.33.0"]); 376 376 + ("dune.3.21.1", ["ocaml.5.4.1"]); 377 377 + ("ocaml.5.4.1", []); 378 378 + ] in 379 379 + Alcotest.(check bool) "yojson: single phase" false 380 380 + (Doc_deps.needs_separate_link ~compile_deps ~link_deps 381 381 + (pkg "yojson.2.2.2")); 382 382 + Alcotest.(check bool) "ppx_yojson: needs separate" true 383 383 + (Doc_deps.needs_separate_link ~compile_deps ~link_deps 384 384 + (pkg "ppx_yojson.1.3.0")); 385 385 + Alcotest.(check bool) "dune: single phase" false 386 386 + (Doc_deps.needs_separate_link ~compile_deps ~link_deps 387 387 + (pkg "dune.3.21.1")) 388 388 + 389 389 + (* ── Odoc_store tests ────────────────────────────────────────────── *) 390 390 + 391 391 + let loc ?(universe = "u1") ?(blessed = true) s : Odoc_store.pkg_loc = 392 392 + { pkg = pkg s; universe; blessed } 393 393 + 394 394 + let test_rel_path_blessed () = 395 395 + let p = Odoc_store.rel_path (loc "astring.0.8.5") in 396 396 + Alcotest.(check string) "blessed" "p/astring/0.8.5" (Fpath.to_string p) 397 397 + 398 398 + let test_rel_path_non_blessed () = 399 399 + let p = Odoc_store.rel_path (loc ~blessed:false ~universe:"abc123" "astring.0.8.5") in 400 400 + Alcotest.(check string) "non-blessed" "u/abc123/astring/0.8.5" (Fpath.to_string p) 401 401 + 402 402 + let test_store_create () = with_tmp_dir @@ fun dir -> 403 403 + let store = Odoc_store.create ~os_dir:dir in 404 404 + ignore store; 405 405 + Alcotest.(check bool) "root dir exists" true 406 406 + (Bos.OS.Dir.exists Fpath.(dir / "odoc-store") |> Result.get_ok) 407 407 + 408 408 + let test_is_compiled_false () = with_tmp_dir @@ fun dir -> 409 409 + let store = Odoc_store.create ~os_dir:dir in 410 410 + Alcotest.(check bool) "not compiled" false 411 411 + (Odoc_store.is_compiled store (loc "astring.0.8.5")) 412 412 + 413 413 + let test_is_compiled_true () = with_tmp_dir @@ fun dir -> 414 414 + let store = Odoc_store.create ~os_dir:dir in 415 415 + let l = loc "astring.0.8.5" in 416 416 + (* Manually create the odoc-out dir to simulate a committed compile *) 417 417 + let odoc_dir = Fpath.(dir / "odoc-store" / "odoc-out" // Odoc_store.rel_path l) in 418 418 + mkdir odoc_dir; 419 419 + Alcotest.(check bool) "compiled" true (Odoc_store.is_compiled store l) 420 420 + 421 421 + let test_is_linked_false () = with_tmp_dir @@ fun dir -> 422 422 + let store = Odoc_store.create ~os_dir:dir in 423 423 + Alcotest.(check bool) "not linked" false 424 424 + (Odoc_store.is_linked store (loc "astring.0.8.5")) 425 425 + 426 426 + let test_is_linked_true () = with_tmp_dir @@ fun dir -> 427 427 + let store = Odoc_store.create ~os_dir:dir in 428 428 + let l = loc "astring.0.8.5" in 429 429 + let html_dir = Fpath.(dir / "odoc-store" / "html" // Odoc_store.rel_path l) in 430 430 + mkdir html_dir; 431 431 + Alcotest.(check bool) "linked" true (Odoc_store.is_linked store l) 432 432 + 433 433 + let test_compile_mounts () = with_tmp_dir @@ fun dir -> 434 434 + let store = Odoc_store.create ~os_dir:dir in 435 435 + let mounts, _root = Odoc_store.compile_mounts store in 436 436 + Alcotest.(check int) "1 mount" 1 (List.length mounts); 437 437 + let m = List.hd mounts in 438 438 + Alcotest.(check string) "dst" "/home/opam/odoc-out" m.Day11_container.Mount.dst; 439 439 + Alcotest.(check bool) "is rw" true (not (List.mem "ro" m.options)) 440 440 + 441 441 + let test_link_mounts () = with_tmp_dir @@ fun dir -> 442 442 + let store = Odoc_store.create ~os_dir:dir in 443 443 + let mounts, _root = Odoc_store.link_mounts store in 444 444 + Alcotest.(check int) "2 mounts" 2 (List.length mounts); 445 445 + let dsts = List.map (fun (m : Day11_container.Mount.t) -> m.dst) mounts 446 446 + |> List.sort String.compare in 447 447 + Alcotest.(check (list string)) "mount dsts" 448 448 + ["/home/opam/html"; "/home/opam/odoc-out"] dsts 449 449 + 450 450 + let test_compile_writes_to_store () = with_tmp_dir @@ fun dir -> 451 451 + let store = Odoc_store.create ~os_dir:dir in 452 452 + let l = loc "astring.0.8.5" in 453 453 + (* Simulate what happens in the container: output goes directly 454 454 + to the mounted odoc-out dir *) 455 455 + let odoc_dir = Fpath.(dir / "odoc-store" / "odoc-out" // Odoc_store.rel_path l / "doc") in 456 456 + mkdir odoc_dir; 457 457 + write_file Fpath.(odoc_dir / "astring.odoc") "odoc content"; 458 458 + Odoc_store.commit_compile store l; 459 459 + Alcotest.(check bool) "is_compiled" true (Odoc_store.is_compiled store l) 460 460 + 461 461 + let test_link_writes_to_store () = with_tmp_dir @@ fun dir -> 462 462 + let store = Odoc_store.create ~os_dir:dir in 463 463 + let l = loc "astring.0.8.5" in 464 464 + let html_dir = Fpath.(dir / "odoc-store" / "html" // Odoc_store.rel_path l / "doc") in 465 465 + mkdir html_dir; 466 466 + write_file Fpath.(html_dir / "index.html") "<html>docs</html>"; 467 467 + Odoc_store.commit_link store l; 468 468 + Alcotest.(check bool) "is_linked" true (Odoc_store.is_linked store l) 469 469 + 470 470 + let test_cleanup_compile () = with_tmp_dir @@ fun dir -> 471 471 + let store = Odoc_store.create ~os_dir:dir in 472 472 + let l = loc "astring.0.8.5" in 473 473 + let odoc_dir = Fpath.(dir / "odoc-store" / "odoc-out" // Odoc_store.rel_path l) in 474 474 + mkdir odoc_dir; 475 475 + Alcotest.(check bool) "exists before" true (Odoc_store.is_compiled store l); 476 476 + Odoc_store.cleanup_compile store l; 477 477 + Alcotest.(check bool) "gone after" false (Odoc_store.is_compiled store l) 478 478 + 479 479 + let test_cleanup_link () = with_tmp_dir @@ fun dir -> 480 480 + let store = Odoc_store.create ~os_dir:dir in 481 481 + let l = loc "astring.0.8.5" in 482 482 + let html_dir = Fpath.(dir / "odoc-store" / "html" // Odoc_store.rel_path l) in 483 483 + mkdir html_dir; 484 484 + Alcotest.(check bool) "exists before" true (Odoc_store.is_linked store l); 485 485 + Odoc_store.cleanup_link store l; 486 486 + Alcotest.(check bool) "gone after" false (Odoc_store.is_linked store l) 487 487 + 300 488 (* ── Test registration ───────────────────────────────────────────── *) 301 489 302 490 let () = ··· 374 562 test_unique_compilers; 375 563 Alcotest.test_case "unique_compilers empty" `Quick 376 564 test_unique_compilers_empty; 565 565 + ] ); 566 566 + ( "Doc_deps", 567 567 + [ 568 568 + Alcotest.test_case "no post deps" `Quick test_doc_deps_no_post; 569 569 + Alcotest.test_case "with post dep" `Quick test_doc_deps_with_post_dep; 570 570 + Alcotest.test_case "absent package" `Quick test_doc_deps_absent_pkg; 571 571 + Alcotest.test_case "leaf" `Quick test_doc_deps_leaf; 572 572 + Alcotest.test_case "mixed" `Quick test_doc_deps_mixed; 573 573 + ] ); 574 574 + ( "Odoc_store", 575 575 + [ 576 576 + Alcotest.test_case "rel_path blessed" `Quick test_rel_path_blessed; 577 577 + Alcotest.test_case "rel_path non-blessed" `Quick test_rel_path_non_blessed; 578 578 + Alcotest.test_case "create" `Quick test_store_create; 579 579 + Alcotest.test_case "is_compiled false" `Quick test_is_compiled_false; 580 580 + Alcotest.test_case "is_compiled true" `Quick test_is_compiled_true; 581 581 + Alcotest.test_case "is_linked false" `Quick test_is_linked_false; 582 582 + Alcotest.test_case "is_linked true" `Quick test_is_linked_true; 583 583 + Alcotest.test_case "compile_mounts" `Quick test_compile_mounts; 584 584 + Alcotest.test_case "link_mounts" `Quick test_link_mounts; 585 585 + Alcotest.test_case "compile writes to store" `Quick test_compile_writes_to_store; 586 586 + Alcotest.test_case "link writes to store" `Quick test_link_writes_to_store; 587 587 + Alcotest.test_case "cleanup_compile" `Quick test_cleanup_compile; 588 588 + Alcotest.test_case "cleanup_link" `Quick test_cleanup_link; 377 589 ] ); 378 590 ]

-13

day11/doc/test/test_doc_integration.ml

reviewed

··· 68 68 Alcotest.(check bool) "has astring" 69 69 true (Astring.String.is_infix ~affix:"astring" cmd) 70 70 71 71 - let test_doc_deps_real_package () = 72 72 - let opam_repository = opam_repository () in 73 73 - let pkg = OpamPackage.of_string "astring.0.8.5" in 74 74 - match Day11_layer.Opam_repo.find_opam_file 75 75 - [ Fpath.v opam_repository ] pkg with 76 76 - | None -> Alcotest.fail "astring opam file not found" 77 77 - | Some opam -> 78 78 - let _compile, _link, needs_separate = Deps.analyze_doc_deps opam in 79 79 - Alcotest.(check bool) "no separate phases" false needs_separate 80 80 - 81 71 (* ── Build odoc ──────────────────────────────────────────────────── *) 82 72 83 73 let test_build_odoc () = with_eio @@ fun env -> ··· 128 118 ( "Command", 129 119 [ Alcotest.test_case "generation" `Quick 130 120 test_command_generation ] ); 131 131 - ( "Deps", 132 132 - [ Alcotest.test_case "real package" `Quick 133 133 - test_doc_deps_real_package ] ); 134 121 ( "Doc_build", 135 122 [ Alcotest.test_case "build odoc" `Slow test_build_odoc ] ) ]

+5 -21

day11/doc/test/test_doc_pipeline.ml

reviewed

··· 40 40 |> ok_or_fail "build odoc-driver" 41 41 in 42 42 Printf.printf " %d packages built\n%!" (List.length odoc_tool.builds); 43 43 - (* Step 2: Classify packages by doc phase needs *) 44 44 - let find_opam = Day11_solver.Git_packages.find_package git_packages in 45 45 - let needs_split = List.filter (fun (b : build) -> 46 46 - match find_opam b.pkg with 47 47 - | None -> false 48 48 - | Some opam -> 49 49 - let _, _, needs_separate = Day11_doc.Deps.analyze_doc_deps opam in 50 50 - needs_separate 51 51 - ) odoc_tool.builds in 52 52 - let no_split = List.filter (fun (b : build) -> 53 53 - not (List.exists (fun (s : build) -> s.hash = b.hash) needs_split) 54 54 - ) odoc_tool.builds in 55 55 - Printf.printf " %d packages need split phases: %s\n%!" 56 56 - (List.length needs_split) 57 57 - (String.concat ", " (List.map (fun (b : build) -> 58 58 - OpamPackage.to_string b.pkg) needs_split)); 59 59 - Printf.printf " %d packages use single phase\n%!" 43 43 + (* Step 2: All packages use compile+link split in unified DAG *) 44 44 + let no_split = odoc_tool.builds in 45 45 + let needs_split = [] in 46 46 + Printf.printf " %d packages for doc generation\n%!" 60 47 (List.length no_split); 61 48 (* Step 3: Generate docs for non-split packages (--actions all) *) 62 49 let universe = Day11_doc.Command.compute_universe_hash ··· 208 195 Printf.printf " Split-phase: %d packages, %d HTML\n%!" 209 196 (List.length compile_builds) !split_html; 210 197 Printf.printf " Total HTML: %d\n%!" (!doc_all_html + !split_html); 211 211 - Alcotest.(check bool) "some single-phase docs" true (!doc_all_count > 0); 212 212 - Alcotest.(check bool) "some split-phase docs" true 213 213 - (List.length compile_builds > 0); 214 214 - Alcotest.(check bool) "split produced HTML" true (!split_html > 0) 198 198 + Alcotest.(check bool) "some single-phase docs" true (!doc_all_count > 0) 215 199 216 200 let () = 217 201 if not (is_integration ()) then

+1 -1

day11/doc/test/test_generate_docs.ml

reviewed

··· 96 96 ] in 97 97 let build_dirs = List.map 98 98 (Day11_layer.Layer_type.build_dir ~os_dir) all_builds in 99 99 - let run, upper = 99 99 + let run, upper, _timing = 100 100 Day11_build.Run_in_layers.run env ~base ~build_dirs 101 101 ~uid:1000 ~gid:1000 ~mounts voodoo_cmd 102 102 |> ok_or_fail "run voodoo"

+18

day11/layer/layer_info.ml

reviewed

··· 36 36 Rresult.R.error_msgf "Layer_info.save %a: %s" 37 37 Fpath.pp path (Printexc.to_string exn) 38 38 39 39 + let save_skeleton path ~pkg ~failed_dep = 40 40 + let now = Unix.time () in 41 41 + let fields = 42 42 + [ ("package", `String pkg); 43 43 + ("exit_status", `Int (-1)); 44 44 + ("failed_dep", `String failed_dep); 45 45 + ("deps", `List []); 46 46 + ("hashes", `List []); 47 47 + ("created", `Float now); 48 48 + ("created_at", `String (format_timestamp now)) ] 49 49 + in 50 50 + try 51 51 + Yojson.Safe.to_file (Fpath.to_string path) (`Assoc fields); 52 52 + Ok () 53 53 + with exn -> 54 54 + Rresult.R.error_msgf "Layer_info.save_skeleton %a: %s" 55 55 + Fpath.pp path (Printexc.to_string exn) 56 56 + 39 57 let load path = 40 58 let path_s = Fpath.to_string path in 41 59 try Ok (Yojson.Safe.from_file path_s)

+9

day11/layer/layer_info.mli

reviewed

··· 24 24 [uid], [gid], [base_hash], [created], [created_at]. 25 25 Optional: [installed_libs], [installed_docs], [extra]. *) 26 26 27 27 + val save_skeleton : 28 28 + Fpath.t -> 29 29 + pkg:string -> 30 30 + failed_dep:string -> 31 31 + (unit, [> Rresult.R.msg ]) result 32 32 + (** [save_skeleton path ~pkg ~failed_dep] writes a minimal layer.json 33 33 + for a package that was not built because [failed_dep] failed. 34 34 + Sets [exit_status] to [-1] and leaves [deps] and [hashes] empty. *) 35 35 + 27 36 val load : Fpath.t -> (Yojson.Safe.t, [> Rresult.R.msg ]) result 28 37 (** [load path] reads and parses a layer.json file. *) 29 38

-41

day11/layer/layer_type.ml

reviewed

··· 10 10 deps : build list; 11 11 } 12 12 13 13 - type doc_compile = { 14 14 - build : build; 15 15 - } 16 16 - 17 17 - type doc_link = { 18 18 - compile : doc_compile; 19 19 - blessed : bool; 20 20 - dep_compiles : doc_compile list; 21 21 - rdep_compiles : doc_compile list; 22 22 - } 23 23 - 24 13 type tool = { 25 14 hash : string; 26 15 dir : Fpath.t; ··· 34 23 let build_dir ~os_dir (b : build) = 35 24 Fpath.(os_dir / build_dir_name b) 36 25 37 37 - let compile_hash ~tool_hash (c : doc_compile) = 38 38 - Hash.of_strings [ "compile"; c.build.hash; tool_hash ] 39 39 - 40 40 - let compile_dir_name ~tool_hash c = 41 41 - "compile-" ^ String.sub (compile_hash ~tool_hash c) 0 12 42 42 - 43 43 - let compile_dir ~os_dir ~tool_hash c = 44 44 - Fpath.(os_dir / compile_dir_name ~tool_hash c) 45 45 - 46 46 - let rec collect_build_hashes (b : build) = 47 47 - b.hash :: List.concat_map collect_build_hashes b.deps 48 48 - 49 49 - let universe d = 50 50 - let hashes = collect_build_hashes d.compile.build in 51 51 - Hash.of_strings (List.sort String.compare hashes) 52 52 - 53 53 - let link_hash ~tool_hash d = 54 54 - let dep_hashes = List.map (compile_hash ~tool_hash) d.dep_compiles in 55 55 - let rdep_hashes = List.map (compile_hash ~tool_hash) d.rdep_compiles in 56 56 - Hash.of_strings 57 57 - ([ "link"; compile_hash ~tool_hash d.compile; 58 58 - universe d; tool_hash; 59 59 - if d.blessed then "blessed" else "" ] 60 60 - @ dep_hashes @ rdep_hashes) 61 61 - 62 62 - let link_dir_name ~tool_hash d = 63 63 - "link-" ^ String.sub (link_hash ~tool_hash d) 0 12 64 64 - 65 65 - let link_dir ~os_dir ~tool_hash d = 66 66 - Fpath.(os_dir / link_dir_name ~tool_hash d)

+5 -54

day11/layer/layer_type.mli

reviewed

··· 1 1 - (** Layer types for build and documentation DAGs. 1 1 + (** Layer types for build DAGs. 2 2 3 3 - {!build}, {!doc_compile}, and {!doc_link} are recursive types 4 4 - that represent both the plan (before building) and the result 5 5 - (after building). Paths on disk are derived from hashes. 3 3 + {!build} is a recursive type that represents both the plan (before 4 4 + building) and the result (after building). Paths on disk are derived 5 5 + from hashes. 6 6 7 7 - {!base} and {!tool} are non-recursive inputs to the DAG. 8 8 - 9 9 - Documentation has two phases: 10 10 - - {b Compile}: turns .cmti/.cmt into .odoc files. Depends only 11 11 - on the package's build layer — no doc dependencies. 12 12 - - {b Link}: resolves cross-references and generates HTML. Depends 13 13 - on compiled odocs of both deps (backward refs) and rdeps 14 14 - (forward linking). *) 7 7 + {!base} and {!tool} are non-recursive inputs to the DAG. *) 15 8 16 9 (** {2 Base layer} *) 17 10 ··· 30 23 } 31 24 (** Path on disk: [os_dir / build_dir_name build]. *) 32 25 33 33 - (** {2 Doc compile layer} *) 34 34 - 35 35 - type doc_compile = { 36 36 - build : build; 37 37 - } 38 38 - (** Compiled .odoc files for a package. Depends only on the 39 39 - package's build layer — no cross-package doc dependencies. 40 40 - Can run as soon as the build completes. 41 41 - 42 42 - Hash is derived from [build.hash] + tool hash. *) 43 43 - 44 44 - (** {2 Doc link layer} *) 45 45 - 46 46 - type doc_link = { 47 47 - compile : doc_compile; 48 48 - blessed : bool; 49 49 - dep_compiles : doc_compile list; 50 50 - rdep_compiles : doc_compile list; 51 51 - } 52 52 - (** Linked documentation with HTML output. Depends on compiled 53 53 - odocs of deps (for backward cross-references) and rdeps 54 54 - (for forward linking — "packages that use this library"). 55 55 - 56 56 - The compile/link split breaks what would otherwise be a 57 57 - circular dependency: A can link to B's docs and B can link 58 58 - to A's docs, because both compile phases complete first. *) 59 59 - 60 26 (** {2 Tool layer} *) 61 27 62 28 type tool = { ··· 71 37 val build_dir_name : build -> string 72 38 val build_dir : os_dir:Fpath.t -> build -> Fpath.t 73 39 74 74 - val compile_hash : tool_hash:string -> doc_compile -> string 75 75 - (** Hash for the compile phase: [build.hash + tool_hash]. *) 76 76 - 77 77 - val compile_dir_name : tool_hash:string -> doc_compile -> string 78 78 - val compile_dir : os_dir:Fpath.t -> tool_hash:string -> doc_compile -> Fpath.t 79 79 - 80 80 - val universe : doc_link -> string 81 81 - (** Universe hash from transitive build dep hashes. *) 82 82 - 83 83 - val link_hash : tool_hash:string -> doc_link -> string 84 84 - (** Hash for the link phase: incorporates compile hash, universe, 85 85 - blessed, and dep/rdep compile hashes. *) 86 86 - 87 87 - val link_dir_name : tool_hash:string -> doc_link -> string 88 88 - val link_dir : os_dir:Fpath.t -> tool_hash:string -> doc_link -> Fpath.t

+22

day11/layer/opam_repo.ml

reviewed

··· 40 40 with exn -> 41 41 Rresult.R.error_msgf "Opam_repo.populate: %s" (Printexc.to_string exn) 42 42 43 43 + let save_snapshot ~layer_dir ~pkg ~opam_repositories = 44 44 + let name = OpamPackage.name_to_string pkg in 45 45 + let pkg_str = OpamPackage.to_string pkg in 46 46 + let rel = Fpath.(v "packages" / name / pkg_str) in 47 47 + let src = 48 48 + List.find_map (fun repo -> 49 49 + let candidate = Fpath.(repo // rel / "opam") in 50 50 + if Bos.OS.File.exists candidate |> Result.get_ok then Some candidate 51 51 + else None 52 52 + ) opam_repositories 53 53 + in 54 54 + match src with 55 55 + | None -> 56 56 + Rresult.R.error_msgf "Opam_repo.save_snapshot: opam file not found for %s" 57 57 + pkg_str 58 58 + | Some src_opam -> 59 59 + let dst_dir = Fpath.(layer_dir / "opam" // rel) in 60 60 + let ( >>= ) = Result.bind in 61 61 + Bos.OS.Dir.create ~path:true dst_dir >>= fun _created -> 62 62 + Bos.OS.File.read src_opam >>= fun content -> 63 63 + Bos.OS.File.write Fpath.(dst_dir / "opam") content 64 64 + 43 65 let find_opam_file repos pkg = 44 66 let name = OpamPackage.name_to_string pkg in 45 67 let pkg_str = OpamPackage.to_string pkg in

+9

day11/layer/opam_repo.mli

reviewed

··· 21 21 [opam_repo]. Packages not found in any repository are silently 22 22 skipped. *) 23 23 24 24 + val save_snapshot : 25 25 + layer_dir:Fpath.t -> 26 26 + pkg:OpamPackage.t -> 27 27 + opam_repositories:Fpath.t list -> 28 28 + (unit, [> Rresult.R.msg ]) result 29 29 + (** [save_snapshot ~layer_dir ~pkg ~opam_repositories] copies the opam 30 30 + file for [pkg] into [layer_dir/opam/packages/name/name.version/opam] 31 31 + so the layer can be rebuilt without the original repository. *) 32 32 + 24 33 val find_opam_file : 25 34 Fpath.t list -> OpamPackage.t -> OpamFile.OPAM.t option 26 35 (** [find_opam_file repos pkg] searches [repos] in order for [pkg]'s

+7 -2

day11/layer/stack.ml

reviewed

··· 15 15 ) layer_dirs in 16 16 if fs_dirs = [] then Ok () 17 17 else begin 18 18 + Log.info (fun m -> m "Merging %d layer fs dirs into %a" 19 19 + (List.length fs_dirs) Fpath.pp target); 18 20 (* Batch all cp commands into a single sudo call to avoid 19 19 - spawning hundreds of sudo processes for large dep lists *) 21 21 + spawning hundreds of sudo processes for large dep lists. 22 22 + Use ; instead of && so one failure doesn't skip the rest. *) 20 23 let target_s = Fpath.to_string target in 21 24 let cmds = List.map (fun fs -> 22 25 Printf.sprintf "cp -n --archive --no-dereference --recursive --link --no-target-directory %s %s" 23 26 (Filename.quote fs) (Filename.quote target_s) 24 27 ) fs_dirs in 25 25 - let script = String.concat " && " cmds in 28 28 + let script = "r=0; " ^ 29 29 + String.concat " " (List.map (fun c -> c ^ " || r=1;") cmds) 30 30 + ^ " exit $r" in 26 31 let result = 27 32 Day11_exec.Sudo.run env 28 33 Bos.Cmd.(v "bash" % "-c" % script)

+4 -2

day11/layer/test/test_layer.ml

reviewed

··· 109 109 deps = ["ocaml.5.4.1"]; hashes = ["build-abc123"]; 110 110 uid = 1000; gid = 1000; base_hash = "test"; 111 111 installed_libs = []; installed_docs = []; patches = []; failed_dep = None; 112 112 - disk_usage = 0; created_at = "2024-01-01T00:00:00Z"; 112 112 + disk_usage = 0; timing = Layer_meta.empty_timing; 113 113 + created_at = "2024-01-01T00:00:00Z"; 113 114 } in 114 115 Layer_meta.save_build path meta |> is_ok "skeleton"; 115 116 let m = Layer_meta.load_build path |> ok_or_fail "load" in ··· 236 237 deps = ["dune.3.0"]; hashes = ["hash1"]; 237 238 uid = 1000; gid = 1000; base_hash = "test"; 238 239 installed_libs = []; installed_docs = []; patches = []; failed_dep = None; 239 239 - disk_usage = 0; created_at = "2024-01-01T00:00:00Z"; 240 240 + disk_usage = 0; timing = Layer_meta.empty_timing; 241 241 + created_at = "2024-01-01T00:00:00Z"; 240 242 } in 241 243 write_skeleton ~layer_dir meta |> is_ok "write"; 242 244 match Layer_meta.load_build Fpath.(layer_dir / "layer.json") with

+3 -1

day11/lib/notify.ml

reviewed

··· 52 52 let token = env "TELEGRAM_BOT_TOKEN" in 53 53 let chat_id = env "TELEGRAM_CHAT_ID" in 54 54 let escaped = String.concat "\\\"" (String.split_on_char '"' message) in 55 55 + let escaped = String.concat "\\n" (String.split_on_char '\n' escaped) in 55 56 run_curl ["-X"; "POST"; 57 57 + "-H"; "'Content-type: application/json'"; 56 58 Printf.sprintf "'https://api.telegram.org/bot%s/sendMessage'" token; 57 57 - "-d"; Printf.sprintf "'chat_id=%s&text=%s'" chat_id escaped] 59 59 + "-d"; Printf.sprintf "'{\"chat_id\":\"%s\",\"text\":\"%s\"}'" chat_id escaped] 58 60 | Email -> 59 61 let to_addr = env "EMAIL_TO" in 60 62 let from_addr = env "EMAIL_FROM" in

+3

day11/solver/context.mli

reviewed

··· 51 51 52 52 val extend_with_extra_doc_deps : t -> t 53 53 (** Extend pins so x-extra-doc-deps appear in the depends formula. *) 54 54 + 55 55 + val get_extra_doc_deps : OpamFile.OPAM.t -> OpamPackage.Name.Set.t 56 56 + (** Extract package names from the [x-extra-doc-deps] extension field. *)

+81 -13

day11/solver/solve.ml

reviewed

··· 78 78 | Ok selections -> 79 79 let examined = Context.examined_packages context in 80 80 let solved_pkgs = Solver.packages_of_result selections in 81 81 - let build_context = Context.with_doc_post ~doc:false ~post:false context in 82 81 let solved_names = 83 82 List.fold_left (fun acc p -> 84 83 OpamPackage.Name.Set.add (OpamPackage.name p) acc) 85 84 OpamPackage.Name.Set.empty solved_pkgs 86 85 in 87 87 - let solution = 86 86 + let compute_deps_with ~doc ~post = 87 87 + let ctx = Context.with_doc_post ~doc ~post context in 88 88 List.fold_left (fun acc pkg -> 89 89 let opam = 90 90 match OpamPackage.Name.Map.find_opt (OpamPackage.name pkg) pins with ··· 94 94 with Not_found -> OpamFile.OPAM.empty 95 95 in 96 96 let deps = 97 97 - Context.filter_deps build_context pkg 97 97 + Context.filter_deps ctx pkg 98 98 (OpamFile.OPAM.depends opam) 99 99 in 100 100 let dep_names = ··· 103 103 OpamPackage.Name.Set.add dep_name acc) 104 104 OpamPackage.Name.Set.empty deps 105 105 in 106 106 - (* Include depopts that are present in the solution so they 107 107 - are built before this package (needed for --with-X flags) *) 108 106 let depopts = OpamFile.OPAM.depopts opam in 109 107 let depopt_names = 110 108 OpamFormula.fold_left ··· 126 124 OpamPackage.Map.add pkg dep_pkgs acc 127 125 ) OpamPackage.Map.empty solved_pkgs 128 126 in 129 129 - Ok (solution, examined) 127 127 + let solution = compute_deps_with ~doc:false ~post:false in 128 128 + let doc_deps = compute_deps_with ~doc:true ~post:true in 129 129 + Ok (solution, doc_deps, examined) 130 130 131 131 let add_ocaml_constraint ?ocaml_version constraints = 132 132 match ocaml_version with ··· 134 134 OpamPackage.Name.Map.add (OpamPackage.name pkg) 135 135 (`Eq, OpamPackage.version pkg) constraints 136 136 | None -> 137 137 - (* No compiler pin — let the solver pick freely *) 138 138 - constraints 137 137 + (* No explicit compiler pin — constrain to ocaml-base-compiler >= 4.08 138 138 + to avoid ocaml-compiler (which builds with ASAN and is extremely slow) 139 139 + and to ensure compatibility with odoc 3.x *) 140 140 + OpamPackage.Name.Map.add 141 141 + (OpamPackage.Name.of_string "ocaml-base-compiler") 142 142 + (`Geq, OpamPackage.Version.of_string "4.08.0") 143 143 + constraints 139 144 140 145 let solve ~packages ~env ?constraints ?pins ?prefer_oldest 141 146 ?(doc = true) ?(extra_targets = []) ?ocaml_version target = ··· 143 148 (Option.value ~default:OpamPackage.Name.Map.empty constraints) in 144 149 match solve_internal ~packages ~env ~constraints ?pins 145 150 ?prefer_oldest ~doc ~extra_targets target with 146 146 - | Ok (solution, _examined) -> Ok solution 151 151 + | Ok (solution, _doc_deps, _examined) -> Ok solution 147 152 | Error (msg, _examined) -> Error msg 148 153 149 154 let solve_with_examined ~packages ~env ?constraints ?pins ?prefer_oldest 150 155 ?ocaml_version target = 151 156 let constraints = add_ocaml_constraint ?ocaml_version 152 157 (Option.value ~default:OpamPackage.Name.Map.empty constraints) in 153 153 - solve_internal ~packages ~env ~constraints ?pins 154 154 - ?prefer_oldest target 158 158 + match solve_internal ~packages ~env ~constraints ?pins 159 159 + ?prefer_oldest target with 160 160 + | Ok (solution, _doc_deps, examined) -> Ok (solution, examined) 161 161 + | Error _ as e -> e 162 162 + 163 163 + let recompute_with_post ~packages ~env solution = 164 164 + let filter_env pkg v = 165 165 + if List.mem v OpamPackageVar.predefined_depends_variables then None 166 166 + else match OpamVariable.Full.to_string v with 167 167 + | "version" -> 168 168 + Some (OpamTypes.S 169 169 + (OpamPackage.Version.to_string (OpamPackage.version pkg))) 170 170 + | x -> env x 171 171 + in 172 172 + let solved_pkgs = OpamPackage.Map.fold (fun pkg _ acc -> pkg :: acc) 173 173 + solution [] in 174 174 + let solved_names = List.fold_left (fun acc p -> 175 175 + OpamPackage.Name.Set.add (OpamPackage.name p) acc) 176 176 + OpamPackage.Name.Set.empty solved_pkgs in 177 177 + List.fold_left (fun acc pkg -> 178 178 + let opam = 179 179 + try Git_packages.get_package packages pkg 180 180 + with Not_found -> OpamFile.OPAM.empty 181 181 + in 182 182 + let deps = 183 183 + OpamFile.OPAM.depends opam 184 184 + |> OpamFilter.partial_filter_formula (filter_env pkg) 185 185 + |> OpamFilter.filter_deps ~build:true ~post:true ~test:false 186 186 + ~doc:true ~dev:false ~dev_setup:false ~default:false 187 187 + in 188 188 + let dep_names = 189 189 + OpamFormula.fold_left 190 190 + (fun acc (dep_name, _) -> 191 191 + OpamPackage.Name.Set.add dep_name acc) 192 192 + OpamPackage.Name.Set.empty deps 193 193 + in 194 194 + let depopts = OpamFile.OPAM.depopts opam in 195 195 + let depopt_names = 196 196 + OpamFormula.fold_left 197 197 + (fun acc (dep_name, _) -> 198 198 + if OpamPackage.Name.Set.mem dep_name solved_names 199 199 + then OpamPackage.Name.Set.add dep_name acc 200 200 + else acc) 201 201 + OpamPackage.Name.Set.empty depopts 202 202 + in 203 203 + (* Include x-extra-doc-deps that are present in the solution *) 204 204 + let extra_doc_deps = Context.get_extra_doc_deps opam in 205 205 + let extra_doc_dep_names = 206 206 + OpamPackage.Name.Set.inter extra_doc_deps solved_names 207 207 + in 208 208 + let all_dep_names = 209 209 + OpamPackage.Name.Set.union dep_names depopt_names 210 210 + |> OpamPackage.Name.Set.union extra_doc_dep_names 211 211 + in 212 212 + let dep_pkgs = 213 213 + List.filter (fun p -> 214 214 + OpamPackage.Name.Set.mem (OpamPackage.name p) all_dep_names) 215 215 + solved_pkgs 216 216 + |> OpamPackage.Set.of_list 217 217 + in 218 218 + OpamPackage.Map.add pkg dep_pkgs acc 219 219 + ) OpamPackage.Map.empty solved_pkgs 155 220 156 221 let find_worker_bin () = 157 222 let exe_dir = Filename.dirname Sys.argv.(0) in ··· 197 262 let np = min np (List.length targets) in 198 263 if np <= 1 then 199 264 List.map (fun target -> 200 200 - (target, solve_internal ~packages ~env ~constraints 201 201 - ?prefer_oldest target) 265 265 + let result = solve_internal ~packages ~env ~constraints 266 266 + ?prefer_oldest target in 267 267 + let result = Result.map (fun (solution, _doc_deps, examined) -> 268 268 + (solution, examined)) result in 269 269 + (target, result) 202 270 ) targets 203 271 else begin 204 272 let worker_bin = find_worker_bin () in

+10

day11/solver/solve.mli

reviewed

··· 36 36 string * OpamPackage.Name.Set.t) result 37 37 (** Like {!solve} but also returns the examined package set. *) 38 38 39 39 + val recompute_with_post : 40 40 + packages:Git_packages.t -> 41 41 + env:(string -> OpamVariable.variable_contents option) -> 42 42 + Day11_graph.Graph.solution -> 43 43 + Day11_graph.Graph.solution 44 44 + (** [recompute_with_post ~packages ~env solution] takes an existing 45 45 + solution (computed with [~post:false]) and recomputes the dependency 46 46 + edges with [{post}] deps included. The set of solved packages stays 47 47 + the same; only the per-package dep sets change. *) 48 48 + 39 49 val solve_many : 40 50 packages:Git_packages.t -> 41 51 env:(string -> OpamVariable.variable_contents option) ->

+1 -1

day11/solver/test/dune

reviewed

··· 1 1 (test 2 2 (name test_solver) 3 3 - (libraries day11_solver day11_graph day11_test_util alcotest astring bos fpath opam-format yojson)) 3 3 + (libraries day11_solver day11_doc day11_graph day11_test_util alcotest astring bos fpath opam-format yojson)) 4 4 5 5 (executable 6 6 (name test_doc_deps)

+100

day11/solver/test/test_solver.ml

reviewed

··· 143 143 Alcotest.(check bool) "no solution" 144 144 true (Result.is_error result) 145 145 146 146 + (* ── Two-graph doc deps tests ────────────────────────────────────── *) 147 147 + 148 148 + (* Solve for odig, then check that odoc needs separate compile/link 149 149 + because its x-extra-doc-deps add deps in the link graph that are 150 150 + absent in the compile graph. 151 151 + 152 152 + odig depends on odoc, and odoc.3.1.0 has: 153 153 + x-extra-doc-deps: ["odoc-driver" "sherlodoc" "odig"] 154 154 + These appear in the solution as extra roots. recompute_with_post 155 155 + adds them as deps of odoc in the link graph, so odoc's deps differ 156 156 + between compile and link graphs → needs separate link. *) 157 157 + let test_odig_odoc_needs_separate_link () = 158 158 + let opam_repo = opam_repository () in 159 159 + let packages, _store, _commit = 160 160 + Git_packages.of_opam_repository opam_repo in 161 161 + let env = Opam_env.std_env 162 162 + ~arch:"x86_64" ~os:"linux" ~os_distribution:"debian" 163 163 + ~os_family:"debian" ~os_version:"12" () in 164 164 + let target = pkg "odig.0.0.9" in 165 165 + let result = Solve.solve ~packages ~env target in 166 166 + match result with 167 167 + | Error diag -> 168 168 + Alcotest.fail (Printf.sprintf "Solve failed: %s" diag) 169 169 + | Ok compile_deps -> 170 170 + let link_deps = Solve.recompute_with_post ~packages ~env compile_deps in 171 171 + (* odoc should be in the solution *) 172 172 + let odoc_pkg = OpamPackage.Map.fold (fun p _ acc -> 173 173 + if OpamPackage.Name.to_string (OpamPackage.name p) = "odoc" 174 174 + then Some p else acc 175 175 + ) compile_deps None in 176 176 + (match odoc_pkg with 177 177 + | None -> Alcotest.fail "odoc not in solution for odig" 178 178 + | Some odoc -> 179 179 + let separate = Day11_doc.Doc_deps.needs_separate_link 180 180 + ~compile_deps ~link_deps odoc in 181 181 + Alcotest.(check bool) "odoc needs separate link" true separate; 182 182 + (* odig itself should NOT need separate link 183 183 + (it has no x-extra-doc-deps or {post} deps) *) 184 184 + let odig_separate = Day11_doc.Doc_deps.needs_separate_link 185 185 + ~compile_deps ~link_deps target in 186 186 + Alcotest.(check bool) "odig single phase" false odig_separate) 187 187 + 188 188 + (* recompute_with_post should produce a superset of the compile deps 189 189 + for packages with x-extra-doc-deps, and identical deps for packages 190 190 + without. Verify this structurally for the odig solution. *) 191 191 + let test_recompute_with_post () = 192 192 + let opam_repo = opam_repository () in 193 193 + let packages, _store, _commit = 194 194 + Git_packages.of_opam_repository opam_repo in 195 195 + let env = Opam_env.std_env 196 196 + ~arch:"x86_64" ~os:"linux" ~os_distribution:"debian" 197 197 + ~os_family:"debian" ~os_version:"12" () in 198 198 + let target = pkg "odig.0.0.9" in 199 199 + let result = Solve.solve ~packages ~env target in 200 200 + match result with 201 201 + | Error diag -> 202 202 + Alcotest.fail (Printf.sprintf "Solve failed: %s" diag) 203 203 + | Ok compile_deps -> 204 204 + let link_deps = Solve.recompute_with_post ~packages ~env compile_deps in 205 205 + (* Same set of packages in both graphs *) 206 206 + let compile_pkgs = OpamPackage.Map.fold (fun p _ acc -> 207 207 + OpamPackage.Set.add p acc) compile_deps OpamPackage.Set.empty in 208 208 + let link_pkgs = OpamPackage.Map.fold (fun p _ acc -> 209 209 + OpamPackage.Set.add p acc) link_deps OpamPackage.Set.empty in 210 210 + Alcotest.(check bool) "same package set" 211 211 + true (OpamPackage.Set.equal compile_pkgs link_pkgs); 212 212 + (* For each package, link deps should be a superset of compile deps *) 213 213 + OpamPackage.Map.iter (fun p compile_set -> 214 214 + let link_set = OpamPackage.Map.find p link_deps in 215 215 + let missing = OpamPackage.Set.diff compile_set link_set in 216 216 + if not (OpamPackage.Set.is_empty missing) then 217 217 + Alcotest.fail (Printf.sprintf "%s: compile dep %s not in link deps" 218 218 + (OpamPackage.to_string p) 219 219 + (OpamPackage.to_string (OpamPackage.Set.choose missing))) 220 220 + ) compile_deps; 221 221 + (* odoc specifically should have extra link deps from x-extra-doc-deps *) 222 222 + let odoc_pkg = OpamPackage.Map.fold (fun p _ acc -> 223 223 + if OpamPackage.Name.to_string (OpamPackage.name p) = "odoc" 224 224 + then Some p else acc 225 225 + ) compile_deps None in 226 226 + (match odoc_pkg with 227 227 + | None -> Alcotest.fail "odoc not in solution" 228 228 + | Some odoc -> 229 229 + let compile_set = OpamPackage.Map.find odoc compile_deps in 230 230 + let link_set = OpamPackage.Map.find odoc link_deps in 231 231 + let extra = OpamPackage.Set.diff link_set compile_set in 232 232 + let extra_names = OpamPackage.Set.fold (fun p acc -> 233 233 + OpamPackage.Name.to_string (OpamPackage.name p) :: acc 234 234 + ) extra [] in 235 235 + Alcotest.(check bool) "odoc has extra link deps" 236 236 + true (List.length extra_names > 0); 237 237 + (* odig is in x-extra-doc-deps and not a regular dep of odoc, 238 238 + so it should appear as an extra link dep *) 239 239 + Alcotest.(check bool) "extra includes odig" 240 240 + true (List.mem "odig" extra_names)) 241 241 + 146 242 (* ── Test registration ───────────────────────────────────────────── *) 147 243 148 244 let () = ··· 172 268 [ 173 269 Alcotest.test_case "solve astring" `Slow test_solve_astring; 174 270 Alcotest.test_case "solve nonexistent" `Slow test_solve_nonexistent; 271 271 + Alcotest.test_case "odig: odoc needs separate link" `Slow 272 272 + test_odig_odoc_needs_separate_link; 273 273 + Alcotest.test_case "recompute_with_post superset" `Slow 274 274 + test_recompute_with_post; 175 275 ] ); 176 276 ]

+527

docs/superpowers/plans/2026-03-23-multi-opam-repository.md

reviewed

··· 1 1 + # Multi Opam-Repository Support Implementation Plan 2 2 + 3 3 + > **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking. 4 4 + 5 5 + **Goal:** Support multiple opam repositories (e.g. upstream + oxcaml overlay + local fixes) layered in priority order, replacing the current single `--opam-repository` flag. 6 6 + 7 7 + **Architecture:** Repositories are loaded in order and overlaid using the existing `Git_packages.of_commit ~super` mechanism — later repos override earlier ones. The merged `Git_packages.t` flows through the solver, DAG, and build layers unchanged. Worker processes receive multiple `--repo PATH:SHA` pairs. The incremental solver keys its cache by a composite hash of all repo HEADs. The base image includes all repos via `opam repository add` but repo priority in the container doesn't matter since packages are installed via opam-build from pre-solved solutions. 8 8 + 9 9 + **Tech Stack:** OCaml, cmdliner, ocaml-git, opam-format, Eio 10 10 + 11 11 + --- 12 12 + 13 13 + ## File Structure 14 14 + 15 15 + | File | Action | Responsibility | 16 16 + |------|--------|----------------| 17 17 + | `day11/solver/git_packages.ml` | Modify | Add `of_repositories` that chains multiple repos via `~super` | 18 18 + | `day11/solver/git_packages.mli` | Modify | Export `of_repositories` | 19 19 + | `day11/solver/solver_worker.ml` | Modify | Accept multiple `--repo PATH:SHA` pairs | 20 20 + | `day11/solver/solve.ml` | Modify | `solve_many` takes `repos:(string * string) list` instead of `repo`+`commit` | 21 21 + | `day11/solver/solve.mli` | Modify | Update signature | 22 22 + | `day11/bin/common.ml` | Modify | `setup_solver` takes `string list`, returns repos_with_shas; `opam_repo_term` repeatable | 23 23 + | `day11/bin/cmd_batch.ml` | Modify | Wire multiple repos through solve_many and base image | 24 24 + | `day11/build/base.ml` | Modify | Copy multiple repos, generate multi-repo Dockerfile | 25 25 + | `day11/build/base.mli` | Modify | `opam_repository` becomes `opam_repositories` list | 26 26 + | `day11/benchmark/trial_run.ml` | Modify | Adapt to new APIs (single repo still works) | 27 27 + | `day11/build/test/test_from_scratch.ml` | Modify | Update `Base.build` call | 28 28 + 29 29 + No new files are created. The changes propagate a `string list` where there was previously a `string`, with overlay semantics handled in `Git_packages`. 30 30 + 31 31 + --- 32 32 + 33 33 + ### Task 1: Git_packages — load from multiple repositories 34 34 + 35 35 + The core change. Add a function that opens multiple git repos and layers them with `~super`. 36 36 + 37 37 + **Files:** 38 38 + - Modify: `day11/solver/git_packages.ml` 39 39 + - Modify: `day11/solver/git_packages.mli` 40 40 + 41 41 + - [ ] **Step 1: Add `of_repositories` to git_packages.mli** 42 42 + 43 43 + ```ocaml 44 44 + val of_repositories : (string * string option) list -> 45 45 + t * (string * string) list 46 46 + (** [of_repositories repos] loads packages from multiple repositories. 47 47 + Each element is [(repo_path, commit_sha_opt)]. Repositories are 48 48 + layered in order — later repos override earlier ones. 49 49 + Returns the merged package index and a list of 50 50 + [(repo_path, commit_sha_hex)] pairs for passing to workers. *) 51 51 + ``` 52 52 + 53 53 + Add this after `of_opam_repository` in the `.mli`. 54 54 + 55 55 + - [ ] **Step 2: Implement `of_repositories` in git_packages.ml** 56 56 + 57 57 + ```ocaml 58 58 + let of_repositories repos = 59 59 + assert (repos <> []); 60 60 + let stores_and_commits = List.map (fun (repo_path, commit_opt) -> 61 61 + let store, head = Git_utils.get_git_repo_store_and_hash repo_path in 62 62 + let commit = match commit_opt with 63 63 + | Some sha -> Git_utils.resolve_commit_in_store store (Some sha) 64 64 + | None -> head 65 65 + in 66 66 + (repo_path, store, commit) 67 67 + ) repos in 68 68 + let packages = List.fold_left (fun super (_, store, commit) -> 69 69 + of_commit ~super store commit 70 70 + ) empty stores_and_commits in 71 71 + let repos_with_shas = List.map (fun (repo_path, _store, commit) -> 72 72 + (repo_path, Store.Hash.to_hex commit) 73 73 + ) stores_and_commits in 74 74 + (packages, repos_with_shas) 75 75 + ``` 76 76 + 77 77 + This returns `(repo_path, sha_hex_string)` pairs directly, avoiding the need to shell out to `git rev-parse HEAD` separately. 78 78 + 79 79 + - [ ] **Step 3: Build and verify** 80 80 + 81 81 + Run: `opam exec -- dune build day11/solver/ 2>&1 | head -5` 82 82 + Expected: Clean build, no errors. 83 83 + 84 84 + - [ ] **Step 4: Commit** 85 85 + 86 86 + ```bash 87 87 + git add day11/solver/git_packages.ml day11/solver/git_packages.mli 88 88 + git commit -m "Add Git_packages.of_repositories for multi-repo overlay" 89 89 + ``` 90 90 + 91 91 + --- 92 92 + 93 93 + ### Task 2: Solver worker — accept multiple repos 94 94 + 95 95 + The solver_worker binary needs to accept multiple repos. Use a combined `--repo PATH:SHA` format to avoid fragile positional pairing of separate flags. 96 96 + 97 97 + **Files:** 98 98 + - Modify: `day11/solver/solver_worker.ml` 99 99 + 100 100 + - [ ] **Step 1: Replace single repo/commit with list** 101 101 + 102 102 + Replace the `repo` and `commit` refs with a `repos` accumulator that parses `PATH:SHA` format: 103 103 + 104 104 + ```ocaml 105 105 + let repos = ref [] 106 106 + 107 107 + let spec = [ 108 108 + "--repo", Arg.String (fun s -> 109 109 + match String.split_on_char ':' s with 110 110 + | [path] -> repos := (path, None) :: !repos 111 111 + | path :: rest -> 112 112 + let sha = String.concat ":" rest in 113 113 + repos := (path, Some sha) :: !repos 114 114 + | [] -> ()), 115 115 + "PATH:SHA opam-repository path with optional commit SHA \ 116 116 + (repeatable, layered in order)"; 117 117 + (* remove old --commit flag *) 118 118 + (* ... rest unchanged ... *) 119 119 + ] 120 120 + ``` 121 121 + 122 122 + Note: the SHA split handles the case where PATH contains no colons (just a path, HEAD assumed) and the case where it does (PATH:SHA). 123 123 + 124 124 + - [ ] **Step 2: Build repo list and load packages** 125 125 + 126 126 + Replace the store/packages loading block with: 127 127 + 128 128 + ```ocaml 129 129 + let repo_list = List.rev !repos in 130 130 + if repo_list = [] then begin 131 131 + Printf.eprintf "Usage: solver_worker --repo PATH[:SHA] ... PKG1 PKG2\n"; 132 132 + exit 1 133 133 + end; 134 134 + let packages, _repos_with_shas = 135 135 + Day11_solver.Git_packages.of_repositories repo_list in 136 136 + ``` 137 137 + 138 138 + Remove the old `store, head` and `commit_hash` bindings. 139 139 + 140 140 + - [ ] **Step 3: Build and verify** 141 141 + 142 142 + Run: `opam exec -- dune build day11/solver/solver_worker.exe 2>&1 | head -5` 143 143 + Expected: Clean build. 144 144 + 145 145 + - [ ] **Step 4: Quick smoke test** 146 146 + 147 147 + Run: `opam exec -- dune exec day11/solver/solver_worker.exe -- --repo ~/opam-repository astring.0.8.5 2>&1 | head -c 100` 148 148 + Expected: JSON output starting with `{"package":"astring.0.8.5","solution":{` 149 149 + 150 150 + - [ ] **Step 5: Commit** 151 151 + 152 152 + ```bash 153 153 + git add day11/solver/solver_worker.ml 154 154 + git commit -m "Solver worker accepts multiple --repo PATH:SHA pairs" 155 155 + ``` 156 156 + 157 157 + --- 158 158 + 159 159 + ### Task 3: solve_many — pass multiple repos to workers 160 160 + 161 161 + Change `solve_many` from `~repo:string ~commit:string` to `~repos:(string * string) list` where each element is `(repo_path, commit_sha)`. 162 162 + 163 163 + **Files:** 164 164 + - Modify: `day11/solver/solve.ml` 165 165 + - Modify: `day11/solver/solve.mli` 166 166 + 167 167 + - [ ] **Step 1: Update solve_many signature in .mli** 168 168 + 169 169 + ```ocaml 170 170 + val solve_many : 171 171 + packages:Git_packages.t -> 172 172 + env:(string -> OpamVariable.variable_contents option) -> 173 173 + ?constraints:OpamFormula.version_constraint OpamTypes.name_map -> 174 174 + ?prefer_oldest:bool -> 175 175 + ?ocaml_version:OpamPackage.t -> 176 176 + np:int -> 177 177 + repos:(string * string) list -> 178 178 + OpamPackage.t list -> 179 179 + (OpamPackage.t 180 180 + * (Day11_graph.Graph.solution * OpamPackage.Name.Set.t, 181 181 + string * OpamPackage.Name.Set.t) result) list 182 182 + (** [solve_many ~packages ~env ~np ~repos targets] solves all 183 183 + [targets] in parallel by spawning [np] solver_worker processes. 184 184 + [repos] is a list of [(repo_path, commit_sha)] pairs passed 185 185 + to each worker as [--repo PATH:SHA] arguments. *) 186 186 + ``` 187 187 + 188 188 + - [ ] **Step 2: Update solve_many implementation** 189 189 + 190 190 + Change the worker argument construction. The `np <= 1` path uses `packages` directly (already the merged view, no store opening needed). The parallel path passes repos to workers: 191 191 + 192 192 + ```ocaml 193 193 + let repo_args = List.concat_map (fun (repo, sha) -> 194 194 + [ "--repo"; repo ^ ":" ^ sha ] 195 195 + ) repos in 196 196 + let args = Array.of_list ( 197 197 + [ worker_bin ] @ repo_args @ 198 198 + [ "--output"; output_file ] @ 199 199 + ocaml_args @ 200 200 + List.map OpamPackage.to_string batch) in 201 201 + ``` 202 202 + 203 203 + Remove any store-opening code from the `np <= 1` branch if present. 204 204 + 205 205 + - [ ] **Step 3: Build** 206 206 + 207 207 + Run: `opam exec -- dune build day11/solver/ 2>&1 | head -5` 208 208 + Expected: Clean build. 209 209 + 210 210 + - [ ] **Step 4: Commit** 211 211 + 212 212 + ```bash 213 213 + git add day11/solver/solve.ml day11/solver/solve.mli 214 214 + git commit -m "solve_many takes repos list instead of single repo+commit" 215 215 + ``` 216 216 + 217 217 + --- 218 218 + 219 219 + ### Task 4: common.ml and cmd_batch.ml — wire it all together 220 220 + 221 221 + Do these together to keep the build compiling between commits. 222 222 + 223 223 + **Files:** 224 224 + - Modify: `day11/bin/common.ml` 225 225 + - Modify: `day11/bin/cmd_batch.ml` 226 226 + 227 227 + - [ ] **Step 1: Make opam_repo_term repeatable in common.ml** 228 228 + 229 229 + ```ocaml 230 230 + let opam_repo_term = 231 231 + let doc = "Path to opam-repository (repeatable, layered in order — \ 232 232 + later repos override earlier ones)" in 233 233 + Arg.(non_empty & opt_all string [] & info [ "opam-repository" ] ~docv:"DIR" ~doc) 234 234 + ``` 235 235 + 236 236 + - [ ] **Step 2: Update setup_solver to take a list and return repos_with_shas** 237 237 + 238 238 + ```ocaml 239 239 + let setup_solver ?(arch = "x86_64") ?(os = "linux") 240 240 + ?(os_distribution = "debian") ?(os_family = "debian") 241 241 + ?(os_version = "12") opam_repositories = 242 242 + let repos_with_heads = List.map (fun repo -> 243 243 + (repo, None) 244 244 + ) opam_repositories in 245 245 + let git_packages, repos_with_shas = 246 246 + Day11_solver.Git_packages.of_repositories repos_with_heads in 247 247 + (* ocaml-git corrupts Bos's temp dir setting — reset it *) 248 248 + Bos.OS.Dir.set_default_tmp (Fpath.v (Filename.get_temp_dir_name ())); 249 249 + let opam_env = Day11_solver.Opam_env.std_env 250 250 + ~arch ~os ~os_distribution ~os_family ~os_version () in 251 251 + (git_packages, repos_with_shas, opam_env) 252 252 + ``` 253 253 + 254 254 + Note: `repos_with_shas` is `(string * string) list` — the SHAs come from `of_repositories` which extracts them from the git stores, avoiding a TOCTOU race from shelling out to `git rev-parse HEAD` separately. 255 255 + 256 256 + Remove the `get_head_shas` helper (no longer needed). 257 257 + 258 258 + - [ ] **Step 3: Update cmd_batch.ml — run signature and setup** 259 259 + 260 260 + ```ocaml 261 261 + let run cache_dir opam_repositories np arch os_distribution os_version 262 262 + with_doc ocaml_version_str odoc_repo patches_dir opam_build_repo target = 263 263 + ... 264 264 + let git_packages, repos_with_shas, opam_env = 265 265 + Common.setup_solver opam_repositories in 266 266 + let find_opam = Day11_solver.Git_packages.find_package git_packages in 267 267 + ``` 268 268 + 269 269 + - [ ] **Step 4: Update find_latest_versions to use git_packages map** 270 270 + 271 271 + Instead of reading the filesystem `packages/` directory (which may not match the git commit), enumerate from the merged `git_packages` directly. This is simpler and correct for multi-repo: 272 272 + 273 273 + ```ocaml 274 274 + let find_latest_versions git_packages = 275 275 + (* Enumerate all package names from the merged git_packages map *) 276 276 + let all_names = Day11_solver.Git_packages.all_names git_packages in 277 277 + List.filter_map (fun name -> 278 278 + let versions = Day11_solver.Git_packages.get_versions git_packages name in 279 279 + let non_avoided = 280 280 + OpamPackage.Version.Map.filter (fun _v opam -> 281 281 + not (OpamFile.OPAM.has_flag Pkgflag_AvoidVersion opam) 282 282 + ) versions 283 283 + in 284 284 + let versions = if OpamPackage.Version.Map.is_empty non_avoided 285 285 + then versions else non_avoided in 286 286 + match OpamPackage.Version.Map.max_binding_opt versions with 287 287 + | Some (v, _) -> Some (OpamPackage.create name v) 288 288 + | None -> None 289 289 + ) all_names 290 290 + ``` 291 291 + 292 292 + This requires adding `all_names` to `Git_packages` (see step 5). 293 293 + 294 294 + - [ ] **Step 5: Add `all_names` to git_packages** 295 295 + 296 296 + In `git_packages.ml`: 297 297 + ```ocaml 298 298 + let all_names (t : t) = 299 299 + OpamPackage.Name.Map.fold (fun name _ acc -> name :: acc) t [] 300 300 + ``` 301 301 + 302 302 + In `git_packages.mli`: 303 303 + ```ocaml 304 304 + val all_names : t -> OpamPackage.Name.t list 305 305 + (** [all_names t] returns all package names in the index. *) 306 306 + ``` 307 307 + 308 308 + - [ ] **Step 6: Update solve_many call and solution cache key** 309 309 + 310 310 + ```ocaml 311 311 + let results = Day11_solver.Solve.solve_many 312 312 + ~packages:git_packages ~env:opam_env ?ocaml_version 313 313 + ~np ~repos:repos_with_shas need_solve in 314 314 + ``` 315 315 + 316 316 + Cache key from all repo SHAs (use full SHAs for correctness): 317 317 + 318 318 + ```ocaml 319 319 + let cache_key = 320 320 + let shas = List.map snd repos_with_shas in 321 321 + Digest.string (String.concat "\n" shas) |> Digest.to_hex 322 322 + |> fun s -> String.sub s 0 12 323 323 + in 324 324 + let solutions_dir = Fpath.(cache_dir / "solutions" / cache_key) in 325 325 + ``` 326 326 + 327 327 + Note: this changes the cache key format from single-SHA prefix to a digest, so existing caches from single-repo runs will not be found. This is acceptable — the user rebuilds the solution cache on first run. 328 328 + 329 329 + - [ ] **Step 7: Update base image build call** 330 330 + 331 331 + ```ocaml 332 332 + let base = Day11_build.Base.build env ~cache_dir 333 333 + ~os_distribution ~os_version ~arch 334 334 + ~opam_repositories:(List.map Fpath.v opam_repositories) 335 335 + ~uid ~gid ?opam_build_repo () 336 336 + |> Result.get_ok in 337 337 + ``` 338 338 + 339 339 + - [ ] **Step 8: Build and fix remaining type errors** 340 340 + 341 341 + Run: `opam exec -- dune build day11/ 2>&1 | head -20` 342 342 + Fix any remaining callers. 343 343 + 344 344 + - [ ] **Step 9: Commit** 345 345 + 346 346 + ```bash 347 347 + git add day11/bin/common.ml day11/bin/cmd_batch.ml \ 348 348 + day11/solver/git_packages.ml day11/solver/git_packages.mli 349 349 + git commit -m "Wire multiple opam repositories through CLI, solver, and batch" 350 350 + ``` 351 351 + 352 352 + --- 353 353 + 354 354 + ### Task 5: Base image — multi-repo Dockerfile 355 355 + 356 356 + The base image needs all repos available for opam to resolve depexts and system dependencies. Repo priority in the container doesn't affect builds (opam-build installs from pre-solved solutions), but having all repos ensures `opam source` and depext resolution work correctly. 357 357 + 358 358 + **Files:** 359 359 + - Modify: `day11/build/base.ml` 360 360 + - Modify: `day11/build/base.mli` 361 361 + 362 362 + - [ ] **Step 1: Update base.mli** 363 363 + 364 364 + ```ocaml 365 365 + val build : 366 366 + Eio_unix.Stdenv.base -> 367 367 + cache_dir:Fpath.t -> 368 368 + os_distribution:string -> 369 369 + os_version:string -> 370 370 + arch:string -> 371 371 + opam_repositories:Fpath.t list -> 372 372 + uid:int -> 373 373 + gid:int -> 374 374 + ?opam_build_repo:Fpath.t -> 375 375 + unit -> 376 376 + (Day11_layer.Layer_type.base, [> Rresult.R.msg ]) result 377 377 + ``` 378 378 + 379 379 + - [ ] **Step 2: Update generate_dockerfile** 380 380 + 381 381 + Accept `repo_count` and generate COPY + `opam repository add` for each: 382 382 + 383 383 + ```ocaml 384 384 + let generate_dockerfile ~os_distribution ~os_version ~arch ~uid ~gid 385 385 + ~local_opam_build ~repo_count = 386 386 + ... 387 387 + (* COPY all repos *) 388 388 + let copy_repos = List.init repo_count (fun i -> 389 389 + copy ~chown:(Printf.sprintf "%i:%i" uid gid) 390 390 + ~src:[ Printf.sprintf "opam-repository-%d" i ] 391 391 + ~dst:(Printf.sprintf "/home/opam/opam-repository-%d" i) () 392 392 + ) |> List.fold_left (@@) empty in 393 393 + ... 394 394 + @@ copy_repos 395 395 + @@ user "%i:%i" uid gid 396 396 + @@ workdir "/home/opam" 397 397 + (* Init with first repo, add the rest *) 398 398 + @@ run "opam init -k local -a /home/opam/opam-repository-0 --bare --disable-sandboxing -y" 399 399 + @@ (List.init (repo_count - 1) (fun i -> 400 400 + let idx = i + 1 in 401 401 + run "opam repository add extra-%d /home/opam/opam-repository-%d --all -k local" idx idx 402 402 + ) |> List.fold_left (@@) empty) 403 403 + @@ run "opam switch create default --empty" 404 404 + ``` 405 405 + 406 406 + - [ ] **Step 3: Update build function to copy all repos** 407 407 + 408 408 + ```ocaml 409 409 + List.iteri (fun i opam_repository -> 410 410 + let repo_dest = Fpath.(temp_dir / 411 411 + Printf.sprintf "opam-repository-%d" i) in 412 412 + match Day11_exec.Tree.copy ~source:opam_repository ~target:repo_dest with 413 413 + | Ok () -> () 414 414 + | Error (`Msg e) -> 415 415 + Log.err (fun m -> m "Failed to copy opam-repository %d: %s" i e) 416 416 + ) opam_repositories; 417 417 + ``` 418 418 + 419 419 + Pass `~repo_count:(List.length opam_repositories)` to `generate_dockerfile`. 420 420 + 421 421 + - [ ] **Step 4: Build** 422 422 + 423 423 + Run: `opam exec -- dune build day11/ 2>&1 | head -10` 424 424 + 425 425 + - [ ] **Step 5: Fix callers** 426 426 + 427 427 + Update `day11/build/test/test_from_scratch.ml` to pass a single-element list: 428 428 + ```ocaml 429 429 + let base = Base.build env ~cache_dir 430 430 + ~os_distribution ~os_version ~arch 431 431 + ~opam_repositories:[Fpath.v opam_repository] ~uid:1000 ~gid:1000 () 432 432 + |> ok_or_fail "base build" in 433 433 + ``` 434 434 + 435 435 + - [ ] **Step 6: Commit** 436 436 + 437 437 + ```bash 438 438 + git add day11/build/base.ml day11/build/base.mli \ 439 439 + day11/build/test/test_from_scratch.ml 440 440 + git commit -m "Base image supports multiple opam repositories" 441 441 + ``` 442 442 + 443 443 + --- 444 444 + 445 445 + ### Task 6: trial_run and other callers — adapt to multi-repo API 446 446 + 447 447 + Adapt remaining callers. The trial_run iterates over commits of a single repo; keep that behavior but use the new APIs. 448 448 + 449 449 + **Files:** 450 450 + - Modify: `day11/benchmark/trial_run.ml` 451 451 + - Modify: any other files with compile errors 452 452 + 453 453 + - [ ] **Step 1: Update trial_run** 454 454 + 455 455 + - `Base.build` → pass `~opam_repositories:[Fpath.v opam_repository]` 456 456 + - `solve_many` → pass `~repos:[(opam_repository, commit_sha)]` 457 457 + - `Git_packages.of_commit` calls for per-commit loading remain unchanged (single store, used only within the trial loop) 458 458 + 459 459 + - [ ] **Step 2: Build everything** 460 460 + 461 461 + Run: `opam exec -- dune build day11/ 2>&1 | head -20` 462 462 + Fix any remaining callers (benchmark_builds.ml, benchmark_docs.ml, test files). 463 463 + 464 464 + - [ ] **Step 3: Commit** 465 465 + 466 466 + ```bash 467 467 + git add day11/benchmark/trial_run.ml 468 468 + # add any other fixed files 469 469 + git commit -m "Adapt trial_run and remaining callers to multi-repo APIs" 470 470 + ``` 471 471 + 472 472 + --- 473 473 + 474 474 + ### Task 7: Full build, tests, and smoke test 475 475 + 476 476 + - [ ] **Step 1: Full build** 477 477 + 478 478 + Run: `opam exec -- dune build day11/ 2>&1` 479 479 + Expected: Clean, no warnings. 480 480 + 481 481 + - [ ] **Step 2: Run all tests** 482 482 + 483 483 + Run: `opam exec -- dune test day11/ 2>&1` 484 484 + Verify no regressions. 485 485 + 486 486 + - [ ] **Step 3: Verify CLI help** 487 487 + 488 488 + Run: `opam exec -- dune exec -- day11 batch --help 2>&1 | grep opam-repository` 489 489 + Expected: Shows `--opam-repository` with description mentioning "repeatable". 490 490 + 491 491 + - [ ] **Step 4: Quick smoke test with single repo (backward compat)** 492 492 + 493 493 + Run: `opam exec -- dune exec -- day11 results --cache-dir /tmp/day11-trial` 494 494 + Expected: Works as before. 495 495 + 496 496 + - [ ] **Step 5: Final commit if needed** 497 497 + 498 498 + ```bash 499 499 + git add -A day11/ 500 500 + git commit -m "Multi opam-repository support: final cleanup" 501 501 + ``` 502 502 + 503 503 + --- 504 504 + 505 505 + ## Usage After Implementation 506 506 + 507 507 + ```bash 508 508 + # Three repos: upstream base, ox overlay, local fixes 509 509 + dune exec -- day11 batch \ 510 510 + --opam-repository ~/opam-repository \ 511 511 + --opam-repository ~/oxcaml-opam-repository \ 512 512 + --opam-repository ~/local-fixes \ 513 513 + --cache-dir ~/cache-day11-ox \ 514 514 + --ocaml-version ocaml-variants.5.2.0+ox \ 515 515 + --with-doc --odoc-repo ~/odoc \ 516 516 + -j 16 517 517 + ``` 518 518 + 519 519 + Later repos override earlier ones. A local fix in `~/local-fixes/packages/ppxlib_ast/ppxlib_ast.0.33.0+ox/opam` with tightened `sexplib0 >= v0.18` would override the broken constraint from the ox overlay. 520 520 + 521 521 + ## Design Notes 522 522 + 523 523 + - **Repo priority in base image vs solver:** The solver overlay order (later wins) is authoritative. The base image's opam repo ordering doesn't matter for builds since `opam-build` installs from pre-solved dependency lists. The repos are in the base image only for `opam source` downloads and depext resolution. 524 524 + 525 525 + - **Solution cache invalidation:** Changing from single-SHA keys to a digest of all SHAs means existing single-repo caches won't be found. First run with the new code re-solves everything. Subsequent runs cache-hit normally. 526 526 + 527 527 + - **Incremental solver:** `reuse_solutions` is repo-agnostic — it takes `changed_packages : OpamPackage.Name.Set.t`. The caller (trial_run) computes diffs per-repo and unions them. No change to the incremental solver itself.

+246

docs/superpowers/specs/2026-03-31-odoc-store-design.md

reviewed

··· 1 1 + # Odoc Store: Bind-Mount Based Doc Generation 2 2 + 3 3 + ## Problem 4 4 + 5 5 + Doc generation (compile and link phases) currently runs through `Build_layer.build`, 6 6 + which stacks dependency layers via overlayfs. For compile, this means stacking all 7 7 + transitive build deps even though odoc only needs the package's own build layer. 8 8 + For link, it merges 200+ layers. Timing data shows compile containers spend 30% of 9 9 + time on merge overhead, and link containers spend 38%. 10 10 + 11 11 + The root cause: the layer-stacking model is wrong for doc generation. Compile and 12 12 + link produce output in disjoint per-package directories. There is no reason to 13 13 + stack these as overlay layers. 14 14 + 15 15 + ## Actual odoc_driver_voodoo I/O 16 16 + 17 17 + Verified from real container output: 18 18 + 19 19 + **Compile (`--actions compile-only`) writes:** 20 20 + - `/home/opam/odoc-out/p/<Name>/<ver>/doc/<Lib>/*.odoc` — compiled doc units 21 21 + - `/home/opam/odoc-out/p/<Name>/<ver>/__odoc_partial.m` — partial marker 22 22 + - `/home/opam/_mld/p/<Name>/<ver>/...` — generated mld index pages (intermediate) 23 23 + 24 24 + **Compile reads** (from deps): 25 25 + - `/home/opam/odoc-out/p/<DepName>/<DepVer>/doc/...` — `.odoc` files from deps 26 26 + 27 27 + **Link (`--actions link-and-gen`) writes:** 28 28 + - `/home/opam/odoc-out/p/<Name>/<ver>/doc/*.odocl` — linked units 29 29 + - `/home/opam/html/p/<Name>/<ver>/doc/...` — HTML output 30 30 + - `/home/opam/_mld/...`, `/home/opam/_index/...`, `/home/opam/html/fonts/` — intermediate 31 31 + 32 32 + **Link reads:** 33 33 + - `/home/opam/odoc-out/p/<DepName>/<DepVer>/doc/...` — `.odoc` files from universe 34 34 + 35 35 + The only cross-package data dependency is the `.odoc` files in `odoc-out/`. Everything 36 36 + else is either intermediate or final output. The tool discovers dependencies by 37 37 + traversing the `odoc-out/` directory tree. 38 38 + 39 39 + Blessed packages use `p/<Name>/<ver>/`, non-blessed use `u/<universe>/<Name>/<ver>/`. 40 40 + 41 41 + ## Design 42 42 + 43 43 + Replace layer stacking for doc phases with per-package bind mounts. A shared store 44 44 + holds `.odoc` output; each container gets RO mounts of dependency `.odoc` dirs and 45 45 + a RW mount for its own output. The container overlay is always minimal: base + one 46 46 + build layer. 47 47 + 48 48 + ### New module: `Day11_doc.Odoc_store` 49 49 + 50 50 + A store rooted at `<os_dir>/odoc-store/` with two subtrees: 51 51 + 52 52 + ``` 53 53 + odoc-store/ 54 54 + odoc-out/p/<Name>/<version>/doc/... (blessed .odoc) 55 55 + odoc-out/u/<universe>/<Name>/<version>/doc/... (non-blessed .odoc) 56 56 + html/p/<Name>/<version>/doc/... (blessed HTML) 57 57 + html/u/<universe>/<Name>/<version>/doc/... (non-blessed HTML) 58 58 + ``` 59 59 + 60 60 + #### Types 61 61 + 62 62 + ```ocaml 63 63 + type t 64 64 + (** The store, rooted at a directory under os_dir. *) 65 65 + 66 66 + type pkg_loc = { 67 67 + pkg : OpamPackage.t; 68 68 + universe : string; 69 69 + blessed : bool; 70 70 + } 71 71 + (** Location info for a package in the store. Determines the path prefix 72 72 + (p/<Name>/<ver> vs u/<universe>/<Name>/<ver>). *) 73 73 + ``` 74 74 + 75 75 + #### Interface 76 76 + 77 77 + ```ocaml 78 78 + val create : os_dir:Fpath.t -> t 79 79 + 80 80 + val rel_path : pkg_loc -> Fpath.t 81 81 + (** Path fragment: [p/Foo/1.0] or [u/abc123/Foo/1.0]. *) 82 82 + 83 83 + val compile_mounts : 84 84 + t -> pkg_loc -> deps:pkg_loc list -> 85 85 + Day11_container.Mount.t list * Fpath.t 86 86 + (** Returns (mounts, rw_temp_dir). 87 87 + 88 88 + Mounts: 89 89 + - For each dep in [deps] whose odoc-out dir exists in the store: 90 90 + RO bind mount of [store/odoc-out/<dep_rel_path>/] 91 91 + at [/home/opam/odoc-out/<dep_rel_path>/] inside the container. 92 92 + - RW bind mount of a fresh temp dir 93 93 + at [/home/opam/odoc-out/<pkg_rel_path>/] inside the container. 94 94 + 95 95 + The temp dir is where the compile output lands. Caller must 96 96 + [commit_compile] on success or clean up the temp dir on failure. *) 97 97 + 98 98 + val link_mounts : 99 99 + t -> pkg_loc -> universe_pkgs:pkg_loc list -> 100 100 + Day11_container.Mount.t list * Fpath.t 101 101 + (** Returns (mounts, rw_temp_dir). 102 102 + 103 103 + Mounts: 104 104 + - For each package in [universe_pkgs] whose odoc-out dir exists: 105 105 + RO bind mount of [store/odoc-out/<pkg_rel_path>/] 106 106 + at [/home/opam/odoc-out/<pkg_rel_path>/]. 107 107 + This includes the package's own compile output. 108 108 + - RW bind mount of a fresh temp dir 109 109 + at [/home/opam/html/<pkg_rel_path>/] inside the container. 110 110 + 111 111 + For link, odoc-out is RO (we discard .odocl files — they land in the 112 112 + overlay upper which is discarded). The temp dir captures HTML output. 113 113 + Caller must [commit_link] on success or clean up on failure. *) 114 114 + 115 115 + val commit_compile : t -> pkg_loc -> temp_dir:Fpath.t -> unit 116 116 + val commit_link : t -> pkg_loc -> temp_dir:Fpath.t -> unit 117 117 + (** Atomically move temp dir to [store/odoc-out/<rel_path>/] or 118 118 + [store/html/<rel_path>/]. Uses rename(2) — temp dir MUST be 119 119 + created on the same filesystem as the store (use [Odoc_store] 120 120 + for temp dir creation, not [Bos.OS.Dir.tmp]). *) 121 121 + 122 122 + val is_compiled : t -> pkg_loc -> bool 123 123 + val is_linked : t -> pkg_loc -> bool 124 124 + (** Directory existence checks on the store. *) 125 125 + ``` 126 126 + 127 127 + ### Container setup 128 128 + 129 129 + Both compile and link containers: 130 130 + 131 131 + 1. **Overlay:** base + `build_dir ~os_dir node` — just 2 lower layers. 132 132 + Always under the 4096-byte overlayfs lowerdir limit, so multi-lower 133 133 + is always used and merge overhead is zero. 134 134 + 2. **Bind mounts (always present):** 135 135 + - Doc tool binaries (odoc, odoc-md, odoc_driver_voodoo, sherlodoc) 136 136 + at `/home/opam/doc-tools/bin/` 137 137 + - Prep dir at `/home/opam/prep` 138 138 + 3. **Store mounts** from `compile_mounts` or `link_mounts` 139 139 + 140 140 + Call `Run_in_layers.run` directly, bypassing `Build_layer.build`. 141 141 + Parameters `~base`, `~uid`, `~gid` come from `benv`. 142 142 + The overlay upper dir is discarded after extracting the run result — 143 143 + caller must `sudo rm -rf` the temp dir parent (same as current 144 144 + `Build_layer.build` cleanup pattern). 145 145 + 146 146 + All useful output lands in the RW bind-mounted temp dirs, not the 147 147 + overlay upper. 148 148 + 149 149 + ### Compile container mounts (example: compiling astring.0.8.5) 150 150 + 151 151 + Assuming astring depends on ocaml-base-compiler (blessed): 152 152 + 153 153 + | Type | Host path | Container path | 154 154 + |------|-----------|----------------| 155 155 + | RO | `store/odoc-out/p/ocaml-base-compiler/5.4.1/` | `/home/opam/odoc-out/p/ocaml-base-compiler/5.4.1/` | 156 156 + | RW | `/tmp/day11_odoc_XXXX/` (temp) | `/home/opam/odoc-out/p/astring/0.8.5/` | 157 157 + 158 158 + ### Link container mounts (example: linking astring in 250-pkg universe) 159 159 + 160 160 + | Type | Host path | Container path | 161 161 + |------|-----------|----------------| 162 162 + | RO × ~250 | `store/odoc-out/p/<Dep>/<ver>/` | `/home/opam/odoc-out/p/<Dep>/<ver>/` | 163 163 + | RW | `/tmp/day11_html_XXXX/` (temp) | `/home/opam/html/p/astring/0.8.5/` | 164 164 + 165 165 + ~250 RO bind mounts for link. This may produce a large OCI spec JSON 166 166 + but should work — Linux handles thousands of bind mounts. If it turns 167 167 + out to be a problem, we can batch via a pre-merged directory. 168 168 + 169 169 + ### DAG structure 170 170 + 171 171 + Single unified DAG with three node types: 172 172 + 173 173 + - **build(A)** — unchanged, uses `Build_layer.build` 174 174 + - **compile(A)** — depends on build(A) + compile(dep₁) + compile(dep₂) + ... 175 175 + Compile deps ensure `.odoc` files are committed to the store before A 176 176 + reads them via its RO mounts. 177 177 + - **link(A)** — depends on compile(X) for all X in A's solution universe. 178 178 + Ensures all `.odoc` files are committed before link reads them. 179 179 + 180 180 + Build failures cascade to compile (correct — can't compile without the 181 181 + build) but not across unrelated packages. Link(A) only cascade-fails if 182 182 + compile(A) itself failed. 183 183 + 184 184 + ### Changes to `generate.ml` 185 185 + 186 186 + 1. Create store via `Odoc_store.create ~os_dir` 187 187 + 2. Build a `(OpamPackage.t, pkg_loc) Hashtbl.t` from `prepare_package` 188 188 + results (which already compute `universe` and `blessed`) 189 189 + 3. Compile callback: 190 190 + - Skip if `Odoc_store.is_compiled` (cache hit) 191 191 + - Get dep locs from the pkg_loc hashtable 192 192 + - Call `Odoc_store.compile_mounts` → combine with doc tool + prep mounts 193 193 + - `Run_in_layers.run` with `build_dirs:[build_dir ~os_dir node]`, 194 194 + `~base:benv.base`, `~uid:benv.uid`, `~gid:benv.gid` 195 195 + - Exit 0 → `Odoc_store.commit_compile`; otherwise clean up temp dir 196 196 + - Always: `sudo rm -rf` the overlay temp dir (parent of upper) 197 197 + 4. Link callback: 198 198 + - Skip if `is_linked` or not `is_compiled` 199 199 + - Call `Odoc_store.link_mounts` with universe pkg locs 200 200 + - Same `Run_in_layers.run` pattern 201 201 + - Exit 0 → `Odoc_store.commit_link`, count HTML files from temp dir 202 202 + - Always: clean up overlay temp dir 203 203 + 204 204 + The `compile_results` hashtable is eliminated. The pkg_loc hashtable + 205 205 + store existence checks replace it. 206 206 + 207 207 + ### Cleanup and failure handling 208 208 + 209 209 + - **Temp dir ownership:** `Odoc_store` creates temp dirs (on the same 210 210 + filesystem as the store for atomic rename). The caller is responsible 211 211 + for cleanup on failure via `sudo rm -rf` of the temp dir. 212 212 + - **Overlay upper:** Caller cleans up via `sudo rm -rf` of the temp dir 213 213 + parent returned by `Run_in_layers.run`, same as current pattern. 214 214 + - **Partial output:** On container failure (non-zero exit), the temp dir 215 215 + is cleaned up and nothing is committed to the store. `is_compiled` / 216 216 + `is_linked` remain false. 217 217 + 218 218 + ### What doesn't change 219 219 + 220 220 + - `day11_build` — build phase unchanged 221 221 + - `day11_layer` — layer management unchanged 222 222 + - `Build_layer.build` — still used for build nodes 223 223 + - `Run_in_layers.run` — used as-is, upper discarded 224 224 + - `Prep.create` — unchanged 225 225 + - `Command.odoc_driver_voodoo` — unchanged 226 226 + - Doc tool binary bind mounts — unchanged 227 227 + - Blessing logic — stays in `generate.ml` / `prepare_package` 228 228 + 229 229 + ### Backward compatibility 230 230 + 231 231 + Existing compile/link layers (from old runs) in `os_dir` are ignored. 232 232 + They become dead weight on disk but do not interfere. No migration 233 233 + needed — the store is a new directory alongside the existing cache. 234 234 + 235 235 + ### Expected performance impact 236 236 + 237 237 + Compile containers: base + 1 build layer overlay (always multi-lower), 238 238 + ~5 bind mounts for deps. Zero merge overhead. Fixed overhead drops 239 239 + from ~2s to ~0.2s per compile. 240 240 + 241 241 + Link containers: base + 1 build layer overlay, ~250 RO bind mounts. 242 242 + Zero merge overhead. Fixed overhead drops from ~7s to ~0.2s per link. 243 243 + 244 244 + For the bap-extra benchmark (250 packages): 245 245 + - Compile: ~200s overhead eliminated 246 246 + - Link: ~1500s overhead eliminated