forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
day11: unified solution type, profiles, CLI fixes, doc forward deps
Major changes:
- Rename day11_graph to day11_solution: Graph.solution → Deps.t,
Solve_result.t carries both build_deps and doc_deps, Solution_json → Json
- Solve.solve returns Solve_result.t with both dependency graphs,
eliminating the separate recompute_with_post function
- Fix doc forward deps: link phase now mounts doc_deps (not just
build_deps) so x-extra-doc-deps like odig are available for
cross-referencing in odoc link
- Merge doc_layer into doc library, hide Day11_opam.Deps (inline
get_extra_doc_deps into solver), remove build- prefix from layer dirs
- Profile system: day11 profile create/show/list/delete with persistent
config at ~/.day11/profiles/. All commands take --profile instead of
individual --cache-dir/--os-dir args. Shared cache at ~/.day11/cache/,
per-profile snapshots at ~/.day11/snapshots/
- Snapshot system: point-in-time state of all repos, keyed by hash of
commit SHAs. Solutions, packages, runs stored per-snapshot
- Wire Summary.finish into cmd_batch so status/results/disk tools work.
Fix disk_usage to scan odoc-store. Fix cmd_results to scan run subdirs
- DAG executor stats: separate ok/failed/cascaded/cached counters.
Cascades don't inflate failure count. Cached failures pre-resolve
as Failed (not Ok). Write cascade layer.json with failed_dep
- New day11 build command for single-package builds within a profile
- Public library names (day11.solution, day11.layer, etc.) for odoc docs.
Per-library .mld index pages. Fix load_package_list to accept JSON arrays
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+2783
-1281
+22
day11.opam
+22
day11.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "OCaml package build and documentation system"
4
+
depends: [
5
+
"dune" {>= "3.20"}
6
+
"odoc" {with-doc}
7
+
]
8
+
build: [
9
+
["dune" "subst"] {dev}
10
+
[
11
+
"dune"
12
+
"build"
13
+
"-p"
14
+
name
15
+
"-j"
16
+
jobs
17
+
"@install"
18
+
"@runtest" {with-test}
19
+
"@doc" {with-doc}
20
+
]
21
+
]
22
+
x-maintenance-intent: ["(latest)"]
+10
-10
day11/batch/blessing.ml
+10
-10
day11/batch/blessing.ml
···
7
7
1. Maximize deps_count (richer docs with optional deps resolved)
8
8
2. Maximize revdeps_count (stability: fewer blessing changes) *)
9
9
10
-
let universe_hash_of_deps = Day11_graph.Universe.of_deps
10
+
let universe_hash_of_deps = Day11_solution.Universe.of_deps
11
11
12
12
let compute_blessings
13
-
(solutions : (OpamPackage.t * Day11_graph.Graph.solution) list) =
13
+
(solutions : (OpamPackage.t * Day11_solution.Deps.t) list) =
14
14
(* Expand direct deps → transitive deps for each solution *)
15
15
let solutions =
16
16
List.map (fun (target, sol) ->
17
-
(target, Day11_graph.Graph.transitive_deps sol)
17
+
(target, Day11_solution.Deps.transitive_deps sol)
18
18
) solutions
19
19
in
20
20
(* Step 1: Compute revdeps counts across all solutions *)
···
43
43
) solution None
44
44
in
45
45
let pkg_universes :
46
-
(OpamPackage.t, (Day11_graph.Universe.t * int * int * OpamPackage.Version.t option) list)
46
+
(OpamPackage.t, (Day11_solution.Universe.t * int * int * OpamPackage.Version.t option) list)
47
47
Hashtbl.t = Hashtbl.create 256
48
48
in
49
49
List.iter (fun (_target, trans_deps) ->
···
57
57
let existing =
58
58
try Hashtbl.find pkg_universes pkg with Not_found -> []
59
59
in
60
-
if not (List.exists (fun (h, _, _, _) -> Day11_graph.Universe.equal h uhash) existing)
60
+
if not (List.exists (fun (h, _, _, _) -> Day11_solution.Universe.equal h uhash) existing)
61
61
then
62
62
Hashtbl.replace pkg_universes pkg
63
63
((uhash, deps_count, revdeps_count, compiler_v) :: existing)
···
73
73
| None, Some _ -> -1
74
74
| None, None -> 0
75
75
in
76
-
let blessed_universe : (OpamPackage.t, Day11_graph.Universe.t) Hashtbl.t =
76
+
let blessed_universe : (OpamPackage.t, Day11_solution.Universe.t) Hashtbl.t =
77
77
Hashtbl.create 256
78
78
in
79
79
Hashtbl.iter (fun pkg entries ->
···
94
94
OpamPackage.Map.mapi (fun pkg deps ->
95
95
let uhash = universe_hash_of_deps deps in
96
96
let blessed_uhash = Hashtbl.find blessed_universe pkg in
97
-
Day11_graph.Universe.equal uhash blessed_uhash
97
+
Day11_solution.Universe.equal uhash blessed_uhash
98
98
) trans_deps
99
99
in
100
100
(target, map)
···
106
106
| None -> false
107
107
108
108
let compute_blessed_universes
109
-
(solutions : (OpamPackage.t * Day11_graph.Graph.solution) list) =
109
+
(solutions : (OpamPackage.t * Day11_solution.Deps.t) list) =
110
110
(* Reuse compute_blessings logic — extract blessed universe per package *)
111
111
let blessings = compute_blessings solutions in
112
112
let trans_solutions =
113
113
List.map (fun (target, sol) ->
114
-
(target, Day11_graph.Graph.transitive_deps sol)
114
+
(target, Day11_solution.Deps.transitive_deps sol)
115
115
) solutions
116
116
in
117
-
let blessed : (OpamPackage.t, Day11_graph.Universe.t) Hashtbl.t =
117
+
let blessed : (OpamPackage.t, Day11_solution.Universe.t) Hashtbl.t =
118
118
Hashtbl.create 256
119
119
in
120
120
List.iter (fun (target, map) ->
+4
-4
day11/batch/blessing.mli
+4
-4
day11/batch/blessing.mli
···
5
5
each package's canonical documentation. *)
6
6
7
7
val compute_blessings :
8
-
(OpamPackage.t * Day11_graph.Graph.solution) list ->
8
+
(OpamPackage.t * Day11_solution.Deps.t) list ->
9
9
(OpamPackage.t * bool OpamPackage.Map.t) list
10
10
(** [compute_blessings solutions] returns per-target blessing maps.
11
11
Heuristic: maximize deps_count (richer docs), then revdeps_count
12
12
(stability). A package in only one universe is always blessed. *)
13
13
14
14
val compute_blessed_universes :
15
-
(OpamPackage.t * Day11_graph.Graph.solution) list ->
16
-
(OpamPackage.t, Day11_graph.Universe.t) Hashtbl.t
15
+
(OpamPackage.t * Day11_solution.Deps.t) list ->
16
+
(OpamPackage.t, Day11_solution.Universe.t) Hashtbl.t
17
17
(** [compute_blessed_universes solutions] returns a map from package
18
18
to the universe of its blessed universe. *)
19
19
20
-
val universe_hash_of_deps : OpamPackage.Set.t -> Day11_graph.Universe.t
20
+
val universe_hash_of_deps : OpamPackage.Set.t -> Day11_solution.Universe.t
21
21
(** Compute a universe identifier from a dependency set. *)
22
22
23
23
val is_blessed : bool OpamPackage.Map.t -> OpamPackage.t -> bool
+2
-1
day11/batch/dune
+2
-1
day11/batch/dune
+8
-10
day11/batch/incremental_solver.ml
+8
-10
day11/batch/incremental_solver.ml
···
1
1
type cached_solution = {
2
2
package : OpamPackage.t;
3
-
solution : Day11_graph.Graph.solution;
4
-
examined : OpamPackage.Name.Set.t;
3
+
result : Day11_solution.Solve_result.t;
5
4
}
6
5
7
6
type cached_failure = {
···
27
26
28
27
let save path entry =
29
28
let json = match entry with
30
-
| Cached_solution { package; solution; examined } ->
29
+
| Cached_solution { package; result } ->
31
30
`Assoc [
32
31
("package", `String (OpamPackage.to_string package));
33
-
("solution", Day11_graph.Solution_json.to_json solution);
34
-
("examined", examined_to_json examined);
32
+
("result", Day11_solution.Solve_result.to_json result);
35
33
]
36
34
| Cached_failure { package; error; examined } ->
37
35
`Assoc [
···
54
52
let package =
55
53
json |> member "package" |> to_string |> OpamPackage.of_string
56
54
in
57
-
let examined = json |> member "examined" |> examined_of_json in
58
55
match json |> member "failed" |> to_bool_option with
59
56
| Some true ->
60
57
let error = json |> member "error" |> to_string in
58
+
let examined = json |> member "examined" |> examined_of_json in
61
59
Ok (Cached_failure { package; error; examined })
62
60
| _ ->
63
-
match Day11_graph.Solution_json.of_json (json |> member "solution") with
64
-
| Ok solution ->
65
-
Ok (Cached_solution { package; solution; examined })
61
+
match Day11_solution.Solve_result.of_json (json |> member "result") with
62
+
| Ok result ->
63
+
Ok (Cached_solution { package; result })
66
64
| Error _ as e -> e
67
65
with exn ->
68
66
Error (`Msg (Printexc.to_string exn))
···
79
77
| Error _ -> ()
80
78
| Ok entry ->
81
79
let examined = match entry with
82
-
| Cached_solution s -> s.examined
80
+
| Cached_solution s -> s.result.examined
83
81
| Cached_failure f -> f.examined
84
82
in
85
83
if OpamPackage.Name.Set.is_empty
+3
-4
day11/batch/incremental_solver.mli
+3
-4
day11/batch/incremental_solver.mli
···
6
6
7
7
type cached_solution = {
8
8
package : OpamPackage.t;
9
-
solution : Day11_graph.Graph.solution;
10
-
examined : OpamPackage.Name.Set.t;
9
+
result : Day11_solution.Solve_result.t;
11
10
}
12
-
(** A solved result together with the set of packages the solver
13
-
examined. The examined set is used to decide reusability. *)
11
+
(** A solved result. The examined set used for reusability checks
12
+
lives inside {!Day11_solution.Solve_result.t}. *)
14
13
15
14
type cached_failure = {
16
15
package : OpamPackage.t;
+161
day11/batch/profile.ml
+161
day11/batch/profile.ml
···
1
+
type target_mode =
2
+
| All_versions
3
+
| Small_universe
4
+
| Packages of string list
5
+
6
+
type t = {
7
+
name : string;
8
+
opam_repositories : string list;
9
+
odoc_repo : string option;
10
+
opam_build_repo : string option;
11
+
compiler : string option;
12
+
target_mode : target_mode;
13
+
with_doc : bool;
14
+
with_jtw : bool;
15
+
jtw_repo : string option;
16
+
arch : string;
17
+
os_distribution : string;
18
+
os_version : string;
19
+
driver_compiler : string;
20
+
extra_pins : string list;
21
+
patches_dir : string option;
22
+
}
23
+
24
+
let target_mode_to_json = function
25
+
| All_versions -> `String "all_versions"
26
+
| Small_universe -> `String "small_universe"
27
+
| Packages pkgs -> `Assoc [("packages", `List (List.map (fun s -> `String s) pkgs))]
28
+
29
+
let target_mode_of_json = function
30
+
| `String "all_versions" -> Ok All_versions
31
+
| `String "small_universe" -> Ok Small_universe
32
+
| `Assoc [("packages", `List l)] ->
33
+
Ok (Packages (List.filter_map (function `String s -> Some s | _ -> None) l))
34
+
| _ -> Error (`Msg "invalid target_mode")
35
+
36
+
let opt_to_json = function
37
+
| None -> `Null
38
+
| Some s -> `String s
39
+
40
+
let opt_of_json = function
41
+
| `Null -> None
42
+
| `String s -> Some s
43
+
| _ -> None
44
+
45
+
let to_json t =
46
+
`Assoc [
47
+
("name", `String t.name);
48
+
("opam_repositories", `List (List.map (fun s -> `String s) t.opam_repositories));
49
+
("odoc_repo", opt_to_json t.odoc_repo);
50
+
("opam_build_repo", opt_to_json t.opam_build_repo);
51
+
("compiler", opt_to_json t.compiler);
52
+
("target_mode", target_mode_to_json t.target_mode);
53
+
("with_doc", `Bool t.with_doc);
54
+
("with_jtw", `Bool t.with_jtw);
55
+
("jtw_repo", opt_to_json t.jtw_repo);
56
+
("arch", `String t.arch);
57
+
("os_distribution", `String t.os_distribution);
58
+
("os_version", `String t.os_version);
59
+
("driver_compiler", `String t.driver_compiler);
60
+
("extra_pins", `List (List.map (fun s -> `String s) t.extra_pins));
61
+
("patches_dir", opt_to_json t.patches_dir);
62
+
]
63
+
64
+
let of_json json =
65
+
try
66
+
let open Yojson.Safe.Util in
67
+
let str key = json |> member key |> to_string in
68
+
let str_opt key = json |> member key |> opt_of_json in
69
+
let str_list key =
70
+
json |> member key |> to_list |> List.map to_string in
71
+
let tm = target_mode_of_json (json |> member "target_mode") in
72
+
match tm with
73
+
| Error e -> Error e
74
+
| Ok target_mode ->
75
+
Ok {
76
+
name = str "name";
77
+
opam_repositories = str_list "opam_repositories";
78
+
odoc_repo = str_opt "odoc_repo";
79
+
opam_build_repo = str_opt "opam_build_repo";
80
+
compiler = str_opt "compiler";
81
+
target_mode;
82
+
with_doc = json |> member "with_doc" |> to_bool_option
83
+
|> Option.value ~default:false;
84
+
with_jtw = json |> member "with_jtw" |> to_bool_option
85
+
|> Option.value ~default:false;
86
+
jtw_repo = str_opt "jtw_repo";
87
+
arch = (try str "arch" with _ -> "x86_64");
88
+
os_distribution = (try str "os_distribution" with _ -> "debian");
89
+
os_version = (try str "os_version" with _ -> "bookworm");
90
+
driver_compiler = (try str "driver_compiler"
91
+
with _ -> "ocaml-base-compiler.5.4.1");
92
+
extra_pins = (try str_list "extra_pins" with _ -> []);
93
+
patches_dir = str_opt "patches_dir";
94
+
}
95
+
with exn ->
96
+
Rresult.R.error_msgf "Profile.of_json: %s" (Printexc.to_string exn)
97
+
98
+
let save ~dir t =
99
+
let path = Fpath.(dir / (t.name ^ ".json")) in
100
+
try
101
+
ignore (Bos.OS.Dir.create ~path:true dir);
102
+
let data = Yojson.Safe.pretty_to_string (to_json t) in
103
+
Bos.OS.File.write path data
104
+
with exn ->
105
+
Rresult.R.error_msgf "Profile.save: %s" (Printexc.to_string exn)
106
+
107
+
let load ~dir ~name =
108
+
let path = Fpath.(dir / (name ^ ".json")) in
109
+
match Bos.OS.File.read path with
110
+
| Error _ as e -> e
111
+
| Ok data ->
112
+
try of_json (Yojson.Safe.from_string data)
113
+
with exn ->
114
+
Rresult.R.error_msgf "Profile.load %s: %s" name (Printexc.to_string exn)
115
+
116
+
let list ~dir =
117
+
match Bos.OS.Dir.contents dir with
118
+
| Error _ -> []
119
+
| Ok entries ->
120
+
List.filter_map (fun p ->
121
+
let name = Fpath.basename p in
122
+
if Fpath.has_ext ".json" p then
123
+
Some (Fpath.rem_ext (Fpath.v name) |> Fpath.to_string)
124
+
else None
125
+
) entries
126
+
127
+
let delete ~dir ~name =
128
+
let path = Fpath.(dir / (name ^ ".json")) in
129
+
Bos.OS.File.delete path
130
+
131
+
let os_dir_name t =
132
+
Printf.sprintf "%s-%s-%s" t.os_distribution t.os_version t.arch
133
+
134
+
let default_dir () =
135
+
let home = try Sys.getenv "HOME" with Not_found -> "/tmp" in
136
+
Fpath.v (Filename.concat home ".day11")
137
+
138
+
let pp fmt t =
139
+
Fmt.pf fmt "@[<v>\
140
+
Profile: %s@,\
141
+
Opam repos: %s@,\
142
+
Odoc repo: %s@,\
143
+
Opam-build repo: %s@,\
144
+
Compiler: %s@,\
145
+
Targets: %s@,\
146
+
Docs: %b@,\
147
+
Platform: %s-%s-%s@,\
148
+
Driver compiler: %s\
149
+
@]"
150
+
t.name
151
+
(String.concat ", " t.opam_repositories)
152
+
(Option.value ~default:"(none)" t.odoc_repo)
153
+
(Option.value ~default:"(none)" t.opam_build_repo)
154
+
(Option.value ~default:"(auto)" t.compiler)
155
+
(match t.target_mode with
156
+
| All_versions -> "all versions"
157
+
| Small_universe -> "small universe"
158
+
| Packages pkgs -> String.concat ", " pkgs)
159
+
t.with_doc
160
+
t.os_distribution t.os_version t.arch
161
+
t.driver_compiler
+55
day11/batch/profile.mli
+55
day11/batch/profile.mli
···
1
+
(** Named profiles for day11 analysis configurations.
2
+
3
+
A profile captures the stable configuration for an ongoing analysis:
4
+
which opam repositories to use, what overrides to apply, what targets
5
+
to build, and what platform to target. Profiles are stored as JSON
6
+
files in a profile directory (default [~/.day11/profiles/]). *)
7
+
8
+
type target_mode =
9
+
| All_versions
10
+
| Small_universe
11
+
| Packages of string list
12
+
13
+
type t = {
14
+
name : string;
15
+
opam_repositories : string list;
16
+
odoc_repo : string option;
17
+
opam_build_repo : string option;
18
+
compiler : string option;
19
+
target_mode : target_mode;
20
+
with_doc : bool;
21
+
with_jtw : bool;
22
+
jtw_repo : string option;
23
+
arch : string;
24
+
os_distribution : string;
25
+
os_version : string;
26
+
driver_compiler : string;
27
+
extra_pins : string list;
28
+
patches_dir : string option;
29
+
}
30
+
31
+
val save : dir:Fpath.t -> t -> (unit, [> Rresult.R.msg ]) result
32
+
(** [save ~dir profile] writes [profile] to [dir/<name>.json]. *)
33
+
34
+
val load : dir:Fpath.t -> name:string -> (t, [> Rresult.R.msg ]) result
35
+
(** [load ~dir ~name] reads a profile from [dir/<name>.json]. *)
36
+
37
+
val list : dir:Fpath.t -> string list
38
+
(** [list ~dir] returns the names of all profiles in [dir]. *)
39
+
40
+
val delete : dir:Fpath.t -> name:string -> (unit, [> Rresult.R.msg ]) result
41
+
(** [delete ~dir ~name] removes the profile file [dir/<name>.json]. *)
42
+
43
+
val to_json : t -> Yojson.Safe.t
44
+
val of_json : Yojson.Safe.t -> (t, [> Rresult.R.msg ]) result
45
+
46
+
val pp : t Fmt.t
47
+
(** Pretty-print a profile for display. *)
48
+
49
+
(** {1 Derived paths} *)
50
+
51
+
val os_dir_name : t -> string
52
+
(** E.g. ["debian-bookworm-x86_64"]. *)
53
+
54
+
val default_dir : unit -> Fpath.t
55
+
(** [~/.day11] *)
+4
-4
day11/batch/rerun.ml
+4
-4
day11/batch/rerun.ml
···
14
14
dir = base_dir;
15
15
image = ""; (* not needed for rebuild *)
16
16
} in
17
-
Day11_build.Types.make_build_env ~base ~os_dir
17
+
Day11_opam_build.Types.make_build_env ~base ~os_dir
18
18
~uid:meta.uid ~gid:meta.gid ()
19
19
20
20
let rerun env ~os_dir ~cache_dir node =
···
22
22
let layer_json = Fpath.(layer_dir / "layer.json") in
23
23
match Day11_layer.Meta.load layer_json with
24
24
| Error (`Msg e) ->
25
-
Day11_build.Types.Failure e
25
+
Day11_opam_build.Types.Failure e
26
26
| Ok { exit_status = 0; _ } ->
27
-
Day11_build.Types.Success node
27
+
Day11_opam_build.Types.Success node
28
28
| Ok meta ->
29
29
let benv = build_env_of_meta ~os_dir ~cache_dir meta in
30
30
let opam_repo = Fpath.(layer_dir / "opam-repository") in
···
34
34
else []
35
35
in
36
36
ignore (Day11_exec.Sudo.rm_rf env layer_dir);
37
-
Day11_build.Build_layer.build env benv
37
+
Day11_opam_build.Build_layer.build env benv
38
38
~opam_repositories:opam_repos node ()
39
39
40
40
let cascade env ~os_dir ~cache_dir nodes =
+1
-1
day11/batch/rerun.mli
+1
-1
day11/batch/rerun.mli
···
9
9
os_dir:Fpath.t ->
10
10
cache_dir:Fpath.t ->
11
11
Day11_opam_layer.Build.t ->
12
-
Day11_build.Types.build_result
12
+
Day11_opam_build.Types.build_result
13
13
(** [rerun env ~os_dir ~cache_dir node] rebuilds a failed layer.
14
14
Reads uid/gid/base_hash from the layer's [layer.json] and
15
15
opam files from its [opam-repository/] directory. *)
+78
day11/batch/snapshot.ml
+78
day11/batch/snapshot.ml
···
1
+
type t = {
2
+
repos : (string * string) list;
3
+
key : string;
4
+
created : string;
5
+
}
6
+
7
+
let git_head_sha repo_path =
8
+
let cmd = Printf.sprintf "git -C %s rev-parse HEAD 2>/dev/null"
9
+
(Filename.quote repo_path) in
10
+
let ic = Unix.open_process_in cmd in
11
+
let sha = try String.trim (input_line ic) with _ -> "unknown" in
12
+
ignore (Unix.close_process_in ic);
13
+
sha
14
+
15
+
let compute_key repos =
16
+
let shas = List.map snd repos in
17
+
let combined = String.concat ":" shas in
18
+
Digest.string combined |> Digest.to_hex |> fun s ->
19
+
String.sub s 0 12
20
+
21
+
let now_iso8601 () =
22
+
let t = Unix.gettimeofday () in
23
+
let tm = Unix.gmtime t in
24
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
25
+
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
26
+
tm.tm_hour tm.tm_min tm.tm_sec
27
+
28
+
let current (profile : Profile.t) =
29
+
let repos = List.map (fun path ->
30
+
(path, git_head_sha path)
31
+
) profile.opam_repositories in
32
+
let key = compute_key repos in
33
+
{ repos; key; created = now_iso8601 () }
34
+
35
+
let to_json t =
36
+
`Assoc [
37
+
("repos", `List (List.map (fun (path, sha) ->
38
+
`Assoc [("path", `String path); ("commit", `String sha)]
39
+
) t.repos));
40
+
("key", `String t.key);
41
+
("created", `String t.created);
42
+
]
43
+
44
+
let of_json json =
45
+
try
46
+
let open Yojson.Safe.Util in
47
+
let repos = json |> member "repos" |> to_list |> List.map (fun r ->
48
+
(r |> member "path" |> to_string,
49
+
r |> member "commit" |> to_string)
50
+
) in
51
+
let key = json |> member "key" |> to_string in
52
+
let created = json |> member "created" |> to_string in
53
+
Ok { repos; key; created }
54
+
with exn ->
55
+
Rresult.R.error_msgf "Snapshot.of_json: %s" (Printexc.to_string exn)
56
+
57
+
let save dir t =
58
+
let path = Fpath.(dir / "repos.json") in
59
+
try
60
+
ignore (Bos.OS.Dir.create ~path:true dir);
61
+
Bos.OS.File.write path
62
+
(Yojson.Safe.pretty_to_string (to_json t))
63
+
with exn ->
64
+
Rresult.R.error_msgf "Snapshot.save: %s" (Printexc.to_string exn)
65
+
66
+
let load dir =
67
+
let path = Fpath.(dir / "repos.json") in
68
+
match Bos.OS.File.read path with
69
+
| Error _ as e -> e
70
+
| Ok data ->
71
+
try of_json (Yojson.Safe.from_string data)
72
+
with exn ->
73
+
Rresult.R.error_msgf "Snapshot.load: %s" (Printexc.to_string exn)
74
+
75
+
let solutions_dir dir = Fpath.(dir / "solutions")
76
+
let packages_dir dir = Fpath.(dir / "packages")
77
+
let runs_dir dir = Fpath.(dir / "runs")
78
+
let status_json dir = Fpath.(dir / "status.json")
+34
day11/batch/snapshot.mli
+34
day11/batch/snapshot.mli
···
1
+
(** Point-in-time state of all opam repositories within a profile.
2
+
3
+
A snapshot captures the git commit SHA of each opam-repository at
4
+
the time of a run. The snapshot key is a hash of all commit SHAs,
5
+
used to identify which solver results and build outcomes belong
6
+
together. Multiple runs may target the same snapshot (e.g. retries
7
+
with [--rebuild-failed]). *)
8
+
9
+
type t = {
10
+
repos : (string * string) list;
11
+
(** [(repo_path, commit_sha)] for each opam-repository. *)
12
+
key : string;
13
+
(** Hash of all commit SHAs — the snapshot identifier. *)
14
+
created : string;
15
+
(** ISO-8601 UTC timestamp of when the snapshot was first seen. *)
16
+
}
17
+
18
+
val current : Profile.t -> t
19
+
(** [current profile] reads the current HEAD of each opam-repository
20
+
in [profile] and returns a snapshot. If a repo is not a git
21
+
repository, uses ["unknown"] as the commit SHA. *)
22
+
23
+
val save : Fpath.t -> t -> (unit, [> Rresult.R.msg ]) result
24
+
(** [save dir snapshot] writes [repos.json] into [dir]. *)
25
+
26
+
val load : Fpath.t -> (t, [> Rresult.R.msg ]) result
27
+
(** [load dir] reads [repos.json] from [dir]. *)
28
+
29
+
(** {1 Derived paths within a snapshot directory} *)
30
+
31
+
val solutions_dir : Fpath.t -> Fpath.t
32
+
val packages_dir : Fpath.t -> Fpath.t
33
+
val runs_dir : Fpath.t -> Fpath.t
34
+
val status_json : Fpath.t -> Fpath.t
+11
-8
day11/batch/targets.ml
+11
-8
day11/batch/targets.ml
···
41
41
let load_package_list filename =
42
42
let json = Yojson.Safe.from_file filename in
43
43
let open Yojson.Safe.Util in
44
-
match json |> member "packages" with
45
-
| `List l -> List.filter_map (fun j ->
46
-
try Some (OpamPackage.of_string (to_string j))
47
-
with _ -> None) l
48
-
| _ ->
49
-
json |> to_list |> List.filter_map (fun j ->
50
-
try Some (OpamPackage.of_string (to_string j))
51
-
with _ -> None)
44
+
let parse_list l = List.filter_map (fun j ->
45
+
try Some (OpamPackage.of_string (to_string j))
46
+
with _ -> None) l
47
+
in
48
+
match json with
49
+
| `List l -> parse_list l
50
+
| `Assoc _ ->
51
+
(match json |> member "packages" with
52
+
| `List l -> parse_list l
53
+
| _ -> [])
54
+
| _ -> []
52
55
53
56
let pick_latest_version git_packages name =
54
57
let n = OpamPackage.Name.of_string name in
+4
-4
day11/batch/test/dune
+4
-4
day11/batch/test/dune
···
1
1
(test
2
2
(name test_batch)
3
-
(libraries day11_batch day11_build day11_graph day11_lib day11_test_util
3
+
(libraries day11_batch day11_opam_build day11_solution day11_lib day11_test_util
4
4
alcotest bos eio_main fpath opam-format unix))
5
5
6
6
(executable
7
7
(name test_batch_integration)
8
-
(libraries day11_batch day11_build day11_graph day11_layer day11_lib
8
+
(libraries day11_batch day11_opam_build day11_solution day11_layer day11_lib
9
9
day11_solver day11_test_util git-unix
10
10
alcotest bos eio_main fpath opam-format unix))
11
11
12
12
(executable
13
13
(name test_cmdliner_all)
14
-
(libraries day11_batch day11_build day11_graph day11_layer day11_lib
14
+
(libraries day11_batch day11_opam_build day11_solution day11_layer day11_lib
15
15
day11_solver day11_test_util
16
16
alcotest bos eio_main fpath opam-format unix))
17
17
18
18
(executable
19
19
(name test_incremental)
20
-
(libraries day11_batch day11_graph day11_solver day11_test_util
20
+
(libraries day11_batch day11_solution day11_solver day11_test_util
21
21
alcotest bos fpath opam-format unix))
22
22
23
23
(executable
+41
-25
day11/batch/test/test_batch.ml
+41
-25
day11/batch/test/test_batch.ml
···
1
1
(* Tests for day11_batch library. *)
2
2
3
3
open Day11_batch
4
-
open Day11_build
4
+
open Day11_opam_build
5
5
open Day11_test_util.Test_util
6
6
7
7
let pkg s = OpamPackage.of_string s
···
98
98
let test_dag_executor_basic () = with_eio @@ fun env ->
99
99
let completed = ref [] in
100
100
let node_c : Day11_opam_layer.Build.t =
101
-
{ hash = "build-c"; pkg = pkg "c.1"; deps = []; universe = Day11_graph.Universe.dummy } in
101
+
{ hash = "build-c"; pkg = pkg "c.1"; deps = []; universe = Day11_solution.Universe.dummy } in
102
102
let node_b : Day11_opam_layer.Build.t =
103
-
{ hash = "build-b"; pkg = pkg "b.1"; deps = [node_c]; universe = Day11_graph.Universe.dummy } in
103
+
{ hash = "build-b"; pkg = pkg "b.1"; deps = [node_c]; universe = Day11_solution.Universe.dummy } in
104
104
let nodes = [ node_c; node_b ] in
105
105
Dag_executor.execute env ~np:2
106
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ node success ->
106
+
~on_complete:(fun ~stats:_ node success ->
107
107
completed := (OpamPackage.to_string node.pkg, success) :: !completed)
108
108
~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ())
109
109
nodes
···
116
116
let test_dag_executor_failure_cascade () = with_eio @@ fun env ->
117
117
let cascaded = ref [] in
118
118
let node_c : Day11_opam_layer.Build.t =
119
-
{ hash = "build-c"; pkg = pkg "c.1"; deps = []; universe = Day11_graph.Universe.dummy } in
119
+
{ hash = "build-c"; pkg = pkg "c.1"; deps = []; universe = Day11_solution.Universe.dummy } in
120
120
let node_b : Day11_opam_layer.Build.t =
121
-
{ hash = "build-b"; pkg = pkg "b.1"; deps = [node_c]; universe = Day11_graph.Universe.dummy } in
121
+
{ hash = "build-b"; pkg = pkg "b.1"; deps = [node_c]; universe = Day11_solution.Universe.dummy } in
122
122
let nodes = [ node_c; node_b ] in
123
123
Dag_executor.execute env ~np:2
124
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ _node _success -> ())
124
+
~on_complete:(fun ~stats:_ _node _success -> ())
125
125
~on_cascade:(fun ~failed ~failed_dep:_ ->
126
126
cascaded := failed.hash :: !cascaded)
127
127
nodes
···
136
136
let test_save_load_solution () =
137
137
with_tmp_dir @@ fun dir ->
138
138
let path = Fpath.(dir / "pkg.json") in
139
+
let solution =
140
+
OpamPackage.Map.empty
141
+
|> OpamPackage.Map.add (pkg "ocaml.5.2.0") OpamPackage.Set.empty
142
+
|> OpamPackage.Map.add (pkg "astring.0.8.5")
143
+
(OpamPackage.Set.singleton (pkg "ocaml.5.2.0")) in
139
144
let entry = Incremental_solver.Cached_solution {
140
145
package = pkg "astring.0.8.5";
141
-
solution =
142
-
OpamPackage.Map.empty
143
-
|> OpamPackage.Map.add (pkg "ocaml.5.2.0") OpamPackage.Set.empty
144
-
|> OpamPackage.Map.add (pkg "astring.0.8.5")
145
-
(OpamPackage.Set.singleton (pkg "ocaml.5.2.0"));
146
-
examined =
147
-
OpamPackage.Name.Set.of_list
148
-
(List.map OpamPackage.Name.of_string [ "astring"; "ocaml"; "dune" ]);
146
+
result = { Day11_solution.Solve_result.
147
+
packages = OpamPackage.Map.fold (fun p _ acc -> OpamPackage.Set.add p acc)
148
+
solution OpamPackage.Set.empty;
149
+
build_deps = solution;
150
+
doc_deps = solution;
151
+
examined =
152
+
OpamPackage.Name.Set.of_list
153
+
(List.map OpamPackage.Name.of_string [ "astring"; "ocaml"; "dune" ]);
154
+
};
149
155
} in
150
156
(match Incremental_solver.save path entry with
151
157
| Ok () -> ()
···
157
163
Alcotest.(check string) "package"
158
164
"astring.0.8.5" (OpamPackage.to_string s.package);
159
165
Alcotest.(check int) "solution size" 2
160
-
(OpamPackage.Map.cardinal s.solution);
166
+
(OpamPackage.Map.cardinal s.result.build_deps);
161
167
Alcotest.(check int) "examined size" 3
162
-
(OpamPackage.Name.Set.cardinal s.examined)
168
+
(OpamPackage.Name.Set.cardinal s.result.examined)
163
169
164
170
let test_save_load_failure () =
165
171
with_tmp_dir @@ fun dir ->
···
189
195
let cur_dir = Fpath.(dir / "cur") in
190
196
ignore (Bos.OS.Dir.create prev_dir);
191
197
ignore (Bos.OS.Dir.create cur_dir);
198
+
let solution = OpamPackage.Map.singleton (pkg "astring.0.8.5") OpamPackage.Set.empty in
192
199
let entry = Incremental_solver.Cached_solution {
193
200
package = pkg "astring.0.8.5";
194
-
solution = OpamPackage.Map.singleton (pkg "astring.0.8.5") OpamPackage.Set.empty;
195
-
examined =
196
-
OpamPackage.Name.Set.of_list
197
-
(List.map OpamPackage.Name.of_string [ "astring"; "ocaml" ]);
201
+
result = { Day11_solution.Solve_result.
202
+
packages = OpamPackage.Set.singleton (pkg "astring.0.8.5");
203
+
build_deps = solution;
204
+
doc_deps = solution;
205
+
examined =
206
+
OpamPackage.Name.Set.of_list
207
+
(List.map OpamPackage.Name.of_string [ "astring"; "ocaml" ]);
208
+
};
198
209
} in
199
210
(match Incremental_solver.save Fpath.(prev_dir / "astring.0.8.5.json") entry with
200
211
| Ok () -> () | Error (`Msg e) -> Alcotest.fail e);
···
216
227
let cur_dir = Fpath.(dir / "cur") in
217
228
ignore (Bos.OS.Dir.create prev_dir);
218
229
ignore (Bos.OS.Dir.create cur_dir);
230
+
let solution = OpamPackage.Map.singleton (pkg "astring.0.8.5") OpamPackage.Set.empty in
219
231
let entry = Incremental_solver.Cached_solution {
220
232
package = pkg "astring.0.8.5";
221
-
solution = OpamPackage.Map.singleton (pkg "astring.0.8.5") OpamPackage.Set.empty;
222
-
examined =
223
-
OpamPackage.Name.Set.of_list
224
-
(List.map OpamPackage.Name.of_string [ "astring"; "ocaml" ]);
233
+
result = { Day11_solution.Solve_result.
234
+
packages = OpamPackage.Set.singleton (pkg "astring.0.8.5");
235
+
build_deps = solution;
236
+
doc_deps = solution;
237
+
examined =
238
+
OpamPackage.Name.Set.of_list
239
+
(List.map OpamPackage.Name.of_string [ "astring"; "ocaml" ]);
240
+
};
225
241
} in
226
242
(match Incremental_solver.save Fpath.(prev_dir / "astring.0.8.5.json") entry with
227
243
| Ok () -> () | Error (`Msg e) -> Alcotest.fail e);
+13
-13
day11/batch/test/test_batch_integration.ml
+13
-13
day11/batch/test/test_batch_integration.ml
···
7
7
Run with: DAY11_INTEGRATION=true dune exec day11/batch/test/test_batch_integration.exe *)
8
8
9
9
open Day11_batch
10
-
open Day11_build
10
+
open Day11_opam_build
11
11
open Day11_test_util.Test_util
12
12
13
13
let arch = "x86_64"
···
18
18
let solve_package git_packages opam_env target_str =
19
19
let target = pkg target_str in
20
20
match Day11_solver.Solve.solve ~packages:git_packages ~env:opam_env target with
21
-
| Ok s -> (target, s)
22
-
| Error diag -> Alcotest.fail ("Solve " ^ target_str ^ ": " ^ diag)
21
+
| Ok result -> (target, result.Day11_solution.Solve_result.build_deps)
22
+
| Error (diag, _) -> Alcotest.fail ("Solve " ^ target_str ^ ": " ^ diag)
23
23
24
24
let setup_solver () =
25
25
let opam_repository = opam_repository () in
···
61
61
(OpamPackage.Set.cardinal all_blessed > 0);
62
62
(* Build DAG *)
63
63
let find_opam = Day11_opam.Git_packages.find_package git_packages in
64
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
64
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
65
65
let base_hash = Base.hash ~image:"test" in
66
66
let nodes = Dag.build_dag cache ~base_hash solutions in
67
67
Printf.printf " DAG: %d nodes\n%!" (List.length nodes);
···
69
69
(* Execute with mock build — all succeed *)
70
70
let completed = ref [] in
71
71
Dag_executor.execute env ~np:4
72
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ node success ->
72
+
~on_complete:(fun ~stats:_ node success ->
73
73
completed := (OpamPackage.to_string node.pkg, success) :: !completed)
74
74
~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ())
75
75
nodes
···
98
98
let solutions = [ sol_astring ] in
99
99
let blessing_maps = Blessing.compute_blessings solutions in
100
100
let find_opam = Day11_opam.Git_packages.find_package git_packages in
101
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
101
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
102
102
let base_hash = Base.hash ~image:"test" in
103
103
let nodes = Dag.build_dag cache ~base_hash solutions in
104
104
Printf.printf " DAG: %d nodes, executing...\n%!" (List.length nodes);
105
105
(* Build mock outcomes for summary *)
106
106
let build_outcomes = ref [] in
107
107
Dag_executor.execute env ~np:4
108
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ node success ->
108
+
~on_complete:(fun ~stats:_ node success ->
109
109
let blessed =
110
110
List.exists (fun (_, map) ->
111
111
Blessing.is_blessed map node.pkg
···
161
161
let sol_astring = solve_package git_packages opam_env "astring.0.8.5" in
162
162
let solutions = [ sol_astring ] in
163
163
let find_opam = Day11_opam.Git_packages.find_package git_packages in
164
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
164
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
165
165
let nodes = Dag.build_dag cache ~base_hash:base.hash
166
166
solutions in
167
167
Printf.printf " DAG: %d nodes\n%!" (List.length nodes);
···
213
213
Printf.printf "Solving and caching %d packages...\n%!" (List.length targets);
214
214
List.iter (fun target_str ->
215
215
let target = pkg target_str in
216
-
match Day11_solver.Solve.solve_with_examined
216
+
match Day11_solver.Solve.solve
217
217
~packages:git_packages ~env:opam_env target with
218
-
| Ok (solution, examined) ->
218
+
| Ok result ->
219
219
let entry = Incremental_solver.Cached_solution {
220
-
package = target; solution; examined;
220
+
package = target; result;
221
221
} in
222
222
(match Incremental_solver.save
223
223
Fpath.(sha1_dir / (target_str ^ ".json")) entry with
224
224
| Ok () -> Printf.printf " Cached %s (examined %d)\n%!"
225
-
target_str (OpamPackage.Name.Set.cardinal examined)
225
+
target_str (OpamPackage.Name.Set.cardinal result.examined)
226
226
| Error (`Msg e) -> Alcotest.fail e)
227
227
| Error (diag, _examined) ->
228
228
Alcotest.fail ("Solve " ^ target_str ^ ": " ^ diag)
···
256
256
| _ -> Alcotest.fail "load astring"
257
257
in
258
258
let examined_name =
259
-
OpamPackage.Name.Set.choose astring_entry.examined in
259
+
OpamPackage.Name.Set.choose astring_entry.result.examined in
260
260
Printf.printf " Simulating change to %s...\n%!"
261
261
(OpamPackage.Name.to_string examined_name);
262
262
let changed_one = OpamPackage.Name.Set.singleton examined_name in
+5
-5
day11/batch/test/test_cmdliner_all.ml
+5
-5
day11/batch/test/test_cmdliner_all.ml
···
4
4
Run with: DAY11_INTEGRATION=true dune exec day11/batch/test/test_cmdliner_all.exe *)
5
5
6
6
open Day11_batch
7
-
open Day11_build
7
+
open Day11_opam_build
8
8
open Day11_test_util.Test_util
9
9
10
10
let scratch_cache_dir = Fpath.v "/tmp/day11-scratch-cache"
···
45
45
Printf.printf " Solving %s... %!" (OpamPackage.to_string target);
46
46
match Day11_solver.Solve.solve ~packages:git_packages ~env:opam_env
47
47
target with
48
-
| Ok solution ->
49
-
Printf.printf "%d packages\n%!" (OpamPackage.Map.cardinal solution);
50
-
Some (target, solution)
51
-
| Error diag ->
48
+
| Ok result ->
49
+
Printf.printf "%d packages\n%!" (OpamPackage.Map.cardinal result.Day11_solution.Solve_result.build_deps);
50
+
Some (target, result.build_deps)
51
+
| Error (diag, _) ->
52
52
Printf.printf "FAILED: %s\n%!" diag;
53
53
None
54
54
) targets in
+2
-2
day11/batch/test/test_examined_diff.ml
+2
-2
day11/batch/test/test_examined_diff.ml
···
29
29
(* Solve each target and collect examined sets *)
30
30
let examined_sets = List.filter_map (fun target_str ->
31
31
let target = OpamPackage.of_string target_str in
32
-
match Day11_solver.Solve.solve_with_examined
32
+
match Day11_solver.Solve.solve
33
33
~packages:git_packages ~env:opam_env target with
34
-
| Ok (_, examined) -> Some (target_str, examined)
34
+
| Ok result -> Some (target_str, result.Day11_solution.Solve_result.examined)
35
35
| Error _ -> None
36
36
) targets in
37
37
(* Find the intersection (common to all) *)
+12
-12
day11/batch/test/test_incremental.ml
+12
-12
day11/batch/test/test_incremental.ml
···
72
72
List.iter (fun target_str ->
73
73
let target = OpamPackage.of_string target_str in
74
74
let cache_file = Fpath.(cache_dir / (target_str ^ ".json")) in
75
-
match Day11_solver.Solve.solve_with_examined
75
+
match Day11_solver.Solve.solve
76
76
~packages:git_packages ~env:opam_env target with
77
-
| Ok (solution, examined) ->
77
+
| Ok result ->
78
78
let entry = Incremental_solver.Cached_solution {
79
-
package = target; solution; examined;
79
+
package = target; result;
80
80
} in
81
81
Printf.printf " %s: %d deps, %d examined\n%!"
82
-
target_str (OpamPackage.Map.cardinal solution)
83
-
(OpamPackage.Name.Set.cardinal examined);
82
+
target_str (OpamPackage.Map.cardinal result.Day11_solution.Solve_result.build_deps)
83
+
(OpamPackage.Name.Set.cardinal result.examined);
84
84
(match Incremental_solver.save cache_file entry with
85
85
| Ok () -> incr solved
86
86
| Error (`Msg e) ->
···
95
95
let target = OpamPackage.of_string target_str in
96
96
Day11_solver.Solve.solve ~packages:git_packages ~env:opam_env target
97
97
98
-
let solutions_equal s1 s2 =
99
-
OpamPackage.Map.equal OpamPackage.Set.equal s1 s2
98
+
let solutions_equal (s1 : Day11_solution.Solve_result.t) (s2 : Day11_solution.Solve_result.t) =
99
+
OpamPackage.Map.equal OpamPackage.Set.equal s1.build_deps s2.build_deps
100
100
101
101
let test_scenario ~name ~before_sha ~after_sha () =
102
102
with_tmp_dir @@ fun dir ->
···
145
145
if not (Sys.file_exists (Fpath.to_string cache_file)) then begin
146
146
Printf.printf " Re-solving %s...\n%!" target_str;
147
147
let target = OpamPackage.of_string target_str in
148
-
match Day11_solver.Solve.solve_with_examined
148
+
match Day11_solver.Solve.solve
149
149
~packages:after_packages ~env:opam_env target with
150
-
| Ok (solution, examined) ->
150
+
| Ok result ->
151
151
let entry = Incremental_solver.Cached_solution {
152
-
package = target; solution; examined;
152
+
package = target; result;
153
153
} in
154
154
ignore (Incremental_solver.save cache_file entry);
155
155
incr re_solved
···
167
167
match Incremental_solver.load cache_file with
168
168
| Ok (Cached_solution cached) ->
169
169
(match fresh_solve ~git_packages:after_packages target_str with
170
-
| Ok fresh_solution ->
171
-
if not (solutions_equal cached.solution fresh_solution) then begin
170
+
| Ok fresh_result ->
171
+
if not (solutions_equal cached.result fresh_result) then begin
172
172
Printf.printf " MISMATCH: %s\n%!" target_str;
173
173
incr mismatches
174
174
end
+10
-10
day11/benchmark/benchmark.ml
+10
-10
day11/benchmark/benchmark.ml
···
62
62
List.filter_map (fun pkg_str ->
63
63
match Day11_solver.Solve.solve ~packages:git_packages ~env:opam_env
64
64
(OpamPackage.of_string pkg_str) with
65
-
| Ok s -> Some (OpamPackage.of_string pkg_str, s)
65
+
| Ok result -> Some (OpamPackage.of_string pkg_str, result.Day11_solution.Solve_result.build_deps)
66
66
| Error _ -> None
67
67
) packages_50) in
68
68
Printf.printf " → %d/%d solved\n%!" (List.length solutions) (List.length packages_50);
69
69
70
70
(* 4. DAG construction *)
71
71
let find_opam = Day11_opam.Git_packages.find_package git_packages in
72
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
72
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
73
73
let nodes =
74
74
time "Build DAG (50 solutions)" (fun () ->
75
-
Day11_build.Dag.build_dag cache ~base_hash:"benchmark" solutions) in
75
+
Day11_opam_build.Dag.build_dag cache ~base_hash:"benchmark" solutions) in
76
76
Printf.printf " → %d unique nodes\n%!" (List.length nodes);
77
77
78
78
(* 5. Blessing *)
···
84
84
Eio_main.run @@ fun env ->
85
85
let env = (env :> Eio_unix.Stdenv.base) in
86
86
let scratch_cache = Fpath.v "/tmp/day11-scratch-cache" in
87
-
(match Day11_build.Base.load_cached ~cache_dir:scratch_cache
87
+
(match Day11_opam_build.Base.load_cached ~cache_dir:scratch_cache
88
88
~os_distribution:"debian" ~os_version:"bookworm" with
89
89
| None ->
90
90
Printf.printf "\nNo cached base image — skipping build benchmarks\n%!"
91
91
| Some base ->
92
92
let os_dir = Fpath.(scratch_cache / "linux-x86_64") in
93
-
let benv = Day11_build.Types.make_build_env ~base ~os_dir
93
+
let benv = Day11_opam_build.Types.make_build_env ~base ~os_dir
94
94
~uid:1000 ~gid:1000 () in
95
-
Day11_build.Types.ensure_dirs benv;
95
+
Day11_opam_build.Types.ensure_dirs benv;
96
96
(* Warm cache: build astring (should be instant) *)
97
-
let astring_hash = Day11_build.Hash_cache.layer_hash cache
97
+
let astring_hash = Day11_opam_build.Hash_cache.layer_hash cache
98
98
~base_hash:base.hash [ OpamPackage.of_string "astring.0.8.5" ] in
99
99
let astring_node : Day11_opam_layer.Build.t =
100
100
{ hash = astring_hash;
101
101
pkg = OpamPackage.of_string "astring.0.8.5";
102
-
deps = []; universe = Day11_graph.Universe.dummy } in
102
+
deps = []; universe = Day11_solution.Universe.dummy } in
103
103
ignore (time "Build astring (cache hit)" (fun () ->
104
-
Day11_build.Build_layer.build env benv astring_node ()));
104
+
Day11_opam_build.Build_layer.build env benv astring_node ()));
105
105
(* Warm cache: build odoc-driver tool *)
106
106
ignore (time "Tools.build_tool odoc-driver (cache hit)" (fun () ->
107
-
Day11_build.Tools.build_tool env benv
107
+
Day11_opam_build.Tools.build_tool env benv
108
108
~packages:git_packages ~repos:repos_with_shas
109
109
(OpamPackage.of_string "odoc-driver.3.1.0")));
110
110
);
+12
-12
day11/benchmark/benchmark_builds.ml
+12
-12
day11/benchmark/benchmark_builds.ml
···
22
22
Printf.printf "=== Layer build benchmark ===\n\n";
23
23
Eio_main.run @@ fun env ->
24
24
let env = (env :> Eio_unix.Stdenv.base) in
25
-
let base = match Day11_build.Base.load_cached ~cache_dir:scratch_cache
25
+
let base = match Day11_opam_build.Base.load_cached ~cache_dir:scratch_cache
26
26
~os_distribution:"debian" ~os_version:"bookworm" with
27
27
| Some b -> b
28
28
| None -> Printf.printf "No cached base — exiting\n%!"; exit 1
29
29
in
30
30
let os_dir = Fpath.(scratch_cache / "linux-x86_64") in
31
-
let benv = Day11_build.Types.make_build_env ~base ~os_dir
31
+
let benv = Day11_opam_build.Types.make_build_env ~base ~os_dir
32
32
~uid:1000 ~gid:1000 () in
33
-
Day11_build.Types.ensure_dirs benv;
33
+
Day11_opam_build.Types.ensure_dirs benv;
34
34
let git_packages, _store, _commit =
35
35
Day11_opam.Git_packages.of_opam_repository opam_repository in
36
36
let opam_env = Day11_opam.Opam_env.std_env
37
37
~arch:"x86_64" ~os:"linux" ~os_distribution:"debian"
38
38
~os_family:"debian" ~os_version:"12" () in
39
39
let find_opam = Day11_opam.Git_packages.find_package git_packages in
40
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
40
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
41
41
(* Build packages that should exist in the compiler layer already.
42
42
These are small packages that build quickly. *)
43
43
let test_packages = [
···
59
59
let solutions = List.filter_map (fun pkg_str ->
60
60
match Day11_solver.Solve.solve ~packages:git_packages ~env:opam_env
61
61
(OpamPackage.of_string pkg_str) with
62
-
| Ok s -> Some (OpamPackage.of_string pkg_str, s)
62
+
| Ok result -> Some (OpamPackage.of_string pkg_str, result.Day11_solution.Solve_result.build_deps)
63
63
| Error _ -> Printf.printf " FAILED: %s\n%!" pkg_str; None
64
64
) test_packages in
65
65
Printf.printf " %d solved\n\n" (List.length solutions);
66
66
(* Build the DAG *)
67
-
let nodes = Day11_build.Dag.build_dag cache ~base_hash:base.hash solutions in
67
+
let nodes = Day11_opam_build.Dag.build_dag cache ~base_hash:base.hash solutions in
68
68
Printf.printf "DAG: %d nodes\n\n" (List.length nodes);
69
69
(* First pass: ensure everything is cached (warm up) *)
70
70
Printf.printf "--- Warm-up (build all, cache fills) ---\n%!";
71
71
let _ = time "Build all (warm-up)" (fun () ->
72
-
Day11_build.Dag_executor.execute env ~np:4
73
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ _ _ -> ())
72
+
Day11_opam_build.Dag_executor.execute env ~np:4
73
+
~on_complete:(fun ~stats:_ _ _ -> ())
74
74
~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ())
75
75
nodes
76
76
(fun node ->
77
-
match Day11_build.Build_layer.build env benv node () with
78
-
| Day11_build.Types.Success _ -> true
77
+
match Day11_opam_build.Build_layer.build env benv node () with
78
+
| Day11_opam_build.Types.Success _ -> true
79
79
| _ -> false)) in
80
80
(* Second pass: time cache hits *)
81
81
Printf.printf "\n--- Cache hit timing ---\n%!";
···
85
85
OpamPackage.equal n.pkg pkg) nodes with
86
86
| Some node ->
87
87
ignore (time (Printf.sprintf "Build %s (cache hit)" pkg_str) (fun () ->
88
-
Day11_build.Build_layer.build env benv node ()))
88
+
Day11_opam_build.Build_layer.build env benv node ()))
89
89
| None -> ()
90
90
) test_packages;
91
91
(* Third pass: clear individual layers and time cold rebuilds *)
···
99
99
(* Delete just this layer to force rebuild *)
100
100
ignore (Day11_exec.Sudo.rm_rf env layer_dir);
101
101
ignore (time (Printf.sprintf "Build %s (cold)" pkg_str) (fun () ->
102
-
Day11_build.Build_layer.build env benv node ()))
102
+
Day11_opam_build.Build_layer.build env benv node ()))
103
103
| None -> ()
104
104
) test_packages;
105
105
Printf.printf "\nDone.\n%!"
+16
-15
day11/benchmark/benchmark_docs.ml
+16
-15
day11/benchmark/benchmark_docs.ml
···
20
20
Printf.printf "=== Doc generation benchmark ===\n\n";
21
21
Eio_main.run @@ fun env ->
22
22
let env = (env :> Eio_unix.Stdenv.base) in
23
-
let base = match Day11_build.Base.load_cached ~cache_dir:scratch_cache
23
+
let base = match Day11_opam_build.Base.load_cached ~cache_dir:scratch_cache
24
24
~os_distribution:"debian" ~os_version:"bookworm" with
25
25
| Some b -> b
26
26
| None -> Printf.printf "No cache\n%!"; exit 1
27
27
in
28
28
let os_dir = Fpath.(scratch_cache / "linux-x86_64") in
29
-
let benv = Day11_build.Types.make_build_env ~base ~os_dir
29
+
let benv = Day11_opam_build.Types.make_build_env ~base ~os_dir
30
30
~uid:1000 ~gid:1000 () in
31
-
Day11_build.Types.ensure_dirs benv;
31
+
Day11_opam_build.Types.ensure_dirs benv;
32
32
let git_packages, repos_with_shas =
33
33
Day11_opam.Git_packages.of_repositories
34
34
[ (opam_repository, None) ] in
···
36
36
~arch:"x86_64" ~os:"linux" ~os_distribution:"debian"
37
37
~os_family:"debian" ~os_version:"12" () in
38
38
let find_opam = Day11_opam.Git_packages.find_package git_packages in
39
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
39
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
40
40
(* Build odoc-driver tools *)
41
41
let odoc_tool = time "Build odoc-driver tools (cache)" (fun () ->
42
-
Day11_build.Tools.build_tool env benv
42
+
Day11_opam_build.Tools.build_tool env benv
43
43
~packages:git_packages ~repos:repos_with_shas
44
44
(OpamPackage.of_string "odoc-driver.3.1.0")
45
45
|> Result.get_ok) in
···
48
48
let voodoo_bin = "/home/opam/doc-tools/bin/odoc_driver_voodoo" in
49
49
(* Solve astring properly *)
50
50
let astring_pkg = OpamPackage.of_string "astring.0.8.5" in
51
-
let astring_solution = time "Solve astring" (fun () ->
51
+
let astring_result = time "Solve astring" (fun () ->
52
52
Day11_solver.Solve.solve ~packages:git_packages ~env:opam_env
53
53
astring_pkg |> Result.get_ok) in
54
+
let astring_solution = astring_result.Day11_solution.Solve_result.build_deps in
54
55
(* Build astring with real deps *)
55
-
let astring_nodes = Day11_build.Dag.build_dag cache ~base_hash:base.hash
56
+
let astring_nodes = Day11_opam_build.Dag.build_dag cache ~base_hash:base.hash
56
57
[ (astring_pkg, astring_solution) ] in
57
58
let astring_build = time "Build astring + deps (cache)" (fun () ->
58
-
Day11_build.Dag_executor.execute env ~np:4
59
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ _ _ -> ())
59
+
Day11_opam_build.Dag_executor.execute env ~np:4
60
+
~on_complete:(fun ~stats:_ _ _ -> ())
60
61
~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ())
61
62
astring_nodes
62
63
(fun node ->
63
-
match Day11_build.Build_layer.build env benv node () with
64
-
| Day11_build.Types.Success _ -> true | _ -> false);
64
+
match Day11_opam_build.Build_layer.build env benv node () with
65
+
| Day11_opam_build.Types.Success _ -> true | _ -> false);
65
66
List.find (fun (n : Day11_opam_layer.Build.t) ->
66
67
OpamPackage.equal n.pkg astring_pkg) astring_nodes) in
67
68
let pkg_dir = Day11_opam_layer.Build.dir ~os_dir astring_build in
···
96
97
voodoo_bin "astring" odoc_bin odoc_md_bin in
97
98
let doc_node : Day11_opam_layer.Build.t =
98
99
{ hash = doc_hash; pkg = astring_pkg;
99
-
deps = astring_build.deps @ [ astring_build ]; universe = Day11_graph.Universe.dummy } in
100
+
deps = astring_build.deps @ [ astring_build ]; universe = Day11_solution.Universe.dummy } in
100
101
let html_count = time "Doc gen astring (cold, single phase)" (fun () ->
101
-
match Day11_build.Build_layer.build env benv ~mounts:all_mounts
102
+
match Day11_opam_build.Build_layer.build env benv ~mounts:all_mounts
102
103
doc_node ~strategy:{ cmd; cleanup = fun _ _ -> () } () with
103
-
| Day11_build.Types.Success bl ->
104
+
| Day11_opam_build.Types.Success bl ->
104
105
let dd = Day11_opam_layer.Build.dir ~os_dir bl in
105
106
let find_run = Day11_exec.Run.run env
106
107
Bos.Cmd.(v "find" % Fpath.to_string Fpath.(dd / "fs")
···
111
112
Printf.printf " → %d HTML files\n%!" html_count;
112
113
(* Cache hit *)
113
114
ignore (time "Doc gen astring (cache hit)" (fun () ->
114
-
Day11_build.Build_layer.build env benv ~mounts:all_mounts
115
+
Day11_opam_build.Build_layer.build env benv ~mounts:all_mounts
115
116
doc_node ~strategy:{ cmd; cleanup = fun _ _ -> () } ()));
116
117
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
117
118
Printf.printf "\nDone.\n%!"
+4
-4
day11/benchmark/dune
+4
-4
day11/benchmark/dune
···
1
1
(executable
2
2
(name benchmark)
3
-
(libraries day11_batch day11_build day11_graph day11_layer day11_solver
3
+
(libraries day11_batch day11_opam_build day11_solution day11_layer day11_solver
4
4
eio_main fpath opam-format unix))
5
5
6
6
(executable
···
9
9
10
10
(executable
11
11
(name benchmark_builds)
12
-
(libraries day11_batch day11_build day11_exec day11_layer day11_solver
12
+
(libraries day11_batch day11_opam_build day11_exec day11_layer day11_solver
13
13
bos eio_main fpath opam-format unix))
14
14
15
15
(executable
16
16
(name benchmark_docs)
17
-
(libraries day11_build day11_container day11_doc day11_exec day11_layer
17
+
(libraries day11_opam_build day11_container day11_doc day11_exec day11_layer
18
18
day11_solver bos eio_main fmt logs logs.fmt fpath opam-format unix))
19
19
20
20
(executable
21
21
(name trial_run)
22
-
(libraries day11_batch day11_build day11_exec day11_layer day11_solver
22
+
(libraries day11_batch day11_opam_build day11_exec day11_layer day11_solver
23
23
day11_solver_pool bos eio_main fpath git-unix opam-format unix))
+14
-14
day11/benchmark/trial_run.ml
+14
-14
day11/benchmark/trial_run.ml
···
105
105
Eio_main.run @@ fun env ->
106
106
let env = (env :> Eio_unix.Stdenv.base) in
107
107
(* Setup base image *)
108
-
let base = match Day11_build.Base.load_cached ~cache_dir:scratch_cache
108
+
let base = match Day11_opam_build.Base.load_cached ~cache_dir:scratch_cache
109
109
~os_distribution:"debian" ~os_version:"bookworm" with
110
110
| Some b -> b
111
111
| None ->
112
112
Printf.printf "Building base image...\n%!";
113
-
Day11_build.Base.build env ~cache_dir:scratch_cache
113
+
Day11_opam_build.Base.build env ~cache_dir:scratch_cache
114
114
~os_distribution:"debian" ~os_version:"bookworm" ~arch:"x86_64"
115
115
~opam_repositories:[Fpath.v opam_repository]
116
116
~uid:(Unix.getuid ()) ~gid:(Unix.getgid ()) ()
117
117
|> Result.get_ok
118
118
in
119
119
let os_dir = Fpath.(scratch_cache / "linux-x86_64") in
120
-
let benv = Day11_build.Types.make_build_env ~base ~os_dir () in
121
-
Day11_build.Types.ensure_dirs benv;
120
+
let benv = Day11_opam_build.Types.make_build_env ~base ~os_dir () in
121
+
Day11_opam_build.Types.ensure_dirs benv;
122
122
(* Get the store for loading packages at different commits *)
123
123
let store, head_commit =
124
124
Day11_opam.Git_utils.get_git_repo_store_and_hash opam_repository in
···
201
201
~repos:[(opam_repository, commit_sha)] need_solve in
202
202
List.filter_map (fun (target, result) ->
203
203
match result with
204
-
| Ok (solution, examined) ->
204
+
| Ok result ->
205
205
let entry = Day11_batch.Incremental_solver.Cached_solution {
206
-
package = target; solution; examined } in
206
+
package = target; result } in
207
207
ignore (Day11_batch.Incremental_solver.save
208
208
Fpath.(solutions_dir / (OpamPackage.to_string target ^ ".json")) entry);
209
-
Some (target, solution)
209
+
Some (target, result.Day11_solution.Solve_result.build_deps)
210
210
| Error (msg, _) ->
211
211
Printf.printf " SOLVE FAIL: %s: %s\n%!"
212
212
(OpamPackage.to_string target)
···
218
218
let all_solutions = List.filter_map (fun target ->
219
219
let cache_file = Fpath.(solutions_dir / (OpamPackage.to_string target ^ ".json")) in
220
220
match Day11_batch.Incremental_solver.load cache_file with
221
-
| Ok (Cached_solution { solution; _ }) -> Some (target, solution)
221
+
| Ok (Cached_solution { result; _ }) -> Some (target, result.build_deps)
222
222
| _ -> None
223
223
) targets in
224
224
ignore new_solutions;
···
227
227
(List.length all_solutions) (List.length new_solutions);
228
228
(* Build DAG *)
229
229
let find_opam = Day11_opam.Git_packages.find_package git_packages in
230
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
231
-
let nodes = Day11_build.Dag.build_dag cache ~base_hash:base.hash
230
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
231
+
let nodes = Day11_opam_build.Dag.build_dag cache ~base_hash:base.hash
232
232
all_solutions in
233
233
if List.length need_solve > 0 then
234
234
Printf.printf " DAG: %d nodes\n%!" (List.length nodes);
···
237
237
let cached = ref 0 in
238
238
let failed = ref 0 in
239
239
time (Printf.sprintf "build %d nodes" (List.length nodes)) (fun () ->
240
-
Day11_build.Dag_executor.execute env ~np:4
241
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ node success ->
240
+
Day11_opam_build.Dag_executor.execute env ~np:4
241
+
~on_complete:(fun ~stats:_ node success ->
242
242
if success then begin
243
243
let dir = Day11_opam_layer.Build.dir ~os_dir node in
244
244
let layer_json = Fpath.(dir / "layer.json") in
···
250
250
~on_cascade:(fun ~failed:_ ~failed_dep:_ -> incr failed)
251
251
nodes
252
252
(fun node ->
253
-
match Day11_build.Build_layer.build env benv node () with
254
-
| Day11_build.Types.Success _ -> true
253
+
match Day11_opam_build.Build_layer.build env benv node () with
254
+
| Day11_opam_build.Types.Success _ -> true
255
255
| _ -> false));
256
256
total_builds := !total_builds + !built;
257
257
total_cache_hits := !total_cache_hits + !cached;
+180
-144
day11/bin/cmd_batch.ml
+180
-144
day11/bin/cmd_batch.ml
···
28
28
Filename.concat tmp name) stale))))
29
29
end
30
30
31
-
let run cache_dir opam_repositories np arch os_distribution os_version
32
-
with_doc ocaml_version_str odoc_repo jtw_repo patches_dir opam_build_repo
33
-
solve_only dry_run rebuild_failed rebuild_base small_universe all_versions
34
-
extra_pins driver_compiler_str fake_build target =
31
+
let run profile_name profile_dir np
32
+
solve_only dry_run rebuild_failed rebuild_base fake_build target_override =
35
33
cleanup_stale_mounts ();
36
-
let cache_dir = Common.fpath cache_dir in
37
-
Bos.OS.Dir.create ~path:true cache_dir |> ignore;
38
-
let ocaml_version = Common.parse_ocaml_version ocaml_version_str in
39
-
let driver_compiler = OpamPackage.of_string driver_compiler_str in
34
+
let profile, paths = match Common.load_profile ~profile_dir ~name:profile_name with
35
+
| Ok x -> x | Error (`Msg e) -> Printf.eprintf "Error: %s\n" e; exit 1
36
+
in
37
+
Common.ensure_paths paths;
38
+
let cache_dir = paths.cache_dir in
39
+
let os_dir = paths.os_dir in
40
+
let ocaml_version = Common.parse_ocaml_version profile.compiler in
41
+
let driver_compiler = OpamPackage.of_string profile.driver_compiler in
42
+
let opam_repositories = profile.opam_repositories in
43
+
let with_doc = profile.with_doc in
44
+
let os_distribution = profile.os_distribution in
45
+
let os_version = profile.os_version in
46
+
let arch = profile.arch in
47
+
let patches_dir = profile.patches_dir in
48
+
let opam_build_repo = profile.opam_build_repo in
49
+
let extra_pins = profile.extra_pins in
50
+
let odoc_repo = profile.odoc_repo in
51
+
let jtw_repo = if profile.with_jtw then profile.jtw_repo else None in
52
+
let small_universe, all_versions, target = match target_override with
53
+
| Some t ->
54
+
(* CLI target overrides the profile's target mode *)
55
+
(false, false, Some t)
56
+
| None ->
57
+
let sm = profile.target_mode = Day11_batch.Profile.Small_universe in
58
+
let av = profile.target_mode = Day11_batch.Profile.All_versions in
59
+
let tgt = match profile.target_mode with
60
+
| Day11_batch.Profile.Packages (pkg :: _) -> Some pkg
61
+
| _ -> None
62
+
in
63
+
(sm, av, tgt)
64
+
in
40
65
let git_packages, repos_with_shas, opam_env =
41
66
Common.setup_solver opam_repositories in
42
67
let targets = Day11_batch.Targets.resolve ~small:small_universe ~all_versions git_packages target in
43
68
Printf.printf "Targets: %d packages\n%!" (List.length targets);
69
+
(* Snapshot — deterministic dir keyed by repo HEADs *)
70
+
let snapshot = Day11_batch.Snapshot.current profile in
71
+
let snapshot_dir = Fpath.(paths.snapshots_base / snapshot.key) in
72
+
ignore (Bos.OS.Dir.create ~path:true snapshot_dir);
73
+
ignore (Day11_batch.Snapshot.save snapshot_dir snapshot);
74
+
Printf.printf "Snapshot: %s\n%!" snapshot.key;
44
75
(* Start run log *)
45
-
Day11_lib.Run_log.set_log_base_dir (Fpath.to_string cache_dir);
76
+
Day11_lib.Run_log.set_log_base_dir (Fpath.to_string snapshot_dir);
46
77
let run_log = Day11_lib.Run_log.start_run () in
47
78
Day11_lib.Run_log.write_plan run_log ~repos_with_shas
48
79
~n_targets:(List.length targets)
···
52
83
| Some v -> Printf.printf "Compiler: %s\n%!" (OpamPackage.to_string v)
53
84
| None -> ());
54
85
(* Solve — load cached solutions where possible *)
55
-
let cache_key =
56
-
let shas = List.map snd repos_with_shas in
57
-
Digest.string (String.concat "\n" shas) |> Digest.to_hex
58
-
|> fun s -> String.sub s 0 12
59
-
in
60
-
let solutions_dir = Fpath.(cache_dir / "solutions" / cache_key) in
86
+
let solutions_dir = Day11_batch.Snapshot.solutions_dir snapshot_dir in
61
87
Bos.OS.Dir.create ~path:true solutions_dir |> ignore;
62
-
(* Write manifest so we can trace which repos/commits produced this cache *)
63
-
let manifest_file = Fpath.(solutions_dir / "repos.json") in
64
-
if not (Bos.OS.File.exists manifest_file |> Result.get_ok) then begin
65
-
let json = `Assoc [
66
-
("repos", `List (List.map (fun (repo, sha) ->
67
-
`Assoc [ ("path", `String repo); ("commit", `String sha) ]
68
-
) repos_with_shas));
69
-
("ocaml_version", match ocaml_version with
70
-
| Some v -> `String (OpamPackage.to_string v)
71
-
| None -> `Null);
72
-
("created", `String (
73
-
let tm = Unix.(gmtime (gettimeofday ())) in
74
-
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
75
-
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
76
-
tm.tm_hour tm.tm_min tm.tm_sec));
77
-
] in
78
-
ignore (Bos.OS.File.write manifest_file
79
-
(Yojson.Safe.pretty_to_string json))
80
-
end;
81
88
let cached = ref 0 in
82
89
let need_solve = List.filter (fun target ->
83
90
let cache_file = Fpath.(solutions_dir /
···
146
153
(* Save new solutions *)
147
154
List.iter (fun (target, result) ->
148
155
let entry = match result with
149
-
| Ok (solution, examined) ->
156
+
| Ok result ->
150
157
Day11_batch.Incremental_solver.Cached_solution {
151
-
package = target; solution; examined }
158
+
package = target; result }
152
159
| Error (msg, examined) ->
153
160
Day11_batch.Incremental_solver.Cached_failure {
154
161
package = target; error = msg; examined }
···
162
169
let cache_file = Fpath.(solutions_dir /
163
170
(OpamPackage.to_string target ^ ".json")) in
164
171
match Day11_batch.Incremental_solver.load cache_file with
165
-
| Ok (Day11_batch.Incremental_solver.Cached_solution { solution; _ }) ->
166
-
Some (target, solution)
172
+
| Ok (Day11_batch.Incremental_solver.Cached_solution { result; _ }) ->
173
+
Some (target, result)
167
174
| _ -> None
168
175
) targets in
176
+
(* Extract build_deps for consumers that don't need doc_deps *)
177
+
let build_solutions = List.map (fun (t, r) ->
178
+
(t, (r : Day11_solution.Solve_result.t).build_deps)) solutions in
169
179
let n_solved = List.length solutions in
170
180
let n_failed = List.length targets - n_solved in
171
181
Printf.printf "Solved: %d/%d (%d failed)\n%!" n_solved (List.length targets) n_failed;
···
176
186
end else
177
187
let find_opam = Day11_opam.Git_packages.find_package git_packages in
178
188
let patches = Option.map (fun dir ->
179
-
Day11_build.Patches.create (Fpath.v dir)) patches_dir in
189
+
Day11_opam_build.Patches.create (Fpath.v dir)) patches_dir in
180
190
(* Delete base image early if --rebuild-base, before loading *)
181
191
if rebuild_base then begin
182
192
let base_dir = Fpath.(cache_dir / "base") in
183
-
let os_dir_pre = Fpath.(cache_dir / Printf.sprintf "%s-%s-%s"
184
-
os_distribution os_version arch) in
185
193
Printf.printf "Deleting base image and all build layers for rebuild...\n%!";
186
194
(* Both dirs have root-owned files — go straight to sudo rm -rf *)
187
195
ignore (Sys.command
188
196
(Printf.sprintf "sudo rm -rf %s %s"
189
-
(Fpath.to_string base_dir) (Fpath.to_string os_dir_pre)))
197
+
(Fpath.to_string base_dir) (Fpath.to_string os_dir)))
190
198
end;
191
-
let base_opt = Day11_build.Base.load_cached ~cache_dir
199
+
let base_opt = Day11_opam_build.Base.load_cached ~cache_dir
192
200
~os_distribution ~os_version in
193
-
let base_hash = Day11_build.Base.build_hash
201
+
let base_hash = Day11_opam_build.Base.build_hash
194
202
~os_distribution ~os_version ~arch in
195
-
let os_dir = Fpath.(cache_dir / Printf.sprintf "%s-%s-%s"
196
-
os_distribution os_version arch) in
197
203
(* Build DAG — no Eio needed *)
198
-
let cache = Day11_build.Hash_cache.create ~find_opam ?patches () in
199
-
let nodes = Day11_build.Dag.build_dag cache
200
-
~base_hash solutions in
204
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam ?patches () in
205
+
let nodes = Day11_opam_build.Dag.build_dag cache
206
+
~base_hash build_solutions in
201
207
Printf.printf "DAG: %d unique build nodes\n%!" (List.length nodes);
202
208
(* Delete failed layers if --rebuild-failed *)
203
209
if rebuild_failed then begin
···
248
254
ignore (Bos.OS.File.delete bin)
249
255
end;
250
256
let opam_build_repo_fpath = Option.map Fpath.v opam_build_repo in
251
-
(match Day11_build.Base.build_opam_build env ~cache_dir ~arch
257
+
(match Day11_opam_build.Base.build_opam_build env ~cache_dir ~arch
252
258
?opam_build_repo:opam_build_repo_fpath () with
253
259
| Ok path ->
254
260
Printf.printf "opam-build: %s\n%!" (Fpath.to_string path)
···
260
266
| None ->
261
267
Printf.printf "Building base image...\n%!";
262
268
let uid = Unix.getuid () and gid = Unix.getgid () in
263
-
(match Day11_build.Base.build env ~cache_dir
269
+
(match Day11_opam_build.Base.build env ~cache_dir
264
270
~os_distribution ~os_version ~arch
265
271
~opam_repositories:(List.map Fpath.v opam_repositories) ~uid ~gid
266
272
() with
···
269
275
Printf.eprintf "Base image build failed: %s\n%!" e;
270
276
exit 1)
271
277
in
272
-
let benv = Day11_build.Types.make_build_env ~base ~os_dir () in
273
-
Day11_build.Types.ensure_dirs benv;
278
+
let benv = Day11_opam_build.Types.make_build_env ~base ~os_dir () in
279
+
Day11_opam_build.Types.ensure_dirs benv;
274
280
(* Create merged opam-repository and mount into containers —
275
281
picks up changes without rebuilding the base image *)
276
-
let merged_repo_dir = Fpath.(cache_dir / "merged-repo") in
282
+
let merged_repo_dir = Fpath.(snapshot_dir / "merged-repo") in
277
283
ignore (Day11_exec.Sudo.rm_rf env merged_repo_dir);
278
284
Bos.OS.Dir.create ~path:true merged_repo_dir |> ignore;
279
285
List.iteri (fun i repo ->
···
292
298
"/home/opam/.opam/repo/default" in
293
299
let base_mounts =
294
300
[ repo_mount ] @
295
-
(match Day11_build.Base.opam_build_mount ~cache_dir with
301
+
(match Day11_opam_build.Base.opam_build_mount ~cache_dir with
296
302
| Some m -> [ m ] | None -> [])
297
303
in
298
304
(* Bless *)
299
-
let blessing_maps = Day11_batch.Blessing.compute_blessings solutions in
305
+
let blessing_maps = Day11_batch.Blessing.compute_blessings build_solutions in
300
306
(* Build function for the unified DAG *)
301
-
let packages_dir = Fpath.(os_dir / "packages") in
307
+
let packages_dir = Day11_batch.Snapshot.packages_dir snapshot_dir in
308
+
ignore (Bos.OS.Dir.create ~path:true packages_dir);
302
309
let fake_strategy pkg =
303
310
let pkg_str = OpamPackage.to_string pkg in
304
-
{ Day11_build.Types.cmd =
311
+
{ Day11_opam_build.Types.cmd =
305
312
Printf.sprintf "echo 'fake-build %s'" pkg_str;
306
-
cleanup = Day11_build.Build_layer.opam_build_cleanup }
313
+
cleanup = Day11_opam_build.Build_layer.opam_build_cleanup }
314
+
in
315
+
(* Accumulate build outcomes for Summary *)
316
+
let build_outcomes_lock = Mutex.create () in
317
+
let build_outcomes : Day11_batch.Summary.build_outcome list ref = ref [] in
318
+
let record_build_outcome (node : Day11_opam_layer.Build.t) success =
319
+
let blessed =
320
+
List.exists (fun (_target, map) ->
321
+
Day11_batch.Blessing.is_blessed map node.pkg
322
+
) blessing_maps
323
+
in
324
+
let log_file =
325
+
let dir = Day11_opam_layer.Build.dir ~os_dir node in
326
+
let p = Fpath.(dir / "build.log") in
327
+
if Sys.file_exists (Fpath.to_string p) then Some p else None
328
+
in
329
+
let outcome : Day11_batch.Summary.build_outcome = {
330
+
pkg = node.pkg;
331
+
build_hash = node.hash;
332
+
success;
333
+
log_file;
334
+
blessed;
335
+
} in
336
+
Mutex.lock build_outcomes_lock;
337
+
build_outcomes := outcome :: !build_outcomes;
338
+
Mutex.unlock build_outcomes_lock
307
339
in
308
340
let build_one (node : Day11_opam_layer.Build.t) =
309
341
let strategy =
···
323
355
installed_libs;
324
356
installed_docs;
325
357
patches = (match patches with
326
-
| Some p -> Day11_build.Patches.patch_filenames p node.pkg
358
+
| Some p -> Day11_opam_build.Patches.patch_filenames p node.pkg
327
359
| None -> []);
328
360
} in
329
361
ignore (Day11_opam_layer.Build_meta.save layer_dir bm)
330
362
in
331
-
match Day11_build.Build_layer.build env benv ?patches
363
+
match Day11_opam_build.Build_layer.build env benv ?patches
332
364
~mounts:base_mounts ~on_extract node ?strategy () with
333
-
| Day11_build.Types.Success _ ->
365
+
| Day11_opam_build.Types.Success _ ->
334
366
let layer_name = Day11_opam_layer.Build.dir_name node in
335
367
ignore (Day11_layer.Symlinks.ensure
336
368
~packages_dir ~id:pkg_str ~layer_name);
369
+
record_build_outcome node true;
337
370
true
338
-
| _ -> false
371
+
| _ ->
372
+
record_build_outcome node false;
373
+
false
339
374
in
340
375
(* Build + Docs (unified pipeline when --with-doc) *)
341
376
if with_doc then begin
···
350
385
(* Build only — no docs *)
351
386
let is_cached node =
352
387
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
353
-
let cached =
354
-
Bos.OS.File.exists Fpath.(layer_dir / "layer.json")
355
-
|> Result.get_ok
356
-
in
357
-
if cached then Day11_layer.Last_used.touch layer_dir;
358
-
cached
388
+
let layer_json = Fpath.(layer_dir / "layer.json") in
389
+
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
390
+
Day11_opam_build.Dag_executor.Not_cached
391
+
else begin
392
+
Day11_layer.Last_used.touch layer_dir;
393
+
match Day11_layer.Meta.load layer_json with
394
+
| Ok meta ->
395
+
let success = meta.exit_status = 0 in
396
+
record_build_outcome node success;
397
+
if success then Day11_opam_build.Dag_executor.Cached_ok
398
+
else Day11_opam_build.Dag_executor.Cached_fail
399
+
| Error _ ->
400
+
record_build_outcome node false;
401
+
Day11_opam_build.Dag_executor.Cached_fail
402
+
end
359
403
in
360
-
Day11_build.Dag_executor.execute env ~np ~is_cached
361
-
~on_complete:(fun ~total ~completed ~failed node success ->
362
-
let status = if success then "ok" else "fail" in
363
-
let layer = Fpath.to_string
364
-
(Day11_opam_layer.Build.dir ~os_dir node) in
365
-
Day11_lib.Run_log.log_build_result run_log
366
-
~pkg:(OpamPackage.to_string node.pkg)
367
-
~hash:node.hash ~status ~failed_dep:None
368
-
~kind:"build" ~layer_dir:layer ();
369
-
if not success then
370
-
Printf.printf "[%d/%d, %d failed] FAIL: %s\n%!"
371
-
completed total failed (OpamPackage.to_string node.pkg)
372
-
else if completed mod 100 = 0 then
373
-
Printf.printf "[%d/%d, %d failed] %s\n%!"
374
-
completed total failed (OpamPackage.to_string node.pkg))
404
+
let cascaded_set : (string, unit) Hashtbl.t = Hashtbl.create 256 in
405
+
Day11_opam_build.Dag_executor.execute env ~np ~is_cached
406
+
~on_complete:(fun ~stats node success ->
407
+
let open Day11_opam_build.Dag_executor in
408
+
if Hashtbl.mem cascaded_set node.hash then
409
+
()
410
+
else begin
411
+
let status = if success then "ok" else "fail" in
412
+
let layer = Fpath.to_string
413
+
(Day11_opam_layer.Build.dir ~os_dir node) in
414
+
Day11_lib.Run_log.log_build_result run_log
415
+
~pkg:(OpamPackage.to_string node.pkg)
416
+
~hash:node.hash ~status ~failed_dep:None
417
+
~kind:"build" ~layer_dir:layer ();
418
+
if not success then
419
+
Printf.printf "[%d/%d, %d ok, %d failed, %d cascade] FAIL: %s\n%!"
420
+
stats.completed stats.total stats.ok stats.failed
421
+
stats.cascaded (OpamPackage.to_string node.pkg)
422
+
else if stats.completed mod 100 = 0 then
423
+
Printf.printf "[%d/%d, %d ok, %d failed, %d cascade] %s\n%!"
424
+
stats.completed stats.total stats.ok stats.failed
425
+
stats.cascaded (OpamPackage.to_string node.pkg)
426
+
end)
375
427
~on_cascade:(fun ~failed ~failed_dep ->
428
+
Hashtbl.replace cascaded_set failed.hash ();
429
+
(* Write a skeleton layer.json so re-runs skip this node *)
430
+
let layer_dir = Day11_opam_layer.Build.dir ~os_dir failed in
431
+
ignore (Bos.OS.Dir.create ~path:true layer_dir);
432
+
let layer_json = Fpath.(layer_dir / "layer.json") in
433
+
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then begin
434
+
let meta : Day11_layer.Meta.t = {
435
+
exit_status = 1;
436
+
parent_hashes = [];
437
+
uid = benv.uid; gid = benv.gid;
438
+
base_hash = benv.base.hash;
439
+
disk_usage = 0;
440
+
timing = Day11_layer.Meta.empty_timing;
441
+
created_at = "";
442
+
failed_dep = Some (Day11_opam_layer.Build.dir_name failed_dep);
443
+
} in
444
+
ignore (Day11_layer.Meta.save layer_json meta)
445
+
end;
446
+
(* Create package symlink so the failure is discoverable *)
447
+
let pkg_str = OpamPackage.to_string failed.pkg in
448
+
let layer_name = Day11_opam_layer.Build.dir_name failed in
449
+
ignore (Day11_layer.Symlinks.ensure
450
+
~packages_dir ~id:pkg_str ~layer_name);
376
451
Day11_lib.Run_log.log_build_result run_log
377
452
~pkg:(OpamPackage.to_string failed.pkg)
378
453
~hash:failed.hash ~status:"cascade"
379
454
~failed_dep:(Some (OpamPackage.to_string failed_dep.pkg))
380
-
~kind:"build" ())
455
+
~kind:"build" ();
456
+
record_build_outcome failed false)
381
457
nodes build_one
382
458
end;
383
459
(* JTW *)
···
387
463
Day11_jtw.Build_tools.build_and_run env benv ~np ~os_dir
388
464
~packages:git_packages ~repos:repos_with_shas ~mounts:[repo_mount]
389
465
~extra_repo_dirs:extra_pins ~repo_dir:dir ~output
390
-
~nodes ~solutions
466
+
~nodes ~solutions:build_solutions
391
467
| None -> ());
392
-
(* Write final summary *)
468
+
(* Write final summary via Summary module *)
393
469
Day11_lib.Run_log.close_build_log ();
394
-
let n_ok = ref 0 in
395
-
let n_fail = ref 0 in
396
-
let n_cascade = ref 0 in
397
-
List.iter (fun (node : Day11_opam_layer.Build.t) ->
398
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
399
-
match Day11_layer.Meta.load Fpath.(dir / "layer.json") with
400
-
| Ok meta ->
401
-
if meta.exit_status = 0 then incr n_ok
402
-
else if meta.exit_status = -1 then incr n_cascade
403
-
else incr n_fail
404
-
| Error _ -> ()
405
-
) nodes;
406
-
ignore (Day11_lib.Run_log.finish_run run_log
407
-
~targets_requested:(List.length targets)
408
-
~packages_built:!n_ok ~packages_failed:!n_fail
409
-
~docs_generated:0 ~failures:[]);
470
+
let compiler = match ocaml_version with
471
+
| Some v -> OpamPackage.to_string v
472
+
| None -> "unknown"
473
+
in
474
+
let results : Day11_batch.Summary.results = {
475
+
builds = !build_outcomes;
476
+
docs = [];
477
+
targets;
478
+
} in
479
+
ignore (Day11_batch.Summary.finish ~os_dir ~packages_dir
480
+
~run_info:run_log ~compiler results);
410
481
0
411
482
end
412
483
···
426
497
let doc = "Delete and rebuild the base image (use when repos or opam-build change)" in
427
498
Arg.(value & flag & info [ "rebuild-base" ] ~doc)
428
499
429
-
let small_universe_term =
430
-
let doc = "Build only ~20 core packages instead of all" in
431
-
Arg.(value & flag & info [ "small-universe" ] ~doc)
432
-
433
-
let all_versions_term =
434
-
let doc = "Build all versions of each package, not just the latest" in
435
-
Arg.(value & flag & info [ "all-versions" ] ~doc)
436
-
437
-
let with_doc_term =
438
-
let doc = "Generate documentation" in
439
-
Arg.(value & flag & info [ "with-doc" ] ~doc)
440
-
441
-
let odoc_repo_term =
442
-
let doc = "Path to local odoc source checkout (pins odoc packages to dev)" in
443
-
Arg.(value & opt (some string) None & info [ "odoc-repo" ] ~docv:"DIR" ~doc)
444
-
445
-
let jtw_repo_term =
446
-
let doc = "Path to local js_top_worker source checkout (pins jtw packages to dev)" in
447
-
Arg.(value & opt (some string) None & info [ "jtw-repo" ] ~docv:"DIR" ~doc)
448
-
449
-
let extra_pin_term =
450
-
let doc = "Extra local source checkout to pin (repeatable). Reads .opam \
451
-
files and pins all packages to dev." in
452
-
Arg.(value & opt_all string [] & info [ "extra-pin" ] ~docv:"DIR" ~doc)
453
-
454
-
let driver_compiler_term =
455
-
let doc = "Compiler for doc driver tools (default ocaml-base-compiler.5.4.1). \
456
-
Only the driver layer uses this; odoc itself is built per target compiler." in
457
-
Arg.(value & opt string "ocaml-base-compiler.5.4.1" &
458
-
info [ "driver-compiler" ] ~docv:"PKG" ~doc)
459
-
460
500
let fake_build_term =
461
501
let doc = "Replace opam-build with a trivial echo command (for testing)" in
462
502
Arg.(value & flag & info [ "fake-build" ] ~doc)
463
503
464
504
let target_term =
465
-
let doc = "Target package (e.g. astring.0.8.5) or @filename for \
466
-
package list. Omit for all packages." in
505
+
let doc = "Optional target package (overrides profile's target mode)" in
467
506
Arg.(value & pos 0 (some string) None & info [] ~docv:"TARGET" ~doc)
468
507
469
508
let cmd =
470
509
let info = Cmd.info "batch" ~doc:"Solve, build, and document packages" in
471
-
let term = Term.(const run $ Common.cache_dir_term $ Common.opam_repo_term
472
-
$ Common.np_term $ Common.arch_term $ Common.os_distribution_term
473
-
$ Common.os_version_term $ with_doc_term $ Common.ocaml_version_term
474
-
$ odoc_repo_term $ jtw_repo_term $ Common.patches_dir_term
475
-
$ Common.opam_build_repo_term $ solve_only_term $ dry_run_term
476
-
$ rebuild_failed_term $ rebuild_base_term $ small_universe_term
477
-
$ all_versions_term
478
-
$ extra_pin_term $ driver_compiler_term $ fake_build_term $ target_term) in
510
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
511
+
$ Common.np_term
512
+
$ solve_only_term $ dry_run_term
513
+
$ rebuild_failed_term $ rebuild_base_term $ fake_build_term
514
+
$ target_term) in
479
515
Cmd.v info term
+245
day11/bin/cmd_build.ml
+245
day11/bin/cmd_build.ml
···
1
+
(** build command: solve and build a single package within a profile *)
2
+
3
+
open Cmdliner
4
+
5
+
let run profile_name profile_dir np target_str doc_output rebuild_failed =
6
+
let profile, paths = match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Ok x -> x | Error (`Msg e) -> Printf.eprintf "Error: %s\n" e; exit 1
8
+
in
9
+
Common.ensure_paths paths;
10
+
let os_dir = paths.os_dir in
11
+
let ocaml_version = Common.parse_ocaml_version profile.compiler in
12
+
let opam_repositories = profile.opam_repositories in
13
+
let patches_dir = profile.patches_dir in
14
+
let opam_build_repo = profile.opam_build_repo in
15
+
let git_packages, repos_with_shas, _opam_env =
16
+
Common.setup_solver opam_repositories in
17
+
let target = OpamPackage.of_string target_str in
18
+
Printf.printf "Target: %s\n%!" target_str;
19
+
(* Snapshot *)
20
+
let snapshot = Day11_batch.Snapshot.current profile in
21
+
let snapshot_dir = Fpath.(paths.snapshots_base / snapshot.key) in
22
+
ignore (Bos.OS.Dir.create ~path:true snapshot_dir);
23
+
ignore (Day11_batch.Snapshot.save snapshot_dir snapshot);
24
+
(* Solve *)
25
+
let solutions_dir = Day11_batch.Snapshot.solutions_dir snapshot_dir in
26
+
ignore (Bos.OS.Dir.create ~path:true solutions_dir);
27
+
Printf.printf "Solving...\n%!";
28
+
let result = Day11_solver_pool.Solver_pool.solve_many
29
+
?ocaml_version ~np:1 ~repos:repos_with_shas [ target ] in
30
+
match List.find_opt (fun (_, r) -> Result.is_ok r) result with
31
+
| None ->
32
+
let err = match result with
33
+
| [ (_, Error (msg, _)) ] -> msg
34
+
| _ -> "unknown error"
35
+
in
36
+
Printf.eprintf "Solve failed: %s\n%!" err; 1
37
+
| Some (target, Ok solve_result) ->
38
+
let solution = solve_result.Day11_solution.Solve_result.build_deps in
39
+
Printf.printf "Solved: %d packages\n%!"
40
+
(OpamPackage.Map.cardinal solution);
41
+
(* Build DAG *)
42
+
let find_opam = Day11_opam.Git_packages.find_package git_packages in
43
+
let patches = Option.map (fun dir ->
44
+
Day11_opam_build.Patches.create (Fpath.v dir)) patches_dir in
45
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam ?patches () in
46
+
let build_solutions = [ (target, solution) ] in
47
+
let base_hash = Day11_opam_build.Base.build_hash
48
+
~os_distribution:profile.os_distribution
49
+
~os_version:profile.os_version ~arch:profile.arch in
50
+
let nodes = Day11_opam_build.Dag.build_dag cache
51
+
~base_hash build_solutions in
52
+
Printf.printf "DAG: %d nodes\n%!" (List.length nodes);
53
+
(* Delete failed layers if requested *)
54
+
if rebuild_failed then begin
55
+
let deleted = ref 0 in
56
+
List.iter (fun (node : Day11_opam_layer.Build.t) ->
57
+
let dir = Day11_opam_layer.Build.dir ~os_dir node in
58
+
let layer_json = Fpath.(dir / "layer.json") in
59
+
if Bos.OS.File.exists layer_json |> Result.get_ok then
60
+
match Day11_layer.Meta.load layer_json with
61
+
| Ok { exit_status; _ } when exit_status <> 0 ->
62
+
ignore (Bos.OS.Path.delete ~recurse:true dir);
63
+
incr deleted
64
+
| _ -> ()
65
+
) nodes;
66
+
if !deleted > 0 then
67
+
Printf.printf "Deleted %d failed layers for rebuild\n%!" !deleted
68
+
end;
69
+
let n_cached = List.length (List.filter (fun (node : Day11_opam_layer.Build.t) ->
70
+
Bos.OS.File.exists Fpath.(Day11_opam_layer.Build.dir ~os_dir node / "layer.json")
71
+
|> Result.get_ok
72
+
) nodes) in
73
+
Printf.printf "Layers: %d cached, %d to build\n%!" n_cached
74
+
(List.length nodes - n_cached);
75
+
if n_cached = List.length nodes && doc_output = None then begin
76
+
Printf.printf "Everything cached, nothing to do.\n%!"; 0
77
+
end else begin
78
+
(* Build *)
79
+
Common.with_eio @@ fun env ->
80
+
let opam_build_repo_fpath = Option.map Fpath.v opam_build_repo in
81
+
(match Day11_opam_build.Base.build_opam_build env
82
+
~cache_dir:paths.cache_dir ~arch:profile.arch
83
+
?opam_build_repo:opam_build_repo_fpath () with
84
+
| Ok _ -> ()
85
+
| Error (`Msg e) ->
86
+
Printf.eprintf "opam-build build failed: %s\n%!" e; exit 1);
87
+
let base = match Day11_opam_build.Base.load_cached
88
+
~cache_dir:paths.cache_dir
89
+
~os_distribution:profile.os_distribution
90
+
~os_version:profile.os_version with
91
+
| Some b -> b
92
+
| None ->
93
+
Printf.printf "Building base image...\n%!";
94
+
let uid = Unix.getuid () and gid = Unix.getgid () in
95
+
(match Day11_opam_build.Base.build env ~cache_dir:paths.cache_dir
96
+
~os_distribution:profile.os_distribution
97
+
~os_version:profile.os_version ~arch:profile.arch
98
+
~opam_repositories:(List.map Fpath.v opam_repositories)
99
+
~uid ~gid () with
100
+
| Ok base -> base
101
+
| Error (`Msg e) ->
102
+
Printf.eprintf "Base image build failed: %s\n%!" e; exit 1)
103
+
in
104
+
let benv = Day11_opam_build.Types.make_build_env ~base ~os_dir () in
105
+
Day11_opam_build.Types.ensure_dirs benv;
106
+
(* Repo mount — reuse from snapshot if available, else build fresh *)
107
+
let merged_repo_dir = Fpath.(snapshot_dir / "merged-repo") in
108
+
if not (Bos.OS.Dir.exists merged_repo_dir |> Result.get_ok) then begin
109
+
Bos.OS.Dir.create ~path:true merged_repo_dir |> ignore;
110
+
List.iteri (fun i repo ->
111
+
let src = Fpath.v repo in
112
+
if i = 0 then
113
+
ignore (Day11_exec.Tree.copy ~source:src ~target:merged_repo_dir)
114
+
else
115
+
let src_pkgs = Fpath.(src / "packages") in
116
+
if Bos.OS.Dir.exists src_pkgs |> Result.get_ok then
117
+
ignore (Sys.command (Printf.sprintf "cp -a %s/* %s/packages/"
118
+
(Fpath.to_string src_pkgs) (Fpath.to_string merged_repo_dir)))
119
+
) opam_repositories
120
+
end;
121
+
let repo_mount = Day11_container.Mount.bind_rw
122
+
~src:(Fpath.to_string merged_repo_dir)
123
+
"/home/opam/.opam/repo/default" in
124
+
let base_mounts =
125
+
[ repo_mount ] @
126
+
(match Day11_opam_build.Base.opam_build_mount ~cache_dir:paths.cache_dir with
127
+
| Some m -> [ m ] | None -> [])
128
+
in
129
+
let packages_dir = Day11_batch.Snapshot.packages_dir snapshot_dir in
130
+
ignore (Bos.OS.Dir.create ~path:true packages_dir);
131
+
(* Build phase *)
132
+
let open Day11_opam_build.Dag_executor in
133
+
execute env ~np
134
+
~is_cached:(fun node ->
135
+
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
136
+
let layer_json = Fpath.(layer_dir / "layer.json") in
137
+
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
138
+
Not_cached
139
+
else
140
+
match Day11_layer.Meta.load layer_json with
141
+
| Ok meta when meta.exit_status = 0 ->
142
+
Day11_layer.Last_used.touch layer_dir;
143
+
Cached_ok
144
+
| _ -> Cached_fail)
145
+
~on_complete:(fun ~stats node success ->
146
+
if success then begin
147
+
let pkg_str = OpamPackage.to_string node.pkg in
148
+
let layer_name = Day11_opam_layer.Build.dir_name node in
149
+
ignore (Day11_layer.Symlinks.ensure ~packages_dir ~id:pkg_str ~layer_name)
150
+
end;
151
+
if stats.completed mod 10 = 0 || not success then
152
+
Printf.printf "[%d/%d, %d ok, %d failed] %s: %s\n%!"
153
+
stats.completed stats.total stats.ok stats.failed
154
+
(OpamPackage.to_string node.pkg)
155
+
(if success then "OK" else "FAIL"))
156
+
~on_cascade:(fun ~failed ~failed_dep ->
157
+
let layer_dir = Day11_opam_layer.Build.dir ~os_dir failed in
158
+
ignore (Bos.OS.Dir.create ~path:true layer_dir);
159
+
let layer_json = Fpath.(layer_dir / "layer.json") in
160
+
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then begin
161
+
let meta : Day11_layer.Meta.t = {
162
+
exit_status = 1; parent_hashes = [];
163
+
uid = benv.uid; gid = benv.gid;
164
+
base_hash = benv.base.hash;
165
+
disk_usage = 0;
166
+
timing = Day11_layer.Meta.empty_timing;
167
+
created_at = "";
168
+
failed_dep = Some (Day11_opam_layer.Build.dir_name failed_dep);
169
+
} in
170
+
ignore (Day11_layer.Meta.save layer_json meta)
171
+
end)
172
+
nodes
173
+
(fun node ->
174
+
match Day11_opam_build.Build_layer.build env benv ?patches
175
+
~mounts:base_mounts node () with
176
+
| Day11_opam_build.Types.Success _ -> true
177
+
| _ -> false);
178
+
(* Doc phase — only if --with-doc <dir> *)
179
+
(match doc_output with
180
+
| None -> ()
181
+
| Some output_dir ->
182
+
Printf.printf "\nGenerating docs to %s...\n%!" output_dir;
183
+
let output = Fpath.v output_dir in
184
+
ignore (Bos.OS.Dir.create ~path:true output);
185
+
(* Use a temporary os_dir for the odoc-store so we don't
186
+
pollute the shared batch cache *)
187
+
let doc_os_dir = Bos.OS.Dir.tmp "day11_build_doc_%s"
188
+
|> Result.get_ok in
189
+
(* Symlink the layer dirs from the shared cache into the temp
190
+
os_dir so the doc pipeline can find them *)
191
+
let _ = Sys.command (Printf.sprintf "ln -s %s/* %s/ 2>/dev/null"
192
+
(Fpath.to_string os_dir) (Fpath.to_string doc_os_dir)) in
193
+
let driver_compiler = OpamPackage.of_string profile.driver_compiler in
194
+
let odoc_repo = profile.odoc_repo in
195
+
let solutions = [ (target, solve_result) ] in
196
+
let blessing_maps =
197
+
[ (target, OpamPackage.Map.map (fun _ -> true) solution) ] in
198
+
Day11_lib.Run_log.set_log_base_dir (Fpath.to_string snapshot_dir);
199
+
let run_log = Day11_lib.Run_log.start_run () in
200
+
Day11_doc.Generate.build_tools_and_run env benv ~np
201
+
~os_dir:doc_os_dir
202
+
~packages:git_packages ~repos:repos_with_shas
203
+
~opam_env:_opam_env ~mounts:base_mounts
204
+
~driver_compiler ~odoc_repo
205
+
~build_one:(fun node ->
206
+
match Day11_opam_build.Build_layer.build env benv ?patches
207
+
~mounts:base_mounts node () with
208
+
| Day11_opam_build.Types.Success _ -> true
209
+
| _ -> false)
210
+
~opam_repositories ~cache ~run_log
211
+
~nodes ~solutions ~blessing_maps;
212
+
(* Move HTML from temp store to user's output dir *)
213
+
let html_root = Fpath.(doc_os_dir / "odoc-store" / "html") in
214
+
if Bos.OS.Dir.exists html_root |> Result.get_ok then begin
215
+
let cmd = Printf.sprintf "cp -a %s/* %s/ 2>/dev/null"
216
+
(Fpath.to_string html_root) (Fpath.to_string output) in
217
+
ignore (Sys.command cmd);
218
+
Printf.printf "HTML written to %s\n%!" output_dir
219
+
end;
220
+
(* Clean up temp store *)
221
+
ignore (Day11_exec.Sudo.rm_rf env doc_os_dir));
222
+
Printf.printf "Done.\n%!";
223
+
0
224
+
end
225
+
| _ -> Printf.eprintf "Unexpected result\n%!"; 1
226
+
227
+
let doc_output_term =
228
+
let doc = "Generate documentation and write HTML to DIR" in
229
+
Arg.(value & opt (some string) None & info [ "with-doc" ] ~docv:"DIR" ~doc)
230
+
231
+
let rebuild_failed_term =
232
+
let doc = "Delete failed layers and rebuild them" in
233
+
Arg.(value & flag & info [ "rebuild-failed" ] ~doc)
234
+
235
+
let target_term =
236
+
let doc = "Package to build (e.g. base.v0.17.3)" in
237
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
238
+
239
+
let cmd =
240
+
let doc = "Solve and build a single package" in
241
+
let info = Cmd.info "build" ~doc in
242
+
Cmd.v info
243
+
Term.(const run $ Common.profile_term $ Common.profile_dir_term
244
+
$ Common.np_term $ target_term $ doc_output_term
245
+
$ rebuild_failed_term)
+12
-9
day11/bin/cmd_debug.ml
+12
-9
day11/bin/cmd_debug.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run os_dir target keep command =
5
+
let run profile_name profile_dir target keep command =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
6
9
Common.with_eio @@ fun env ->
7
-
let os_dir = Common.fpath os_dir in
10
+
let os_dir = paths.os_dir in
8
11
(* Resolve target: hash or package name *)
9
12
let node =
10
13
match Day11_opam_layer.Build_meta.load_tree ~os_dir target with
11
14
| Ok n -> n
12
15
| Error _ ->
13
-
(* Try as package name — look up from history *)
16
+
(* Try as package name -- look up from history *)
14
17
let packages_dir = Fpath.(os_dir / "packages") in
15
18
let entries = Day11_lib.History.read ~packages_dir ~pkg_str:target in
16
19
let failure = List.find_opt (fun (e : Day11_lib.History.entry) ->
···
28
31
Printf.eprintf "No failed build found for %s\n" target;
29
32
exit 1
30
33
in
31
-
match Day11_build.Debug.setup env ~os_dir ~keep node with
34
+
match Day11_opam_build.Debug.setup env ~os_dir ~keep node with
32
35
| Error (`Msg e) ->
33
36
Printf.eprintf "Setup failed: %s\n" e; 1
34
37
| Ok session ->
35
38
Printf.printf "Debug container for %s\n%!"
36
39
(OpamPackage.to_string session.pkg);
37
40
let result = match command with
38
-
| Some cmd -> Day11_build.Debug.run_command env session cmd
39
-
| None -> Day11_build.Debug.run_interactive env session
41
+
| Some cmd -> Day11_opam_build.Debug.run_command env session cmd
42
+
| None -> Day11_opam_build.Debug.run_interactive env session
40
43
in
41
-
if not keep then Day11_build.Debug.teardown env session;
44
+
if not keep then Day11_opam_build.Debug.teardown env session;
42
45
if keep then
43
46
Printf.printf "Debug dir kept at: %s\n%!"
44
47
(Fpath.to_string session.temp_dir);
···
58
61
59
62
let cmd =
60
63
let info = Cmd.info "debug" ~doc:"Launch interactive debug container" in
61
-
let term = Term.(const run $ Common.os_dir_term $ target_term
62
-
$ keep_term $ command_term) in
64
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
65
+
$ target_term $ keep_term $ command_term) in
63
66
Cmd.v info term
+10
-7
day11/bin/cmd_disk.ml
+10
-7
day11/bin/cmd_disk.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run os_dir cache_dir =
6
-
let os_dir = Common.fpath os_dir in
7
-
let cache_dir = Common.fpath cache_dir in
8
-
let report = Day11_lib.Disk_usage.scan ~os_dir ~cache_dir in
9
-
Fmt.pr "%a\n" Day11_lib.Disk_usage.pp report;
10
-
0
5
+
let run profile_name profile_dir =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
9
+
let os_dir = paths.os_dir in
10
+
let cache_dir = paths.cache_dir in
11
+
let report = Day11_lib.Disk_usage.scan ~os_dir ~cache_dir in
12
+
Fmt.pr "%a\n" Day11_lib.Disk_usage.pp report;
13
+
0
11
14
12
15
let cmd =
13
16
let info = Cmd.info "disk" ~doc:"Show disk usage breakdown" in
14
-
let term = Term.(const run $ Common.os_dir_term $ Common.cache_dir_term) in
17
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term) in
15
18
Cmd.v info term
+9
-4
day11/bin/cmd_failures.ml
+9
-4
day11/bin/cmd_failures.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run os_dir =
6
-
let os_dir = Common.fpath os_dir in
7
-
let packages_dir = Fpath.(os_dir / "packages") in
5
+
let run profile_name profile_dir =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
9
+
match Common.latest_snapshot_dir paths with
10
+
| None -> Printf.printf "No snapshots found\n"; 1
11
+
| Some snapshot_dir ->
12
+
let packages_dir = Fpath.(snapshot_dir / "packages") in
8
13
let pkg_dir_s = Fpath.to_string packages_dir in
9
14
if not (Sys.file_exists pkg_dir_s) then begin
10
15
Printf.printf "No packages directory\n"; 1
···
34
39
35
40
let cmd =
36
41
let info = Cmd.info "failures" ~doc:"List packages with failing builds" in
37
-
let term = Term.(const run $ Common.os_dir_term) in
42
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term) in
38
43
Cmd.v info term
+81
-79
day11/bin/cmd_gc.ml
+81
-79
day11/bin/cmd_gc.ml
···
10
10
String.trim line
11
11
with _ -> "?"
12
12
13
-
let run cache_dir delete_orphans =
14
-
let cache_dir = Common.fpath cache_dir in
13
+
let run profile_name profile_dir delete_orphans =
14
+
match Common.load_profile ~profile_dir ~name:profile_name with
15
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
16
+
| Ok (_profile, paths) ->
17
+
let cache_dir = paths.cache_dir in
18
+
let os_dir = paths.os_dir in
19
+
let snapshot_dir = Common.latest_snapshot_dir paths in
15
20
Printf.printf "=== Garbage Collection ===\n\n";
16
21
Printf.printf "Disk usage:\n";
17
22
Printf.printf " Cache dir: %s\n"
···
23
28
let n_stale = Day11_lib.Gc.gc_stale_temp_dirs () in
24
29
if n_stale > 0 then
25
30
Printf.printf "Cleaned %d stale overlay temp dirs\n\n" n_stale;
26
-
(* 2. GC old solution caches — keep the 3 most recent *)
27
-
let solutions_dir = Fpath.(cache_dir / "solutions") in
28
-
(match Bos.OS.Dir.contents solutions_dir with
29
-
| Ok dirs ->
30
-
let dirs = dirs
31
-
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
32
-
|> List.sort (fun a b ->
33
-
let ma = try (Unix.stat (Fpath.to_string a)).Unix.st_mtime
34
-
with _ -> 0.0 in
35
-
let mb = try (Unix.stat (Fpath.to_string b)).Unix.st_mtime
36
-
with _ -> 0.0 in
37
-
compare mb ma)
38
-
in
39
-
if List.length dirs > 3 then begin
40
-
let to_delete = List.filteri (fun i _ -> i >= 3) dirs in
41
-
Printf.printf "Solution caches: keeping 3 of %d, deleting %d\n"
42
-
(List.length dirs) (List.length to_delete);
43
-
List.iter (fun d ->
44
-
Printf.printf " Deleting %s\n" (Fpath.basename d);
45
-
ignore (Sys.command (Printf.sprintf "rm -rf %s"
46
-
(Fpath.to_string d)))
47
-
) to_delete;
48
-
Printf.printf "\n"
49
-
end else
50
-
Printf.printf "Solution caches: %d (keeping all)\n\n"
51
-
(List.length dirs)
52
-
| Error _ -> ());
53
-
(* 3. GC old run dirs — keep last 10 *)
54
-
let runs_dir = Fpath.(cache_dir / "runs") in
55
-
(match Bos.OS.Dir.contents runs_dir with
56
-
| Ok dirs ->
57
-
let dirs = dirs
58
-
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
59
-
|> List.sort (fun a b ->
60
-
compare (Fpath.to_string b) (Fpath.to_string a))
61
-
in
62
-
if List.length dirs > 10 then begin
63
-
let to_delete = List.filteri (fun i _ -> i >= 10) dirs in
64
-
Printf.printf "Run dirs: keeping 10 of %d, deleting %d\n"
65
-
(List.length dirs) (List.length to_delete);
66
-
List.iter (fun d ->
67
-
ignore (Bos.OS.Path.delete ~recurse:true d)
68
-
) to_delete;
69
-
Printf.printf "\n"
70
-
end else
71
-
Printf.printf "Run dirs: %d (keeping all)\n\n" (List.length dirs)
72
-
| Error _ -> ());
31
+
(* 2. GC old solution caches -- keep the 3 most recent *)
32
+
(match snapshot_dir with
33
+
| Some snap_dir ->
34
+
let solutions_dir = Fpath.(snap_dir / "solutions") in
35
+
(match Bos.OS.Dir.contents solutions_dir with
36
+
| Ok dirs ->
37
+
let dirs = dirs
38
+
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
39
+
|> List.sort (fun a b ->
40
+
let ma = try (Unix.stat (Fpath.to_string a)).Unix.st_mtime
41
+
with _ -> 0.0 in
42
+
let mb = try (Unix.stat (Fpath.to_string b)).Unix.st_mtime
43
+
with _ -> 0.0 in
44
+
compare mb ma)
45
+
in
46
+
if List.length dirs > 3 then begin
47
+
let to_delete = List.filteri (fun i _ -> i >= 3) dirs in
48
+
Printf.printf "Solution caches: keeping 3 of %d, deleting %d\n"
49
+
(List.length dirs) (List.length to_delete);
50
+
List.iter (fun d ->
51
+
Printf.printf " Deleting %s\n" (Fpath.basename d);
52
+
ignore (Sys.command (Printf.sprintf "rm -rf %s"
53
+
(Fpath.to_string d)))
54
+
) to_delete;
55
+
Printf.printf "\n"
56
+
end else
57
+
Printf.printf "Solution caches: %d (keeping all)\n\n"
58
+
(List.length dirs)
59
+
| Error _ -> ())
60
+
| None ->
61
+
Printf.printf "No snapshot found, skipping solution GC\n\n");
62
+
(* 3. GC old run dirs -- keep last 10 *)
63
+
(match snapshot_dir with
64
+
| Some snap_dir ->
65
+
let runs_dir = Fpath.(snap_dir / "runs") in
66
+
(match Bos.OS.Dir.contents runs_dir with
67
+
| Ok dirs ->
68
+
let dirs = dirs
69
+
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
70
+
|> List.sort (fun a b ->
71
+
compare (Fpath.to_string b) (Fpath.to_string a))
72
+
in
73
+
if List.length dirs > 10 then begin
74
+
let to_delete = List.filteri (fun i _ -> i >= 10) dirs in
75
+
Printf.printf "Run dirs: keeping 10 of %d, deleting %d\n"
76
+
(List.length dirs) (List.length to_delete);
77
+
List.iter (fun d ->
78
+
ignore (Bos.OS.Path.delete ~recurse:true d)
79
+
) to_delete;
80
+
Printf.printf "\n"
81
+
end else
82
+
Printf.printf "Run dirs: %d (keeping all)\n\n" (List.length dirs)
83
+
| Error _ -> ())
84
+
| None ->
85
+
Printf.printf "No snapshot found, skipping run GC\n\n");
73
86
(* 4. Find referenced build layers from latest run's build.jsonl *)
74
87
let latest_run_dir =
75
-
match Bos.OS.Dir.contents runs_dir with
76
-
| Ok dirs ->
77
-
dirs
78
-
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
79
-
|> List.sort (fun a b ->
80
-
compare (Fpath.to_string b) (Fpath.to_string a))
81
-
|> (function d :: _ -> Some d | [] -> None)
82
-
| Error _ -> None
83
-
in
84
-
(* Find the os_dir *)
85
-
let os_dir =
86
-
match Bos.OS.Dir.contents cache_dir with
87
-
| Ok entries ->
88
-
List.find_opt (fun p ->
89
-
let name = Fpath.basename p in
90
-
String.length name > 0 &&
91
-
name <> "solutions" && name <> "runs" &&
92
-
name <> "base" && name <> "merged-repo" &&
93
-
not (Fpath.has_ext ".json" p) &&
94
-
Bos.OS.Dir.exists p |> Result.get_ok
95
-
) entries
96
-
| Error _ -> None
88
+
match snapshot_dir with
89
+
| None -> None
90
+
| Some snap_dir ->
91
+
let runs_dir = Fpath.(snap_dir / "runs") in
92
+
match Bos.OS.Dir.contents runs_dir with
93
+
| Ok dirs ->
94
+
dirs
95
+
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
96
+
|> List.sort (fun a b ->
97
+
compare (Fpath.to_string b) (Fpath.to_string a))
98
+
|> (function d :: _ -> Some d | [] -> None)
99
+
| Error _ -> None
97
100
in
98
-
(match os_dir, latest_run_dir with
99
-
| Some os_dir, Some run_dir ->
100
-
let os_dir_s = Fpath.to_string os_dir in
101
+
let os_dir_s = Fpath.to_string os_dir in
102
+
(match latest_run_dir with
103
+
| Some run_dir ->
101
104
(* Collect referenced layer names from build.jsonl *)
102
105
let build_jsonl = Fpath.(run_dir / "build.jsonl") in
103
106
let referenced =
···
148
151
(* 5. GC odoc store universes *)
149
152
let store_u = Filename.concat os_dir_s "odoc-store/odoc-out/u" in
150
153
if Sys.file_exists store_u then begin
151
-
(* All universes currently in use are referenced *)
152
154
let all_universes =
153
155
try Sys.readdir store_u |> Array.to_list
154
156
|> List.filter (fun n ->
···
157
159
Printf.printf "Odoc store: %d universe hashes in u/\n"
158
160
(List.length all_universes);
159
161
if delete_orphans then begin
160
-
(* For now, keep all — need solution data to determine referenced *)
161
162
Printf.printf " (universe GC requires solution data, skipping)\n\n"
162
163
end else
163
164
Printf.printf "\n"
164
165
end
165
-
| _ ->
166
-
Printf.printf "No os_dir or run data found.\n\n");
166
+
| None ->
167
+
Printf.printf "No run data found.\n\n");
167
168
(* 6. Summary *)
168
169
Printf.printf "Cache dir: %s\n"
169
170
(du (Printf.sprintf "du -sh %s 2>/dev/null | cut -f1"
···
176
177
177
178
let cmd =
178
179
let info = Cmd.info "gc" ~doc:"Reclaim disk space and clean up" in
179
-
let term = Term.(const run $ Common.cache_dir_term $ delete_orphans_term) in
180
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
181
+
$ delete_orphans_term) in
180
182
Cmd.v info term
+7
-3
day11/bin/cmd_log.ml
+7
-3
day11/bin/cmd_log.ml
···
32
32
| [] -> None
33
33
end
34
34
35
-
let run os_dir arg =
36
-
let os_dir = Common.fpath os_dir in
35
+
let run profile_name profile_dir arg =
36
+
match Common.load_profile ~profile_dir ~name:profile_name with
37
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
38
+
| Ok (_profile, paths) ->
39
+
let os_dir = paths.os_dir in
37
40
let layer = match resolve_layer os_dir arg with
38
41
| Some l -> l
39
42
| None ->
···
64
67
65
68
let cmd =
66
69
let info = Cmd.info "log" ~doc:"View build or doc log" in
67
-
let term = Term.(const run $ Common.os_dir_term $ target_term) in
70
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
71
+
$ target_term) in
68
72
Cmd.v info term
+167
day11/bin/cmd_profile.ml
+167
day11/bin/cmd_profile.ml
···
1
+
(** profile command: create, show, list, delete profiles *)
2
+
3
+
open Cmdliner
4
+
5
+
let profile_dir_term =
6
+
let doc = "Profile directory (default ~/.day11)" in
7
+
Arg.(value & opt string "" & info [ "profile-dir" ] ~docv:"DIR" ~doc)
8
+
9
+
let resolve_profile_dir s =
10
+
if s = "" then Day11_batch.Profile.default_dir ()
11
+
else Fpath.v s
12
+
13
+
let name_term =
14
+
let doc = "Profile name" in
15
+
Arg.(required & opt (some string) None & info [ "name" ] ~docv:"NAME" ~doc)
16
+
17
+
(* ── create ────────────────────────────────────────────────────── *)
18
+
19
+
let opam_repo_term =
20
+
let doc = "opam-repository path (repeatable, layered in order)" in
21
+
Arg.(non_empty & opt_all string [] &
22
+
info [ "opam-repository" ] ~docv:"DIR" ~doc)
23
+
24
+
let odoc_repo_term =
25
+
let doc = "Local odoc checkout to pin" in
26
+
Arg.(value & opt (some string) None & info [ "odoc-repo" ] ~docv:"DIR" ~doc)
27
+
28
+
let opam_build_repo_term =
29
+
let doc = "Local opam-build checkout" in
30
+
Arg.(value & opt (some string) None &
31
+
info [ "opam-build-repo" ] ~docv:"DIR" ~doc)
32
+
33
+
let compiler_term =
34
+
let doc = "Compiler version constraint (e.g. ocaml-base-compiler.5.4.1)" in
35
+
Arg.(value & opt (some string) None &
36
+
info [ "compiler" ] ~docv:"PKG" ~doc)
37
+
38
+
let all_versions_term =
39
+
let doc = "Build all versions of each package" in
40
+
Arg.(value & flag & info [ "all-versions" ] ~doc)
41
+
42
+
let small_universe_term =
43
+
let doc = "Build a curated small universe" in
44
+
Arg.(value & flag & info [ "small-universe" ] ~doc)
45
+
46
+
let with_doc_term =
47
+
let doc = "Generate documentation" in
48
+
Arg.(value & flag & info [ "with-doc" ] ~doc)
49
+
50
+
let arch_term =
51
+
let doc = "Architecture (default x86_64)" in
52
+
Arg.(value & opt string "x86_64" & info [ "arch" ] ~docv:"ARCH" ~doc)
53
+
54
+
let os_distribution_term =
55
+
let doc = "OS distribution (default debian)" in
56
+
Arg.(value & opt string "debian" &
57
+
info [ "os-distribution" ] ~docv:"DIST" ~doc)
58
+
59
+
let os_version_term =
60
+
let doc = "OS version (default bookworm)" in
61
+
Arg.(value & opt string "bookworm" &
62
+
info [ "os-version" ] ~docv:"VER" ~doc)
63
+
64
+
let driver_compiler_term =
65
+
let doc = "Compiler for doc driver tools" in
66
+
Arg.(value & opt string "ocaml-base-compiler.5.4.1" &
67
+
info [ "driver-compiler" ] ~docv:"PKG" ~doc)
68
+
69
+
let run_create profile_dir name opam_repositories odoc_repo opam_build_repo
70
+
compiler all_versions small_universe with_doc
71
+
arch os_distribution os_version driver_compiler =
72
+
let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
73
+
let target_mode =
74
+
if all_versions then Day11_batch.Profile.All_versions
75
+
else if small_universe then Day11_batch.Profile.Small_universe
76
+
else Day11_batch.Profile.All_versions
77
+
in
78
+
let profile : Day11_batch.Profile.t = {
79
+
name;
80
+
opam_repositories;
81
+
odoc_repo;
82
+
opam_build_repo;
83
+
compiler;
84
+
target_mode;
85
+
with_doc;
86
+
with_jtw = false;
87
+
jtw_repo = None;
88
+
arch;
89
+
os_distribution;
90
+
os_version;
91
+
driver_compiler;
92
+
extra_pins = [];
93
+
patches_dir = None;
94
+
} in
95
+
match Day11_batch.Profile.save ~dir profile with
96
+
| Ok () ->
97
+
Printf.printf "Profile '%s' created.\n%!" name;
98
+
Fmt.pr "%a@." Day11_batch.Profile.pp profile;
99
+
0
100
+
| Error (`Msg e) ->
101
+
Printf.eprintf "Error: %s\n%!" e; 1
102
+
103
+
let create_cmd =
104
+
let doc = "Create a new profile" in
105
+
let info = Cmd.info "create" ~doc in
106
+
Cmd.v info
107
+
Term.(const run_create
108
+
$ profile_dir_term $ name_term
109
+
$ opam_repo_term $ odoc_repo_term $ opam_build_repo_term
110
+
$ compiler_term $ all_versions_term $ small_universe_term
111
+
$ with_doc_term
112
+
$ arch_term $ os_distribution_term $ os_version_term
113
+
$ driver_compiler_term)
114
+
115
+
(* ── show ──────────────────────────────────────────────────────── *)
116
+
117
+
let run_show profile_dir name =
118
+
let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
119
+
match Day11_batch.Profile.load ~dir ~name with
120
+
| Ok profile ->
121
+
Fmt.pr "%a@." Day11_batch.Profile.pp profile;
122
+
0
123
+
| Error (`Msg e) ->
124
+
Printf.eprintf "Error: %s\n%!" e; 1
125
+
126
+
let show_cmd =
127
+
let doc = "Show a profile" in
128
+
let info = Cmd.info "show" ~doc in
129
+
Cmd.v info Term.(const run_show $ profile_dir_term $ name_term)
130
+
131
+
(* ── list ──────────────────────────────────────────────────────── *)
132
+
133
+
let run_list profile_dir =
134
+
let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
135
+
let names = Day11_batch.Profile.list ~dir in
136
+
if names = [] then
137
+
Printf.printf "No profiles found in %s\n%!" (Fpath.to_string dir)
138
+
else
139
+
List.iter (fun name -> Printf.printf "%s\n" name) names;
140
+
0
141
+
142
+
let list_cmd =
143
+
let doc = "List profiles" in
144
+
let info = Cmd.info "list" ~doc in
145
+
Cmd.v info Term.(const run_list $ profile_dir_term)
146
+
147
+
(* ── delete ────────────────────────────────────────────────────── *)
148
+
149
+
let run_delete profile_dir name =
150
+
let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
151
+
match Day11_batch.Profile.delete ~dir ~name with
152
+
| Ok () ->
153
+
Printf.printf "Profile '%s' deleted.\n%!" name; 0
154
+
| Error (`Msg e) ->
155
+
Printf.eprintf "Error: %s\n%!" e; 1
156
+
157
+
let delete_cmd =
158
+
let doc = "Delete a profile" in
159
+
let info = Cmd.info "delete" ~doc in
160
+
Cmd.v info Term.(const run_delete $ profile_dir_term $ name_term)
161
+
162
+
(* ── group ─────────────────────────────────────────────────────── *)
163
+
164
+
let cmd =
165
+
let doc = "Manage analysis profiles" in
166
+
let info = Cmd.info "profile" ~doc in
167
+
Cmd.group info [ create_cmd; show_cmd; list_cmd; delete_cmd ]
+11
-4
day11/bin/cmd_query.ml
+11
-4
day11/bin/cmd_query.ml
···
27
27
0
28
28
end
29
29
30
-
let run os_dir package =
31
-
let os_dir = Common.fpath os_dir in
32
-
let packages_dir = Fpath.(os_dir / "packages") in
30
+
let run profile_name profile_dir package =
31
+
match Common.load_profile ~profile_dir ~name:profile_name with
32
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
33
+
| Ok (_profile, paths) ->
34
+
match Common.latest_snapshot_dir paths with
35
+
| None -> Printf.printf "No snapshots found\n"; 1
36
+
| Some snapshot_dir ->
37
+
let os_dir = paths.os_dir in
38
+
let packages_dir = Fpath.(snapshot_dir / "packages") in
33
39
let entries = Day11_lib.History.read ~packages_dir ~pkg_str:package in
34
40
if entries = [] then
35
41
(* Fall back to showing layers discovered via symlinks *)
···
52
58
53
59
let cmd =
54
60
let info = Cmd.info "query" ~doc:"Show build history for a package" in
55
-
let term = Term.(const run $ Common.os_dir_term $ package_term) in
61
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
62
+
$ package_term) in
56
63
Cmd.v info term
+2
-2
day11/bin/cmd_rdeps.ml
+2
-2
day11/bin/cmd_rdeps.ml
···
13
13
Printf.eprintf "Cannot solve %s: %s\n" package diag; 1
14
14
| None ->
15
15
Printf.eprintf "No result for %s\n" package; 1
16
-
| Some (Ok (solution, _examined)) ->
17
-
let rdeps = Day11_graph.Rdeps.find [ solution ] pkg in
16
+
| Some (Ok result) ->
17
+
let rdeps = Day11_solution.Rdeps.find [ result.Day11_solution.Solve_result.build_deps ] pkg in
18
18
if OpamPackage.Set.is_empty rdeps then
19
19
Printf.printf "No reverse dependencies for %s\n" package
20
20
else begin
+11
-6
day11/bin/cmd_report.ml
+11
-6
day11/bin/cmd_report.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run cache_dir =
6
-
let cache_dir = Common.fpath cache_dir in
7
-
let runs_dir = Fpath.(cache_dir / "runs") in
5
+
let run profile_name profile_dir =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
9
+
match Common.latest_snapshot_dir paths with
10
+
| None -> Printf.printf "No snapshots found\n"; 1
11
+
| Some snapshot_dir ->
12
+
let runs_dir = Fpath.(snapshot_dir / "runs") in
8
13
let load_run f =
9
14
try
10
15
let data = In_channel.with_open_text (Fpath.to_string f)
···
110
115
end
111
116
| None ->
112
117
pr "## Changes\n\nNo previous run to compare.\n\n");
113
-
(* Top blockers — compute cascade block counts from failed_dep *)
118
+
(* Top blockers -- compute cascade block counts from failed_dep *)
114
119
pr "## Top Blockers\n\n";
115
120
let layers = latest_json |> member "layers" |> to_assoc in
116
121
(* blocked_by.(dep) = list of packages blocked by dep *)
···
171
176
pr "| ... | | |\n";
172
177
pr "\n*Run `day11 results` for full impact analysis.*\n";
173
178
(* Write report *)
174
-
let reports_dir = Fpath.(cache_dir / "reports") in
179
+
let reports_dir = Fpath.(paths.cache_dir / "reports") in
175
180
Bos.OS.Dir.create ~path:true reports_dir |> ignore;
176
181
let date = String.sub ts 0 10 in
177
182
let report_file = Fpath.(reports_dir / (date ^ ".md")) in
···
183
188
184
189
let cmd =
185
190
let info = Cmd.info "report" ~doc:"Generate daily build summary report" in
186
-
let term = Term.(const run $ Common.cache_dir_term) in
191
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term) in
187
192
Cmd.v info term
+10
-6
day11/bin/cmd_rerun.ml
+10
-6
day11/bin/cmd_rerun.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run os_dir layer_hash =
5
+
let run profile_name profile_dir layer_hash =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
6
9
Common.with_eio @@ fun env ->
7
-
let os_dir = Common.fpath os_dir in
10
+
let os_dir = paths.os_dir in
8
11
match Day11_opam_layer.Build_meta.load_tree ~os_dir layer_hash with
9
12
| Error (`Msg e) ->
10
13
Printf.eprintf "Cannot load layer %s: %s\n" layer_hash e;
11
14
1
12
15
| Ok node ->
13
-
let cache_dir = Fpath.parent os_dir in
16
+
let cache_dir = paths.cache_dir in
14
17
Printf.printf "Rerunning %s (%s)...\n%!"
15
18
(OpamPackage.to_string node.pkg)
16
19
(Day11_opam_layer.Build.dir_name node);
17
20
match Day11_batch.Rerun.rerun env ~os_dir ~cache_dir node with
18
-
| Day11_build.Types.Success _ ->
21
+
| Day11_opam_build.Types.Success _ ->
19
22
Printf.printf "Success\n"; 0
20
-
| Day11_build.Types.Failure msg ->
23
+
| Day11_opam_build.Types.Failure msg ->
21
24
Printf.printf "Failed: %s\n" msg; 1
22
25
| _ ->
23
26
Printf.printf "Unexpected result\n"; 1
···
28
31
29
32
let cmd =
30
33
let info = Cmd.info "rerun" ~doc:"Retry a failed build" in
31
-
let term = Term.(const run $ Common.os_dir_term $ hash_term) in
34
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
35
+
$ hash_term) in
32
36
Cmd.v info term
+51
-35
day11/bin/cmd_results.ml
+51
-35
day11/bin/cmd_results.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run cache_dir =
6
-
let cache_dir = Common.fpath cache_dir in
5
+
let run profile_name profile_dir =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
9
+
match Common.latest_snapshot_dir paths with
10
+
| None -> Printf.printf "No snapshots found\n"; 1
11
+
| Some snapshot_dir ->
7
12
(* Load solutions *)
8
-
let solutions_dir = Fpath.(cache_dir / "solutions") in
9
-
let all_solutions : (string, Day11_graph.Graph.solution) Hashtbl.t =
13
+
let solutions_dir = Fpath.(snapshot_dir / "solutions") in
14
+
let all_solutions : (string, Day11_solution.Deps.t) Hashtbl.t =
10
15
Hashtbl.create 4096 in
11
16
let n_solve_failures = ref 0 in
12
17
(match Bos.OS.Dir.contents solutions_dir with
···
38
43
&& Fpath.basename f <> "repos.json" then
39
44
match Day11_batch.Incremental_solver.load f with
40
45
| Ok (Day11_batch.Incremental_solver.Cached_solution
41
-
{ package; solution; _ }) ->
46
+
{ package; result; _ }) ->
42
47
let key = OpamPackage.to_string package in
43
48
if not (Hashtbl.mem all_solutions key) then
44
-
Hashtbl.replace all_solutions key solution
49
+
Hashtbl.replace all_solutions key result.build_deps
45
50
| Ok (Day11_batch.Incremental_solver.Cached_failure _) ->
46
51
incr n_solve_failures
47
52
| _ -> ()
···
53
58
Printf.printf " Solutions cached: %d (across all solve passes)\n"
54
59
(Hashtbl.length all_solutions);
55
60
Printf.printf " Solve failed: %d\n\n" !n_solve_failures;
56
-
(* Load runs *)
57
-
let runs_dir = Fpath.(cache_dir / "runs") in
61
+
(* Load runs -- each run is a subdirectory containing summary.json *)
62
+
let runs_dir = Fpath.(snapshot_dir / "runs") in
58
63
let load_run f =
59
64
try
60
65
let data = In_channel.with_open_text (Fpath.to_string f)
···
62
67
Some (Yojson.Safe.from_string data)
63
68
with _ -> None
64
69
in
65
-
let run_pkg_status json =
66
-
let open Yojson.Safe.Util in
67
-
let layers = json |> member "layers" |> to_assoc in
70
+
let run_pkg_status_from_jsonl run_dir =
71
+
let jsonl_path = Fpath.(run_dir / "build.jsonl") in
68
72
let pkg_status : (string, string) Hashtbl.t = Hashtbl.create 256 in
69
-
List.iter (fun (_hash, entry) ->
70
-
let pkg = entry |> member "package" |> to_string in
71
-
let status = entry |> member "status" |> to_string in
72
-
match Hashtbl.find_opt pkg_status pkg with
73
-
| Some "ok" -> ()
74
-
| _ -> Hashtbl.replace pkg_status pkg status
75
-
) layers;
73
+
if Sys.file_exists (Fpath.to_string jsonl_path) then begin
74
+
let ic = open_in (Fpath.to_string jsonl_path) in
75
+
Fun.protect ~finally:(fun () -> close_in ic) (fun () ->
76
+
try while true do
77
+
let line = input_line ic in
78
+
if String.length line > 0 then begin
79
+
let open Yojson.Safe.Util in
80
+
let json = Yojson.Safe.from_string line in
81
+
let pkg = json |> member "pkg" |> to_string in
82
+
let status = json |> member "status" |> to_string in
83
+
match Hashtbl.find_opt pkg_status pkg with
84
+
| Some "ok" -> ()
85
+
| _ -> Hashtbl.replace pkg_status pkg status
86
+
end
87
+
done with End_of_file -> ())
88
+
end;
76
89
pkg_status
77
90
in
78
91
let runs =
79
92
match Bos.OS.Dir.contents runs_dir with
80
-
| Ok files ->
81
-
files
82
-
|> List.filter (fun f -> Fpath.has_ext ".json" f)
93
+
| Ok entries ->
94
+
entries
95
+
|> List.filter (fun d ->
96
+
Sys.file_exists (Fpath.to_string Fpath.(d / "summary.json")))
83
97
|> List.sort (fun a b ->
84
98
compare (Fpath.to_string b) (Fpath.to_string a))
85
99
| Error _ -> []
86
100
in
87
101
(* Use latest run for build results and failure ranking *)
88
102
(match runs with
89
-
| latest_file :: _ ->
90
-
(match load_run latest_file with
103
+
| latest_dir :: _ ->
104
+
let summary_file = Fpath.(latest_dir / "summary.json") in
105
+
(match load_run summary_file with
91
106
| Some latest_json ->
92
107
let open Yojson.Safe.Util in
93
-
let ts = latest_json |> member "timestamp" |> to_string in
94
-
let ps = run_pkg_status latest_json in
108
+
let ts = latest_json |> member "run_id" |> to_string in
109
+
let ps = run_pkg_status_from_jsonl latest_dir in
95
110
let n_ok = Hashtbl.fold (fun _ s n ->
96
111
if s = "ok" then n + 1 else n) ps 0 in
97
112
let n_fail = Hashtbl.fold (fun _ s n ->
98
113
if s = "fail" then n + 1 else n) ps 0 in
99
114
let n_cascade = Hashtbl.fold (fun _ s n ->
100
115
if s = "cascade" then n + 1 else n) ps 0 in
101
-
let n_target_solved = match latest_json |> member "solved" with
116
+
let n_target_solved = match latest_json |> member "targets_requested" with
102
117
| `Int n -> Some n | _ -> None in
103
118
Printf.printf "=== Build Results (run %s) ===\n" ts;
104
119
(match n_target_solved with
···
178
193
(* Run history *)
179
194
if List.length runs > 1 then begin
180
195
Printf.printf "\n=== Run History ===\n";
181
-
List.iter (fun f ->
182
-
match load_run f with
196
+
List.iter (fun run_dir ->
197
+
match load_run Fpath.(run_dir / "summary.json") with
183
198
| Some json ->
184
199
let open Yojson.Safe.Util in
185
-
let ts = json |> member "timestamp" |> to_string in
186
-
let ps = run_pkg_status json in
200
+
let ts = json |> member "run_id" |> to_string in
201
+
let ps = run_pkg_status_from_jsonl run_dir in
187
202
let n_ok = Hashtbl.fold (fun _ s n ->
188
203
if s = "ok" then n + 1 else n) ps 0 in
189
204
let n_fail = Hashtbl.fold (fun _ s n ->
···
195
210
| None -> ()
196
211
) runs;
197
212
(* Diff last two runs *)
198
-
match load_run (List.nth runs 0), load_run (List.nth runs 1) with
199
-
| Some latest, Some prev ->
200
-
let latest_ps = run_pkg_status latest in
201
-
let prev_ps = run_pkg_status prev in
213
+
match load_run Fpath.((List.nth runs 0) / "summary.json"),
214
+
load_run Fpath.((List.nth runs 1) / "summary.json") with
215
+
| Some _latest, Some _prev ->
216
+
let latest_ps = run_pkg_status_from_jsonl (List.nth runs 0) in
217
+
let prev_ps = run_pkg_status_from_jsonl (List.nth runs 1) in
202
218
let fixed = ref [] in
203
219
let regressed = ref [] in
204
220
Hashtbl.iter (fun pkg status ->
···
240
256
let cmd =
241
257
let info = Cmd.info "results"
242
258
~doc:"Summarise build results with failure impact ranking" in
243
-
let term = Term.(const run $ Common.cache_dir_term) in
259
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term) in
244
260
Cmd.v info term
+9
-4
day11/bin/cmd_status.ml
+9
-4
day11/bin/cmd_status.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let run os_dir =
6
-
let os_dir = Common.fpath os_dir in
7
-
match Day11_lib.Status_index.read ~dir:os_dir with
5
+
let run profile_name profile_dir =
6
+
match Common.load_profile ~profile_dir ~name:profile_name with
7
+
| Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8
+
| Ok (_profile, paths) ->
9
+
match Common.latest_snapshot_dir paths with
10
+
| None -> Printf.printf "No snapshots found\n"; 1
11
+
| Some snapshot_dir ->
12
+
match Day11_lib.Status_index.read ~dir:snapshot_dir with
8
13
| None ->
9
14
Printf.printf "No status.json found\n";
10
15
1
···
34
39
35
40
let cmd =
36
41
let info = Cmd.info "status" ~doc:"Show build status overview" in
37
-
let term = Term.(const run $ Common.os_dir_term) in
42
+
let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term) in
38
43
Cmd.v info term
+54
day11/bin/common.ml
+54
day11/bin/common.ml
···
69
69
| None -> None
70
70
| Some s -> Some (OpamPackage.of_string s)
71
71
72
+
(* ── Profile support ───────────────────────────────────────────── *)
73
+
74
+
let profile_term =
75
+
let doc = "Profile name (from ~/.day11/profiles/)" in
76
+
Arg.(required & opt (some string) None & info [ "profile" ] ~docv:"NAME" ~doc)
77
+
78
+
let profile_dir_term =
79
+
let doc = "Profile directory (default ~/.day11)" in
80
+
Arg.(value & opt string "" & info [ "profile-dir" ] ~docv:"DIR" ~doc)
81
+
82
+
type paths = {
83
+
profile_dir : Fpath.t;
84
+
cache_dir : Fpath.t;
85
+
os_dir : Fpath.t;
86
+
snapshots_base : Fpath.t;
87
+
}
88
+
89
+
let resolve_profile_dir s =
90
+
if s = "" then Day11_batch.Profile.default_dir ()
91
+
else Fpath.v s
92
+
93
+
let load_profile ~profile_dir ~name =
94
+
let pdir = resolve_profile_dir profile_dir in
95
+
let profiles_dir = Fpath.(pdir / "profiles") in
96
+
match Day11_batch.Profile.load ~dir:profiles_dir ~name with
97
+
| Error e -> Error e
98
+
| Ok profile ->
99
+
let cache_dir = Fpath.(pdir / "cache") in
100
+
let os_dir = Fpath.(cache_dir / Day11_batch.Profile.os_dir_name profile) in
101
+
let snapshots_base = Fpath.(pdir / "snapshots" / name) in
102
+
Ok (profile, { profile_dir = pdir; cache_dir; os_dir; snapshots_base })
103
+
104
+
let ensure_paths (paths : paths) =
105
+
ignore (Bos.OS.Dir.create ~path:true paths.cache_dir);
106
+
ignore (Bos.OS.Dir.create ~path:true paths.os_dir);
107
+
ignore (Bos.OS.Dir.create ~path:true paths.snapshots_base)
108
+
109
+
let latest_snapshot_dir (paths : paths) =
110
+
match Bos.OS.Dir.contents paths.snapshots_base with
111
+
| Error _ -> None
112
+
| Ok entries ->
113
+
let dirs = entries
114
+
|> List.filter (fun p -> Bos.OS.Dir.exists p |> Result.get_ok)
115
+
|> List.filter_map (fun p ->
116
+
try
117
+
let stat = Unix.stat (Fpath.to_string p) in
118
+
Some (p, stat.Unix.st_mtime)
119
+
with Unix.Unix_error _ -> None)
120
+
|> List.sort (fun (_, t1) (_, t2) -> compare t2 t1)
121
+
in
122
+
match dirs with
123
+
| (p, _) :: _ -> Some p
124
+
| [] -> None
125
+
72
126
let read_pins_from_dir dir =
73
127
let opam_files = Sys.readdir dir |> Array.to_list
74
128
|> List.filter (fun f -> Filename.check_suffix f ".opam") in
+2
-1
day11/bin/dune
+2
-1
day11/bin/dune
···
1
1
(executable
2
2
(name main)
3
3
(public_name day11)
4
-
(libraries day11_batch day11_build day11_doc day11_exec day11_graph
4
+
(package day11)
5
+
(libraries day11_batch day11_opam_build day11_doc day11_exec day11_solution
5
6
day11_jtw day11_layer day11_lib day11_solver day11_solver_pool
6
7
bos cmdliner eio_main fpath git-unix opam-format unix))
+2
day11/bin/main.ml
+2
day11/bin/main.ml
+1
-1
day11/build/README.md
day11/opam_build/README.md
+1
-1
day11/build/README.md
day11/opam_build/README.md
day11/build/base.ml
day11/opam_build/base.ml
day11/build/base.ml
day11/opam_build/base.ml
-42
day11/build/base.mli
-42
day11/build/base.mli
···
1
-
(** Base image management. *)
2
-
3
-
val ensure :
4
-
Eio_unix.Stdenv.base ->
5
-
cache_dir:Fpath.t ->
6
-
image:string ->
7
-
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
8
-
9
-
val build :
10
-
Eio_unix.Stdenv.base ->
11
-
cache_dir:Fpath.t ->
12
-
os_distribution:string ->
13
-
os_version:string ->
14
-
arch:string ->
15
-
opam_repositories:Fpath.t list ->
16
-
uid:int ->
17
-
gid:int ->
18
-
unit ->
19
-
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
20
-
21
-
val build_opam_build :
22
-
Eio_unix.Stdenv.base ->
23
-
cache_dir:Fpath.t ->
24
-
arch:string ->
25
-
?opam_build_repo:Fpath.t ->
26
-
unit ->
27
-
(Fpath.t, [> Rresult.R.msg ]) result
28
-
(** Build opam-build binary separately and cache it.
29
-
Returns the path to the cached binary. *)
30
-
31
-
val opam_build_mount :
32
-
cache_dir:Fpath.t -> Day11_container.Mount.t option
33
-
(** Returns a mount for the cached opam-build binary, or None. *)
34
-
35
-
val hash : image:string -> string
36
-
val build_hash :
37
-
os_distribution:string -> os_version:string -> arch:string -> string
38
-
39
-
val load_cached :
40
-
cache_dir:Fpath.t ->
41
-
os_distribution:string -> os_version:string ->
42
-
Day11_layer.Base.t option
day11/build/build_layer.ml
day11/opam_build/build_layer.ml
day11/build/build_layer.ml
day11/opam_build/build_layer.ml
day11/build/build_layer.mli
day11/opam_build/build_layer.mli
day11/build/build_layer.mli
day11/opam_build/build_layer.mli
+3
-3
day11/build/dag.ml
day11/opam_build/dag.ml
+3
-3
day11/build/dag.ml
day11/opam_build/dag.ml
···
11
11
| None -> []
12
12
in
13
13
let universe =
14
-
Day11_graph.Universe.of_deps (OpamPackage.Set.of_list pkg_deps) in
14
+
Day11_solution.Universe.of_deps (OpamPackage.Set.of_list pkg_deps) in
15
15
let key = (OpamPackage.to_string pkg,
16
-
Day11_graph.Universe.to_string universe) in
16
+
Day11_solution.Universe.to_string universe) in
17
17
match Hashtbl.find_opt memo key with
18
18
| Some node -> node
19
19
| None ->
···
35
35
node
36
36
in
37
37
List.iter (fun (_target, solution) ->
38
-
let trans = Day11_graph.Graph.transitive_deps solution in
38
+
let trans = Day11_solution.Deps.transitive_deps solution in
39
39
OpamPackage.Map.iter (fun pkg _deps ->
40
40
ignore (get_node solution trans pkg)
41
41
) solution
+1
-1
day11/build/dag.mli
day11/opam_build/dag.mli
+1
-1
day11/build/dag.mli
day11/opam_build/dag.mli
···
6
6
val build_dag :
7
7
Hash_cache.t ->
8
8
base_hash:string ->
9
-
(OpamPackage.t * Day11_graph.Graph.solution) list ->
9
+
(OpamPackage.t * Day11_solution.Deps.t) list ->
10
10
Day11_opam_layer.Build.t list
11
11
(** [build_dag cache ~base_hash solutions] builds a deduplicated
12
12
DAG of build nodes across all solutions. *)
+37
-13
day11/build/dag_executor.ml
day11/opam_build/dag_executor.ml
+37
-13
day11/build/dag_executor.ml
day11/opam_build/dag_executor.ml
···
14
14
type build = Build.t
15
15
16
16
type outcome = Ok | Failed | Cascaded
17
+
type cache_status = Not_cached | Cached_ok | Cached_fail
18
+
19
+
type stats = {
20
+
total : int;
21
+
completed : int;
22
+
ok : int;
23
+
failed : int;
24
+
cascaded : int;
25
+
cached : int;
26
+
}
17
27
18
28
let execute env ~np ~on_complete ~on_cascade
19
-
?(priority = fun _ -> 0) ?(is_cached = fun _ -> false) nodes build_one =
20
-
let completed = Atomic.make 0 in
21
-
let failed = Atomic.make 0 in
29
+
?(priority = fun _ -> 0) ?(is_cached = fun _ -> Not_cached) nodes build_one =
30
+
let a_completed = Atomic.make 0 in
31
+
let a_ok = Atomic.make 0 in
32
+
let a_failed = Atomic.make 0 in
33
+
let a_cascaded = Atomic.make 0 in
22
34
let sem = Eio.Semaphore.make np in
23
35
let promises : (string, outcome Promise.t) Hashtbl.t =
24
36
Hashtbl.create (List.length nodes)
···
26
38
(* Pre-resolve cached nodes — no fibers needed *)
27
39
let n_cached = ref 0 in
28
40
List.iter (fun (node : build) ->
29
-
if is_cached node then begin
41
+
match is_cached node with
42
+
| Not_cached -> ()
43
+
| Cached_ok ->
30
44
let p, r = Promise.create () in
31
45
Hashtbl.replace promises node.hash p;
32
46
Promise.resolve r Ok;
33
47
incr n_cached
34
-
end
48
+
| Cached_fail ->
49
+
let p, r = Promise.create () in
50
+
Hashtbl.replace promises node.hash p;
51
+
Promise.resolve r Failed;
52
+
incr n_cached
35
53
) nodes;
54
+
let cached = !n_cached in
36
55
let uncached = List.filter (fun (node : build) ->
37
56
not (Hashtbl.mem promises node.hash)
38
57
) nodes in
39
58
let total = List.length uncached in
40
59
Printf.printf " Executor: %d cached (pre-resolved), %d to run\n%!"
41
-
!n_cached total;
60
+
cached total;
61
+
let make_stats () =
62
+
{ total; completed = Atomic.get a_completed;
63
+
ok = Atomic.get a_ok; failed = Atomic.get a_failed;
64
+
cascaded = Atomic.get a_cascaded; cached }
65
+
in
42
66
let sorted_nodes = List.sort (fun a b ->
43
67
compare (priority b) (priority a)) uncached in
44
68
let rec run_node (node : build) : outcome =
···
71
95
| None -> false
72
96
) node.deps
73
97
in
74
-
let c = Atomic.fetch_and_add completed 1 + 1 in
75
-
let f = Atomic.fetch_and_add failed 1 + 1 in
98
+
ignore (Atomic.fetch_and_add a_completed 1);
99
+
ignore (Atomic.fetch_and_add a_cascaded 1);
76
100
on_cascade ~failed:node ~failed_dep;
77
-
on_complete ~total ~completed:c ~failed:f node false;
101
+
on_complete ~stats:(make_stats ()) node false;
78
102
Cascaded
79
103
end else begin
80
104
Eio.Semaphore.acquire sem;
···
82
106
Fun.protect ~finally:(fun () -> Eio.Semaphore.release sem)
83
107
(fun () -> build_one node)
84
108
in
85
-
let c = Atomic.fetch_and_add completed 1 + 1 in
86
-
let f = if success then Atomic.get failed
87
-
else Atomic.fetch_and_add failed 1 + 1 in
88
-
on_complete ~total ~completed:c ~failed:f node success;
109
+
ignore (Atomic.fetch_and_add a_completed 1);
110
+
if success then ignore (Atomic.fetch_and_add a_ok 1)
111
+
else ignore (Atomic.fetch_and_add a_failed 1);
112
+
on_complete ~stats:(make_stats ()) node success;
89
113
if success then Ok else Failed
90
114
end
91
115
in
+17
-4
day11/build/dag_executor.mli
day11/opam_build/dag_executor.mli
+17
-4
day11/build/dag_executor.mli
day11/opam_build/dag_executor.mli
···
7
7
Cached nodes (identified by [is_cached]) have their promises
8
8
pre-resolved and are excluded from the executor loop entirely. *)
9
9
10
+
type cache_status = Not_cached | Cached_ok | Cached_fail
11
+
12
+
type stats = {
13
+
total : int;
14
+
completed : int;
15
+
ok : int;
16
+
failed : int;
17
+
cascaded : int;
18
+
cached : int;
19
+
}
20
+
10
21
val execute :
11
22
Eio_unix.Stdenv.base ->
12
23
np:int ->
13
-
on_complete:(total:int -> completed:int -> failed:int ->
24
+
on_complete:(stats:stats ->
14
25
Day11_opam_layer.Build.t -> bool -> unit) ->
15
26
on_cascade:(failed:Day11_opam_layer.Build.t ->
16
27
failed_dep:Day11_opam_layer.Build.t -> unit) ->
17
28
?priority:(Day11_opam_layer.Build.t -> int) ->
18
-
?is_cached:(Day11_opam_layer.Build.t -> bool) ->
29
+
?is_cached:(Day11_opam_layer.Build.t -> cache_status) ->
19
30
Day11_opam_layer.Build.t list ->
20
31
(Day11_opam_layer.Build.t -> bool) ->
21
32
unit
22
33
(** [execute env ~np ~on_complete ~on_cascade ?priority ?is_cached nodes build_one]
23
34
executes [nodes] in dependency order with up to [np] concurrent
24
-
workers. Nodes where [is_cached] returns [true] are pre-resolved
25
-
and skipped entirely. [build_one] is only called for uncached nodes. *)
35
+
workers. Nodes where [is_cached] returns [Cached_ok] or [Cached_fail]
36
+
are pre-resolved and skipped entirely. [Cached_fail] nodes propagate
37
+
failure to dependents (triggering cascades).
38
+
[build_one] is only called for uncached nodes. *)
day11/build/debug.ml
day11/opam_build/debug.ml
day11/build/debug.ml
day11/opam_build/debug.ml
day11/build/debug.mli
day11/opam_build/debug.mli
day11/build/debug.mli
day11/opam_build/debug.mli
+3
-2
day11/build/dune
day11/opam_build/dune
+3
-2
day11/build/dune
day11/opam_build/dune
···
1
1
(library
2
-
(name day11_build)
3
-
(libraries day11_container day11_exec day11_graph
2
+
(name day11_opam_build)
3
+
(public_name day11.opam-build)
4
+
(libraries day11_container day11_exec day11_solution
4
5
day11_layer day11_opam day11_opam_layer day11_runner
5
6
day11_solver_pool
6
7
bos dockerfile eio fpath opam-format rresult yojson unix))
day11/build/hash_cache.ml
day11/opam_build/hash_cache.ml
day11/build/hash_cache.ml
day11/opam_build/hash_cache.ml
day11/build/hash_cache.mli
day11/opam_build/hash_cache.mli
day11/build/hash_cache.mli
day11/opam_build/hash_cache.mli
day11/build/patches.ml
day11/opam_build/patches.ml
day11/build/patches.ml
day11/opam_build/patches.ml
-29
day11/build/test/dune
-29
day11/build/test/dune
···
1
-
(test
2
-
(name test_build)
3
-
(libraries day11_build day11_graph day11_layer
4
-
alcotest bos eio_main fpath opam-format yojson))
5
-
6
-
(executable
7
-
(name test_build_integration)
8
-
(libraries day11_build day11_layer day11_exec day11_test_util
9
-
alcotest astring bos eio_main fpath opam-format))
10
-
11
-
(executable
12
-
(name test_layered_build)
13
-
(libraries day11_build day11_layer day11_test_util
14
-
alcotest astring bos eio_main fpath opam-format))
15
-
16
-
(executable
17
-
(name test_from_scratch)
18
-
(libraries day11_build day11_graph day11_layer day11_solver day11_test_util
19
-
alcotest bos eio_main fpath opam-format))
20
-
21
-
(executable
22
-
(name test_tools)
23
-
(libraries day11_build day11_exec day11_layer day11_solver day11_test_util
24
-
alcotest astring bos eio_main fpath opam-format))
25
-
26
-
(executable
27
-
(name test_tools_pinned)
28
-
(libraries day11_build day11_layer day11_solver day11_test_util
29
-
alcotest bos eio_main fpath opam-format))
+9
-9
day11/build/test/test_build.ml
day11/opam_build/test/test_build.ml
+9
-9
day11/build/test/test_build.ml
day11/opam_build/test/test_build.ml
···
1
-
(* Tests for the day11_build library. *)
1
+
(* Tests for the day11_opam_build library. *)
2
2
3
-
open Day11_build
3
+
open Day11_opam_build
4
4
5
5
(* ── Helpers ─────────────────────────────────────────────────────── *)
6
6
···
10
10
11
11
let test_build_result_variants () =
12
12
let _s = Types.Success
13
-
{ hash = "build-abc"; pkg = pkg "x.1"; deps = []; universe = Day11_graph.Universe.dummy } in
13
+
{ hash = "build-abc"; pkg = pkg "x.1"; deps = []; universe = Day11_solution.Universe.dummy } in
14
14
let _f = Types.Failure "build-abc123" in
15
15
let _d = Types.Dependency_failed in
16
16
let _n = Types.No_solution "unsatisfiable" in
···
21
21
let node : Day11_opam_layer.Build.t = {
22
22
hash = "build-abc123";
23
23
pkg = pkg "yojson.2.2.2";
24
-
deps = [{ hash = "build-def456"; pkg = pkg "dune.3.0"; deps = []; universe = Day11_graph.Universe.dummy }];
25
-
universe = Day11_graph.Universe.dummy;
24
+
deps = [{ hash = "build-def456"; pkg = pkg "dune.3.0"; deps = []; universe = Day11_solution.Universe.dummy }];
25
+
universe = Day11_solution.Universe.dummy;
26
26
} in
27
27
Alcotest.(check string) "pkg"
28
28
"yojson.2.2.2" (OpamPackage.to_string node.pkg);
···
160
160
let u1 = (List.nth c_nodes 0).universe in
161
161
let u2 = (List.nth c_nodes 1).universe in
162
162
Alcotest.(check bool) "different universes"
163
-
false (Day11_graph.Universe.equal u1 u2)
163
+
false (Day11_solution.Universe.equal u1 u2)
164
164
165
165
let test_dag_universe_set () =
166
166
(* Check universe is computed from transitive deps *)
···
180
180
let b_node = List.find (fun (n : Day11_opam_layer.Build.t) ->
181
181
OpamPackage.to_string n.pkg = "b.1") nodes in
182
182
(* b.1's universe should include c.1 and d.1 (transitive deps) *)
183
-
let expected = Day11_graph.Universe.of_deps
183
+
let expected = Day11_solution.Universe.of_deps
184
184
(OpamPackage.Set.of_list [ pkg "c.1"; pkg "d.1" ]) in
185
185
Alcotest.(check bool) "universe includes transitive deps"
186
-
true (Day11_graph.Universe.equal b_node.universe expected)
186
+
true (Day11_solution.Universe.equal b_node.universe expected)
187
187
188
188
(* ── Test registration ───────────────────────────────────────────── *)
189
189
190
190
let () =
191
-
Alcotest.run "day11_build"
191
+
Alcotest.run "day11_opam_build"
192
192
[
193
193
( "Types",
194
194
[
+4
-4
day11/build/test/test_build_integration.ml
day11/opam_build/test/test_build_integration.ml
+4
-4
day11/build/test/test_build_integration.ml
day11/opam_build/test/test_build_integration.ml
···
1
1
(* Integration test: build an OCaml package using Build_layer.build.
2
2
3
3
Requires: Linux, runc, sudo, Docker, network access.
4
-
Run with: DAY11_INTEGRATION=true dune exec day11/build/test/test_build_integration.exe *)
4
+
Run with: DAY11_INTEGRATION=true dune exec day11/opam_build/test/test_build_integration.exe *)
5
5
6
-
open Day11_build
6
+
open Day11_opam_build
7
7
open Day11_test_util.Test_util
8
8
9
9
let base_image = "ocaml/opam:debian-ocaml-5.2"
···
22
22
let layer_hash = Day11_layer.Hash.of_strings
23
23
[ "build"; base.hash; "astring.0.8.5" ] in
24
24
let node : Day11_opam_layer.Build.t =
25
-
{ hash = layer_hash; pkg; deps = []; universe = Day11_graph.Universe.dummy } in
25
+
{ hash = layer_hash; pkg; deps = []; universe = Day11_solution.Universe.dummy } in
26
26
let result =
27
27
Build_layer.build env benv
28
28
~opam_repositories:[]
···
57
57
let layer_hash = Day11_layer.Hash.of_strings
58
58
[ "build"; base.hash; "astring.0.8.5" ] in
59
59
let node : Day11_opam_layer.Build.t =
60
-
{ hash = layer_hash; pkg; deps = []; universe = Day11_graph.Universe.dummy } in
60
+
{ hash = layer_hash; pkg; deps = []; universe = Day11_solution.Universe.dummy } in
61
61
let t0 = Unix.gettimeofday () in
62
62
let result =
63
63
Build_layer.build env benv
+6
-6
day11/build/test/test_from_scratch.ml
day11/opam_build/test/test_from_scratch.ml
+6
-6
day11/build/test/test_from_scratch.ml
day11/opam_build/test/test_from_scratch.ml
···
1
1
(* Integration test: build astring from scratch, including the compiler.
2
2
3
3
Requires: Linux, runc, sudo, Docker, network access, git opam-repository.
4
-
Run with: DAY11_INTEGRATION=true dune exec day11/build/test/test_from_scratch.exe *)
4
+
Run with: DAY11_INTEGRATION=true dune exec day11/opam_build/test/test_from_scratch.exe *)
5
5
6
-
open Day11_build
6
+
open Day11_opam_build
7
7
open Day11_test_util.Test_util
8
8
9
9
let os_distribution = "debian"
···
24
24
let solution =
25
25
match Day11_solver.Solve.solve ~packages:git_packages ~env:opam_env
26
26
(OpamPackage.of_string "astring.0.8.5") with
27
-
| Ok s -> s
28
-
| Error diag -> Alcotest.fail ("Solve failed: " ^ diag)
27
+
| Ok result -> result
28
+
| Error (diag, _) -> Alcotest.fail ("Solve failed: " ^ diag)
29
29
in
30
-
let pkgs = OpamPackage.Map.keys solution in
30
+
let pkgs = OpamPackage.Map.keys solution.Day11_solution.Solve_result.build_deps in
31
31
Printf.printf "Solved: %d packages\n%!" (List.length pkgs);
32
32
Printf.printf "\nBuilding base image from %s:%s...\n%!"
33
33
os_distribution os_version;
···
46
46
let layer_hash =
47
47
Hash_cache.layer_hash cache ~base_hash:base.hash all_pkgs in
48
48
let node : Day11_opam_layer.Build.t =
49
-
{ hash = layer_hash; pkg; deps; universe = Day11_graph.Universe.dummy } in
49
+
{ hash = layer_hash; pkg; deps; universe = Day11_solution.Universe.dummy } in
50
50
Printf.printf "\n--- Building %s (layer: %s, deps: %d) ---\n%!"
51
51
pkg_str (Day11_opam_layer.Build.dir_name node) (List.length deps);
52
52
let result =
+3
-3
day11/build/test/test_layered_build.ml
day11/opam_build/test/test_layered_build.ml
+3
-3
day11/build/test/test_layered_build.ml
day11/opam_build/test/test_layered_build.ml
···
1
1
(* Integration test: build OCaml packages layer by layer.
2
2
3
3
Requires: Linux, runc, sudo, Docker, network access.
4
-
Run with: DAY11_INTEGRATION=true dune exec day11/build/test/test_layered_build.exe *)
4
+
Run with: DAY11_INTEGRATION=true dune exec day11/opam_build/test/test_layered_build.exe *)
5
5
6
-
open Day11_build
6
+
open Day11_opam_build
7
7
open Day11_test_util.Test_util
8
8
9
9
let base_image = "ocaml/opam:debian-ocaml-5.2"
···
32
32
let layer_hash = Day11_layer.Hash.of_strings
33
33
([ "build"; base.hash; pkg_str ] @ dep_hashes) in
34
34
let node : Day11_opam_layer.Build.t =
35
-
{ hash = layer_hash; pkg; deps; universe = Day11_graph.Universe.dummy } in
35
+
{ hash = layer_hash; pkg; deps; universe = Day11_solution.Universe.dummy } in
36
36
Printf.printf "\n--- Building %s (layer: %s, deps: %d) ---\n%!"
37
37
pkg_str (Day11_opam_layer.Build.dir_name node) (List.length deps);
38
38
let result =
+2
-2
day11/build/test/test_tools.ml
day11/opam_build/test/test_tools.ml
+2
-2
day11/build/test/test_tools.ml
day11/opam_build/test/test_tools.ml
···
2
2
3
3
Requires: base image cache at /tmp/day11-scratch-cache,
4
4
opam-repository at /home/jjl25/opam-repository
5
-
Run with: DAY11_INTEGRATION=true dune exec day11/build/test/test_tools.exe *)
5
+
Run with: DAY11_INTEGRATION=true dune exec day11/opam_build/test/test_tools.exe *)
6
6
7
-
open Day11_build
7
+
open Day11_opam_build
8
8
open Day11_test_util.Test_util
9
9
10
10
let cache_dir = Fpath.v "/tmp/day11-scratch-cache"
+2
-2
day11/build/test/test_tools_pinned.ml
day11/opam_build/test/test_tools_pinned.ml
+2
-2
day11/build/test/test_tools_pinned.ml
day11/opam_build/test/test_tools_pinned.ml
···
13
13
DAY11_INTEGRATION=true \
14
14
OPAM_REPOSITORY=~/opam-repository \
15
15
ODOC_REPO=~/odoc \
16
-
dune exec day11/build/test/test_tools_pinned.exe *)
16
+
dune exec day11/opam_build/test/test_tools_pinned.exe *)
17
17
18
-
open Day11_build
18
+
open Day11_opam_build
19
19
open Day11_test_util.Test_util
20
20
21
21
let cache_dir =
-3
day11/build/test_noop/dune
-3
day11/build/test_noop/dune
+6
-6
day11/build/test_noop/test_executor.ml
day11/opam_build/test_noop/test_executor.ml
+6
-6
day11/build/test_noop/test_executor.ml
day11/opam_build/test_noop/test_executor.ml
···
21
21
let pkg = OpamPackage.of_string pkg_str in
22
22
(* Store without deps first, patch later *)
23
23
let node : Day11_opam_layer.Build.t =
24
-
{ hash; pkg; deps = []; universe = Day11_graph.Universe.dummy } in
24
+
{ hash; pkg; deps = []; universe = Day11_solution.Universe.dummy } in
25
25
Hashtbl.replace nodes_by_hash hash node;
26
26
ignore dep_hashes;
27
27
incr count
···
41
41
) dep_hashes in
42
42
let pkg = (Hashtbl.find nodes_by_hash hash).pkg in
43
43
Hashtbl.replace nodes_by_hash hash
44
-
{ Day11_opam_layer.Build.hash; pkg; deps; universe = Day11_graph.Universe.dummy }
44
+
{ Day11_opam_layer.Build.hash; pkg; deps; universe = Day11_solution.Universe.dummy }
45
45
done with End_of_file -> close_in ic);
46
46
let all_nodes = Hashtbl.fold (fun _ n acc -> n :: acc)
47
47
nodes_by_hash [] in
···
52
52
let max_active = Atomic.make 0 in
53
53
let t0 = Unix.gettimeofday () in
54
54
Eio_main.run @@ fun _env ->
55
-
Day11_build.Dag_executor.execute
55
+
Day11_opam_build.Dag_executor.execute
56
56
(_env :> Eio_unix.Stdenv.base) ~np
57
-
~on_complete:(fun ~total ~completed ~failed:_ _node _success ->
58
-
if completed mod 1000 = 0 then begin
57
+
~on_complete:(fun ~stats _node _success ->
58
+
if stats.completed mod 1000 = 0 then begin
59
59
let elapsed = Unix.gettimeofday () -. t0 in
60
60
Printf.printf " [%d/%d] %.1fs max_active=%d\n%!"
61
-
completed total elapsed (Atomic.get max_active)
61
+
stats.completed stats.total elapsed (Atomic.get max_active)
62
62
end)
63
63
~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ())
64
64
all_nodes
+5
-4
day11/build/tools.ml
day11/opam_build/tools.ml
+5
-4
day11/build/tools.ml
day11/opam_build/tools.ml
···
45
45
Rresult.R.error_msgf "Cannot solve %s: no result" pkg_str
46
46
| Some (Error (diag, _examined)) ->
47
47
Rresult.R.error_msgf "Cannot solve %s: %s" pkg_str diag
48
-
| Some (Ok (solution, _examined)) ->
48
+
| Some (Ok result) ->
49
+
let solution = result.Day11_solution.Solve_result.build_deps in
49
50
let cache = match cache with
50
51
| Some c -> c
51
52
| None ->
···
85
86
) nodes;
86
87
let failed = ref None in
87
88
Dag_executor.execute env ~np
88
-
~on_complete:(fun ~total ~completed ~failed:f node success ->
89
-
Printf.printf " [%d/%d, %d failed] %s: %s\n%!"
90
-
completed total f
89
+
~on_complete:(fun ~stats node success ->
90
+
Printf.printf " [%d/%d, %d ok, %d failed] %s: %s\n%!"
91
+
stats.completed stats.total stats.ok stats.failed
91
92
(OpamPackage.to_string node.pkg)
92
93
(if success then "OK" else "FAIL");
93
94
if not success && !failed = None then
day11/build/tools.mli
day11/opam_build/tools.mli
day11/build/tools.mli
day11/opam_build/tools.mli
+1
-1
day11/build/types.ml
day11/opam_build/types.ml
+1
-1
day11/build/types.ml
day11/opam_build/types.ml
-37
day11/build/types.mli
-37
day11/build/types.mli
···
1
-
(** Build types. *)
2
-
3
-
module Build = Day11_opam_layer.Build
4
-
module Tool = Day11_opam_layer.Tool
5
-
type build = Build.t
6
-
type tool = Tool.t
7
-
8
-
type build_env = {
9
-
base : Day11_layer.Base.t;
10
-
os_dir : Fpath.t;
11
-
uid : int;
12
-
gid : int;
13
-
}
14
-
(** Invariant build parameters for a batch run.
15
-
The opam switch is always ["default"]. *)
16
-
17
-
val make_build_env :
18
-
base:Day11_layer.Base.t -> os_dir:Fpath.t ->
19
-
?uid:int -> ?gid:int -> unit -> build_env
20
-
21
-
val packages_dir : build_env -> Fpath.t
22
-
val ensure_dirs : build_env -> unit
23
-
val switch : string
24
-
25
-
type build_result =
26
-
| Success of Day11_opam_layer.Build.t
27
-
| Failure of string
28
-
| Dependency_failed
29
-
| No_solution of string
30
-
| Solution of Day11_graph.Graph.solution
31
-
32
-
type build_strategy = {
33
-
cmd : string;
34
-
cleanup : Eio_unix.Stdenv.base -> Fpath.t -> unit;
35
-
}
36
-
(** A build strategy: the command to run inside the container,
37
-
and a cleanup function applied to the upper dir after the build. *)
+2
-2
day11/container/README.md
+2
-2
day11/container/README.md
···
8
8
9
9
No domain knowledge. This library does not know about opam packages,
10
10
layers in the day11 sense, caching, doc generation, or builds. It is
11
-
composed by `day11/build` (which adds all those concerns) to run one
11
+
composed by `day11/opam_build` (via `day11/runner`) to run one
12
12
container per package build.
13
13
14
14
## External dependencies
···
108
108
109
109
## A typical caller
110
110
111
-
The call order inside `day11/build/run_in_layers.ml`:
111
+
The call order inside `day11/runner/run_in_layers.ml`:
112
112
113
113
```ocaml
114
114
Overlay.mount env ~lower ~upper ~work ~target:merged;
+1
day11/container/dune
+1
day11/container/dune
+29
day11/doc-pages/batch.mld
+29
day11/doc-pages/batch.mld
···
1
+
{0 day11-batch}
2
+
3
+
Batch orchestration for documentation builds. {!Day11_batch.Targets} resolves CLI
4
+
arguments into a list of packages to process, supporting explicit
5
+
targets, JSON file input, small-universe mode, and all-versions mode.
6
+
{!Day11_batch.Incremental_solver} caches solver results keyed by opam-repo commit
7
+
SHA and reuses solutions whose examined package set does not overlap
8
+
with changed packages, avoiding redundant re-solving across runs.
9
+
{!Day11_batch.Blessing} selects the canonical documentation universe for each
10
+
package when it appears in multiple solutions, using a heuristic that
11
+
maximizes dependency count for richer docs. {!Day11_batch.Rerun} rebuilds failed
12
+
layers and cascades recovery to dependents whose failing dependency has
13
+
since succeeded. {!Day11_batch.Summary} aggregates build and doc outcomes, records
14
+
per-package history, generates the status index, and prints a
15
+
human-readable summary.
16
+
17
+
Sits near the top of the dependency hierarchy, depending on
18
+
{!day11-opam-build}, {!page-solution}, {!day11-lib}, {!day11-layer},
19
+
and {!day11-exec}.
20
+
21
+
{1 Modules}
22
+
23
+
{!modules:
24
+
Day11_batch.Targets
25
+
Day11_batch.Incremental_solver
26
+
Day11_batch.Blessing
27
+
Day11_batch.Rerun
28
+
Day11_batch.Summary
29
+
}
+23
day11/doc-pages/container.mld
+23
day11/doc-pages/container.mld
···
1
+
{0 day11-container}
2
+
3
+
OCI container runtime primitives. {!Day11_container.Overlay} wraps Linux overlayfs
4
+
mount/umount via sudo, assembling read-only lowers and a writable
5
+
upper into a single merged rootfs. {!Day11_container.Runc} drives the [runc] OCI
6
+
runtime to execute containers, with stdout/stderr capture and
7
+
container lifecycle management. {!Day11_container.Oci_spec} generates [config.json]
8
+
templates with sensible defaults (namespaces, capabilities, seccomp
9
+
sync-masking, standard system mounts) parameterized by the rootfs
10
+
path. {!Day11_container.Mount} describes bind-mount specifications for the OCI spec.
11
+
12
+
Depends on {!page-exec} for subprocess execution. Has no knowledge of
13
+
opam, layers, or build orchestration — callers compose these
14
+
primitives with the layer and runner libraries.
15
+
16
+
{1 Modules}
17
+
18
+
{!modules:
19
+
Day11_container.Overlay
20
+
Day11_container.Runc
21
+
Day11_container.Oci_spec
22
+
Day11_container.Mount
23
+
}
+41
day11/doc-pages/doc.mld
+41
day11/doc-pages/doc.mld
···
1
+
{0 day11-doc}
2
+
3
+
Documentation generation pipeline using odoc. {!Day11_doc.Generate} orchestrates
4
+
the two-pass process: compile (produce [.odoc] files per package) then
5
+
link (cross-reference and generate HTML), with tool builds integrated
6
+
into the unified DAG for parallel execution. {!Day11_doc.Doc_deps} determines
7
+
whether a package needs separate compile and link phases by comparing
8
+
its dependency graphs with and without [{post}] deps. {!Day11_doc.Phase} defines
9
+
doc phase and result types. {!Day11_doc.Command} generates the shell commands
10
+
for [odoc_driver_voodoo] invocations. {!Day11_doc.Prep} creates the directory
11
+
layout expected by the driver, using bind mounts to avoid copying
12
+
files from cached build layers. {!Day11_doc.Odoc_store} provides per-package
13
+
isolated mounts for odoc output with atomic commit on success.
14
+
{!Day11_doc.Sync} distributes generated HTML via rsync. {!Day11_doc.Combine} aggregates
15
+
doc layers into a single overlayfs for local viewing. {!Day11_doc.Tool_binaries}
16
+
extracts specific tool binaries for bind-mounting into containers.
17
+
{!Day11_doc.Tool_layer} manages driver and per-compiler odoc tool layers.
18
+
{!Day11_doc.Universe} tracks universe directories for documentation GC.
19
+
{!Day11_doc.Doc_meta} is the sidecar metadata for doc layers ([doc.json]),
20
+
recording the package name, phase, and dependencies.
21
+
22
+
Sits near the top of the dependency hierarchy, depending on
23
+
{!page-opam_build}, {!page-opam_layer}, {!page-layer},
24
+
{!page-container}, and {!page-exec}.
25
+
26
+
{1 Modules}
27
+
28
+
{!modules:
29
+
Day11_doc.Generate
30
+
Day11_doc.Doc_deps
31
+
Day11_doc.Doc_meta
32
+
Day11_doc.Phase
33
+
Day11_doc.Command
34
+
Day11_doc.Prep
35
+
Day11_doc.Odoc_store
36
+
Day11_doc.Sync
37
+
Day11_doc.Combine
38
+
Day11_doc.Tool_binaries
39
+
Day11_doc.Tool_layer
40
+
Day11_doc.Universe
41
+
}
+27
day11/doc-pages/exec.mld
+27
day11/doc-pages/exec.mld
···
1
+
{0 day11-exec}
2
+
3
+
Process execution primitives and filesystem utilities. {!Day11_exec.Run} launches
4
+
subprocesses via Eio with captured stdout/stderr. {!Day11_exec.Sudo} wraps
5
+
commands with privilege escalation for root-owned container artifacts.
6
+
{!Day11_exec.Dir_lock} provides dual-layer (in-process Eio mutex + cross-process
7
+
POSIX lockf) directory locking. {!Day11_exec.Fork_client} avoids the cost of
8
+
forking a large process by delegating to a small helper daemon.
9
+
{!Day11_exec.Atomic_swap} implements staging/commit/rollback for atomic directory
10
+
replacement. {!Day11_exec.Tree} provides recursive hardlink, copy, and diff-based
11
+
cleansing of directory trees. {!Day11_exec.Util} has miscellaneous helpers
12
+
(nproc, dir_size).
13
+
14
+
No domain knowledge — this library provides generic OS-level building
15
+
blocks used by every layer above it in the hierarchy.
16
+
17
+
{1 Modules}
18
+
19
+
{!modules:
20
+
Day11_exec.Run
21
+
Day11_exec.Sudo
22
+
Day11_exec.Dir_lock
23
+
Day11_exec.Fork_client
24
+
Day11_exec.Atomic_swap
25
+
Day11_exec.Tree
26
+
Day11_exec.Util
27
+
}
+47
day11/doc-pages/index.mld
+47
day11/doc-pages/index.mld
···
1
+
{0 day11}
2
+
3
+
An OCaml package build and documentation system. Builds opam packages
4
+
in layered overlayfs containers, generates documentation with odoc,
5
+
and manages a content-addressed layer cache.
6
+
7
+
{1 Architecture}
8
+
9
+
The libraries are organised in layers of increasing domain specificity.
10
+
11
+
{2 Foundation}
12
+
13
+
Generic primitives with no domain knowledge:
14
+
15
+
- {!page-solution} — Solution types: dependency graphs, solve results
16
+
- {!page-exec} — Process execution: sudo, locking, fork helper
17
+
- {!page-lib} — Shared utilities: logging, progress, GC, notifications
18
+
19
+
{2 Storage and Runtime}
20
+
21
+
Layered storage and OCI container execution:
22
+
23
+
- {!page-layer} — On-disk layer format, overlayfs stacking, LRU, hashing
24
+
- {!page-container} — OCI runtime: overlayfs mounts, runc, spec generation
25
+
- {!page-runner} — Intersection of layer + container: run commands in layered rootfs
26
+
27
+
{2 Opam Integration}
28
+
29
+
Package metadata, solver, and build orchestration:
30
+
31
+
- {!page-opam} — Git-backed opam package index, environment, dep extraction
32
+
- {!page-solver} — Dependency solving via opam-0install
33
+
- {!page-solver_pool} — Parallel out-of-process solving
34
+
- {!page-opam_layer} — Opam-flavoured layer types: build nodes, tools, sidecars
35
+
- {!page-opam_build} — Build orchestration: DAG execution, hash caching, tools
36
+
37
+
{2 Documentation Pipeline}
38
+
39
+
Odoc documentation generation:
40
+
41
+
- {!page-doc} — Full doc pipeline: compile, link, odoc store, metadata, tool management
42
+
43
+
{2 Batch and Extras}
44
+
45
+
- {!page-batch} — Batch orchestration: targets, incremental solving, blessing
46
+
- {!page-jtw} — JavaScript-to-Wasm build pipeline
47
+
- {!page-test_util} — Shared test helpers
+26
day11/doc-pages/jtw.mld
+26
day11/doc-pages/jtw.mld
···
1
+
{0 day11-jtw}
2
+
3
+
JavaScript-to-Wasm build pipeline for js_top_worker integration.
4
+
{!Day11_jtw.Build_tools} orchestrates end-to-end JTW processing: building tool
5
+
layers per compiler version, running per-package and per-solution
6
+
generation, and assembling the content-hashed output directory.
7
+
{!Day11_jtw.Generate} drives the three generation phases -- per-package artifact
8
+
extraction (cma.js, cmi, META), per-solution worker.js production, and
9
+
final assembly into a serving-ready directory structure. {!Day11_jtw.Tool_layer}
10
+
manages the JTW tool layer lifecycle: installing js_of_ocaml and
11
+
js_top_worker, building worker.js, and extracting stdlib CMIs per OCaml
12
+
version. {!Day11_jtw.Gen} provides pure utility functions for hashing, findlib
13
+
index generation, dynamic_cmis.json creation, and container script
14
+
generation.
15
+
16
+
Depends on {!day11-opam-build}, {!day11-container}, {!day11-doc},
17
+
{!day11-layer}, and {!day11-solver}.
18
+
19
+
{1 Modules}
20
+
21
+
{!modules:
22
+
Day11_jtw.Build_tools
23
+
Day11_jtw.Generate
24
+
Day11_jtw.Tool_layer
25
+
Day11_jtw.Gen
26
+
}
+33
day11/doc-pages/layer.mld
+33
day11/doc-pages/layer.mld
···
1
+
{0 day11-layer}
2
+
3
+
Generic layered storage on disk. A layer is a directory containing a
4
+
[fs/] tree (the filesystem delta) plus metadata files. {!Day11_layer.Meta}
5
+
serializes per-layer metadata ([layer.json]) covering exit status,
6
+
parent hashes, timing, and disk usage. {!Day11_layer.Dir} owns the
7
+
[build-XXXXXXXXXXXX] naming convention. {!Day11_layer.Base} represents the
8
+
foundational rootfs image at the bottom of every overlay stack.
9
+
{!Day11_layer.Hash} computes content-addressed cache keys from layer inputs.
10
+
{!Day11_layer.Stack} merges multiple layers into one directory via hardlinked
11
+
copies, and plans overlayfs lowerdir layouts that fit kernel page-size
12
+
limits. {!Day11_layer.Scan} enumerates layers from the on-disk cache. {!Day11_layer.Import}
13
+
extracts layer filesystems from Docker images. {!Day11_layer.Last_used} maintains
14
+
a cheap mtime-based sentinel for LRU eviction. {!Day11_layer.Symlinks} maintains
15
+
per-identifier tracking symlinks for layer discovery.
16
+
17
+
Depends on {!day11-exec} for subprocess and sudo access. Has no opam
18
+
or package-domain knowledge — domain-specific metadata lives in
19
+
sidecar files owned by higher libraries.
20
+
21
+
{1 Modules}
22
+
23
+
{!modules:
24
+
Day11_layer.Meta
25
+
Day11_layer.Dir
26
+
Day11_layer.Base
27
+
Day11_layer.Hash
28
+
Day11_layer.Stack
29
+
Day11_layer.Scan
30
+
Day11_layer.Import
31
+
Day11_layer.Last_used
32
+
Day11_layer.Symlinks
33
+
}
+38
day11/doc-pages/lib.mld
+38
day11/doc-pages/lib.mld
···
1
+
{0 day11-lib}
2
+
3
+
Shared utilities used across day11 libraries and binaries. {!Day11_lib.Run_log}
4
+
tracks the lifecycle of a batch run with structured JSONL logging,
5
+
phase files for mid-run status checks, and a final summary.
6
+
{!Day11_lib.Progress} maintains immutable progress state written as
7
+
[progress.json] for web dashboard polling. {!Day11_lib.History} provides
8
+
append-only per-package build history in JSONL format with file locking
9
+
for concurrent access. {!Day11_lib.Status_index} aggregates all packages' current
10
+
build status into a single snapshot, detecting changes between runs.
11
+
{!Day11_lib.Notify} sends messages to Slack, Zulip, Telegram, Email, or stdout.
12
+
{!Day11_lib.Disk_usage} reports cache disk consumption by category. {!Day11_lib.Gc}
13
+
garbage-collects unreferenced build layers and stale odoc store
14
+
entries. {!Day11_lib.Classify} scans build logs to categorize failures as
15
+
transient, missing depext, or genuine build errors. {!Day11_lib.Epoch} manages
16
+
atomic documentation deployment via versioned epoch directories and a
17
+
live symlink. {!Day11_lib.Build_config} persists batch run parameters so
18
+
rerun/cascade commands need no CLI arguments. {!Day11_lib.Build_lock} tracks
19
+
in-progress builds via file locks for dashboard and status reporting.
20
+
{!Day11_lib.Package_list} generates the list of successfully-built packages for
21
+
publishing.
22
+
23
+
{1 Modules}
24
+
25
+
{!modules:
26
+
Day11_lib.Run_log
27
+
Day11_lib.Progress
28
+
Day11_lib.History
29
+
Day11_lib.Status_index
30
+
Day11_lib.Notify
31
+
Day11_lib.Disk_usage
32
+
Day11_lib.Gc
33
+
Day11_lib.Classify
34
+
Day11_lib.Epoch
35
+
Day11_lib.Build_config
36
+
Day11_lib.Build_lock
37
+
Day11_lib.Package_list
38
+
}
+20
day11/doc-pages/opam.mld
+20
day11/doc-pages/opam.mld
···
1
+
{0 day11-opam}
2
+
3
+
Pure opam metadata helpers with no solver dependency.
4
+
{!Day11_opam.Git_packages} reads opam packages directly from git tree objects
5
+
without a working tree checkout, supporting both lazy and eager
6
+
loading, multi-repository layering, and inter-commit diffing.
7
+
{!Day11_opam.Git_utils} opens git stores and resolves commits and refs.
8
+
{!Day11_opam.Opam_env} provides the environment function for evaluating opam
9
+
filter expressions (arch, os, os-distribution, etc.).
10
+
This library has no dependency on the solver or the build system. It
11
+
sits near the bottom of the hierarchy, providing the package index
12
+
that the solver and build orchestration consume.
13
+
14
+
{1 Modules}
15
+
16
+
{!modules:
17
+
Day11_opam.Git_packages
18
+
Day11_opam.Git_utils
19
+
Day11_opam.Opam_env
20
+
}
+35
day11/doc-pages/opam_build.mld
+35
day11/doc-pages/opam_build.mld
···
1
+
{0 day11-opam-build}
2
+
3
+
Opam package build orchestration: compiles packages inside layered
4
+
containers and manages the build cache. {!Day11_opam_build.Build_layer} handles the
5
+
single-layer container lifecycle — locking, overlay mounting, runc
6
+
invocation, cleanup, and sidecar writing. {!Day11_opam_build.Dag} constructs
7
+
deduplicated DAGs of build nodes across multiple solver solutions.
8
+
{!Day11_opam_build.Dag_executor} runs the DAG in parallel using Eio fibers with
9
+
promise-based memoization, skipping cached nodes. {!Day11_opam_build.Hash_cache}
10
+
memoizes content-hash computation for layer cache keys. {!Day11_opam_build.Tools}
11
+
solves and builds tool packages (odoc, sherlodoc, etc.) from pinned
12
+
local checkouts or the opam repository. {!Day11_opam_build.Types} defines shared build
13
+
types: {!Day11_opam_build.Types.build_env}, {!Day11_opam_build.Types.build_result}, and
14
+
{!Day11_opam_build.Types.build_strategy}. {!Day11_opam_build.Base} manages base image layers (Docker
15
+
import and caching). {!Day11_opam_build.Debug} provides interactive debug containers
16
+
for investigating failed builds. {!Day11_opam_build.Patches} manages per-package patch
17
+
files that modify builds before execution.
18
+
19
+
Depends on {!day11-runner}, {!day11-opam-layer}, {!day11-solver} (via
20
+
solver_pool), {!day11-opam}, {!page-solution}, and the lower layer and
21
+
container libraries.
22
+
23
+
{1 Modules}
24
+
25
+
{!modules:
26
+
Day11_opam_build.Build_layer
27
+
Day11_opam_build.Dag
28
+
Day11_opam_build.Dag_executor
29
+
Day11_opam_build.Hash_cache
30
+
Day11_opam_build.Tools
31
+
Day11_opam_build.Types
32
+
Day11_opam_build.Base
33
+
Day11_opam_build.Debug
34
+
Day11_opam_build.Patches
35
+
}
+30
day11/doc-pages/opam_layer.mld
+30
day11/doc-pages/opam_layer.mld
···
1
+
{0 day11-opam-layer}
2
+
3
+
Opam-flavoured layer types that give domain meaning to the generic
4
+
{!day11-layer} storage. {!Day11_opam_layer.Build} is the recursive DAG node type: each
5
+
node carries a content-addressed hash, a package, direct dependency
6
+
nodes, and a universe identifier. {!Day11_opam_layer.Tool} aggregates multiple build
7
+
nodes into a single tool layer (e.g. odoc + deps). {!Day11_opam_layer.Build_meta}
8
+
reads and writes the [build.json] sidecar that marks a layer as an
9
+
opam package build and records installed libraries, docs, and patches.
10
+
{!Day11_opam_layer.Installed_files} scans a layer's overlay for [.cmi], [.cmti],
11
+
[.mld], and other documentation-relevant files. {!Day11_opam_layer.Opam_repo}
12
+
assembles an [opam-repository/] directory for container builds by
13
+
copying opam files from source repositories. {!Day11_opam_layer.Opamh} writes
14
+
synthetic opam switch-state files so the container sees stacked deps
15
+
as installed.
16
+
17
+
Depends on {!day11-layer}, {!day11-exec}, and {!page-solution}. This
18
+
library defines the types that {!day11-opam-build} and {!day11-doc}
19
+
operate on.
20
+
21
+
{1 Modules}
22
+
23
+
{!modules:
24
+
Day11_opam_layer.Build
25
+
Day11_opam_layer.Tool
26
+
Day11_opam_layer.Build_meta
27
+
Day11_opam_layer.Installed_files
28
+
Day11_opam_layer.Opam_repo
29
+
Day11_opam_layer.Opamh
30
+
}
+22
day11/doc-pages/runner.mld
+22
day11/doc-pages/runner.mld
···
1
+
{0 day11-runner}
2
+
3
+
Intersection of layered storage and container execution. {!Day11_runner.Run_in_layers}
4
+
handles the complete container lifecycle: stacking a base layer plus
5
+
dependency layers as an overlayfs, optionally seeding the upper
6
+
directory via a caller-supplied [prep_upper] callback, mounting,
7
+
running the container described by an OCI spec, and cleaning up.
8
+
9
+
This module knows nothing about opam, doc generation, or any specific
10
+
build domain. All domain-specific concerns — switch state, environment
11
+
variables, bind mounts, commands — are injected by the caller through
12
+
the [prep_upper] callback and the {!Day11_container.Oci_spec.t}.
13
+
14
+
Depends on {!day11-layer} for storage and stacking, {!day11-container}
15
+
for overlayfs mounts and runc execution, and {!day11-exec} for
16
+
subprocess primitives.
17
+
18
+
{1 Modules}
19
+
20
+
{!modules:
21
+
Day11_runner.Run_in_layers
22
+
}
+23
day11/doc-pages/solution.mld
+23
day11/doc-pages/solution.mld
···
1
+
{0 day11-solution}
2
+
3
+
Pure dependency graph types and operations. {!Day11_solution.Deps.t} is the
4
+
fundamental type — a map from packages to their direct dependencies —
5
+
used throughout the system. {!Day11_solution.Solve_result} carries both the build
6
+
dependency graph (acyclic) and the doc dependency graph (may have
7
+
cycles) returned by the solver. {!Day11_solution.Json} handles serialization
8
+
for caching and inter-process communication. {!Day11_solution.Universe} computes a
9
+
hash of a package's transitive dependency set, used to distinguish
10
+
build contexts. {!Day11_solution.Rdeps} provides reverse dependency lookup.
11
+
12
+
No I/O, no solver, no opam-format dependency beyond types. This
13
+
library sits at the bottom of the dependency hierarchy.
14
+
15
+
{1 Modules}
16
+
17
+
{!modules:
18
+
Day11_solution.Deps
19
+
Day11_solution.Solve_result
20
+
Day11_solution.Json
21
+
Day11_solution.Universe
22
+
Day11_solution.Rdeps
23
+
}
+23
day11/doc-pages/solver.mld
+23
day11/doc-pages/solver.mld
···
1
+
{0 day11-solver}
2
+
3
+
Dependency solving via opam-0install. {!Day11_solver.Solve} is the main entry
4
+
point: given a target package and a git-backed package index, it
5
+
returns a {!Day11_solution.Solve_result.t} with both the build dependency
6
+
graph (acyclic, for topological ordering) and the doc dependency graph
7
+
(may have cycles from [{post}] deps and [x-extra-doc-deps], for odoc
8
+
cross-referencing). {!Day11_solver.Context} implements the opam-0install solver
9
+
interface, supporting [prefer_oldest], pinned packages, user
10
+
constraints, and tracking of examined packages for incremental cache
11
+
invalidation. {!Day11_solver.Dot_solution} renders dependency graphs as Graphviz
12
+
DOT files for debugging.
13
+
14
+
Depends on {!page-solution} for solution types and {!day11-opam} for the
15
+
git-backed package index.
16
+
17
+
{1 Modules}
18
+
19
+
{!modules:
20
+
Day11_solver.Solve
21
+
Day11_solver.Context
22
+
Day11_solver.Dot_solution
23
+
}
+17
day11/doc-pages/solver_pool.mld
+17
day11/doc-pages/solver_pool.mld
···
1
+
{0 day11-solver-pool}
2
+
3
+
Parallel solving via solver_worker subprocesses. {!Day11_solver_pool.Solver_pool} spawns
4
+
multiple out-of-process solver workers to solve packages in parallel,
5
+
avoiding any in-process solver dependency. The single entry point
6
+
{!Day11_solver_pool.Solver_pool.solve_many} takes a list of target packages and a
7
+
parallelism level, distributes work across workers, and collects
8
+
results. Supports multi-repository solving, pinned directories, version
9
+
constraints, and optional doc-dependency inclusion.
10
+
11
+
Depends on {!page-solution} for solution result types.
12
+
13
+
{1 Modules}
14
+
15
+
{!modules:
16
+
Day11_solver_pool.Solver_pool
17
+
}
+15
day11/doc-pages/test_util.mld
+15
day11/doc-pages/test_util.mld
···
1
+
{0 day11-test-util}
2
+
3
+
Shared test helpers for day11 test suites. {!Day11_test_util.Test_util} provides
4
+
conveniences used across all day11 Alcotest tests: temporary directory
5
+
creation with automatic cleanup, Eio event loop setup, result
6
+
unwrapping that integrates with Alcotest failure reporting, filesystem
7
+
helpers for directory and file creation, and environment-variable
8
+
guards for skipping integration tests when external resources (such as
9
+
an opam-repository checkout) are not available.
10
+
11
+
{1 Modules}
12
+
13
+
{!modules:
14
+
Day11_test_util.Test_util
15
+
}
+3
-3
day11/doc/doc_deps.ml
+3
-3
day11/doc/doc_deps.ml
···
1
-
let needs_separate_link ~compile_deps ~link_deps pkg =
2
-
let compile_set = match OpamPackage.Map.find_opt pkg compile_deps with
1
+
let needs_separate_link (result : Day11_solution.Solve_result.t) pkg =
2
+
let compile_set = match OpamPackage.Map.find_opt pkg result.build_deps with
3
3
| Some deps -> deps
4
4
| None -> OpamPackage.Set.empty
5
5
in
6
-
let link_set = match OpamPackage.Map.find_opt pkg link_deps with
6
+
let link_set = match OpamPackage.Map.find_opt pkg result.doc_deps with
7
7
| Some deps -> deps
8
8
| None -> OpamPackage.Set.empty
9
9
in
+9
-11
day11/doc/doc_deps.mli
+9
-11
day11/doc/doc_deps.mli
···
1
1
(** Determine whether a package needs separate compile and link phases.
2
2
3
-
Given two dependency graphs from the same solve — one computed
4
-
without [{post}] deps (compile graph) and one with [{post}] deps
5
-
(link graph) — compare a package's deps in each. If they differ,
6
-
the package needs separate compile and link phases for documentation;
7
-
the link phase needs odoc output from the extra [{post}] deps that
8
-
aren't available at compile time. *)
3
+
Compares a package's dependencies in the build graph (no [{post}]
4
+
deps) versus the doc graph (with [{post}] deps and
5
+
[x-extra-doc-deps]). If they differ, the package needs separate
6
+
compile and link phases; the link phase needs odoc output from the
7
+
extra deps that aren't available at compile time. *)
9
8
10
9
val needs_separate_link :
11
-
compile_deps:Day11_graph.Graph.solution ->
12
-
link_deps:Day11_graph.Graph.solution ->
10
+
Day11_solution.Solve_result.t ->
13
11
OpamPackage.t ->
14
12
bool
15
-
(** [needs_separate_link ~compile_deps ~link_deps pkg] returns [true]
16
-
when [pkg]'s dependencies differ between the compile graph (no
17
-
[{post}] deps) and the link graph (with [{post}] deps). *)
13
+
(** [needs_separate_link result pkg] returns [true] when [pkg]'s
14
+
dependencies differ between [result.build_deps] and
15
+
[result.doc_deps]. *)
+5
-3
day11/doc/dune
+5
-3
day11/doc/dune
···
1
1
(library
2
2
(name day11_doc)
3
-
(libraries astring day11_batch day11_build day11_container day11_doc_layer
4
-
day11_exec day11_graph day11_layer day11_lib day11_opam_layer
5
-
bos fpath opam-format rresult yojson unix))
3
+
(public_name day11.doc)
4
+
(libraries astring day11_batch day11_opam_build day11_container
5
+
day11_exec day11_solution day11_layer day11_lib day11_opam_layer
6
+
bos fpath opam-format rresult yojson unix)
7
+
(preprocess (pps ppx_deriving_yojson)))
+129
-95
day11/doc/generate.ml
+129
-95
day11/doc/generate.ml
···
1
1
open Day11_opam_layer
2
2
module Build = Day11_opam_layer.Build
3
3
module Tool = Day11_opam_layer.Tool
4
-
module Doc_meta = Day11_doc_layer.Doc_meta
4
+
(* Doc_meta is now part of this library *)
5
5
6
6
(* Local aliases so the existing code reads naturally. *)
7
7
type build = Build.t
···
22
22
) solution None
23
23
24
24
let extract_bin ~os_dir tool_builds name =
25
-
let switch = Day11_build.Types.switch in
25
+
let switch = Day11_opam_build.Types.switch in
26
26
List.find_map (fun (bl : build) ->
27
27
let bin = Fpath.(Build.dir ~os_dir bl / "fs" / "home" / "opam"
28
28
/ ".opam" / switch / "bin" / name) in
···
135
135
let hash = Day11_layer.Hash.of_strings
136
136
[ "compile"; node.hash; composite_tool_hash ] in
137
137
let compile_node : build =
138
-
{ hash; pkg = node.pkg; deps = [ node ]; universe = Day11_graph.Universe.dummy } in
138
+
{ hash; pkg = node.pkg; deps = [ node ]; universe = Day11_solution.Universe.dummy } in
139
139
let on_extract ~layer_dir ~success:_ =
140
140
let dm : Doc_meta.t = {
141
141
package = OpamPackage.to_string node.pkg;
···
145
145
ignore (Doc_meta.save layer_dir dm)
146
146
in
147
147
let result =
148
-
match Day11_build.Build_layer.build env benv
148
+
match Day11_opam_build.Build_layer.build env benv
149
149
~mounts:(mounts @ store_mounts) ~build_dirs:[]
150
150
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
151
151
~on_extract
152
152
compile_node
153
153
~strategy:{ cmd; cleanup = doc_cleanup } () with
154
-
| Day11_build.Types.Success bl ->
154
+
| Day11_opam_build.Types.Success bl ->
155
155
Hashtbl.replace dep_locs node.hash pkg_loc;
156
156
Some bl
157
157
| _ ->
···
164
164
165
165
let link_package env benv ~os_dir ~store ~driver_tool ~odoc_tools
166
166
~build_hash_blessed ~find_odoc_tool ~compile_results ~dep_locs
167
+
~doc_dep_hashes
167
168
~build_hash ~universe_hashes
168
169
(node : build) =
169
170
match Hashtbl.find_opt compile_results build_hash with
···
173
174
~build_hash_blessed ~find_odoc_tool node with
174
175
| None -> None
175
176
| Some (composite_tool_hash, universe, blessed, pkg_loc, mounts, prep_dir) ->
176
-
let seen = Hashtbl.create 16 in
177
-
List.iter (collect_transitive_deps seen) node.deps;
178
-
let deps = Hashtbl.fold (fun bh () acc ->
179
-
match Hashtbl.find_opt dep_locs bh with
180
-
| Some loc -> loc :: acc | None -> acc
181
-
) seen [] in
177
+
(* Mount odoc output from doc_deps (not build_deps), so forward
178
+
deps like odig are available for cross-referencing. *)
179
+
let doc_dep_bhs = match Hashtbl.find_opt doc_dep_hashes build_hash with
180
+
| Some bhs -> bhs | None -> [] in
181
+
let deps = List.filter_map (fun bh ->
182
+
Hashtbl.find_opt dep_locs bh
183
+
) doc_dep_bhs in
182
184
let store_mounts, _ =
183
185
Odoc_store.link_mounts store pkg_loc ~deps in
184
186
let dep_compile_layers =
···
198
200
@ dep_hashes) in
199
201
let link_node : build =
200
202
{ hash; pkg = node.pkg;
201
-
deps = [ node; compile_bl ] @ dep_compile_layers; universe = Day11_graph.Universe.dummy } in
203
+
deps = [ node; compile_bl ] @ dep_compile_layers; universe = Day11_solution.Universe.dummy } in
202
204
let on_extract ~layer_dir ~success:_ =
203
205
let dm : Doc_meta.t = {
204
206
package = OpamPackage.to_string node.pkg;
···
208
210
ignore (Doc_meta.save layer_dir dm)
209
211
in
210
212
let result =
211
-
match Day11_build.Build_layer.build env benv
213
+
match Day11_opam_build.Build_layer.build env benv
212
214
~mounts:(mounts @ store_mounts) ~build_dirs:[]
213
215
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
214
216
~on_extract
215
217
link_node
216
218
~strategy:{ cmd; cleanup = doc_cleanup } () with
217
-
| Day11_build.Types.Success _bl ->
219
+
| Day11_opam_build.Types.Success _bl ->
218
220
Printf.printf " %s: linked\n%!"
219
221
(OpamPackage.to_string node.pkg);
220
222
Some 0
···
259
261
@ dep_hashes) in
260
262
let doc_node : build =
261
263
{ hash; pkg = node.pkg;
262
-
deps = [ node ] @ dep_compile_layers; universe = Day11_graph.Universe.dummy } in
264
+
deps = [ node ] @ dep_compile_layers; universe = Day11_solution.Universe.dummy } in
263
265
let on_extract ~layer_dir ~success:_ =
264
266
let dm : Doc_meta.t = {
265
267
package = OpamPackage.to_string node.pkg;
···
269
271
ignore (Doc_meta.save layer_dir dm)
270
272
in
271
273
let result =
272
-
match Day11_build.Build_layer.build env benv
274
+
match Day11_opam_build.Build_layer.build env benv
273
275
~mounts:(mounts @ store_mounts) ~build_dirs:[]
274
276
~prep_upper:(doc_prep_upper env ~uid:benv.uid ~gid:benv.gid)
275
277
~on_extract
276
278
doc_node
277
279
~strategy:{ cmd; cleanup = doc_cleanup } () with
278
-
| Day11_build.Types.Success bl ->
280
+
| Day11_opam_build.Types.Success bl ->
279
281
Hashtbl.replace compile_results build_hash bl;
280
282
Hashtbl.replace dep_locs node.hash pkg_loc;
281
283
Printf.printf " %s: doc-all OK\n%!"
···
291
293
292
294
let run env benv ~np ~os_dir ~(driver_tool : Tool.t) ~odoc_tools
293
295
~tool_source_dirs ~mounts
294
-
~packages ~opam_env ~run_log
296
+
~run_log
295
297
~build_one ~nodes ~solutions ~blessing_maps:_ =
296
298
(* Create shared odoc store for all doc containers *)
297
299
let store = Odoc_store.create ~os_dir in
···
367
369
List.iter (fun (node : build) ->
368
370
Hashtbl.replace build_by_hash node.hash node
369
371
) nodes;
370
-
(* Compute link deps (with {post}) per solution for split detection *)
371
-
let link_solutions = List.map (fun (target, solution) ->
372
-
let link_deps = Day11_opam.Deps.recompute_with_post
373
-
~packages ~env:opam_env solution in
374
-
(target, solution, link_deps)
375
-
) solutions in
376
-
(* Per build hash: does it need separate compile+link? *)
372
+
(* Per build hash: does it need separate compile+link?
373
+
Compare build_deps (no {post}) vs doc_deps (with {post} + x-extra-doc-deps). *)
377
374
let needs_split : (string, bool) Hashtbl.t = Hashtbl.create 64 in
378
-
List.iter (fun (_target, compile_deps, link_deps) ->
375
+
List.iter (fun (_target, (result : Day11_solution.Solve_result.t)) ->
376
+
let compiler = find_compiler result.build_deps in
377
+
let compiler_s = match compiler with
378
+
| Some c -> OpamPackage.to_string c | None -> "" in
379
379
OpamPackage.Map.iter (fun pkg _deps ->
380
-
let compiler = find_compiler compile_deps in
381
-
let compiler_s = match compiler with
382
-
| Some c -> OpamPackage.to_string c | None -> "" in
383
380
let pkg_s = OpamPackage.to_string pkg in
384
-
if Doc_deps.needs_separate_link ~compile_deps ~link_deps pkg then
385
-
(* Mark all build hashes for this pkg as needing split.
386
-
We'll look up the build hash after creating the index. *)
381
+
if Doc_deps.needs_separate_link result pkg then
387
382
Hashtbl.replace needs_split (pkg_s ^ ":" ^ compiler_s) true
388
-
) compile_deps
389
-
) link_solutions;
383
+
) result.build_deps
384
+
) solutions;
390
385
(* Reverse index: pkg_string -> list of (build_hash, build) *)
391
386
let pkg_to_builds : (string, (string * build) list) Hashtbl.t =
392
387
Hashtbl.create (List.length nodes) in
···
401
396
Also populate node_compiler for all build nodes. *)
402
397
let pkg_compiler_to_hash : (string * string, string) Hashtbl.t =
403
398
Hashtbl.create (List.length nodes) in
404
-
List.iter (fun (_target, solution, _link_deps) ->
399
+
List.iter (fun (_target, (result : Day11_solution.Solve_result.t)) ->
400
+
let solution = result.build_deps in
405
401
let compiler = find_compiler solution in
406
402
let compiler_s = match compiler with
407
403
| Some c -> OpamPackage.to_string c | None -> "" in
···
420
416
| _ -> ())
421
417
) builds
422
418
) solution
423
-
) link_solutions;
419
+
) solutions;
420
+
(* build_hash -> doc dep build hashes.
421
+
For the link phase, we need to mount odoc output from doc_deps
422
+
(which includes {post} deps and x-extra-doc-deps like odig),
423
+
not just the build DAG deps. *)
424
+
let doc_dep_hashes : (string, string list) Hashtbl.t = Hashtbl.create 64 in
425
+
List.iter (fun (_target, (result : Day11_solution.Solve_result.t)) ->
426
+
let compiler = find_compiler result.build_deps in
427
+
let compiler_s = match compiler with
428
+
| Some c -> OpamPackage.to_string c | None -> "" in
429
+
OpamPackage.Map.iter (fun pkg doc_deps_set ->
430
+
let pkg_s = OpamPackage.to_string pkg in
431
+
match Hashtbl.find_opt pkg_compiler_to_hash (pkg_s, compiler_s) with
432
+
| None -> ()
433
+
| Some pkg_bh ->
434
+
let dep_bhs = OpamPackage.Set.fold (fun dep_pkg acc ->
435
+
let dep_s = OpamPackage.to_string dep_pkg in
436
+
match Hashtbl.find_opt pkg_compiler_to_hash (dep_s, compiler_s) with
437
+
| Some bh when not (String.equal bh pkg_bh) -> bh :: acc
438
+
| _ -> acc
439
+
) doc_deps_set [] in
440
+
Hashtbl.replace doc_dep_hashes pkg_bh dep_bhs
441
+
) result.doc_deps
442
+
) solutions;
424
443
(* Resolve needs_split to build hashes *)
425
444
let needs_split_bh : (string, bool) Hashtbl.t = Hashtbl.create 64 in
426
445
Hashtbl.iter (fun key _ ->
···
436
455
(* Compute blessed per build hash. Each build node carries its
437
456
universe. Compare against the blessed universe for its package. *)
438
457
let blessed_universes = Day11_batch.Blessing.compute_blessed_universes
439
-
(List.map (fun (t, s, _) -> (t, s)) link_solutions) in
458
+
(List.map (fun (t, (r : Day11_solution.Solve_result.t)) ->
459
+
(t, r.build_deps)) solutions) in
440
460
let build_hash_blessed : (string, bool) Hashtbl.t =
441
461
Hashtbl.create (List.length nodes) in
442
462
List.iter (fun (node : build) ->
443
463
match Hashtbl.find_opt blessed_universes node.pkg with
444
-
| Some blessed_u when Day11_graph.Universe.equal node.universe blessed_u ->
464
+
| Some blessed_u when Day11_solution.Universe.equal node.universe blessed_u ->
445
465
Hashtbl.replace build_hash_blessed node.hash true
446
466
| _ -> ()
447
467
) nodes;
448
468
(* Build hash -> universe of build hashes (for link/doc-all deps) *)
449
469
let build_hash_universe : (string, string list) Hashtbl.t =
450
470
Hashtbl.create 64 in
451
-
List.iter (fun (_target, solution, _link_deps) ->
471
+
List.iter (fun (_target, (result : Day11_solution.Solve_result.t)) ->
472
+
let solution = result.build_deps in
452
473
let compiler = find_compiler solution in
453
474
let compiler_s = match compiler with
454
475
| Some c -> OpamPackage.to_string c
···
463
484
List.iter (fun bh ->
464
485
Hashtbl.replace build_hash_universe bh bh_list
465
486
) bh_list
466
-
) link_solutions;
487
+
) solutions;
467
488
(* Build doc DAG nodes.
468
489
For packages that DON'T need separate link: "doc-all" node
469
490
depends on build(A), tool finals, and compile/doc-all of deps
···
485
506
let compile_hash = Day11_layer.Hash.of_strings
486
507
[ "compile"; node.hash; composite_tool_hash ] in
487
508
let cn : build = { hash = compile_hash; pkg = node.pkg;
488
-
deps = [ node; driver_final; odoc_final ]; universe = Day11_graph.Universe.dummy } in
509
+
deps = [ node; driver_final; odoc_final ]; universe = Day11_solution.Universe.dummy } in
489
510
Hashtbl.replace compile_nodes node.hash cn
490
511
end else begin
491
512
(* Single doc-all phase — deps computed after universe is known *)
···
493
514
let doc_all_hash = Day11_layer.Hash.of_strings
494
515
[ "doc-all"; node.hash; universe; composite_tool_hash ] in
495
516
let dn : build = { hash = doc_all_hash; pkg = node.pkg;
496
-
deps = [ node; driver_final; odoc_final ]; universe = Day11_graph.Universe.dummy } in
517
+
deps = [ node; driver_final; odoc_final ]; universe = Day11_solution.Universe.dummy } in
497
518
Hashtbl.replace doc_all_nodes node.hash dn
498
519
end
499
520
) nodes;
···
511
532
| Some dn -> dn :: acc
512
533
| None -> acc
513
534
) seen [] in
514
-
{ dn with deps = dn.deps @ dep_docs; universe = Day11_graph.Universe.dummy }
535
+
{ dn with deps = dn.deps @ dep_docs; universe = Day11_solution.Universe.dummy }
515
536
in
516
537
let compile_snapshot = Hashtbl.fold (fun k v acc -> (k, v) :: acc)
517
538
compile_nodes [] in
···
551
572
([ "link"; own_compile.hash; universe; composite_tool_hash ]
552
573
@ dep_hashes) in
553
574
let ln : build = { hash = link_hash; pkg = build_node.pkg;
554
-
deps = [ build_node; own_compile ] @ dep_compile_layers; universe = Day11_graph.Universe.dummy } in
575
+
deps = [ build_node; own_compile ] @ dep_compile_layers; universe = Day11_solution.Universe.dummy } in
555
576
link_nodes_list := ln :: !link_nodes_list
556
577
) compile_nodes;
557
578
let compile_list = Hashtbl.fold (fun _ cn acc -> cn :: acc) compile_nodes [] in
···
638
659
if Odoc_store.is_compiled store loc then
639
660
Hashtbl.replace dep_locs build_hash loc
640
661
) node_pkg_loc;
662
+
let open Day11_opam_build.Dag_executor in
641
663
let is_cached node =
642
664
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
643
-
let layer_cached =
644
-
Bos.OS.File.exists Fpath.(layer_dir / "layer.json")
645
-
|> Result.get_ok
646
-
in
647
-
if layer_cached then Day11_layer.Last_used.touch layer_dir;
648
-
if not layer_cached then false
649
-
else if Hashtbl.mem doc_all_set node.hash then
650
-
(* Doc-all: check store has both odoc-out and html *)
651
-
match Hashtbl.find_opt node_pkg_loc node.hash with
652
-
| Some loc -> Odoc_store.is_compiled store loc && Odoc_store.is_linked store loc
653
-
| None -> layer_cached
654
-
else if Hashtbl.mem compile_set node.hash then
655
-
match Hashtbl.find_opt node_pkg_loc node.hash with
656
-
| Some loc -> Odoc_store.is_compiled store loc
657
-
| None -> layer_cached
658
-
else if Hashtbl.mem link_set node.hash then
659
-
match Hashtbl.find_opt node_pkg_loc node.hash with
660
-
| Some loc -> Odoc_store.is_linked store loc
661
-
| None -> layer_cached
662
-
else
663
-
layer_cached
664
-
in
665
-
Day11_build.Dag_executor.execute env ~np ~priority:node_priority ~is_cached
666
-
~on_complete:(fun ~total ~completed ~failed node success ->
667
-
let status = if success then "ok" else "fail" in
668
-
let kind =
669
-
if Hashtbl.mem compile_set node.hash then "compile"
670
-
else if Hashtbl.mem doc_all_set node.hash then "doc-all"
671
-
else if Hashtbl.mem link_set node.hash then "link"
672
-
else if Hashtbl.mem tool_node_set node.hash then "tool"
673
-
else "build"
665
+
let layer_json = Fpath.(layer_dir / "layer.json") in
666
+
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
667
+
Not_cached
668
+
else begin
669
+
Day11_layer.Last_used.touch layer_dir;
670
+
let meta_ok = match Day11_layer.Meta.load layer_json with
671
+
| Ok meta -> meta.exit_status = 0
672
+
| Error _ -> false
674
673
in
675
-
let layer = Fpath.to_string
676
-
(Day11_opam_layer.Build.dir ~os_dir node) in
677
-
Day11_lib.Run_log.log_build_result run_log
678
-
~pkg:(OpamPackage.to_string node.pkg)
679
-
~hash:node.hash ~status ~failed_dep:None
680
-
~kind ~layer_dir:layer ();
681
-
if completed mod 100 = 0 || not success then
682
-
Printf.printf " [%d/%d, %d failed] %s: %s\n%!"
683
-
completed total failed (OpamPackage.to_string node.pkg)
684
-
(if success then "OK" else "FAIL"))
674
+
if not meta_ok then Cached_fail
675
+
else if Hashtbl.mem doc_all_set node.hash then
676
+
(match Hashtbl.find_opt node_pkg_loc node.hash with
677
+
| Some loc when Odoc_store.is_compiled store loc
678
+
&& Odoc_store.is_linked store loc -> Cached_ok
679
+
| _ -> Not_cached)
680
+
else if Hashtbl.mem compile_set node.hash then
681
+
(match Hashtbl.find_opt node_pkg_loc node.hash with
682
+
| Some loc when Odoc_store.is_compiled store loc -> Cached_ok
683
+
| _ -> Not_cached)
684
+
else if Hashtbl.mem link_set node.hash then
685
+
(match Hashtbl.find_opt node_pkg_loc node.hash with
686
+
| Some loc when Odoc_store.is_linked store loc -> Cached_ok
687
+
| _ -> Not_cached)
688
+
else Cached_ok
689
+
end
690
+
in
691
+
let doc_cascaded : (string, unit) Hashtbl.t = Hashtbl.create 256 in
692
+
Day11_opam_build.Dag_executor.execute env ~np ~priority:node_priority ~is_cached
693
+
~on_complete:(fun ~stats node success ->
694
+
let open Day11_opam_build.Dag_executor in
695
+
if Hashtbl.mem doc_cascaded node.hash then ()
696
+
else begin
697
+
let status = if success then "ok" else "fail" in
698
+
let kind =
699
+
if Hashtbl.mem compile_set node.hash then "compile"
700
+
else if Hashtbl.mem doc_all_set node.hash then "doc-all"
701
+
else if Hashtbl.mem link_set node.hash then "link"
702
+
else if Hashtbl.mem tool_node_set node.hash then "tool"
703
+
else "build"
704
+
in
705
+
let layer = Fpath.to_string
706
+
(Day11_opam_layer.Build.dir ~os_dir node) in
707
+
Day11_lib.Run_log.log_build_result run_log
708
+
~pkg:(OpamPackage.to_string node.pkg)
709
+
~hash:node.hash ~status ~failed_dep:None
710
+
~kind ~layer_dir:layer ();
711
+
if stats.completed mod 100 = 0 || not success then
712
+
Printf.printf " [%d/%d, %d ok, %d failed, %d cascade] %s: %s\n%!"
713
+
stats.completed stats.total stats.ok stats.failed
714
+
stats.cascaded (OpamPackage.to_string node.pkg)
715
+
(if success then "OK" else "FAIL")
716
+
end)
685
717
~on_cascade:(fun ~failed ~failed_dep ->
718
+
Hashtbl.replace doc_cascaded failed.hash ();
686
719
let kind =
687
720
if Hashtbl.mem compile_set failed.hash then "compile"
688
721
else if Hashtbl.mem doc_all_set failed.hash then "doc-all"
···
738
771
| Some hs -> hs | None -> [] in
739
772
(match link_package env benv ~os_dir ~store ~driver_tool ~odoc_tools
740
773
~build_hash_blessed ~find_odoc_tool ~compile_results ~dep_locs
774
+
~doc_dep_hashes
741
775
~build_hash ~universe_hashes
742
776
build_node with
743
777
| Some n ->
···
753
787
(* Pinned tool package: source mount + source_dir_strategy *)
754
788
let src_mount = Day11_container.Mount.bind_ro
755
789
~src:dir "/home/opam/src" in
756
-
let strategy = Day11_build.Tools.source_dir_strategy node.pkg in
757
-
(match Day11_build.Build_layer.build env benv
790
+
let strategy = Day11_opam_build.Tools.source_dir_strategy node.pkg in
791
+
(match Day11_opam_build.Build_layer.build env benv
758
792
~mounts:(src_mount :: mounts) node ~strategy () with
759
-
| Day11_build.Types.Success _ -> true
793
+
| Day11_opam_build.Types.Success _ -> true
760
794
| _ -> false)
761
795
| None ->
762
796
build_one node
···
791
825
792
826
let unique_compilers solutions =
793
827
let seen = Hashtbl.create 4 in
794
-
List.filter_map (fun (_target, solution) ->
795
-
match find_compiler solution with
828
+
List.filter_map (fun (_target, (result : Day11_solution.Solve_result.t)) ->
829
+
match find_compiler result.build_deps with
796
830
| Some c when not (Hashtbl.mem seen (OpamPackage.to_string c)) ->
797
831
Hashtbl.replace seen (OpamPackage.to_string c) ();
798
832
Some c
799
833
| _ -> None
800
834
) solutions
801
835
802
-
let build_tools_and_run env benv ~np ~os_dir ~packages ~repos ~opam_env
836
+
let build_tools_and_run env benv ~np ~os_dir ~packages ~repos ~opam_env:_
803
837
~mounts ~driver_compiler ~odoc_repo ~build_one
804
838
~opam_repositories:_
805
839
~cache ~run_log
···
808
842
let all_pin_dirs, all_source_dirs = match odoc_repo with
809
843
| Some dir ->
810
844
Printf.printf "Using local odoc from %s\n%!" dir;
811
-
let pins = Day11_build.Tools.read_pins_from_dir dir in
845
+
let pins = Day11_opam_build.Tools.read_pins_from_dir dir in
812
846
let source_dirs = OpamPackage.Name.Map.fold (fun name _ acc ->
813
847
OpamPackage.Name.Map.add name dir acc
814
848
) pins OpamPackage.Name.Map.empty in
···
820
854
let driver_pkg = OpamPackage.of_string "odoc-driver.3.1.0" in
821
855
Printf.printf "Planning doc driver (%s)...\n%!"
822
856
(OpamPackage.to_string driver_compiler);
823
-
let driver_result = Day11_build.Tools.plan_tool benv
857
+
let driver_result = Day11_opam_build.Tools.plan_tool benv
824
858
~packages ~repos ~doc:false ~cache
825
859
~ocaml_version:driver_compiler driver_pkg in
826
860
match driver_result with
···
840
874
let odoc_tools = List.filter_map (fun compiler_v ->
841
875
Printf.printf "Planning odoc for %s...\n%!"
842
876
(OpamPackage.to_string compiler_v);
843
-
match Day11_build.Tools.plan_tool benv
877
+
match Day11_opam_build.Tools.plan_tool benv
844
878
~packages ~repos ~pin_dirs:all_pin_dirs
845
879
~source_dirs:all_source_dirs ~doc:false ~cache
846
880
~ocaml_version:compiler_v odoc_pkg with
···
858
892
let doc_count, doc_html =
859
893
run env benv ~np ~os_dir ~driver_tool ~odoc_tools
860
894
~tool_source_dirs:all_source_dirs ~mounts
861
-
~packages ~opam_env ~run_log
895
+
~run_log
862
896
~build_one ~nodes ~solutions ~blessing_maps in
863
897
Printf.printf "\n=== Docs: %d packages, %d HTML files ===\n%!"
864
898
doc_count doc_html
+7
-9
day11/doc/generate.mli
+7
-9
day11/doc/generate.mli
···
20
20
run in parallel with regular package builds instead of blocking. *)
21
21
22
22
val find_compiler :
23
-
Day11_graph.Graph.solution -> OpamPackage.t option
23
+
Day11_solution.Deps.t -> OpamPackage.t option
24
24
(** [find_compiler solution] returns the concrete compiler package
25
25
([ocaml-base-compiler], [ocaml-variants], or [ocaml-system])
26
26
from [solution], or [None] if none is found. *)
27
27
28
28
val unique_compilers :
29
-
(OpamPackage.t * Day11_graph.Graph.solution) list ->
29
+
(OpamPackage.t * Day11_solution.Solve_result.t) list ->
30
30
OpamPackage.t list
31
31
(** Extract unique concrete compiler packages from solutions. *)
32
32
33
33
val run :
34
34
Eio_unix.Stdenv.base ->
35
-
Day11_build.Types.build_env ->
35
+
Day11_opam_build.Types.build_env ->
36
36
np:int ->
37
37
os_dir:Fpath.t ->
38
38
driver_tool:Day11_opam_layer.Tool.t ->
39
39
odoc_tools:(OpamPackage.t * Day11_opam_layer.Tool.t) list ->
40
40
tool_source_dirs:string OpamPackage.Name.Map.t ->
41
41
mounts:Day11_container.Mount.t list ->
42
-
packages:Day11_opam.Git_packages.t ->
43
-
opam_env:(string -> OpamVariable.variable_contents option) ->
44
42
run_log:Day11_lib.Run_log.t ->
45
43
build_one:(Day11_opam_layer.Build.t -> bool) ->
46
44
nodes:Day11_opam_layer.Build.t list ->
47
-
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
45
+
solutions:(OpamPackage.t * Day11_solution.Solve_result.t) list ->
48
46
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
49
47
int * int
50
48
51
49
val build_tools_and_run :
52
50
Eio_unix.Stdenv.base ->
53
-
Day11_build.Types.build_env ->
51
+
Day11_opam_build.Types.build_env ->
54
52
np:int ->
55
53
os_dir:Fpath.t ->
56
54
packages:Day11_opam.Git_packages.t ->
···
61
59
odoc_repo:string option ->
62
60
build_one:(Day11_opam_layer.Build.t -> bool) ->
63
61
opam_repositories:string list ->
64
-
cache:Day11_build.Hash_cache.t ->
62
+
cache:Day11_opam_build.Hash_cache.t ->
65
63
run_log:Day11_lib.Run_log.t ->
66
64
nodes:Day11_opam_layer.Build.t list ->
67
-
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
65
+
solutions:(OpamPackage.t * Day11_solution.Solve_result.t) list ->
68
66
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
69
67
unit
70
68
(** Plan doc tools (driver + per-compiler odoc) and run a unified DAG
+11
-2
day11/doc/odoc_store.ml
+11
-2
day11/doc/odoc_store.ml
···
101
101
(* With direct RW mounts, output goes straight to the store.
102
102
commit is a no-op — just verify the output landed. *)
103
103
104
+
let dir_non_empty path =
105
+
match Bos.OS.Dir.exists path with
106
+
| Ok false -> false
107
+
| Ok true ->
108
+
(match Bos.OS.Dir.contents path with
109
+
| Ok (_ :: _) -> true
110
+
| _ -> false)
111
+
| Error _ -> false
112
+
104
113
let is_compiled t loc =
105
-
Bos.OS.Dir.exists (odoc_out_dir t loc) |> Result.get_ok
114
+
dir_non_empty (odoc_out_dir t loc)
106
115
107
116
let is_linked t loc =
108
-
Bos.OS.Dir.exists (html_dir t loc) |> Result.get_ok
117
+
dir_non_empty (html_dir t loc)
109
118
110
119
let html_root t = Fpath.(t.root / "html")
+4
-4
day11/doc/test/dune
+4
-4
day11/doc/test/dune
···
4
4
5
5
(executable
6
6
(name test_doc_integration)
7
-
(libraries day11_build day11_container day11_doc day11_exec day11_graph
7
+
(libraries day11_opam_build day11_container day11_doc day11_exec day11_solution
8
8
day11_layer day11_solver day11_test_util
9
9
alcotest astring bos eio_main fpath opam-format yojson))
10
10
11
11
(executable
12
12
(name test_generate_docs)
13
-
(libraries day11_build day11_container day11_doc day11_exec day11_layer
13
+
(libraries day11_opam_build day11_container day11_doc day11_exec day11_layer
14
14
day11_opam_layer day11_runner day11_solver day11_test_util
15
15
alcotest astring bos eio_main fpath opam-format))
16
16
17
17
(executable
18
18
(name test_doc_compile_link)
19
-
(libraries day11_build day11_container day11_doc day11_exec day11_layer
19
+
(libraries day11_opam_build day11_container day11_doc day11_exec day11_layer
20
20
day11_solver day11_test_util
21
21
alcotest bos eio_main fpath opam-format))
22
22
23
23
(executable
24
24
(name test_doc_pipeline)
25
-
(libraries day11_build day11_container day11_doc day11_exec day11_layer
25
+
(libraries day11_opam_build day11_container day11_doc day11_exec day11_layer
26
26
day11_solver day11_test_util
27
27
alcotest bos eio_main fpath opam-format))
+69
-23
day11/doc/test/test_doc.ml
+69
-23
day11/doc/test/test_doc.ml
···
267
267
Alcotest.(check bool) "none" true
268
268
(Generate.find_compiler solution = None)
269
269
270
+
let make_solve_result solution =
271
+
{ Day11_solution.Solve_result.
272
+
packages = OpamPackage.Map.fold (fun p _ acc -> OpamPackage.Set.add p acc)
273
+
solution OpamPackage.Set.empty;
274
+
build_deps = solution;
275
+
doc_deps = solution;
276
+
examined = OpamPackage.Name.Set.empty }
277
+
270
278
let test_unique_compilers () =
271
279
let sol1 =
272
280
OpamPackage.Map.empty
···
284
292
|> OpamPackage.Map.add (pkg "fmt.0.11.0") OpamPackage.Set.empty
285
293
in
286
294
let compilers = Generate.unique_compilers
287
-
[ (pkg "astring.0.8.5", sol1);
288
-
(pkg "distributed.0.6.0", sol2);
289
-
(pkg "fmt.0.11.0", sol3) ] in
295
+
[ (pkg "astring.0.8.5", make_solve_result sol1);
296
+
(pkg "distributed.0.6.0", make_solve_result sol2);
297
+
(pkg "fmt.0.11.0", make_solve_result sol3) ] in
290
298
Alcotest.(check int) "two unique" 2 (List.length compilers);
291
299
let strs = List.map OpamPackage.to_string compilers
292
300
|> List.sort String.compare in
···
306
314
(OpamPackage.Set.of_list (List.map pkg deps)) acc
307
315
) OpamPackage.Map.empty entries
308
316
317
+
let make_result ?(doc_deps = OpamPackage.Map.empty) build_deps =
318
+
{ Day11_solution.Solve_result.
319
+
packages = OpamPackage.Map.fold (fun p _ acc ->
320
+
OpamPackage.Set.add p acc) build_deps OpamPackage.Set.empty;
321
+
build_deps;
322
+
doc_deps;
323
+
examined = OpamPackage.Name.Set.empty }
324
+
309
325
(* No {post} deps anywhere — compile and link graphs identical.
310
326
Every package can use --actions all. *)
311
327
let test_doc_deps_no_post () =
···
314
330
("dune.3.21.1", ["ocaml.5.4.1"]);
315
331
("ocaml.5.4.1", []);
316
332
] in
333
+
let result = make_result ~doc_deps:deps deps in
317
334
Alcotest.(check bool) "fmt: single phase" false
318
-
(Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps
319
-
(pkg "fmt.0.11.0"));
335
+
(Doc_deps.needs_separate_link result (pkg "fmt.0.11.0"));
320
336
Alcotest.(check bool) "dune: single phase" false
321
-
(Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps
322
-
(pkg "dune.3.21.1"))
337
+
(Doc_deps.needs_separate_link result (pkg "dune.3.21.1"))
323
338
324
339
(* Package has a {post} dep — link graph has an extra dep that the
325
340
compile graph doesn't. That package needs separate phases. *)
···
329
344
("dune.3.21.1", ["ocaml.5.4.1"]);
330
345
("ocaml.5.4.1", []);
331
346
] in
332
-
let link_deps = make_solution [
347
+
let doc_deps = make_solution [
333
348
("odoc.3.1.0", ["ocaml.5.4.1"; "dune.3.21.1"; "odoc-parser.3.0.0"]);
334
349
("dune.3.21.1", ["ocaml.5.4.1"]);
335
350
("ocaml.5.4.1", []);
336
351
] in
352
+
let result = make_result ~doc_deps compile_deps in
337
353
Alcotest.(check bool) "odoc: needs separate" true
338
-
(Doc_deps.needs_separate_link ~compile_deps ~link_deps
339
-
(pkg "odoc.3.1.0"));
354
+
(Doc_deps.needs_separate_link result (pkg "odoc.3.1.0"));
340
355
Alcotest.(check bool) "dune: single phase" false
341
-
(Doc_deps.needs_separate_link ~compile_deps ~link_deps
342
-
(pkg "dune.3.21.1"))
356
+
(Doc_deps.needs_separate_link result (pkg "dune.3.21.1"))
343
357
344
358
(* Package not in either graph — no deps to compare, single phase. *)
345
359
let test_doc_deps_absent_pkg () =
···
347
361
("fmt.0.11.0", ["ocaml.5.4.1"]);
348
362
("ocaml.5.4.1", []);
349
363
] in
364
+
let result = make_result ~doc_deps:deps deps in
350
365
Alcotest.(check bool) "absent: single phase" false
351
-
(Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps
352
-
(pkg "unknown-pkg.1.0"))
366
+
(Doc_deps.needs_separate_link result (pkg "unknown-pkg.1.0"))
353
367
354
368
(* Single package, no deps in either graph *)
355
369
let test_doc_deps_leaf () =
356
370
let deps = make_solution [
357
371
("astring.0.8.5", []);
358
372
] in
373
+
let result = make_result ~doc_deps:deps deps in
359
374
Alcotest.(check bool) "leaf: single phase" false
360
-
(Doc_deps.needs_separate_link ~compile_deps:deps ~link_deps:deps
361
-
(pkg "astring.0.8.5"))
375
+
(Doc_deps.needs_separate_link result (pkg "astring.0.8.5"))
362
376
363
377
(* Multiple packages in a solution, only the one with {post} deps
364
378
needs separate phases — the others are unaffected. *)
···
369
383
("dune.3.21.1", ["ocaml.5.4.1"]);
370
384
("ocaml.5.4.1", []);
371
385
] in
372
-
let link_deps = make_solution [
386
+
let doc_deps = make_solution [
373
387
("yojson.2.2.2", ["ocaml.5.4.1"; "dune.3.21.1"]);
374
388
("ppx_yojson.1.3.0", ["ocaml.5.4.1"; "dune.3.21.1"; "yojson.2.2.2";
375
389
"ppxlib.0.33.0"]);
376
390
("dune.3.21.1", ["ocaml.5.4.1"]);
377
391
("ocaml.5.4.1", []);
378
392
] in
393
+
let result = make_result ~doc_deps compile_deps in
379
394
Alcotest.(check bool) "yojson: single phase" false
380
-
(Doc_deps.needs_separate_link ~compile_deps ~link_deps
381
-
(pkg "yojson.2.2.2"));
395
+
(Doc_deps.needs_separate_link result (pkg "yojson.2.2.2"));
382
396
Alcotest.(check bool) "ppx_yojson: needs separate" true
383
-
(Doc_deps.needs_separate_link ~compile_deps ~link_deps
384
-
(pkg "ppx_yojson.1.3.0"));
397
+
(Doc_deps.needs_separate_link result (pkg "ppx_yojson.1.3.0"));
385
398
Alcotest.(check bool) "dune: single phase" false
386
-
(Doc_deps.needs_separate_link ~compile_deps ~link_deps
387
-
(pkg "dune.3.21.1"))
399
+
(Doc_deps.needs_separate_link result (pkg "dune.3.21.1"))
388
400
389
401
(* ── Odoc_store tests ────────────────────────────────────────────── *)
390
402
···
461
473
(* 0 dep mounts + 1 RW odoc + 1 RW html = 2 mounts *)
462
474
Alcotest.(check int) "2 mounts" 2 (List.length mounts)
463
475
476
+
(* ── Doc_meta tests ─────────────────────────────────────────────── *)
477
+
478
+
let test_doc_meta_roundtrip () = with_tmp_dir @@ fun layer_dir ->
479
+
let m : Doc_meta.t = {
480
+
package = "fmt.0.9.0";
481
+
phase = Doc_meta.Doc_all;
482
+
deps = [ "ocaml.5.4.1"; "fmt.0.9.0" ];
483
+
} in
484
+
Doc_meta.save layer_dir m |> _is_ok "save";
485
+
Alcotest.(check bool) "exists" true (Doc_meta.exists layer_dir);
486
+
let loaded = Doc_meta.load layer_dir |> ok_or_fail "load" in
487
+
Alcotest.(check string) "package" "fmt.0.9.0" loaded.package;
488
+
Alcotest.(check bool) "phase doc-all" true (loaded.phase = Doc_meta.Doc_all)
489
+
490
+
let test_doc_meta_phases () = with_tmp_dir @@ fun layer_dir ->
491
+
List.iter (fun phase ->
492
+
let m : Doc_meta.t = { package = "x.1"; phase; deps = [] } in
493
+
Doc_meta.save layer_dir m |> _is_ok "save";
494
+
let loaded = Doc_meta.load layer_dir |> ok_or_fail "load" in
495
+
Alcotest.(check bool) "phase round-trip" true (loaded.phase = phase)
496
+
) [ Doc_meta.Compile; Doc_meta.Link; Doc_meta.Doc_all ]
497
+
498
+
let test_doc_meta_missing () = with_tmp_dir @@ fun layer_dir ->
499
+
Alcotest.(check bool) "exists false" false (Doc_meta.exists layer_dir);
500
+
match Doc_meta.load layer_dir with
501
+
| Ok _ -> Alcotest.fail "should not load missing"
502
+
| Error _ -> ()
503
+
464
504
(* ── Test registration ───────────────────────────────────────────── *)
465
505
466
506
let () =
···
559
599
Alcotest.test_case "compile_mounts" `Quick test_compile_mounts;
560
600
Alcotest.test_case "link_mounts" `Quick test_link_mounts;
561
601
Alcotest.test_case "doc_all_mounts" `Quick test_doc_all_mounts;
602
+
] );
603
+
( "Doc_meta",
604
+
[
605
+
Alcotest.test_case "roundtrip" `Quick test_doc_meta_roundtrip;
606
+
Alcotest.test_case "all phases" `Quick test_doc_meta_phases;
607
+
Alcotest.test_case "missing" `Quick test_doc_meta_missing;
562
608
] );
563
609
]
+6
-5
day11/doc/test/test_doc_compile_link.ml
+6
-5
day11/doc/test/test_doc_compile_link.ml
···
7
7
Run with: OPAM_REPOSITORY=... DAY11_INTEGRATION=true \
8
8
dune exec day11/doc/test/test_doc_compile_link.exe *)
9
9
10
-
open Day11_build
10
+
open Day11_opam_build
11
11
module Build = Day11_opam_layer.Build
12
12
module Tool = Day11_opam_layer.Tool
13
13
type build = Build.t
···
62
62
[ "compile"; pkg_build.hash; odoc_tool.hash ] in
63
63
let compile_node : build =
64
64
{ hash = compile_hash; pkg;
65
-
deps = pkg_build.deps @ [ pkg_build ]; universe = Day11_graph.Universe.dummy } in
65
+
deps = pkg_build.deps @ [ pkg_build ]; universe = Day11_solution.Universe.dummy } in
66
66
let compile_build = match
67
67
Build_layer.build env benv ~mounts:all_mounts
68
68
compile_node ~strategy:{ cmd = compile_cmd; cleanup = fun _ _ -> () } ()
···
89
89
[ "link"; compile_build.hash; universe ] in
90
90
let link_node : build =
91
91
{ hash = link_hash; pkg;
92
-
deps = pkg_build.deps @ [ pkg_build; compile_build ]; universe = Day11_graph.Universe.dummy } in
92
+
deps = pkg_build.deps @ [ pkg_build; compile_build ]; universe = Day11_solution.Universe.dummy } in
93
93
let html_count = match
94
94
Build_layer.build env benv ~mounts:all_mounts
95
95
link_node ~strategy:{ cmd = link_cmd; cleanup = fun _ _ -> () } ()
···
146
146
let cache = Hash_cache.create ~find_opam () in
147
147
let astring_solution = match Day11_solver.Solve.solve ~packages:git_packages
148
148
~env:opam_env astring_pkg with
149
-
| Ok s -> s | Error e -> Alcotest.fail ("solve astring: " ^ e) in
149
+
| Ok result -> result.Day11_solution.Solve_result.build_deps
150
+
| Error (e, _) -> Alcotest.fail ("solve astring: " ^ e) in
150
151
let astring_nodes = Dag.build_dag cache ~base_hash:base.hash
151
152
[ (astring_pkg, astring_solution) ] in
152
153
Dag_executor.execute env ~np:4
153
-
~on_complete:(fun ~total:_ ~completed:_ ~failed:_ _ _ -> ())
154
+
~on_complete:(fun ~stats:_ _ _ -> ())
154
155
~on_cascade:(fun ~failed:_ ~failed_dep:_ -> ())
155
156
astring_nodes
156
157
(fun node -> match Build_layer.build env benv node () with
+3
-3
day11/doc/test/test_doc_integration.ml
+3
-3
day11/doc/test/test_doc_integration.ml
···
13
13
let base_dir = Fpath.(cache_dir / "base")
14
14
let switch = "default"
15
15
let make_base () : Day11_layer.Base.t =
16
-
{ hash = Day11_build.Base.build_hash ~os_distribution:"debian"
16
+
{ hash = Day11_opam_build.Base.build_hash ~os_distribution:"debian"
17
17
~os_version:"bookworm" ~arch:"x86_64";
18
18
dir = base_dir;
19
19
image = "debian:bookworm" }
···
87
87
| None -> Alcotest.skip ()
88
88
in
89
89
Printf.printf "Building %s...\n%!" (OpamPackage.to_string odoc_pkg);
90
-
let benv : Day11_build.Types.build_env =
90
+
let benv : Day11_opam_build.Types.build_env =
91
91
{ base; os_dir; uid = 1000; gid = 1000 } in
92
92
let tool =
93
-
Day11_build.Tools.build_tool env benv ~packages:git_packages ~repos:repos_with_shas
93
+
Day11_opam_build.Tools.build_tool env benv ~packages:git_packages ~repos:repos_with_shas
94
94
odoc_pkg
95
95
|> ok_or_fail "build_tool"
96
96
in
+4
-4
day11/doc/test/test_doc_pipeline.ml
+4
-4
day11/doc/test/test_doc_pipeline.ml
···
7
7
Run with: OPAM_REPOSITORY=... DAY11_INTEGRATION=true \
8
8
dune exec day11/doc/test/test_doc_pipeline.exe *)
9
9
10
-
open Day11_build
10
+
open Day11_opam_build
11
11
module Build = Day11_opam_layer.Build
12
12
module Tool = Day11_opam_layer.Tool
13
13
type build = Build.t
···
77
77
[ "doc-all"; b.hash; odoc_tool.hash; universe ] in
78
78
let doc_node : build =
79
79
{ hash = doc_hash; pkg = b.pkg;
80
-
deps = odoc_tool.builds @ [ b ]; universe = Day11_graph.Universe.dummy } in
80
+
deps = odoc_tool.builds @ [ b ]; universe = Day11_solution.Universe.dummy } in
81
81
(match Build_layer.build env benv ~mounts:[ prep_mount ]
82
82
doc_node ~strategy:{ cmd; cleanup = fun _ _ -> () } () with
83
83
| Types.Success bl ->
···
126
126
[ "compile"; b.hash; odoc_tool.hash ] in
127
127
let compile_node : build =
128
128
{ hash = compile_hash; pkg = b.pkg;
129
-
deps = odoc_tool.builds @ [ b ]; universe = Day11_graph.Universe.dummy } in
129
+
deps = odoc_tool.builds @ [ b ]; universe = Day11_solution.Universe.dummy } in
130
130
match Build_layer.build env benv ~mounts:[ prep_mount ]
131
131
compile_node
132
132
~strategy:{ cmd; cleanup = fun _ _ -> () } () with
···
170
170
(* Link deps include: tool layers + build + compile layer *)
171
171
let link_node : build =
172
172
{ hash = link_hash; pkg = b.pkg;
173
-
deps = odoc_tool.builds @ [ b; compile_bl ]; universe = Day11_graph.Universe.dummy } in
173
+
deps = odoc_tool.builds @ [ b; compile_bl ]; universe = Day11_solution.Universe.dummy } in
174
174
(match Build_layer.build env benv ~mounts:[ prep_mount ]
175
175
link_node ~strategy:{ cmd; cleanup = fun _ _ -> () } () with
176
176
| Types.Success bl ->
+10
-10
day11/doc/test/test_generate_docs.ml
+10
-10
day11/doc/test/test_generate_docs.ml
···
11
11
let base_dir = Fpath.(cache_dir / "base")
12
12
let _switch = "default"
13
13
let make_base () : Day11_layer.Base.t =
14
-
{ hash = Day11_build.Base.build_hash ~os_distribution:"debian"
14
+
{ hash = Day11_opam_build.Base.build_hash ~os_distribution:"debian"
15
15
~os_version:"bookworm" ~arch:"x86_64";
16
16
dir = base_dir;
17
17
image = "debian:bookworm" }
···
26
26
[ (opam_repository, None) ] in
27
27
(* Step 1: Build odoc-driver *)
28
28
Printf.printf "Building odoc-driver.3.1.0...\n%!";
29
-
let benv : Day11_build.Types.build_env =
29
+
let benv : Day11_opam_build.Types.build_env =
30
30
{ base; os_dir; uid = 1000; gid = 1000 } in
31
31
let driver_tool =
32
-
Day11_build.Tools.build_tool env benv ~packages:git_packages ~repos:repos_with_shas
32
+
Day11_opam_build.Tools.build_tool env benv ~packages:git_packages ~repos:repos_with_shas
33
33
(OpamPackage.of_string "odoc-driver.3.1.0")
34
34
|> ok_or_fail "build odoc-driver"
35
35
in
···
42
42
with Not_found -> None
43
43
in
44
44
let astring_pkg = OpamPackage.of_string "astring.0.8.5" in
45
-
let cache = Day11_build.Hash_cache.create ~find_opam () in
45
+
let cache = Day11_opam_build.Hash_cache.create ~find_opam () in
46
46
let astring_layer_hash =
47
-
Day11_build.Hash_cache.layer_hash cache ~base_hash:base.hash
47
+
Day11_opam_build.Hash_cache.layer_hash cache ~base_hash:base.hash
48
48
[ astring_pkg ] in
49
49
let astring_node : Day11_opam_layer.Build.t =
50
50
{ hash = astring_layer_hash; pkg = astring_pkg;
51
-
deps = driver_tool.builds; universe = Day11_graph.Universe.dummy } in
51
+
deps = driver_tool.builds; universe = Day11_solution.Universe.dummy } in
52
52
let astring_result =
53
-
Day11_build.Build_layer.build env benv
53
+
Day11_opam_build.Build_layer.build env benv
54
54
astring_node ()
55
55
in
56
56
(match astring_result with
57
-
| Day11_build.Types.Success bl ->
57
+
| Day11_opam_build.Types.Success bl ->
58
58
Printf.printf "astring: %s\n%!" bl.hash
59
59
| _ -> Alcotest.fail "astring build failed");
60
60
(* Step 3: Create prep structure *)
···
78
78
(* Step 4: Run odoc_driver_voodoo via Run_in_layers *)
79
79
let all_builds = driver_tool.builds @
80
80
(match astring_result with
81
-
| Day11_build.Types.Success bl -> [ bl ]
81
+
| Day11_opam_build.Types.Success bl -> [ bl ]
82
82
| _ -> []) in
83
83
let voodoo_cmd =
84
84
"eval $(opam env) && " ^
···
94
94
] in
95
95
let build_dirs = List.map
96
96
(Day11_opam_layer.Build.dir ~os_dir) all_builds in
97
-
let spec = Day11_build.Build_layer.opam_build_spec
97
+
let spec = Day11_opam_build.Build_layer.opam_build_spec
98
98
~cmd:voodoo_cmd ~mounts ~uid:1000 ~gid:1000 in
99
99
let run, upper, _timing =
100
100
Day11_runner.Run_in_layers.run env ~base ~build_dirs spec
-65
day11/doc_layer/README.md
-65
day11/doc_layer/README.md
···
1
-
# doc_layer — odoc doc-layer sidecars
2
-
3
-
A small data-only library that defines the on-disk format for odoc
4
-
documentation layers in the day11 cache.
5
-
6
-
The only thing in here is `Doc_meta`, which serializes the
7
-
[`doc.json`](#doc-meta) sidecar that lives next to a layer's
8
-
`layer.json`. The presence of `doc.json` marks a layer as odoc
9
-
output.
10
-
11
-
This library is intentionally tiny: one module, no opam dependency,
12
-
no recursive types. It depends only on
13
-
[`day11_layer`](../layer/) and `yojson`. Anything that wants to
14
-
enumerate or interpret doc layers can link this library without
15
-
pulling in the full opam-format / opam package universe.
16
-
17
-
## Module
18
-
19
-
### `Doc_meta`
20
-
21
-
```ocaml
22
-
type phase = Compile | Link | Doc_all
23
-
24
-
val string_of_phase : phase -> string
25
-
val phase_of_string : string -> phase
26
-
27
-
type t = {
28
-
package : string;
29
-
phase : phase;
30
-
deps : string list;
31
-
}
32
-
33
-
val filename : string (* "doc.json" *)
34
-
val save : Fpath.t -> t -> (unit, _) result
35
-
val load : Fpath.t -> (t, _) result
36
-
val exists : Fpath.t -> bool
37
-
```
38
-
39
-
The phase distinguishes the three odoc-driver invocation modes:
40
-
41
-
- **`Compile`** produces `.odoc` files only. Used when packages need
42
-
a separate link phase later.
43
-
- **`Link`** produces `.odocl` linked output, consuming the `.odoc`
44
-
files from a previous compile phase.
45
-
- **`Doc_all`** runs the whole pipeline (compile + link + html) in
46
-
one container. The common case for packages whose dep tree fits
47
-
in one shot.
48
-
49
-
`package` is a string (typically `name.version`) — the library does
50
-
not require it to be a typed `OpamPackage.t`, so doc_layer stays
51
-
opam-independent.
52
-
53
-
## Where doc layers come from
54
-
55
-
The day11 doc pipeline (`day11/doc/generate.ml`) builds a doc layer
56
-
for each documented package version, then writes a `Doc_meta.t` to
57
-
`doc.json` in the layer directory. After that, anyone who wants to
58
-
find or interpret doc layers (e.g. a doc-browsing UI) can scan the
59
-
cache for `doc.json` files and load them via `Doc_meta.load`.
60
-
61
-
## Testing
62
-
63
-
Unit tests in `test/test_doc_layer.ml` cover round-trip save/load,
64
-
all three phase variants, and missing-file handling. No filesystem
65
-
permissions or container runtime required.
day11/doc_layer/doc_meta.ml
day11/doc/doc_meta.ml
day11/doc_layer/doc_meta.ml
day11/doc/doc_meta.ml
day11/doc_layer/doc_meta.mli
day11/doc/doc_meta.mli
day11/doc_layer/doc_meta.mli
day11/doc/doc_meta.mli
-4
day11/doc_layer/dune
-4
day11/doc_layer/dune
-4
day11/doc_layer/test/dune
-4
day11/doc_layer/test/dune
-43
day11/doc_layer/test/test_doc_layer.ml
-43
day11/doc_layer/test/test_doc_layer.ml
···
1
-
(* Tests for the day11_doc_layer library. *)
2
-
3
-
open Day11_doc_layer
4
-
open Day11_test_util.Test_util
5
-
6
-
let is_ok msg r = ok_or_fail msg r |> ignore
7
-
8
-
let test_doc_meta_roundtrip () = with_tmp_dir @@ fun layer_dir ->
9
-
let m : Doc_meta.t = {
10
-
package = "fmt.0.9.0";
11
-
phase = Doc_meta.Doc_all;
12
-
deps = [ "ocaml.5.4.1"; "fmt.0.9.0" ];
13
-
} in
14
-
Doc_meta.save layer_dir m |> is_ok "save";
15
-
Alcotest.(check bool) "exists" true (Doc_meta.exists layer_dir);
16
-
let loaded = Doc_meta.load layer_dir |> ok_or_fail "load" in
17
-
Alcotest.(check string) "package" "fmt.0.9.0" loaded.package;
18
-
Alcotest.(check bool) "phase doc-all" true (loaded.phase = Doc_meta.Doc_all)
19
-
20
-
let test_doc_meta_phases () = with_tmp_dir @@ fun layer_dir ->
21
-
List.iter (fun phase ->
22
-
let m : Doc_meta.t = { package = "x.1"; phase; deps = [] } in
23
-
Doc_meta.save layer_dir m |> is_ok "save";
24
-
let loaded = Doc_meta.load layer_dir |> ok_or_fail "load" in
25
-
Alcotest.(check bool) "phase round-trip" true (loaded.phase = phase)
26
-
) [ Doc_meta.Compile; Doc_meta.Link; Doc_meta.Doc_all ]
27
-
28
-
let test_doc_meta_missing () = with_tmp_dir @@ fun layer_dir ->
29
-
Alcotest.(check bool) "exists false" false (Doc_meta.exists layer_dir);
30
-
match Doc_meta.load layer_dir with
31
-
| Ok _ -> Alcotest.fail "should not load missing"
32
-
| Error _ -> ()
33
-
34
-
let () =
35
-
Alcotest.run "day11_doc_layer"
36
-
[
37
-
( "Doc_meta",
38
-
[
39
-
Alcotest.test_case "roundtrip" `Quick test_doc_meta_roundtrip;
40
-
Alcotest.test_case "all phases" `Quick test_doc_meta_phases;
41
-
Alcotest.test_case "missing" `Quick test_doc_meta_missing;
42
-
] );
43
-
]
+1
day11/exec/dune
+1
day11/exec/dune
+1
day11/exec/helper/dune
+1
day11/exec/helper/dune
-3
day11/graph/dune
-3
day11/graph/dune
+6
-7
day11/graph/graph.ml
day11/solution/deps.ml
+6
-7
day11/graph/graph.ml
day11/solution/deps.ml
···
1
-
type solution = OpamPackage.Set.t OpamPackage.Map.t
1
+
type t = OpamPackage.Set.t OpamPackage.Map.t
2
2
3
-
let transitive_deps solution =
3
+
let transitive_deps deps =
4
4
let cache = Hashtbl.create 64 in
5
5
let rec go pkg =
6
6
match Hashtbl.find_opt cache pkg with
7
7
| Some deps -> deps
8
8
| None ->
9
-
let direct = match OpamPackage.Map.find_opt pkg solution with
9
+
let direct = match OpamPackage.Map.find_opt pkg deps with
10
10
| Some s -> s | None -> OpamPackage.Set.empty in
11
11
let transitive =
12
12
OpamPackage.Set.fold (fun dep acc ->
···
16
16
Hashtbl.replace cache pkg transitive;
17
17
transitive
18
18
in
19
-
OpamPackage.Map.mapi (fun pkg _ -> go pkg) solution
19
+
OpamPackage.Map.mapi (fun pkg _ -> go pkg) deps
20
20
21
21
let compiler_names = [ "ocaml-base-compiler"; "ocaml-variants"; "ocaml" ]
22
22
23
-
let extract_ocaml_version solution =
23
+
let extract_ocaml_version deps =
24
24
List.find_map (fun name ->
25
25
let name = OpamPackage.Name.of_string name in
26
26
OpamPackage.Map.filter (fun pkg _ ->
27
27
OpamPackage.Name.equal (OpamPackage.name pkg) name
28
-
) solution
28
+
) deps
29
29
|> OpamPackage.Map.min_binding_opt
30
30
|> Option.map fst
31
31
) compiler_names
32
-
-17
day11/graph/graph.mli
-17
day11/graph/graph.mli
···
1
-
(** Dependency graph operations.
2
-
3
-
Pure functions on solution maps where each package maps to its
4
-
direct dependencies. No solver or I/O dependencies. *)
5
-
6
-
type solution = OpamPackage.Set.t OpamPackage.Map.t
7
-
(** A dependency solution: maps each package to its direct dependencies. *)
8
-
9
-
val transitive_deps : solution -> solution
10
-
(** [transitive_deps solution] enriches the map so each package maps
11
-
to its full transitive dependency closure. *)
12
-
13
-
val extract_ocaml_version : solution -> OpamPackage.t option
14
-
(** [extract_ocaml_version solution] finds [ocaml-base-compiler],
15
-
[ocaml-variants], or [ocaml] in the solution. Returns the first
16
-
match found. *)
17
-
+1
-1
day11/graph/rdeps.ml
day11/solution/rdeps.ml
+1
-1
day11/graph/rdeps.ml
day11/solution/rdeps.ml
+1
-1
day11/graph/rdeps.mli
day11/solution/rdeps.mli
+1
-1
day11/graph/rdeps.mli
day11/solution/rdeps.mli
+1
-1
day11/graph/solution_json.ml
day11/solution/json.ml
+1
-1
day11/graph/solution_json.ml
day11/solution/json.ml
+2
-2
day11/graph/solution_json.mli
day11/solution/json.mli
+2
-2
day11/graph/solution_json.mli
day11/solution/json.mli
···
4
4
to and from JSON. Used for caching solved results on disk and
5
5
for inter-process communication. *)
6
6
7
-
type t = OpamPackage.Set.t OpamPackage.Map.t
8
-
(** A dependency solution: maps each package to its direct dependencies. *)
7
+
type t = Deps.t
8
+
(** Alias for {!Deps.t}. *)
9
9
10
10
val to_json : t -> Yojson.Safe.t
11
11
(** Serialize a solution to JSON. *)
-3
day11/graph/test/dune
-3
day11/graph/test/dune
+17
-17
day11/graph/test/test_graph.ml
day11/solution/test/test_graph.ml
+17
-17
day11/graph/test/test_graph.ml
day11/solution/test/test_graph.ml
···
1
-
(* Tests for the day11_graph library. *)
1
+
(* Tests for the day11_solution library. *)
2
2
3
-
open Day11_graph
3
+
open Day11_solution
4
4
open Day11_test_util.Test_util
5
5
6
6
let is_ok msg r = ok_or_fail msg r |> ignore
···
22
22
23
23
let test_transitive_deps () =
24
24
let s = make_solution () in
25
-
let t = Graph.transitive_deps s in
25
+
let t = Deps.transitive_deps s in
26
26
let a_deps = OpamPackage.Map.find (pkg "a.1") t in
27
27
Alcotest.(check bool) "a has b"
28
28
true (OpamPackage.Set.mem (pkg "b.1") a_deps);
···
38
38
|> OpamPackage.Map.add (pkg "ocaml-base-compiler.5.1.0") OpamPackage.Set.empty
39
39
|> OpamPackage.Map.add (pkg "dune.3.0") OpamPackage.Set.empty
40
40
in
41
-
let v = Graph.extract_ocaml_version s in
41
+
let v = Deps.extract_ocaml_version s in
42
42
Alcotest.(check (option string)) "found compiler"
43
43
(Some "ocaml-base-compiler.5.1.0")
44
44
(Option.map OpamPackage.to_string v)
45
45
46
46
let test_extract_ocaml_version_none () =
47
47
let s = OpamPackage.Map.singleton (pkg "dune.3.0") OpamPackage.Set.empty in
48
-
let v = Graph.extract_ocaml_version s in
48
+
let v = Deps.extract_ocaml_version s in
49
49
Alcotest.(check bool) "no compiler" true (Option.is_none v)
50
50
51
51
(* ── Rdeps tests ────────────────────────────────────────────────── *)
···
108
108
109
109
let test_solution_json_roundtrip () =
110
110
let s = make_json_solution () in
111
-
let json = Solution_json.to_json s in
112
-
let s2 = Solution_json.of_json json |> ok_or_fail "of_json" in
111
+
let json = Json.to_json s in
112
+
let s2 = Json.of_json json |> ok_or_fail "of_json" in
113
113
Alcotest.(check bool) "roundtrip"
114
114
true (OpamPackage.Map.equal OpamPackage.Set.equal s s2)
115
115
116
116
let test_solution_string_roundtrip () =
117
117
let s = make_json_solution () in
118
-
let str = Solution_json.to_string s in
119
-
let s2 = Solution_json.of_string str |> ok_or_fail "of_string" in
118
+
let str = Json.to_string s in
119
+
let s2 = Json.of_string str |> ok_or_fail "of_string" in
120
120
Alcotest.(check bool) "roundtrip"
121
121
true (OpamPackage.Map.equal OpamPackage.Set.equal s s2)
122
122
123
123
let test_solution_file_roundtrip () = with_tmp_dir @@ fun dir ->
124
124
let path = Fpath.(dir / "solution.json") in
125
125
let s = make_json_solution () in
126
-
Solution_json.save path s |> is_ok "save";
127
-
let s2 = Solution_json.load path |> ok_or_fail "load" in
126
+
Json.save path s |> is_ok "save";
127
+
let s2 = Json.load path |> ok_or_fail "load" in
128
128
Alcotest.(check bool) "roundtrip"
129
129
true (OpamPackage.Map.equal OpamPackage.Set.equal s s2)
130
130
131
131
let test_solution_corrupt () =
132
-
is_error "corrupt" (Solution_json.of_json (`String "not an object"));
133
-
is_error "corrupt" (Solution_json.of_string "{broken")
132
+
is_error "corrupt" (Json.of_json (`String "not an object"));
133
+
is_error "corrupt" (Json.of_string "{broken")
134
134
135
135
let test_solution_load_missing () =
136
-
is_error "missing" (Solution_json.load (Fpath.v "/nonexistent/solution.json"))
136
+
is_error "missing" (Json.load (Fpath.v "/nonexistent/solution.json"))
137
137
138
138
(* ── Test registration ───────────────────────────────────────────── *)
139
139
140
140
let () =
141
-
Alcotest.run "day11_graph"
141
+
Alcotest.run "day11_solution"
142
142
[
143
-
( "Graph",
143
+
( "Deps",
144
144
[
145
145
Alcotest.test_case "transitive_deps" `Quick test_transitive_deps;
146
146
Alcotest.test_case "extract_ocaml_version" `Quick
···
148
148
Alcotest.test_case "extract_ocaml_version none" `Quick
149
149
test_extract_ocaml_version_none;
150
150
] );
151
-
( "Solution_json",
151
+
( "Json",
152
152
[
153
153
Alcotest.test_case "json roundtrip" `Quick test_solution_json_roundtrip;
154
154
Alcotest.test_case "string roundtrip" `Quick test_solution_string_roundtrip;
day11/graph/universe.ml
day11/solution/universe.ml
day11/graph/universe.ml
day11/solution/universe.ml
day11/graph/universe.mli
day11/solution/universe.mli
day11/graph/universe.mli
day11/solution/universe.mli
+9
-2
day11/jtw/build_tools.ml
+9
-2
day11/jtw/build_tools.ml
···
2
2
~extra_repo_dirs ~repo_dir ~solutions =
3
3
Printf.printf "\nBuilding JTW tools from %s...\n%!" repo_dir;
4
4
let compiler_versions =
5
-
Day11_doc.Generate.unique_compilers solutions in
5
+
let seen = Hashtbl.create 4 in
6
+
List.filter_map (fun (_target, solution) ->
7
+
match Day11_doc.Generate.find_compiler solution with
8
+
| Some c when not (Hashtbl.mem seen (OpamPackage.to_string c)) ->
9
+
Hashtbl.replace seen (OpamPackage.to_string c) ();
10
+
Some c
11
+
| _ -> None
12
+
) solutions in
6
13
List.filter_map (fun compiler_v ->
7
14
Printf.printf "Building JTW for %s...\n%!"
8
15
(OpamPackage.to_string compiler_v);
9
-
match Day11_build.Tools.build_tool_from_repo env benv ~np
16
+
match Day11_opam_build.Tools.build_tool_from_repo env benv ~np
10
17
~packages ~repos ~ocaml_version:compiler_v
11
18
~mounts ~extra_repo_dirs ~repo_dir
12
19
~extra_target_names:Tool_layer.extra_tool_targets
+4
-4
day11/jtw/build_tools.mli
+4
-4
day11/jtw/build_tools.mli
···
6
6
7
7
val build_per_compiler :
8
8
Eio_unix.Stdenv.base ->
9
-
Day11_build.Types.build_env ->
9
+
Day11_opam_build.Types.build_env ->
10
10
np:int ->
11
11
packages:Day11_opam.Git_packages.t ->
12
12
repos:(string * string) list ->
13
13
mounts:Day11_container.Mount.t list ->
14
14
extra_repo_dirs:string list ->
15
15
repo_dir:string ->
16
-
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
16
+
solutions:(OpamPackage.t * Day11_solution.Deps.t) list ->
17
17
(OpamPackage.t * Day11_opam_layer.Tool.t) list
18
18
(** Build JTW tools for each compiler version. Returns the built tools. *)
19
19
20
20
val build_and_run :
21
21
Eio_unix.Stdenv.base ->
22
-
Day11_build.Types.build_env ->
22
+
Day11_opam_build.Types.build_env ->
23
23
np:int ->
24
24
os_dir:Fpath.t ->
25
25
packages:Day11_opam.Git_packages.t ->
···
29
29
repo_dir:string ->
30
30
output:string ->
31
31
nodes:Day11_opam_layer.Build.t list ->
32
-
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
32
+
solutions:(OpamPackage.t * Day11_solution.Deps.t) list ->
33
33
unit
34
34
(** Build tools, generate per-package artifacts and worker.js, then
35
35
assemble the output directory at [output]. *)
+2
-1
day11/jtw/dune
+2
-1
day11/jtw/dune
+6
-6
day11/jtw/generate.ml
+6
-6
day11/jtw/generate.ml
···
20
20
~build_hash:node.hash ~tools_hash:jtw_tool.hash in
21
21
let jtw_node : build =
22
22
{ hash; pkg = node.pkg;
23
-
deps = jtw_tool.builds @ [ node ]; universe = Day11_graph.Universe.dummy } in
24
-
match Day11_build.Build_layer.build env benv
23
+
deps = jtw_tool.builds @ [ node ]; universe = Day11_solution.Universe.dummy } in
24
+
match Day11_opam_build.Build_layer.build env benv
25
25
jtw_node
26
26
~strategy:{ cmd; cleanup = fun _ _ -> () } () with
27
-
| Day11_build.Types.Success bl ->
27
+
| Day11_opam_build.Types.Success bl ->
28
28
Printf.printf " %s: OK\n%!" (OpamPackage.to_string node.pkg);
29
29
Some bl
30
30
| _ ->
···
44
44
let dummy_pkg = OpamPackage.of_string "jtw-worker.0" in
45
45
let worker_node : build =
46
46
{ hash; pkg = dummy_pkg;
47
-
deps = jtw_tool.builds @ solution_nodes; universe = Day11_graph.Universe.dummy } in
48
-
match Day11_build.Build_layer.build env benv
47
+
deps = jtw_tool.builds @ solution_nodes; universe = Day11_solution.Universe.dummy } in
48
+
match Day11_opam_build.Build_layer.build env benv
49
49
worker_node
50
50
~strategy:{ cmd; cleanup = fun _ _ -> () } () with
51
-
| Day11_build.Types.Success bl ->
51
+
| Day11_opam_build.Types.Success bl ->
52
52
Printf.printf " worker.js: OK\n%!";
53
53
Some bl
54
54
| _ ->
+3
-3
day11/jtw/generate.mli
+3
-3
day11/jtw/generate.mli
···
13
13
14
14
val run :
15
15
Eio_unix.Stdenv.base ->
16
-
Day11_build.Types.build_env ->
16
+
Day11_opam_build.Types.build_env ->
17
17
os_dir:Fpath.t ->
18
18
jtw_tools:(OpamPackage.t * Day11_opam_layer.Tool.t) list ->
19
19
nodes:Day11_opam_layer.Build.t list ->
20
-
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
20
+
solutions:(OpamPackage.t * Day11_solution.Deps.t) list ->
21
21
(OpamPackage.t, Day11_opam_layer.Build.t) Hashtbl.t
22
22
* (OpamPackage.t * Day11_opam_layer.Build.t) list
23
23
(** [run env benv ~os_dir ~jtw_tools ~nodes ~solutions] generates
···
31
31
output:string ->
32
32
jtw_results:(OpamPackage.t, Day11_opam_layer.Build.t) Hashtbl.t ->
33
33
worker_layers:(OpamPackage.t * Day11_opam_layer.Build.t) list ->
34
-
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
34
+
solutions:(OpamPackage.t * Day11_solution.Deps.t) list ->
35
35
unit
36
36
(** [assemble ~os_dir ~output ~jtw_results ~worker_layers ~solutions]
37
37
copies artifacts into a content-hashed directory structure at
+1
-1
day11/jtw/test/dune
+1
-1
day11/jtw/test/dune
+2
-2
day11/jtw/test/test_jtw_integration.ml
+2
-2
day11/jtw/test/test_jtw_integration.ml
···
6
6
Requires: from-scratch cache at /tmp/day11-scratch-cache, network
7
7
Run with: DAY11_INTEGRATION=true dune exec day11/jtw/test/test_jtw_integration.exe *)
8
8
9
-
open Day11_build
9
+
open Day11_opam_build
10
10
open Day11_test_util.Test_util
11
11
12
12
let scratch_cache_dir = Fpath.v "/tmp/day11-scratch-cache"
···
105
105
let layer_hash = Day11_layer.Hash.of_strings
106
106
[ "jtw-tools"; base.hash; jtw_local_source ] in
107
107
let jtw_node : Day11_opam_layer.Build.t =
108
-
{ hash = layer_hash; pkg = jtw_pkg; deps = tool.builds; universe = Day11_graph.Universe.dummy } in
108
+
{ hash = layer_hash; pkg = jtw_pkg; deps = tool.builds; universe = Day11_solution.Universe.dummy } in
109
109
let result =
110
110
Build_layer.build env benv
111
111
~mounts:[ jtw_mount ]
+1
day11/layer/cli/dune
+1
day11/layer/cli/dune
+1
-1
day11/layer/dir.ml
+1
-1
day11/layer/dir.ml
+5
-10
day11/layer/dir.mli
+5
-10
day11/layer/dir.mli
···
1
1
(** On-disk layer directory naming convention.
2
2
3
-
All layers, regardless of kind (opam build, doc, future), live in
4
-
a directory whose name is derived from the layer's content hash.
5
-
This module owns that convention so individual kinds don't have
6
-
to know it. *)
3
+
All layers live in a directory whose name is derived from the
4
+
layer's content hash. This module owns that convention so
5
+
individual layer kinds don't have to know it. *)
7
6
8
7
val name : string -> string
9
8
(** [name hash] returns the directory basename for a layer with full
10
-
content hash [hash]. The first 12 hex characters are used and
11
-
prefixed with ["build-"], producing e.g. ["build-c9f7404f9f87"].
12
-
13
-
The ["build-"] prefix is historical: it was originally only used
14
-
for opam package build layers, but the same naming applies to
15
-
every layer kind now. *)
9
+
content hash [hash]. Uses the first 12 hex characters, producing
10
+
e.g. ["c9f7404f9f87"]. *)
16
11
17
12
val path : os_dir:Fpath.t -> string -> Fpath.t
18
13
(** [path ~os_dir hash] is [os_dir / name hash]. *)
+1
day11/layer/dune
+1
day11/layer/dune
+2
-2
day11/layer/test/test_layer.ml
+2
-2
day11/layer/test/test_layer.ml
···
29
29
30
30
let test_layer_dir_name () =
31
31
Alcotest.(check string) "12-char hash"
32
-
"build-c9f7404f9f87"
32
+
"c9f7404f9f87"
33
33
(Dir.name "c9f7404f9f87a8b3c4d5e6f7");
34
34
Alcotest.(check string) "short hash"
35
-
"build-abc"
35
+
"abc"
36
36
(Dir.name "abc")
37
37
38
38
(* ── Symlinks tests ────────────────────────────────────────── *)
+11
-2
day11/lib/build_lock.mli
+11
-2
day11/lib/build_lock.mli
···
1
1
(** Lock file tracking and management.
2
2
3
-
Queries active lock files to report what's currently building.
4
-
Used by the web dashboard and for stale lock cleanup. *)
3
+
Each in-progress build acquires a file lock under
4
+
[<cache_dir>/locks/]. This module queries those lock files to report
5
+
what is currently building, and can clean up stale locks left by
6
+
crashed processes. Used by the web dashboard and CLI status commands. *)
5
7
8
+
(** The build stage a lock belongs to. *)
6
9
type stage = Build | Doc | Tool
7
10
11
+
(** Metadata parsed from a held lock file. *)
8
12
type lock_info = {
9
13
stage : stage;
10
14
package : string;
···
16
20
temp_log_path : string option;
17
21
}
18
22
23
+
(** Return metadata for every currently-held lock in [cache_dir]. *)
19
24
val list_active : cache_dir:string -> lock_info list
25
+
26
+
(** Remove lock files whose owning process is no longer running. *)
20
27
val cleanup_stale : cache_dir:string -> unit
28
+
29
+
(** Test whether the lock at the given path is currently held by a process. *)
21
30
val is_lock_held : string -> bool
+18
-3
day11/lib/disk_usage.ml
+18
-3
day11/lib/disk_usage.ml
···
32
32
|> List.fold_left (fun acc name ->
33
33
acc + dir_size Fpath.(dir / name)) 0
34
34
35
+
let is_layer_dir name =
36
+
(* Layer dirs are 12-char hex strings (new format) or build-<hex> (legacy) *)
37
+
let is_hex c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') in
38
+
(String.length name = 12 && String.for_all is_hex name)
39
+
|| (String.length name > 6
40
+
&& String.sub name 0 6 = "build-")
41
+
35
42
let scan ~os_dir ~cache_dir =
36
-
let base = dir_size Fpath.(os_dir / "base") in
37
-
let builds = sum_matching ~dir:os_dir "build-" in
38
-
let docs = sum_matching ~dir:os_dir "doc-" in
43
+
let base = dir_size Fpath.(cache_dir / "base") in
44
+
let builds =
45
+
let dir_s = Fpath.to_string os_dir in
46
+
if not (Sys.file_exists dir_s) then 0
47
+
else
48
+
Sys.readdir dir_s |> Array.to_list
49
+
|> List.filter is_layer_dir
50
+
|> List.fold_left (fun acc name ->
51
+
acc + dir_size Fpath.(os_dir / name)) 0
52
+
in
53
+
let docs = dir_size Fpath.(os_dir / "odoc-store") in
39
54
let jtw = sum_matching ~dir:os_dir "jtw-" in
40
55
let solutions = dir_size Fpath.(cache_dir / "solutions") in
41
56
let logs = dir_size Fpath.(cache_dir / "logs") in
+1
day11/lib/dune
+1
day11/lib/dune
+26
-10
day11/lib/history.mli
+26
-10
day11/lib/history.mli
···
3
3
Each package has a [history.jsonl] file with one JSON entry per
4
4
build. Uses file locking for concurrent access safety. *)
5
5
6
+
(** A single build history entry recording what happened and when. *)
6
7
type entry = {
7
-
ts : string;
8
-
run : string;
9
-
build_hash : string;
10
-
status : string;
11
-
category : string;
12
-
compiler : string;
13
-
blessed : bool;
14
-
error : string option;
15
-
failed_dep : string option;
16
-
failed_dep_hash : string option;
8
+
ts : string; (** ISO-8601 timestamp of the build. *)
9
+
run : string; (** Run identifier this entry belongs to. *)
10
+
build_hash : string; (** Content hash of the build layer. *)
11
+
status : string; (** Outcome status (e.g. ["ok"], ["fail"]). *)
12
+
category : string; (** Failure category (e.g. ["build_failure"]). *)
13
+
compiler : string; (** OCaml compiler version used. *)
14
+
blessed : bool; (** Whether this is the blessed (primary) build. *)
15
+
error : string option; (** Optional error message. *)
16
+
failed_dep : string option; (** Package name of the failing dependency, if any. *)
17
+
failed_dep_hash : string option; (** Build hash of the failing dependency, if any. *)
17
18
}
18
19
20
+
(** Append an entry to the history file for [pkg_str] under [packages_dir].
21
+
Creates the file if it does not exist. *)
19
22
val append : packages_dir:Fpath.t -> pkg_str:string -> entry -> unit
23
+
24
+
(** Read all history entries for [pkg_str], most recent first. *)
20
25
val read : packages_dir:Fpath.t -> pkg_str:string -> entry list
26
+
27
+
(** Read the latest entry per unique {!field:entry.build_hash}, most recent first. *)
21
28
val read_latest : packages_dir:Fpath.t -> pkg_str:string -> entry list
29
+
30
+
(** Return the most recent blessed entry, or [None]. *)
22
31
val read_blessed : packages_dir:Fpath.t -> pkg_str:string -> entry option
32
+
33
+
(** Remove duplicate consecutive entries older than [max_age_days],
34
+
keeping the first and last of each run of identical results. *)
23
35
val compact : packages_dir:Fpath.t -> pkg_str:string ->
24
36
max_age_days:int -> unit
37
+
38
+
(** Serialize an entry to JSON. *)
25
39
val entry_to_json : entry -> Yojson.Safe.t
40
+
41
+
(** Deserialize an entry from JSON, returning [None] on malformed input. *)
26
42
val entry_of_json : Yojson.Safe.t -> entry option
+11
-1
day11/lib/notify.mli
+11
-1
day11/lib/notify.mli
···
1
1
(** Pluggable notifications.
2
2
3
-
Send messages to external services via curl or stdout. *)
3
+
Send messages to external services (Slack, Zulip, Telegram, Email)
4
+
or to stdout. Each channel uses environment variables for credentials
5
+
and endpoints; see the implementation for required variables. *)
4
6
7
+
(** Supported notification channels. *)
5
8
type channel = Slack | Zulip | Telegram | Email | Stdout
6
9
10
+
(** Send [message] to the given [channel]. Returns [0] on success, [1] on
11
+
failure. External channels dispatch via [curl]; {!Stdout} prints
12
+
directly. *)
7
13
val send : channel:channel -> message:string -> int
14
+
15
+
(** Parse a lowercase channel name (e.g. ["slack"], ["telegram"]). *)
8
16
val channel_of_string : string -> channel option
17
+
18
+
(** Lowercase string representation of a {!type:channel}. *)
9
19
val channel_to_string : channel -> string
+27
-2
day11/lib/progress.mli
+27
-2
day11/lib/progress.mli
···
1
1
(** Batch progress tracking.
2
2
3
-
Immutable state updated during a batch run, written as JSON
4
-
for the web dashboard to poll. *)
3
+
Immutable state updated during a batch run, written as
4
+
[progress.json] for the web dashboard to poll. Each mutation
5
+
returns a new {!type:t} value. *)
5
6
7
+
(** The current phase of a batch run. *)
6
8
type phase = Solving | Blessings | Building | Gc | Completed
7
9
10
+
(** Opaque progress state. Use {!create} to initialise and the
11
+
[set_*] / [incr_*] functions to update. *)
8
12
type t
9
13
14
+
(** Create initial progress state in the {!Solving} phase. *)
10
15
val create : run_id:string -> start_time:string -> targets:string list -> t
16
+
17
+
(** Set the current phase. *)
11
18
val set_phase : t -> phase -> t
19
+
20
+
(** Record how many solutions were found and how many failed. *)
12
21
val set_solutions : t -> found:int -> failed:int -> t
22
+
23
+
(** Set the total number of builds (and docs) expected. *)
13
24
val set_build_total : t -> int -> t
25
+
26
+
(** Increment the count of completed builds by one. *)
14
27
val incr_build_completed : t -> t
28
+
29
+
(** Increment the count of completed doc builds by one. *)
15
30
val incr_doc_completed : t -> t
31
+
32
+
(** Set completed build and doc counts directly. *)
16
33
val set_completed : t -> build:int -> doc:int -> t
34
+
35
+
(** Serialize progress state to JSON. *)
17
36
val to_json : t -> Yojson.Safe.t
37
+
38
+
(** Write [progress.json] atomically into [run_dir]. *)
18
39
val write : run_dir:string -> t -> unit
40
+
41
+
(** Delete [progress.json] from [run_dir], ignoring errors. *)
19
42
val delete : run_dir:string -> unit
43
+
44
+
(** Convert a phase to its lowercase string representation. *)
20
45
val phase_to_string : phase -> string
+26
-12
day11/lib/status_index.mli
+26
-12
day11/lib/status_index.mli
···
1
1
(** Global status index.
2
2
3
3
Aggregates all packages' current build status into a single
4
-
snapshot, detecting changes from the previous snapshot. *)
4
+
snapshot, detecting changes from the previous snapshot. Written
5
+
to [status.json] for consumption by the web dashboard and
6
+
notification system. *)
5
7
8
+
(** A status change for a single package between two runs. *)
6
9
type change = {
7
-
package : string;
8
-
build_hash : string;
9
-
blessed : bool;
10
-
from_status : string;
11
-
to_status : string;
10
+
package : string; (** Package name (e.g. ["foo.1.0"]). *)
11
+
build_hash : string; (** Content hash of the build layer. *)
12
+
blessed : bool; (** Whether this is the blessed build. *)
13
+
from_status : string; (** Previous status category. *)
14
+
to_status : string; (** New status category. *)
12
15
}
13
16
17
+
(** A complete status snapshot for one run. *)
14
18
type t = {
15
-
generated : string;
16
-
run_id : string;
17
-
blessed_totals : (string * int) list;
18
-
non_blessed_totals : (string * int) list;
19
-
changes : change list;
20
-
new_packages : string list;
19
+
generated : string; (** ISO-8601 generation timestamp. *)
20
+
run_id : string; (** Unique run identifier. *)
21
+
blessed_totals : (string * int) list; (** Category counts for blessed builds. *)
22
+
non_blessed_totals : (string * int) list; (** Category counts for non-blessed builds. *)
23
+
changes : change list; (** Status changes since the previous run. *)
24
+
new_packages : string list; (** Packages seen for the first time in this run. *)
21
25
}
22
26
27
+
(** Scan [packages_dir] and build a status snapshot for [run_id],
28
+
computing changes relative to [previous] (if provided). *)
23
29
val generate : packages_dir:Fpath.t -> run_id:string ->
24
30
previous:t option -> t
31
+
32
+
(** Write the status index as [status.json] in [dir]. *)
25
33
val write : dir:Fpath.t -> t -> unit
34
+
35
+
(** Read a previously written status index from [dir], or [None]. *)
26
36
val read : dir:Fpath.t -> t option
37
+
38
+
(** Serialize a status index to JSON. *)
27
39
val to_json : t -> Yojson.Safe.t
40
+
41
+
(** Deserialize a status index from JSON, returning [None] on malformed input. *)
28
42
val of_json : Yojson.Safe.t -> t option
-90
day11/opam/deps.ml
-90
day11/opam/deps.ml
···
1
-
let get_extra_doc_deps opamfile =
2
-
let open OpamParserTypes.FullPos in
3
-
let extensions = OpamFile.OPAM.extensions opamfile in
4
-
match OpamStd.String.Map.find_opt "x-extra-doc-deps" extensions with
5
-
| None -> OpamPackage.Name.Set.empty
6
-
| Some value ->
7
-
let extract_name item =
8
-
match item.pelem with
9
-
| String name -> Some name
10
-
| Option (inner, _) ->
11
-
(match inner.pelem with
12
-
| String name -> Some name
13
-
| _ -> None)
14
-
| _ -> None
15
-
in
16
-
let extract_names acc v =
17
-
match v.pelem with
18
-
| List { pelem = items; _ } ->
19
-
List.fold_left (fun acc item ->
20
-
match extract_name item with
21
-
| Some name ->
22
-
OpamPackage.Name.Set.add
23
-
(OpamPackage.Name.of_string name) acc
24
-
| None -> acc
25
-
) acc items
26
-
| _ -> acc
27
-
in
28
-
extract_names OpamPackage.Name.Set.empty value
29
-
30
-
let predefined_depends_variables =
31
-
List.map OpamVariable.Full.of_string [
32
-
"build"; "post"; "with-test"; "with-doc"; "with-dev-setup"; "dev";
33
-
]
34
-
35
-
let recompute_with_post ~packages ~env solution =
36
-
let filter_env pkg v =
37
-
if List.mem v predefined_depends_variables then None
38
-
else match OpamVariable.Full.to_string v with
39
-
| "version" ->
40
-
Some (OpamTypes.S
41
-
(OpamPackage.Version.to_string (OpamPackage.version pkg)))
42
-
| x -> env x
43
-
in
44
-
let solved_pkgs = OpamPackage.Map.fold (fun pkg _ acc -> pkg :: acc)
45
-
solution [] in
46
-
let solved_names = List.fold_left (fun acc p ->
47
-
OpamPackage.Name.Set.add (OpamPackage.name p) acc)
48
-
OpamPackage.Name.Set.empty solved_pkgs in
49
-
List.fold_left (fun acc pkg ->
50
-
let opam =
51
-
try Git_packages.get_package packages pkg
52
-
with Not_found -> OpamFile.OPAM.empty
53
-
in
54
-
let deps =
55
-
OpamFile.OPAM.depends opam
56
-
|> OpamFilter.partial_filter_formula (filter_env pkg)
57
-
|> OpamFilter.filter_deps ~build:true ~post:true ~test:false
58
-
~doc:true ~dev:false ~dev_setup:false ~default:false
59
-
in
60
-
let dep_names =
61
-
OpamFormula.fold_left
62
-
(fun acc (dep_name, _) ->
63
-
OpamPackage.Name.Set.add dep_name acc)
64
-
OpamPackage.Name.Set.empty deps
65
-
in
66
-
let depopts = OpamFile.OPAM.depopts opam in
67
-
let depopt_names =
68
-
OpamFormula.fold_left
69
-
(fun acc (dep_name, _) ->
70
-
if OpamPackage.Name.Set.mem dep_name solved_names
71
-
then OpamPackage.Name.Set.add dep_name acc
72
-
else acc)
73
-
OpamPackage.Name.Set.empty depopts
74
-
in
75
-
let extra_doc_deps = get_extra_doc_deps opam in
76
-
let extra_doc_dep_names =
77
-
OpamPackage.Name.Set.inter extra_doc_deps solved_names
78
-
in
79
-
let all_dep_names =
80
-
OpamPackage.Name.Set.union dep_names depopt_names
81
-
|> OpamPackage.Name.Set.union extra_doc_dep_names
82
-
in
83
-
let dep_pkgs =
84
-
List.filter (fun p ->
85
-
OpamPackage.Name.Set.mem (OpamPackage.name p) all_dep_names)
86
-
solved_pkgs
87
-
|> OpamPackage.Set.of_list
88
-
in
89
-
OpamPackage.Map.add pkg dep_pkgs acc
90
-
) OpamPackage.Map.empty solved_pkgs
-16
day11/opam/deps.mli
-16
day11/opam/deps.mli
···
1
-
(** Dependency recomputation and extra doc deps.
2
-
3
-
Pure functions operating on opam metadata — no solver dependency. *)
4
-
5
-
val get_extra_doc_deps : OpamFile.OPAM.t -> OpamPackage.Name.Set.t
6
-
(** Extract package names from the [x-extra-doc-deps] extension field. *)
7
-
8
-
val recompute_with_post :
9
-
packages:Git_packages.t ->
10
-
env:(string -> OpamVariable.variable_contents option) ->
11
-
OpamPackage.Set.t OpamPackage.Map.t ->
12
-
OpamPackage.Set.t OpamPackage.Map.t
13
-
(** [recompute_with_post ~packages ~env solution] takes an existing
14
-
solution and recomputes the dependency edges with [{post}] deps
15
-
included. The set of solved packages stays the same; only the
16
-
per-package dep sets change. *)
+1
day11/opam/dune
+1
day11/opam/dune
+59
day11/opam_build/base.mli
+59
day11/opam_build/base.mli
···
1
+
(** Base image management.
2
+
3
+
Builds and caches the root filesystem layer that all package builds
4
+
start from. The base contains a Debian image with opam, build tools,
5
+
and pre-initialised opam repositories. Docker is used to produce the
6
+
image, which is then imported as a layer for overlayfs use. *)
7
+
8
+
(** Ensure a base layer exists for the given Docker [image] tag, building
9
+
and importing it if not already cached. *)
10
+
val ensure :
11
+
Eio_unix.Stdenv.base ->
12
+
cache_dir:Fpath.t ->
13
+
image:string ->
14
+
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
15
+
16
+
(** Build a base layer from scratch using the given OS distribution,
17
+
version, architecture, and opam repositories. The [uid] and [gid]
18
+
are set as the non-root user inside the image. *)
19
+
val build :
20
+
Eio_unix.Stdenv.base ->
21
+
cache_dir:Fpath.t ->
22
+
os_distribution:string ->
23
+
os_version:string ->
24
+
arch:string ->
25
+
opam_repositories:Fpath.t list ->
26
+
uid:int ->
27
+
gid:int ->
28
+
unit ->
29
+
(Day11_layer.Base.t, [> Rresult.R.msg ]) result
30
+
31
+
(** Build the [opam-build] binary in a Docker container and cache it.
32
+
Returns the path to the cached binary. If [opam_build_repo] is
33
+
provided, that local checkout is used instead of cloning from GitHub. *)
34
+
val build_opam_build :
35
+
Eio_unix.Stdenv.base ->
36
+
cache_dir:Fpath.t ->
37
+
arch:string ->
38
+
?opam_build_repo:Fpath.t ->
39
+
unit ->
40
+
(Fpath.t, [> Rresult.R.msg ]) result
41
+
42
+
(** Return a read-only bind mount for the cached [opam-build] binary,
43
+
or [None] if it has not been built yet. *)
44
+
val opam_build_mount :
45
+
cache_dir:Fpath.t -> Day11_container.Mount.t option
46
+
47
+
(** Compute a content hash for a Docker image tag. *)
48
+
val hash : image:string -> string
49
+
50
+
(** Compute a content hash from OS distribution, version, and architecture. *)
51
+
val build_hash :
52
+
os_distribution:string -> os_version:string -> arch:string -> string
53
+
54
+
(** Load a previously cached base layer, returning [None] if the cache
55
+
directory does not contain a valid base image. *)
56
+
val load_cached :
57
+
cache_dir:Fpath.t ->
58
+
os_distribution:string -> os_version:string ->
59
+
Day11_layer.Base.t option
+29
day11/opam_build/test/dune
+29
day11/opam_build/test/dune
···
1
+
(test
2
+
(name test_build)
3
+
(libraries day11_opam_build day11_solution day11_layer
4
+
alcotest bos eio_main fpath opam-format yojson))
5
+
6
+
(executable
7
+
(name test_build_integration)
8
+
(libraries day11_opam_build day11_layer day11_exec day11_test_util
9
+
alcotest astring bos eio_main fpath opam-format))
10
+
11
+
(executable
12
+
(name test_layered_build)
13
+
(libraries day11_opam_build day11_layer day11_test_util
14
+
alcotest astring bos eio_main fpath opam-format))
15
+
16
+
(executable
17
+
(name test_from_scratch)
18
+
(libraries day11_opam_build day11_solution day11_layer day11_solver day11_test_util
19
+
alcotest bos eio_main fpath opam-format))
20
+
21
+
(executable
22
+
(name test_tools)
23
+
(libraries day11_opam_build day11_exec day11_layer day11_solver day11_test_util
24
+
alcotest astring bos eio_main fpath opam-format))
25
+
26
+
(executable
27
+
(name test_tools_pinned)
28
+
(libraries day11_opam_build day11_layer day11_solver day11_test_util
29
+
alcotest bos eio_main fpath opam-format))
+3
day11/opam_build/test_noop/dune
+3
day11/opam_build/test_noop/dune
+52
day11/opam_build/types.mli
+52
day11/opam_build/types.mli
···
1
+
(** Build types.
2
+
3
+
Core type definitions shared across the opam-build pipeline:
4
+
environment configuration, result variants, and build strategies. *)
5
+
6
+
module Build = Day11_opam_layer.Build
7
+
module Tool = Day11_opam_layer.Tool
8
+
9
+
(** Alias for {!Day11_opam_layer.Build.t}. *)
10
+
type build = Build.t
11
+
12
+
(** Alias for {!Day11_opam_layer.Tool.t}. *)
13
+
type tool = Tool.t
14
+
15
+
(** Invariant build parameters for a batch run.
16
+
The opam switch is always ["default"]. *)
17
+
type build_env = {
18
+
base : Day11_layer.Base.t; (** Root filesystem layer. *)
19
+
os_dir : Fpath.t; (** Per-OS cache directory. *)
20
+
uid : int; (** UID of the non-root user in the container. *)
21
+
gid : int; (** GID of the non-root user in the container. *)
22
+
}
23
+
24
+
(** Create a {!type:build_env}. [uid] and [gid] default to the current
25
+
process's UID/GID. *)
26
+
val make_build_env :
27
+
base:Day11_layer.Base.t -> os_dir:Fpath.t ->
28
+
?uid:int -> ?gid:int -> unit -> build_env
29
+
30
+
(** Return the [packages/] subdirectory of {!field:build_env.os_dir}. *)
31
+
val packages_dir : build_env -> Fpath.t
32
+
33
+
(** Create [os_dir] and [packages/] if they do not exist. *)
34
+
val ensure_dirs : build_env -> unit
35
+
36
+
(** The opam switch name used in all builds (["default"]). *)
37
+
val switch : string
38
+
39
+
(** Outcome of a build or solve step. *)
40
+
type build_result =
41
+
| Success of Day11_opam_layer.Build.t (** Build completed successfully. *)
42
+
| Failure of string (** Build failed with an error message. *)
43
+
| Dependency_failed (** A dependency's build failed. *)
44
+
| No_solution of string (** Solver could not find a solution. *)
45
+
| Solution of Day11_solution.Deps.t (** Solver produced a solution (not yet built). *)
46
+
47
+
(** A build strategy: the command to run inside the container,
48
+
and a cleanup function applied to the upper dir after the build. *)
49
+
type build_strategy = {
50
+
cmd : string;
51
+
cleanup : Eio_unix.Stdenv.base -> Fpath.t -> unit;
52
+
}
+1
-1
day11/opam_layer/README.md
+1
-1
day11/opam_layer/README.md
+1
-1
day11/opam_layer/build.ml
+1
-1
day11/opam_layer/build.ml
+1
-1
day11/opam_layer/build.mli
+1
-1
day11/opam_layer/build.mli
+1
-1
day11/opam_layer/build_meta.ml
+1
-1
day11/opam_layer/build_meta.ml
+2
-1
day11/opam_layer/dune
+2
-1
day11/opam_layer/dune
+3
-3
day11/runner/README.md
+3
-3
day11/runner/README.md
···
49
49
`upper` and decides what to do with it.
50
50
- Does not know about opam, opam switches, opam package builds, or
51
51
documentation. The opam-flavoured spec defaults (cwd `/home/opam`,
52
-
bash wrapping, network on, etc.) live in `Day11_build.Build_layer`,
52
+
bash wrapping, network on, etc.) live in `Day11_opam_build.Build_layer`,
53
53
not here.
54
54
- Does not know about cache layout, layer naming conventions, dep
55
55
DAGs, or universes. Those are layer/opam concerns.
···
61
61
bos eio fpath logs rresult unix)
62
62
```
63
63
64
-
Notably no `day11_opam_layer`, no `opam-format`, no `day11_build`.
64
+
Notably no `day11_opam_layer`, no `opam-format`, no `day11_opam_build`.
65
65
This library can be linked from any consumer that wants the
66
66
"layered container runner" primitive.
67
67
···
81
81
that library to depend on the other, breaking its isolation.
82
82
A separate `day11_runner` library is the right home: it depends
83
83
on both, and is itself depended on by callers that need the
84
-
combined primitive (currently `day11_build`).
84
+
combined primitive (currently `day11_opam_build`).
85
85
86
86
## Testing
87
87
+1
day11/runner/dune
+1
day11/runner/dune
+16
day11/solution/deps.mli
+16
day11/solution/deps.mli
···
1
+
(** Dependency graph operations.
2
+
3
+
Pure functions on dependency maps where each package maps to its
4
+
direct dependencies. No solver or I/O dependencies. *)
5
+
6
+
type t = OpamPackage.Set.t OpamPackage.Map.t
7
+
(** A dependency graph: maps each package to its direct dependencies. *)
8
+
9
+
val transitive_deps : t -> t
10
+
(** [transitive_deps deps] enriches the map so each package maps
11
+
to its full transitive dependency closure. *)
12
+
13
+
val extract_ocaml_version : t -> OpamPackage.t option
14
+
(** [extract_ocaml_version deps] finds [ocaml-base-compiler],
15
+
[ocaml-variants], or [ocaml] in the graph. Returns the first
16
+
match found. *)
+4
day11/solution/dune
+4
day11/solution/dune
+52
day11/solution/solve_result.ml
+52
day11/solution/solve_result.ml
···
1
+
type t = {
2
+
packages : OpamPackage.Set.t;
3
+
build_deps : Deps.t;
4
+
doc_deps : Deps.t;
5
+
examined : OpamPackage.Name.Set.t;
6
+
}
7
+
8
+
let packages_to_json pkgs =
9
+
`List (OpamPackage.Set.fold (fun p acc ->
10
+
`String (OpamPackage.to_string p) :: acc
11
+
) pkgs [])
12
+
13
+
let packages_of_json json =
14
+
let open Yojson.Safe.Util in
15
+
json |> to_list |> List.map to_string
16
+
|> List.map OpamPackage.of_string
17
+
|> OpamPackage.Set.of_list
18
+
19
+
let examined_to_json examined =
20
+
`List (OpamPackage.Name.Set.fold (fun n acc ->
21
+
`String (OpamPackage.Name.to_string n) :: acc
22
+
) examined [])
23
+
24
+
let examined_of_json json =
25
+
let open Yojson.Safe.Util in
26
+
json |> to_list |> List.map to_string
27
+
|> List.map OpamPackage.Name.of_string
28
+
|> OpamPackage.Name.Set.of_list
29
+
30
+
let to_json t =
31
+
`Assoc [
32
+
("packages", packages_to_json t.packages);
33
+
("build_deps", Json.to_json t.build_deps);
34
+
("doc_deps", Json.to_json t.doc_deps);
35
+
("examined", examined_to_json t.examined);
36
+
]
37
+
38
+
let of_json json =
39
+
try
40
+
let open Yojson.Safe.Util in
41
+
let packages = json |> member "packages" |> packages_of_json in
42
+
let build_deps = json |> member "build_deps"
43
+
|> Json.of_json in
44
+
let doc_deps = json |> member "doc_deps"
45
+
|> Json.of_json in
46
+
let examined = json |> member "examined" |> examined_of_json in
47
+
match build_deps, doc_deps with
48
+
| Ok build_deps, Ok doc_deps ->
49
+
Ok { packages; build_deps; doc_deps; examined }
50
+
| Error e, _ | _, Error e -> Error e
51
+
with exn ->
52
+
Rresult.R.error_msgf "Solve_result.of_json: %s" (Printexc.to_string exn)
+33
day11/solution/solve_result.mli
+33
day11/solution/solve_result.mli
···
1
+
(** Result of dependency solving.
2
+
3
+
Carries both the build dependency graph (acyclic, used for
4
+
topological build ordering) and the doc dependency graph (may
5
+
contain cycles via [x-extra-doc-deps], used for odoc
6
+
cross-referencing). Both graphs span the same package set. *)
7
+
8
+
type t = {
9
+
packages : OpamPackage.Set.t;
10
+
(** The version assignment chosen by the solver. *)
11
+
12
+
build_deps : Deps.t;
13
+
(** Acyclic. Each package mapped to the packages it needs to build
14
+
and install. Safe to topologically sort. *)
15
+
16
+
doc_deps : Deps.t;
17
+
(** May contain cycles. Each package mapped to the packages whose
18
+
odoc output it needs for cross-referencing. Equals {!build_deps}
19
+
plus [{post}] deps and [x-extra-doc-deps] edges. Do NOT
20
+
topologically sort this graph. *)
21
+
22
+
examined : OpamPackage.Name.Set.t;
23
+
(** Package names the solver touched during solving. Used for
24
+
incremental cache invalidation: if none of the examined names
25
+
changed between opam-repo commits, the cached result is still
26
+
valid. *)
27
+
}
28
+
29
+
val to_json : t -> Yojson.Safe.t
30
+
(** Serialize a solve result to JSON. *)
31
+
32
+
val of_json : Yojson.Safe.t -> (t, [> Rresult.R.msg ]) result
33
+
(** Deserialize a solve result from JSON. *)
+3
day11/solution/test/dune
+3
day11/solution/test/dune
-29
day11/solver/context.ml
-29
day11/solver/context.ml
···
98
98
let examined_packages t = !(t.examined_packages)
99
99
100
100
let with_doc_post ~doc ~post t = { t with doc; post }
101
-
102
-
let get_extra_doc_deps = Day11_opam.Deps.get_extra_doc_deps
103
-
104
-
let extend_with_extra_doc_deps t =
105
-
let new_pins =
106
-
OpamPackage.Name.Map.mapi (fun _name (version, opam) ->
107
-
let extra_deps = get_extra_doc_deps opam in
108
-
if OpamPackage.Name.Set.is_empty extra_deps then
109
-
(version, opam)
110
-
else begin
111
-
let depends = OpamFile.OPAM.depends opam in
112
-
let extra_formula =
113
-
OpamPackage.Name.Set.fold (fun dep_name acc ->
114
-
let atom =
115
-
OpamFormula.Atom (dep_name, OpamFormula.Empty) in
116
-
OpamFormula.And (acc, atom)
117
-
) extra_deps OpamFormula.Empty
118
-
in
119
-
let new_depends = match extra_formula with
120
-
| OpamFormula.Empty -> depends
121
-
| _ -> OpamFormula.And (depends, extra_formula)
122
-
in
123
-
let new_opam =
124
-
OpamFile.OPAM.with_depends new_depends opam in
125
-
(version, new_opam)
126
-
end
127
-
) t.pins
128
-
in
129
-
{ t with pins = new_pins }
+3
-7
day11/solver/context.mli
+3
-7
day11/solver/context.mli
···
47
47
(** Returns the set of package names examined during solving. *)
48
48
49
49
val with_doc_post : doc:bool -> post:bool -> t -> t
50
-
(** Create a new context with different doc/post settings. *)
51
-
52
-
val extend_with_extra_doc_deps : t -> t
53
-
(** Extend pins so x-extra-doc-deps appear in the depends formula. *)
54
-
55
-
val get_extra_doc_deps : OpamFile.OPAM.t -> OpamPackage.Name.Set.t
56
-
(** Extract package names from the [x-extra-doc-deps] extension field. *)
50
+
(** Create a context with different doc/post settings for recomputing
51
+
dependency edges under alternate filter flags. Internal to the
52
+
solver library. *)
+4
-2
day11/solver/dune
+4
-2
day11/solver/dune
···
1
1
(library
2
2
(name day11_solver)
3
+
(public_name day11.solver)
3
4
(modules :standard \ solver_worker)
4
-
(libraries bos day11_graph day11_opam fmt fpath
5
+
(libraries bos day11_solution day11_opam fmt fpath
5
6
opam-0install opam-format rresult))
6
7
7
8
(executable
8
9
(name solver_worker)
9
10
(modules solver_worker)
10
11
(public_name day11-solver-worker)
11
-
(libraries cmdliner day11_solver day11_graph opam-format yojson))
12
+
(package day11)
13
+
(libraries cmdliner day11_solver day11_solution opam-format yojson))
+49
-26
day11/solver/solve.ml
+49
-26
day11/solver/solve.ml
···
1
1
module Solver = Opam_0install.Solver.Make (Context)
2
2
3
+
(** Extract package names from the [x-extra-doc-deps] extension field. *)
4
+
let get_extra_doc_deps opamfile =
5
+
let open OpamParserTypes.FullPos in
6
+
let extensions = OpamFile.OPAM.extensions opamfile in
7
+
match OpamStd.String.Map.find_opt "x-extra-doc-deps" extensions with
8
+
| None -> OpamPackage.Name.Set.empty
9
+
| Some value ->
10
+
let extract_name item =
11
+
match item.pelem with
12
+
| String name -> Some name
13
+
| Option (inner, _) ->
14
+
(match inner.pelem with
15
+
| String name -> Some name
16
+
| _ -> None)
17
+
| _ -> None
18
+
in
19
+
let extract_names acc v =
20
+
match v.pelem with
21
+
| List { pelem = items; _ } ->
22
+
List.fold_left (fun acc item ->
23
+
match extract_name item with
24
+
| Some name ->
25
+
OpamPackage.Name.Set.add
26
+
(OpamPackage.Name.of_string name) acc
27
+
| None -> acc
28
+
) acc items
29
+
| _ -> acc
30
+
in
31
+
extract_names OpamPackage.Name.Set.empty value
32
+
3
33
let solve_internal ~packages:pkgs ~env ?(constraints = OpamPackage.Name.Map.empty)
4
34
?(pins = OpamPackage.Name.Map.empty)
5
35
?(prefer_oldest = false) ?(doc = true)
6
36
?(extra_targets = []) target =
7
37
let name = OpamPackage.name target in
8
38
let version = OpamPackage.version target in
9
-
(* Don't overwrite an existing constraint — e.g. the compiler
10
-
version pin from --ocaml-version should not be clobbered
11
-
when the target happens to be a compiler package *)
12
39
match OpamPackage.Name.Map.find_opt name constraints with
13
40
| Some (`Eq, existing) when not (OpamPackage.Version.equal existing version) ->
14
41
let msg = Printf.sprintf "Target %s conflicts with constraint %s = %s"
···
20
47
let constraints =
21
48
OpamPackage.Name.Map.add name (`Eq, version) constraints
22
49
in
23
-
(* Pin extra targets so the solver sees them *)
24
50
let constraints = List.fold_left (fun acc et ->
25
51
OpamPackage.Name.Map.add (OpamPackage.name et)
26
52
(`Eq, OpamPackage.version et) acc
···
29
55
Context.create ~prefer_oldest ~constraints ~pins ~env ~packages:pkgs
30
56
~doc ()
31
57
in
32
-
(* If a compiler is pinned in constraints, add it as a root.
33
-
Otherwise let the solver discover the compiler via ocaml deps. *)
34
58
let compiler_root =
35
59
let compiler_names = List.map OpamPackage.Name.of_string
36
60
[ "ocaml-base-compiler"; "ocaml-variants"; "ocaml-system" ] in
···
83
107
OpamPackage.Name.Set.add (OpamPackage.name p) acc)
84
108
OpamPackage.Name.Set.empty solved_pkgs
85
109
in
86
-
let compute_deps_with ~doc ~post =
110
+
let compute_deps ~doc ~post ~extra_doc =
87
111
let ctx = Context.with_doc_post ~doc ~post context in
88
112
List.fold_left (fun acc pkg ->
89
113
let opam =
···
115
139
let all_dep_names =
116
140
OpamPackage.Name.Set.union dep_names depopt_names
117
141
in
142
+
(* When computing doc deps, also include per-package
143
+
x-extra-doc-deps (intersected with the solved set). *)
144
+
let all_dep_names =
145
+
if extra_doc then
146
+
let extra = get_extra_doc_deps opam in
147
+
let extra_in_solution =
148
+
OpamPackage.Name.Set.inter extra solved_names in
149
+
OpamPackage.Name.Set.union all_dep_names extra_in_solution
150
+
else
151
+
all_dep_names
152
+
in
118
153
let dep_pkgs =
119
154
List.filter (fun p ->
120
155
OpamPackage.Name.Set.mem (OpamPackage.name p) all_dep_names)
···
124
159
OpamPackage.Map.add pkg dep_pkgs acc
125
160
) OpamPackage.Map.empty solved_pkgs
126
161
in
127
-
let solution = compute_deps_with ~doc:false ~post:false in
128
-
let doc_deps = compute_deps_with ~doc:true ~post:true in
129
-
Ok (solution, doc_deps, examined)
162
+
let build_deps = compute_deps ~doc:false ~post:false ~extra_doc:false in
163
+
let doc_deps = compute_deps ~doc:true ~post:true ~extra_doc:true in
164
+
let packages = OpamPackage.Set.of_list solved_pkgs in
165
+
Ok ({ Day11_solution.Solve_result.packages; build_deps; doc_deps; examined },
166
+
examined)
130
167
131
168
let add_ocaml_constraint ?ocaml_version constraints =
132
169
match ocaml_version with
···
134
171
OpamPackage.Name.Map.add (OpamPackage.name pkg)
135
172
(`Eq, OpamPackage.version pkg) constraints
136
173
| None ->
137
-
(* No explicit compiler pin — constrain to ocaml-base-compiler >= 4.08
138
-
to avoid ocaml-compiler (which builds with ASAN and is extremely slow)
139
-
and to ensure compatibility with odoc 3.x *)
140
174
OpamPackage.Name.Map.add
141
175
(OpamPackage.Name.of_string "ocaml-base-compiler")
142
176
(`Geq, OpamPackage.Version.of_string "4.08.0")
···
148
182
(Option.value ~default:OpamPackage.Name.Map.empty constraints) in
149
183
match solve_internal ~packages ~env ~constraints ?pins
150
184
?prefer_oldest ~doc ~extra_targets target with
151
-
| Ok (solution, _doc_deps, _examined) -> Ok solution
152
-
| Error (msg, _examined) -> Error msg
153
-
154
-
let solve_with_examined ~packages ~env ?constraints ?pins ?prefer_oldest
155
-
?(doc = true) ?ocaml_version target =
156
-
let constraints = add_ocaml_constraint ?ocaml_version
157
-
(Option.value ~default:OpamPackage.Name.Map.empty constraints) in
158
-
match solve_internal ~packages ~env ~constraints ?pins
159
-
?prefer_oldest ~doc target with
160
-
| Ok (solution, _doc_deps, examined) -> Ok (solution, examined)
161
-
| Error _ as e -> e
162
-
163
-
185
+
| Ok (result, _examined) -> Ok result
186
+
| Error (msg, examined) -> Error (msg, examined)
+19
-21
day11/solver/solve.mli
+19
-21
day11/solver/solve.mli
···
2
2
3
3
The main entry point for resolving package dependencies using
4
4
opam-0install. Takes a target package and an opam-repository,
5
-
returns a dependency solution. *)
5
+
returns a {!Day11_solution.Solve_result.t} containing both the build
6
+
dependency graph (acyclic, for build ordering) and the doc
7
+
dependency graph (may have cycles, for odoc cross-referencing). *)
6
8
7
9
val solve :
8
10
packages:Day11_opam.Git_packages.t ->
···
14
16
?extra_targets:OpamPackage.t list ->
15
17
?ocaml_version:OpamPackage.t ->
16
18
OpamPackage.t ->
17
-
(Day11_graph.Graph.solution, string) result
19
+
(Day11_solution.Solve_result.t, string * OpamPackage.Name.Set.t) result
18
20
(** [solve ~packages ~env ?pins ?doc ?ocaml_version target] solves the
19
-
dependencies for [target]. [pins] override packages from the
20
-
repository with local versions (e.g. from a dev checkout).
21
-
When [doc] is true (default), [{with-doc}] dependencies and
22
-
[x-extra-doc-deps] are included. Set [~doc:false] for tool builds
23
-
that don't need doc deps.
24
-
When [ocaml_version] is provided, the compiler is pinned to
25
-
that version. Otherwise defaults to [>= 4.08]. *)
21
+
dependencies for [target].
26
22
27
-
val solve_with_examined :
28
-
packages:Day11_opam.Git_packages.t ->
29
-
env:(string -> OpamVariable.variable_contents option) ->
30
-
?constraints:OpamFormula.version_constraint OpamTypes.name_map ->
31
-
?pins:(OpamPackage.Version.t * OpamFile.OPAM.t) OpamPackage.Name.Map.t ->
32
-
?prefer_oldest:bool ->
33
-
?doc:bool ->
34
-
?ocaml_version:OpamPackage.t ->
35
-
OpamPackage.t ->
36
-
(Day11_graph.Graph.solution * OpamPackage.Name.Set.t,
37
-
string * OpamPackage.Name.Set.t) result
38
-
(** Like {!solve} but also returns the examined package set. *)
23
+
Returns a {!Day11_solution.Solve_result.t} with both [build_deps]
24
+
(for topological build ordering) and [doc_deps] (for odoc
25
+
cross-referencing, including [{post}] deps and per-package
26
+
[x-extra-doc-deps]).
39
27
28
+
The error case includes the [examined] set so incremental solvers
29
+
can cache failures too.
30
+
31
+
When [doc] is true (default), [{with-doc}] dependencies and
32
+
[x-extra-doc-deps] are included in the solve and in [doc_deps].
33
+
Set [~doc:false] for tool builds that don't need doc deps;
34
+
in that case [doc_deps] equals [build_deps].
35
+
36
+
When [ocaml_version] is provided, the compiler is pinned to that
37
+
version. Otherwise defaults to [>= 4.08]. *)
+8
-7
day11/solver/solver_worker.ml
+8
-7
day11/solver/solver_worker.ml
···
94
94
(`Eq, OpamPackage.version pkg) acc
95
95
) OpamPackage.Name.Map.empty constraint_strs
96
96
97
+
let examined_to_json examined =
98
+
`List (OpamPackage.Name.Set.fold (fun n acc ->
99
+
`String (OpamPackage.Name.to_string n) :: acc) examined [])
100
+
97
101
let solve_one ~packages ~env ~pins ~constraints ~doc ?ocaml_version pkg =
98
-
match Day11_solver.Solve.solve_with_examined ~packages ~env
102
+
match Day11_solver.Solve.solve ~packages ~env
99
103
~pins ~constraints ~doc ?ocaml_version pkg with
100
-
| Ok (solution, examined) ->
104
+
| Ok result ->
101
105
`Assoc [
102
106
("package", `String (OpamPackage.to_string pkg));
103
-
("solution", Day11_graph.Solution_json.to_json solution);
104
-
("examined", `List (OpamPackage.Name.Set.fold (fun n acc ->
105
-
`String (OpamPackage.Name.to_string n) :: acc) examined []));
107
+
("result", Day11_solution.Solve_result.to_json result);
106
108
]
107
109
| Error (msg, examined) ->
108
110
`Assoc [
109
111
("failed", `Bool true);
110
112
("package", `String (OpamPackage.to_string pkg));
111
113
("error", `String msg);
112
-
("examined", `List (OpamPackage.Name.Set.fold (fun n acc ->
113
-
`String (OpamPackage.Name.to_string n) :: acc) examined []));
114
+
("examined", examined_to_json examined);
114
115
]
115
116
116
117
let run repo_list output ocaml_version pin_dirs constraint_strs no_doc
+1
-1
day11/solver/test/dune
+1
-1
day11/solver/test/dune
···
1
1
(test
2
2
(name test_solver)
3
-
(libraries day11_solver day11_doc day11_graph day11_test_util alcotest astring bos fpath opam-format yojson))
3
+
(libraries day11_solver day11_doc day11_solution day11_test_util alcotest astring bos fpath opam-format yojson))
4
4
5
5
(executable
6
6
(name test_doc_deps)
+5
-3
day11/solver/test/test_doc_deps.ml
+5
-3
day11/solver/test/test_doc_deps.ml
···
52
52
) solution OpamPackage.Name.Set.empty in
53
53
54
54
match result_old, result_new with
55
-
| Error msg, _ ->
55
+
| Error (msg, _), _ ->
56
56
Printf.printf "FAIL: test-old solve failed: %s\n%!" msg;
57
57
exit 1
58
-
| _, Error msg ->
58
+
| _, Error (msg, _) ->
59
59
Printf.printf "FAIL: test-new solve failed: %s\n%!" msg;
60
60
exit 1
61
-
| Ok sol_old, Ok sol_new ->
61
+
| Ok result_old, Ok result_new ->
62
+
let sol_old = result_old.Day11_solution.Solve_result.build_deps in
63
+
let sol_new = result_new.Day11_solution.Solve_result.build_deps in
62
64
let names_old = pkg_names sol_old in
63
65
let names_new = pkg_names sol_new in
64
66
Printf.printf "test-old solution: %d packages\n%!"
+21
-23
day11/solver/test/test_solver.ml
+21
-23
day11/solver/test/test_solver.ml
···
74
74
let result = Solve.solve ~packages ~env
75
75
(pkg "astring.0.8.5") in
76
76
match result with
77
-
| Ok solution ->
78
-
let names = OpamPackage.Map.keys solution
77
+
| Ok result ->
78
+
let names = OpamPackage.Map.keys result.Day11_solution.Solve_result.build_deps
79
79
|> List.map OpamPackage.to_string in
80
80
Alcotest.(check bool) "has astring"
81
81
true (List.exists (fun n ->
···
84
84
true (List.exists (fun n ->
85
85
Astring.String.is_prefix ~affix:"ocaml-base-compiler" n
86
86
|| Astring.String.is_prefix ~affix:"ocaml-compiler" n) names)
87
-
| Error diag ->
87
+
| Error (diag, _) ->
88
88
Alcotest.fail (Printf.sprintf "Solve failed: %s" diag)
89
89
90
90
let test_solve_nonexistent () =
···
107
107
108
108
odig depends on odoc, and odoc.3.1.0 has:
109
109
x-extra-doc-deps: ["odoc-driver" "sherlodoc" "odig"]
110
-
These appear in the solution as extra roots. recompute_with_post
111
-
adds them as deps of odoc in the link graph, so odoc's deps differ
112
-
between compile and link graphs → needs separate link. *)
110
+
These appear in the solution as extra roots. The solver adds them
111
+
as deps of odoc in the doc_deps graph, so odoc's deps differ
112
+
between build_deps and doc_deps → needs separate link. *)
113
113
let test_odig_odoc_needs_separate_link () =
114
114
let opam_repo = opam_repository () in
115
115
let packages, _store, _commit =
···
120
120
let target = pkg "odig.0.0.9" in
121
121
let result = Solve.solve ~packages ~env target in
122
122
match result with
123
-
| Error diag ->
123
+
| Error (diag, _) ->
124
124
Alcotest.fail (Printf.sprintf "Solve failed: %s" diag)
125
-
| Ok compile_deps ->
126
-
let link_deps = Day11_opam.Deps.recompute_with_post ~packages ~env compile_deps in
125
+
| Ok result ->
127
126
(* odoc should be in the solution *)
128
127
let odoc_pkg = OpamPackage.Map.fold (fun p _ acc ->
129
128
if OpamPackage.Name.to_string (OpamPackage.name p) = "odoc"
130
129
then Some p else acc
131
-
) compile_deps None in
130
+
) result.Day11_solution.Solve_result.build_deps None in
132
131
(match odoc_pkg with
133
132
| None -> Alcotest.fail "odoc not in solution for odig"
134
133
| Some odoc ->
135
-
let separate = Day11_doc.Doc_deps.needs_separate_link
136
-
~compile_deps ~link_deps odoc in
134
+
let separate = Day11_doc.Doc_deps.needs_separate_link result odoc in
137
135
Alcotest.(check bool) "odoc needs separate link" true separate;
138
136
(* odig itself should NOT need separate link
139
137
(it has no x-extra-doc-deps or {post} deps) *)
140
-
let odig_separate = Day11_doc.Doc_deps.needs_separate_link
141
-
~compile_deps ~link_deps target in
138
+
let odig_separate = Day11_doc.Doc_deps.needs_separate_link result target in
142
139
Alcotest.(check bool) "odig single phase" false odig_separate)
143
140
144
-
(* recompute_with_post should produce a superset of the compile deps
145
-
for packages with x-extra-doc-deps, and identical deps for packages
146
-
without. Verify this structurally for the odig solution. *)
147
-
let test_recompute_with_post () =
141
+
(* doc_deps should be a superset of the build_deps for packages with
142
+
x-extra-doc-deps, and identical deps for packages without.
143
+
Verify this structurally for the odig solution. *)
144
+
let test_doc_deps_superset () =
148
145
let opam_repo = opam_repository () in
149
146
let packages, _store, _commit =
150
147
Day11_opam.Git_packages.of_opam_repository opam_repo in
···
154
151
let target = pkg "odig.0.0.9" in
155
152
let result = Solve.solve ~packages ~env target in
156
153
match result with
157
-
| Error diag ->
154
+
| Error (diag, _) ->
158
155
Alcotest.fail (Printf.sprintf "Solve failed: %s" diag)
159
-
| Ok compile_deps ->
160
-
let link_deps = Day11_opam.Deps.recompute_with_post ~packages ~env compile_deps in
156
+
| Ok result ->
157
+
let compile_deps = result.Day11_solution.Solve_result.build_deps in
158
+
let link_deps = result.doc_deps in
161
159
(* Same set of packages in both graphs *)
162
160
let compile_pkgs = OpamPackage.Map.fold (fun p _ acc ->
163
161
OpamPackage.Set.add p acc) compile_deps OpamPackage.Set.empty in
···
217
215
Alcotest.test_case "solve nonexistent" `Slow test_solve_nonexistent;
218
216
Alcotest.test_case "odig: odoc needs separate link" `Slow
219
217
test_odig_odoc_needs_separate_link;
220
-
Alcotest.test_case "recompute_with_post superset" `Slow
221
-
test_recompute_with_post;
218
+
Alcotest.test_case "doc_deps superset" `Slow
219
+
test_doc_deps_superset;
222
220
] );
223
221
]
+2
-1
day11/solver_pool/dune
+2
-1
day11/solver_pool/dune
+12
-8
day11/solver_pool/solver_pool.ml
+12
-8
day11/solver_pool/solver_pool.ml
···
14
14
failwith (Printf.sprintf "solver_worker binary not found (tried: %s, argv0=%s)"
15
15
tried Sys.argv.(0))
16
16
17
+
let examined_of_json json =
18
+
let open Yojson.Safe.Util in
19
+
json |> to_list |> List.map to_string
20
+
|> List.map OpamPackage.Name.of_string
21
+
|> OpamPackage.Name.Set.of_list
22
+
17
23
let parse_result_line line =
18
24
let json = Yojson.Safe.from_string line in
19
25
let open Yojson.Safe.Util in
20
26
let pkg = json |> member "package" |> to_string
21
27
|> OpamPackage.of_string in
22
-
let examined =
23
-
json |> member "examined" |> to_list |> List.map to_string
24
-
|> List.map OpamPackage.Name.of_string
25
-
|> OpamPackage.Name.Set.of_list in
26
28
match json |> member "failed" |> to_bool_option with
27
29
| Some true ->
28
30
let error = json |> member "error" |> to_string in
31
+
let examined = json |> member "examined" |> examined_of_json in
29
32
(pkg, Error (error, examined))
30
33
| _ ->
31
-
match Day11_graph.Solution_json.of_json
32
-
(json |> member "solution") with
33
-
| Ok solution -> (pkg, Ok (solution, examined))
34
-
| Error (`Msg e) -> (pkg, Error (e, examined))
34
+
match Day11_solution.Solve_result.of_json
35
+
(json |> member "result") with
36
+
| Ok result -> (pkg, Ok result)
37
+
| Error (`Msg e) ->
38
+
(pkg, Error (e, OpamPackage.Name.Set.empty))
35
39
36
40
let solve_many ?(pin_dirs = []) ?(constraints = []) ?(doc = true)
37
41
?ocaml_version ~np ~repos targets =
+1
-1
day11/solver_pool/solver_pool.mli
+1
-1
day11/solver_pool/solver_pool.mli
···
12
12
repos:(string * string) list ->
13
13
OpamPackage.t list ->
14
14
(OpamPackage.t
15
-
* (Day11_graph.Graph.solution * OpamPackage.Name.Set.t,
15
+
* (Day11_solution.Solve_result.t,
16
16
string * OpamPackage.Name.Set.t) result) list
17
17
(** [solve_many ?pin_dirs ?constraints ?doc ?ocaml_version ~np ~repos targets]
18
18
solves all [targets] in parallel by spawning [np] solver_worker processes.
+1
day11/test_util/dune
+1
day11/test_util/dune