jon.recoil.org
forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
1(** Read layer info for packages from day10's cache directory.
2 Uses the [packages/<pkg>/] directory structure with symlinks:
3 {[
4 build-<hash> -> ../../build-<hash> (all builds)
5 doc-<hash> -> ../../doc-<hash> (all docs)
6 blessed-build -> ../../build-<hash> (canonical build if blessed)
7 blessed-docs -> ../../doc-<hash> (canonical docs if blessed)
8 ]}
9 Falls back to scanning [build-*] directories if no symlinks exist. *)
10
11type layer_info = {
12 package: string;
13 deps: string list;
14 created: float;
15 exit_status: int;
16}
17
18(** Read layer.json from a directory and parse it *)
19let read_layer_json path =
20 if Sys.file_exists path then
21 try
22 let content = In_channel.with_open_text path In_channel.input_all in
23 let json = Yojson.Safe.from_string content in
24 let open Yojson.Safe.Util in
25 (* Handle deps which may have OpamPackage objects or strings *)
26 let deps_list = json |> member "deps" |> to_list in
27 let deps = deps_list |> List.filter_map (fun d ->
28 match d with
29 | `String s -> Some s
30 | _ -> None (* Skip non-string deps *)
31 ) in
32 Some {
33 package = json |> member "package" |> to_string;
34 deps;
35 created = json |> member "created" |> to_float;
36 exit_status = json |> member "exit_status" |> to_int;
37 }
38 with _ -> None
39 else
40 None
41
42(** Follow a symlink and read layer.json from the target directory *)
43let read_layer_via_symlink symlink_path =
44 if Sys.file_exists symlink_path then
45 try
46 let target = Unix.readlink symlink_path in
47 (* Target is relative like "../../build-abc123" *)
48 let layer_dir = Filename.concat (Filename.dirname symlink_path) target in
49 let layer_json = Filename.concat layer_dir "layer.json" in
50 read_layer_json layer_json
51 with Unix.Unix_error _ -> None
52 else
53 None
54
55(** Get layer info for a package.
56 Checks blessed-build first, then falls back to most recent build symlink,
57 then falls back to scanning build-* directories. *)
58let get_package_layer ~cache_dir ~platform ~package =
59 let pkg_dir = Filename.concat cache_dir
60 (Filename.concat platform
61 (Filename.concat "packages" package)) in
62 (* Try blessed-build first *)
63 let blessed_build = Filename.concat pkg_dir "blessed-build" in
64 match read_layer_via_symlink blessed_build with
65 | Some info -> Some info
66 | None ->
67 (* Try to find any build-* symlink in the package directory *)
68 if Sys.file_exists pkg_dir && Sys.is_directory pkg_dir then
69 let build_symlinks = Sys.readdir pkg_dir
70 |> Array.to_list
71 |> List.filter (fun name -> String.length name > 6 && String.sub name 0 6 = "build-")
72 |> List.sort (fun a b -> String.compare b a) (* Most recent first by hash *)
73 in
74 match build_symlinks with
75 | first :: _ ->
76 read_layer_via_symlink (Filename.concat pkg_dir first)
77 | [] -> None
78 else
79 (* No package directory - fall back to scanning build-* directories *)
80 let platform_dir = Filename.concat cache_dir platform in
81 if Sys.file_exists platform_dir && Sys.is_directory platform_dir then
82 Sys.readdir platform_dir
83 |> Array.to_list
84 |> List.filter (fun name -> String.length name > 6 && String.sub name 0 6 = "build-")
85 |> List.find_map (fun build_dir ->
86 let layer_json = Filename.concat platform_dir
87 (Filename.concat build_dir "layer.json") in
88 match read_layer_json layer_json with
89 | Some info when info.package = package -> Some info
90 | _ -> None)
91 else
92 None
93
94(** List all packages with layer info (for computing reverse deps).
95 Returns list of (package_name, layer_info) pairs.
96 Uses packages/ directory structure - each subdirectory is a package. *)
97let list_all_packages ~cache_dir ~platform =
98 let packages_dir = Filename.concat cache_dir
99 (Filename.concat platform "packages") in
100 if Sys.file_exists packages_dir && Sys.is_directory packages_dir then
101 Sys.readdir packages_dir
102 |> Array.to_list
103 |> List.filter (fun name ->
104 (* Each entry should be a directory (package.version) *)
105 let path = Filename.concat packages_dir name in
106 Sys.is_directory path)
107 |> List.filter_map (fun package ->
108 match get_package_layer ~cache_dir ~platform ~package with
109 | Some info -> Some (package, info)
110 | None -> None)
111 else
112 (* Fall back to scanning build-* directories *)
113 let platform_dir = Filename.concat cache_dir platform in
114 if Sys.file_exists platform_dir && Sys.is_directory platform_dir then
115 Sys.readdir platform_dir
116 |> Array.to_list
117 |> List.filter (fun name -> String.length name > 6 && String.sub name 0 6 = "build-")
118 |> List.filter_map (fun build_dir ->
119 let layer_json = Filename.concat platform_dir
120 (Filename.concat build_dir "layer.json") in
121 match read_layer_json layer_json with
122 | Some info -> Some (info.package, info)
123 | None -> None)
124 else
125 []
126
127(** Compute reverse dependencies: which packages depend on the given package.
128 Returns a list of package names that have this package in their deps. *)
129let get_reverse_deps ~cache_dir ~platform ~package =
130 list_all_packages ~cache_dir ~platform
131 |> List.filter_map (fun (pkg_name, info) ->
132 if List.mem package info.deps then Some pkg_name else None)
133 |> List.sort String.compare