forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Use Layer.t throughout day11 codebase
Replace ad-hoc Fpath.(dir / "layer.json") and Dir.path patterns
with Layer.of_hash, Layer.exists, Layer.is_ok, Layer.meta_path,
Layer.log_path, Layer.fs across all day11 modules:
- build_layer.ml: extract_layer takes ~layer, result_of_layer
uses Layer.is_ok, cache check uses Layer.exists
- Build.layer added alongside Build.dir for typed access
- cmd_batch/cmd_build: is_cached and on_cascade use Layer.t
- cmd_query/cmd_log: use Layer.meta_path/log_path
- generate.ml: is_cached uses Layer.exists/is_ok
- build_meta, rerun, tool_layer, layer_cli updated
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+91
-90
+8
-7
day11/batch/rerun.ml
+8
-7
day11/batch/rerun.ml
···
1
1
module Build = Day11_opam_layer.Build
2
2
module Tool = Day11_opam_layer.Tool
3
+
module Layer = Day11_layer.Layer
3
4
type build = Build.t
4
5
5
6
let load_exit_status layer_json =
···
18
19
~uid:meta.uid ~gid:meta.gid ()
19
20
20
21
let rerun env ~os_dir ~cache_dir node =
21
-
let layer_dir = Build.dir ~os_dir node in
22
-
let layer_json = Fpath.(layer_dir / "layer.json") in
23
-
match Day11_layer.Meta.load layer_json with
22
+
let layer = Build.layer ~os_dir node in
23
+
let layer_dir = Layer.dir layer in
24
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
24
25
| Error (`Msg e) ->
25
26
Day11_opam_build.Types.Failure e
26
27
| Ok { exit_status = 0; _ } ->
···
40
41
let cascade env ~os_dir ~cache_dir nodes =
41
42
let rerun_count = ref 0 in
42
43
List.iter (fun (node : build) ->
43
-
let layer_json = Fpath.(Build.dir ~os_dir node / "layer.json") in
44
-
match load_exit_status layer_json with
44
+
let layer = Build.layer ~os_dir node in
45
+
match load_exit_status (Layer.meta_path layer) with
45
46
| Some (-1) ->
46
47
let all_deps_ok = List.for_all (fun (dep : build) ->
47
-
let dep_json = Fpath.(Build.dir ~os_dir dep / "layer.json") in
48
-
load_exit_status dep_json = Some 0
48
+
let dep_layer = Build.layer ~os_dir dep in
49
+
load_exit_status (Layer.meta_path dep_layer) = Some 0
49
50
) node.deps in
50
51
if all_deps_ok then begin
51
52
ignore (rerun env ~os_dir ~cache_dir node);
+15
-20
day11/bin/cmd_batch.ml
+15
-20
day11/bin/cmd_batch.ml
···
3
3
open Cmdliner
4
4
module Build = Day11_opam_layer.Build
5
5
module Tool = Day11_opam_layer.Tool
6
+
module Layer = Day11_layer.Layer
6
7
type build = Build.t
7
8
type tool = Tool.t
8
9
···
219
220
let root_deleted = ref 0 in
220
221
let cascade_deleted = ref 0 in
221
222
List.iter (fun (node : Day11_opam_layer.Build.t) ->
222
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
223
-
let layer_json = Fpath.(dir / "layer.json") in
224
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
225
-
match Day11_layer.Meta.load layer_json with
223
+
let layer = Build.layer ~os_dir node in
224
+
if Layer.exists layer then
225
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
226
226
| Ok { exit_status; failed_dep; _ } when exit_status <> 0 ->
227
-
ignore (Bos.OS.Path.delete ~recurse:true dir);
227
+
ignore (Bos.OS.Path.delete ~recurse:true (Layer.dir layer));
228
228
if failed_dep = None then incr root_deleted
229
229
else incr cascade_deleted
230
230
| _ -> ()
···
235
235
end;
236
236
(* Check which layers already exist *)
237
237
let n_cached = List.length (List.filter (fun (node : Day11_opam_layer.Build.t) ->
238
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
239
-
Bos.OS.File.exists Fpath.(dir / "layer.json") |> Result.get_ok
238
+
Layer.exists (Build.layer ~os_dir node)
240
239
) nodes) in
241
240
let n_need_build = List.length nodes - n_cached in
242
241
Printf.printf "Layers: %d cached, %d need building\n%!" n_cached n_need_build;
···
246
245
if n_need_build > 0 then begin
247
246
Printf.printf "\nLayers to build:\n";
248
247
List.iter (fun (node : Day11_opam_layer.Build.t) ->
249
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
250
-
if not (Bos.OS.File.exists Fpath.(dir / "layer.json")
251
-
|> Result.get_ok) then
248
+
if not (Layer.exists (Build.layer ~os_dir node)) then
252
249
Printf.printf " %s (%d deps)\n"
253
250
(OpamPackage.to_string node.pkg) (List.length node.deps)
254
251
) nodes
···
393
390
else begin
394
391
(* Build only — no docs *)
395
392
let is_cached node =
396
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
397
-
let layer_json = Fpath.(layer_dir / "layer.json") in
398
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
393
+
let layer = Build.layer ~os_dir node in
394
+
if not (Layer.exists layer) then
399
395
Day11_opam_build.Dag_executor.Not_cached
400
396
else begin
401
-
Day11_layer.Last_used.touch layer_dir;
402
-
match Day11_layer.Meta.load layer_json with
397
+
Day11_layer.Last_used.touch (Layer.dir layer);
398
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
403
399
| Ok meta ->
404
400
let success = meta.exit_status = 0 in
405
401
record_build_outcome node success;
···
436
432
~on_cascade:(fun ~failed ~failed_dep ->
437
433
Hashtbl.replace cascaded_set failed.hash ();
438
434
(* Write a skeleton layer.json so re-runs skip this node *)
439
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir failed in
440
-
ignore (Bos.OS.Dir.create ~path:true layer_dir);
441
-
let layer_json = Fpath.(layer_dir / "layer.json") in
442
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then begin
435
+
let layer = Build.layer ~os_dir failed in
436
+
ignore (Bos.OS.Dir.create ~path:true (Layer.dir layer));
437
+
if not (Layer.exists layer) then begin
443
438
let meta : Day11_layer.Meta.t = {
444
439
exit_status = 1;
445
440
parent_hashes = [];
···
450
445
created_at = "";
451
446
failed_dep = Some (Day11_opam_layer.Build.dir_name failed_dep);
452
447
} in
453
-
ignore (Day11_layer.Meta.save layer_json meta)
448
+
ignore (Day11_layer.Meta.save (Layer.meta_path layer) meta)
454
449
end;
455
450
(* Create package symlink so the failure is discoverable *)
456
451
let pkg_str = OpamPackage.to_string failed.pkg in
+15
-17
day11/bin/cmd_build.ml
+15
-17
day11/bin/cmd_build.ml
···
1
1
(** build command: solve and build a single package within a profile *)
2
2
3
3
open Cmdliner
4
+
module Build = Day11_opam_layer.Build
5
+
module Layer = Day11_layer.Layer
4
6
5
7
let run profile_name profile_dir np target_str doc_output rebuild_failed =
6
8
let profile, paths = match Common.load_profile ~profile_dir ~name:profile_name with
···
55
57
if rebuild_failed then begin
56
58
let deleted = ref 0 in
57
59
List.iter (fun (node : Day11_opam_layer.Build.t) ->
58
-
let dir = Day11_opam_layer.Build.dir ~os_dir node in
59
-
let layer_json = Fpath.(dir / "layer.json") in
60
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
61
-
match Day11_layer.Meta.load layer_json with
60
+
let layer = Build.layer ~os_dir node in
61
+
if Layer.exists layer then
62
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
62
63
| Ok { exit_status; _ } when exit_status <> 0 ->
63
-
ignore (Bos.OS.Path.delete ~recurse:true dir);
64
+
ignore (Bos.OS.Path.delete ~recurse:true (Layer.dir layer));
64
65
incr deleted
65
66
| _ -> ()
66
67
) nodes;
···
68
69
Printf.printf "Deleted %d failed layers for rebuild\n%!" !deleted
69
70
end;
70
71
let n_cached = List.length (List.filter (fun (node : Day11_opam_layer.Build.t) ->
71
-
Bos.OS.File.exists Fpath.(Day11_opam_layer.Build.dir ~os_dir node / "layer.json")
72
-
|> Result.get_ok
72
+
Layer.exists (Build.layer ~os_dir node)
73
73
) nodes) in
74
74
Printf.printf "Layers: %d cached, %d to build\n%!" n_cached
75
75
(List.length nodes - n_cached);
···
133
133
let open Day11_opam_build.Dag_executor in
134
134
execute env ~np
135
135
~is_cached:(fun node ->
136
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
137
-
let layer_json = Fpath.(layer_dir / "layer.json") in
138
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
136
+
let layer = Build.layer ~os_dir node in
137
+
if not (Layer.exists layer) then
139
138
Not_cached
140
139
else
141
-
match Day11_layer.Meta.load layer_json with
140
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
142
141
| Ok meta when meta.exit_status = 0 ->
143
-
Day11_layer.Last_used.touch layer_dir;
142
+
Day11_layer.Last_used.touch (Layer.dir layer);
144
143
Cached_ok
145
144
| _ -> Cached_fail)
146
145
~on_complete:(fun ~stats node success ->
···
155
154
(OpamPackage.to_string node.pkg)
156
155
(if success then "OK" else "FAIL"))
157
156
~on_cascade:(fun ~failed ~failed_dep ->
158
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir failed in
159
-
ignore (Bos.OS.Dir.create ~path:true layer_dir);
160
-
let layer_json = Fpath.(layer_dir / "layer.json") in
161
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then begin
157
+
let layer = Build.layer ~os_dir failed in
158
+
ignore (Bos.OS.Dir.create ~path:true (Layer.dir layer));
159
+
if not (Layer.exists layer) then begin
162
160
let meta : Day11_layer.Meta.t = {
163
161
exit_status = 1; parent_hashes = [];
164
162
uid = benv.uid; gid = benv.gid;
···
168
166
created_at = "";
169
167
failed_dep = Some (Day11_opam_layer.Build.dir_name failed_dep);
170
168
} in
171
-
ignore (Day11_layer.Meta.save layer_json meta)
169
+
ignore (Day11_layer.Meta.save (Layer.meta_path layer) meta)
172
170
end)
173
171
nodes
174
172
(fun node ->
+4
-2
day11/bin/cmd_log.ml
+4
-2
day11/bin/cmd_log.ml
···
1
1
(** log command: view build or doc log *)
2
2
3
3
open Cmdliner
4
+
module Layer = Day11_layer.Layer
4
5
5
6
let resolve_layer os_dir ~packages_dir arg =
6
7
(* If it looks like a layer dir name and exists, use it *)
···
45
46
Printf.eprintf "No layer or package found for %s\n" arg;
46
47
exit 1
47
48
in
48
-
let layer_dir = Fpath.(os_dir / layer) in
49
+
let ly = Layer.of_hash ~os_dir layer in
50
+
let layer_dir = Layer.dir ly in
49
51
(* Try layer.log first (build), then odoc-voodoo-all.log (doc) *)
50
52
let log_file =
51
-
let build_log = Fpath.(layer_dir / "layer.log") in
53
+
let build_log = Layer.log_path ly in
52
54
let doc_log = Fpath.(layer_dir / "odoc-voodoo-all.log") in
53
55
if Bos.OS.File.exists build_log |> Result.get_ok then Some build_log
54
56
else if Bos.OS.File.exists doc_log |> Result.get_ok then Some doc_log
+3
-3
day11/bin/cmd_query.ml
+3
-3
day11/bin/cmd_query.ml
···
1
1
(** query command: show detailed info for a package *)
2
2
3
3
open Cmdliner
4
+
module Layer = Day11_layer.Layer
4
5
5
6
let show_layers_from_symlinks ~os_dir ~packages_dir ~pkg_str =
6
7
let symlinks = Day11_layer.Scan.list_package_symlinks
···
12
13
end else begin
13
14
Printf.printf "Layers for %s (%d):\n\n" pkg_str (List.length symlinks);
14
15
List.iter (fun (name, _target) ->
15
-
let layer_dir = Fpath.(os_dir / name) in
16
-
let layer_json = Fpath.(layer_dir / "layer.json") in
17
-
match Day11_layer.Meta.load layer_json with
16
+
let layer = Layer.of_hash ~os_dir name in
17
+
match Day11_layer.Meta.load (Layer.meta_path layer) with
18
18
| Ok meta ->
19
19
let status = if meta.exit_status = 0 then "ok"
20
20
else if meta.failed_dep <> None then "cascade"
+3
-3
day11/doc-pages/ocurrent_sketch.ml
+3
-3
day11/doc-pages/ocurrent_sketch.ml
···
40
40
41
41
let build ctx job key =
42
42
Current.Job.log job "Building %s" (OpamPackage.to_string key.pkg);
43
-
let layer_dir = Day11_layer.Dir.path ~os_dir:ctx.benv.os_dir key.hash in
44
-
if Sys.file_exists (Fpath.to_string Fpath.(layer_dir / "layer.json")) then
45
-
Lwt.return_ok layer_dir
43
+
let layer = Day11_layer.Layer.of_hash ~os_dir:ctx.benv.os_dir key.hash in
44
+
if Day11_layer.Layer.exists layer then
45
+
Lwt.return_ok (Day11_layer.Layer.dir layer)
46
46
else
47
47
(* Call the build primitive *)
48
48
match Day11_opam_build.Build_layer.build ctx.env ctx.benv
+5
-10
day11/doc/generate.ml
+5
-10
day11/doc/generate.ml
···
525
525
in
526
526
let open Day11_opam_build.Dag_executor in
527
527
let is_cached node =
528
-
let layer_dir = Day11_opam_layer.Build.dir ~os_dir node in
529
-
let layer_json = Fpath.(layer_dir / "layer.json") in
530
-
if not (Bos.OS.File.exists layer_json |> Result.get_ok) then
528
+
let layer = Build.layer ~os_dir node in
529
+
if not (Layer.exists layer) then
531
530
Not_cached
532
531
else begin
533
-
Day11_layer.Last_used.touch layer_dir;
534
-
let meta_ok = match Day11_layer.Meta.load layer_json with
535
-
| Ok meta -> meta.exit_status = 0
536
-
| Error _ -> false
537
-
in
538
-
if not meta_ok then Cached_fail
539
-
else Cached_ok
532
+
Day11_layer.Last_used.touch (Layer.dir layer);
533
+
if Layer.is_ok layer then Cached_ok
534
+
else Cached_fail
540
535
end
541
536
in
542
537
let dispatch = make_dispatch benv ~os_dir ~plan ~tool_source_dirs
+1
-1
day11/doc/tool_layer.ml
+1
-1
day11/doc/tool_layer.ml
···
17
17
@ [ install ])
18
18
19
19
let driver_exists ~layer_dir =
20
-
Sys.file_exists (Fpath.to_string Fpath.(layer_dir / "layer.json"))
20
+
Day11_layer.Layer.exists { hash = ""; dir = layer_dir }
21
21
22
22
let has_odoc_driver_voodoo ~layer_dir =
23
23
let bin = Fpath.(layer_dir / "fs" / "home" / "opam" / ".opam"
+1
-2
day11/jtw/tool_layer.ml
+1
-2
day11/jtw/tool_layer.ml
···
68
68
let extra_tool_targets = [ "js_top_worker-web" ]
69
69
70
70
let exists ~layer_dir =
71
-
Sys.file_exists
72
-
(Fpath.to_string Fpath.(layer_dir / "layer.json"))
71
+
Bos.OS.File.exists Fpath.(layer_dir / "layer.json") |> Result.get_ok
73
72
74
73
let has_jsoo ~layer_dir =
75
74
let path = Fpath.(layer_dir / "fs" / "home" / "opam" / ".opam"
+5
-3
day11/layer/cli/layer_cli.ml
+5
-3
day11/layer/cli/layer_cli.ml
···
27
27
28
28
let load_meta layer_dir =
29
29
L.Meta.load Fpath.(layer_dir / "layer.json")
30
+
(* layer_dir comes from fold_layers which walks the filesystem
31
+
directly — it doesn't have a hash, so we can't use Layer.t here *)
30
32
31
33
(** List every non-layer-core file in the layer directory. Used to
32
34
show what sidecars etc. are present. *)
···
277
279
(* ── log ─────────────────────────────────────────────────────────── *)
278
280
279
281
let cmd_log os_dir hash_prefix =
280
-
with_resolved_layer os_dir hash_prefix @@ fun _os_dir _name layer_dir ->
281
-
let log_path = Fpath.(layer_dir / "layer.log") in
282
-
match Bos.OS.File.read log_path with
282
+
with_resolved_layer os_dir hash_prefix @@ fun os_dir name _layer_dir ->
283
+
let layer = L.Layer.of_hash ~os_dir name in
284
+
match Bos.OS.File.read (L.Layer.log_path layer) with
283
285
| Ok content -> print_string content; 0
284
286
| Error (`Msg e) -> Printf.eprintf "%s\n" e; 1
285
287
+22
-19
day11/opam_build/build_layer.ml
+22
-19
day11/opam_build/build_layer.ml
···
76
76
Bos.Cmd.(v "chown" % "-R" % Printf.sprintf "%d:%d" uid gid
77
77
% Fpath.to_string home_dir))
78
78
79
-
(** Read the build result from an existing layer.json. *)
80
-
let result_of_layer_json layer_json (node : Build.t) =
81
-
match Day11_layer.Meta.load layer_json with
82
-
| Ok { exit_status = 0; _ } -> Types.Success node
83
-
| _ -> Types.Failure (Build.dir_name node)
79
+
module Layer = Day11_layer.Layer
80
+
81
+
(** Read the build result from an existing layer. *)
82
+
let result_of_layer layer (node : Build.t) =
83
+
if Layer.is_ok layer then Types.Success node
84
+
else Types.Failure (Build.dir_name node)
84
85
85
86
(** Extract the build result: move upper to layer, write generic
86
87
layer.json, then call [on_extract] so the caller can write any
87
88
domain-specific sidecar files. *)
88
-
let extract_layer env ~layer_dir ~layer_json ~upper ~pkg_str
89
+
let extract_layer env ~layer ~upper ~pkg_str
89
90
~(node : Build.t) ~(benv : Types.build_env)
90
91
~timing ~on_extract (run : Day11_exec.Run.t) =
91
92
let exit_code = match run.status with
···
94
95
in
95
96
Log.info (fun m -> m "Build %s: exit %d (%.1fs)"
96
97
pkg_str exit_code run.time);
97
-
let _ = Bos.OS.File.write Fpath.(layer_dir / "layer.log")
98
+
let layer_dir = Layer.dir layer in
99
+
let layer_json = Layer.meta_path layer in
100
+
let _ = Bos.OS.File.write (Layer.log_path layer)
98
101
(Printf.sprintf "=== STDOUT ===\n%s\n=== STDERR ===\n%s\n"
99
102
run.output run.errors) in
100
103
let _ = Day11_exec.Sudo.run env
101
104
Bos.Cmd.(v "mv" % Fpath.to_string upper
102
-
% Fpath.to_string Fpath.(layer_dir / "fs")) in
105
+
% Fpath.to_string (Layer.fs layer)) in
103
106
let dep_hashes =
104
107
List.map (fun (d : Build.t) -> d.hash) node.deps in
105
108
let disk_usage = match Day11_exec.Util.dir_size layer_dir with
···
131
134
in
132
135
List.iter walk node.deps;
133
136
Hashtbl.fold (fun hash () acc ->
134
-
Day11_layer.Dir.path ~os_dir hash :: acc
137
+
Layer.dir (Layer.of_hash ~os_dir hash) :: acc
135
138
) seen []
136
139
137
140
(** Main entry point. *)
···
157
160
| None ->
158
161
opam_build_prep_upper env ~uid:benv.uid ~gid:benv.gid
159
162
in
160
-
let layer_dir = Build.dir ~os_dir node in
161
-
let layer_json = Fpath.(layer_dir / "layer.json") in
162
-
if Bos.OS.File.exists layer_json |> Result.get_ok then begin
163
+
let layer = Build.layer ~os_dir node in
164
+
if Layer.exists layer then begin
163
165
Log.info (fun m -> m "Cache hit: %s (%s)" pkg_str layer_name);
164
-
Day11_layer.Last_used.touch layer_dir;
165
-
result_of_layer_json layer_json node
166
+
Day11_layer.Last_used.touch (Layer.dir layer);
167
+
result_of_layer layer node
166
168
end else begin
167
169
Log.info (fun m -> m "Building %s (%s)" pkg_str layer_name);
170
+
let layer_dir = Layer.dir layer in
168
171
let lock_file = Fpath.(os_dir / (layer_name ^ ".lock")) in
169
172
let _lock_result =
170
173
Day11_exec.Dir_lock.with_lock ~marker_file:(Fpath.v "layer.json")
···
202
205
| Ok (run, upper, timing) ->
203
206
strategy.cleanup env upper;
204
207
let _exit_code =
205
-
extract_layer env ~layer_dir ~layer_json ~upper
208
+
extract_layer env ~layer ~upper
206
209
~pkg_str ~node ~benv
207
210
~timing ~on_extract run in
208
211
ignore (Day11_exec.Sudo.rm_rf env (Fpath.parent upper));
···
220
223
created_at = "";
221
224
failed_dep = None;
222
225
} in
223
-
let _ = Day11_layer.Meta.save layer_json fail_meta in
224
-
on_extract ~layer_dir ~success:false;
226
+
let _ = Day11_layer.Meta.save (Layer.meta_path layer) fail_meta in
227
+
on_extract ~layer_dir:(Layer.dir layer) ~success:false;
225
228
Ok ())
226
229
in
227
-
if Bos.OS.File.exists layer_json |> Result.get_ok then
228
-
result_of_layer_json layer_json node
230
+
if Layer.exists layer then
231
+
result_of_layer layer node
229
232
else
230
233
Types.Failure layer_name
231
234
end
+2
day11/opam_layer/build.ml
+2
day11/opam_layer/build.ml
+3
day11/opam_layer/build.mli
+3
day11/opam_layer/build.mli
+3
-2
day11/opam_layer/build_meta.ml
+3
-2
day11/opam_layer/build_meta.ml
···
38
38
match Hashtbl.find_opt cache h with
39
39
| Some b -> Ok b
40
40
| None ->
41
-
let layer_dir = Day11_layer.Dir.path ~os_dir h in
41
+
let layer = Day11_layer.Layer.of_hash ~os_dir h in
42
+
let layer_dir = Day11_layer.Layer.dir layer in
42
43
let* layer_meta =
43
-
Day11_layer.Meta.load Fpath.(layer_dir / "layer.json")
44
+
Day11_layer.Meta.load (Day11_layer.Layer.meta_path layer)
44
45
in
45
46
let* build_meta = load layer_dir in
46
47
let* deps = load_deps layer_meta.parent_hashes in
-1
root.opam
-1
root.opam