jon.recoil.org
A fork of mtelver's day10 project
1let std_env ?(ocaml_native = true) ?opam_version ~arch ~os ~os_distribution ~os_family ~os_version ?ocaml_version () = function
2 | "arch" -> Some (OpamTypes.S arch)
3 | "os" -> Some (OpamTypes.S os)
4 | "os-distribution" -> Some (OpamTypes.S os_distribution)
5 | "os-version" -> Some (OpamTypes.S os_version)
6 | "os-family" -> Some (OpamTypes.S os_family)
7 | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
8 (* There is no system compiler *)
9 | "sys-ocaml-arch"
10 | "sys-ocaml-cc"
11 | "sys-ocaml-libc"
12 | "sys-ocaml-system"
13 | "sys-ocaml-version" ->
14 Some (OpamTypes.S "")
15 | "ocaml:native" -> Some (OpamTypes.B ocaml_native)
16 | "ocaml:version" -> Option.map (fun v -> OpamTypes.S (OpamPackage.version_to_string v)) ocaml_version
17 | "enable-ocaml-beta-repository" -> None (* Fake variable? *)
18 | _ ->
19 None
20
21let save_layer_info ?installed_libs ?installed_docs name pkg deps hashes rc =
22 let base_fields =
23 [
24 ("package", `String (OpamPackage.to_string pkg));
25 ("exit_status", `Int rc);
26 ("deps", `List (List.map (fun p -> `String (OpamPackage.to_string p)) deps));
27 ("hashes", `List (List.map (fun h -> `String h) hashes));
28 ("created", `Float (Unix.time ()));
29 ]
30 in
31 let fields = base_fields in
32 let fields =
33 match installed_libs with
34 | None -> fields
35 | Some libs -> fields @ [ ("installed_libs", `List (List.map (fun s -> `String s) libs)) ]
36 in
37 let fields =
38 match installed_docs with
39 | None -> fields
40 | Some docs -> fields @ [ ("installed_docs", `List (List.map (fun s -> `String s) docs)) ]
41 in
42 Yojson.Safe.to_file name (`Assoc fields)
43
44(** Ensure a symlink exists from [packages/<pkg_str>/<layer_name>] to [../../<layer_name>].
45 This enables tracking all builds/docs for a package.version. *)
46let ensure_package_layer_symlink ~cache_dir ~os_key ~pkg_str ~layer_name =
47 let pkg_dir = Path.(cache_dir / os_key / "packages" / pkg_str) in
48 let symlink_path = Path.(pkg_dir / layer_name) in
49 let target = Path.(".." / ".." / layer_name) in
50 (* Create package directory if needed *)
51 if not (Sys.file_exists pkg_dir) then
52 Os.mkdir ~parents:true pkg_dir;
53 (* Create symlink if it doesn't exist. Handle race condition where another
54 worker creates it between our check and symlink call. *)
55 if not (Sys.file_exists symlink_path) then
56 (try Unix.symlink target symlink_path with Unix.Unix_error (Unix.EEXIST, _, _) -> ())
57
58(** Ensure blessed-build or blessed-docs symlink exists for a package.
59 These point to the layer that produced the blessed (canonical) docs. *)
60let ensure_package_blessed_symlink ~cache_dir ~os_key ~pkg_str ~kind ~layer_name =
61 let pkg_dir = Path.(cache_dir / os_key / "packages" / pkg_str) in
62 let symlink_name = match kind with `Build -> "blessed-build" | `Docs -> "blessed-docs" in
63 let symlink_path = Path.(pkg_dir / symlink_name) in
64 let target = Path.(".." / ".." / layer_name) in
65 (* Create package directory if needed *)
66 if not (Sys.file_exists pkg_dir) then
67 Os.mkdir ~parents:true pkg_dir;
68 (* Create or update symlink (blessed can change between runs).
69 Handle race condition where another worker creates the symlink between
70 our unlink and symlink calls. *)
71 (try Unix.unlink symlink_path with Unix.Unix_error (Unix.ENOENT, _, _) -> ());
72 (try Unix.symlink target symlink_path with Unix.Unix_error (Unix.EEXIST, _, _) -> ())
73
74let save_doc_layer_info ?doc_result name pkg ~build_hash ~dep_doc_hashes =
75 let fields =
76 [
77 ("package", `String (OpamPackage.to_string pkg));
78 ("build_hash", `String build_hash);
79 ("dep_doc_hashes", `List (List.map (fun h -> `String h) dep_doc_hashes));
80 ("created", `Float (Unix.time ()));
81 ]
82 in
83 let fields =
84 match doc_result with
85 | None -> fields
86 | Some doc -> fields @ [ ("doc", doc) ]
87 in
88 Yojson.Safe.to_file name (`Assoc fields)
89
90let load_layer_info_exit_status name =
91 let json = Yojson.Safe.from_file name in
92 Yojson.Safe.Util.(json |> member "exit_status" |> to_int)
93
94let load_layer_info_package_name name =
95 let json = Yojson.Safe.from_file name in
96 Yojson.Safe.Util.(json |> member "package" |> to_string)
97
98let load_layer_info_installed_libs name =
99 let json = Yojson.Safe.from_file name in
100 let open Yojson.Safe.Util in
101 match json |> member "installed_libs" with
102 | `Null -> []
103 | libs -> libs |> to_list |> List.map to_string
104
105let load_layer_info_installed_docs name =
106 let json = Yojson.Safe.from_file name in
107 let open Yojson.Safe.Util in
108 match json |> member "installed_docs" with
109 | `Null -> []
110 | docs -> docs |> to_list |> List.map to_string
111
112let load_layer_info_doc_failed name =
113 let json = Yojson.Safe.from_file name in
114 let open Yojson.Safe.Util in
115 match json |> member "doc" with
116 | `Null -> false
117 | doc ->
118 match doc |> member "status" |> to_string with
119 | "failure" -> true
120 | _ -> false
121
122let load_layer_info_dep_doc_hashes name =
123 let json = Yojson.Safe.from_file name in
124 let open Yojson.Safe.Util in
125 match json |> member "dep_doc_hashes" with
126 | `Null -> []
127 | hashes -> hashes |> to_list |> List.map to_string
128
129let solution_to_json pkgs =
130 `Assoc
131 (OpamPackage.Map.fold
132 (fun pkg deps lst -> (OpamPackage.to_string pkg, `List (OpamPackage.Set.to_list_map (fun p -> `String (OpamPackage.to_string p)) deps)) :: lst)
133 pkgs [])
134
135let solution_of_json json =
136 let open Yojson.Safe.Util in
137 json |> to_assoc
138 |> List.fold_left
139 (fun acc (s, l) ->
140 let pkg = s |> OpamPackage.of_string in
141 let deps = l |> to_list |> List.map (fun s -> s |> to_string |> OpamPackage.of_string) |> OpamPackage.Set.of_list in
142 OpamPackage.Map.add pkg deps acc)
143 OpamPackage.Map.empty
144
145let solution_save name pkgs =
146 Yojson.Safe.to_file name (solution_to_json pkgs)
147
148let solution_load name =
149 Yojson.Safe.from_file name |> solution_of_json
150
151let solution_to_string pkgs =
152 Yojson.Safe.to_string (solution_to_json pkgs)
153
154let solution_of_string str =
155 Yojson.Safe.from_string str |> solution_of_json
156
157(** Scan a layer's fs directory for installed lib files.
158 Returns a list of relative paths within lib/ (e.g., ["ocaml/format.cmti", "hmap/hmap.cmti"]).
159 Only includes files with documentation-relevant extensions.
160 Skips directories that can't be read (permission denied). *)
161let scan_installed_lib_files ~layer_dir =
162 let lib_dir = Path.(layer_dir / "fs" / "home" / "opam" / ".opam" / "default" / "lib") in
163 (* Include .ml and .mli for odoc source documentation *)
164 let extensions = [ ".cmi"; ".cmti"; ".cmt"; ".cma"; ".cmxa"; ".cmx"; ".ml"; ".mli" ] in
165 let files = [ "META"; "dune-package" ] in
166 let result = ref [] in
167 let rec scan_dir prefix dir =
168 try
169 if Sys.file_exists dir && Sys.is_directory dir then
170 Sys.readdir dir |> Array.iter (fun name ->
171 let full_path = Path.(dir / name) in
172 let rel_path = if prefix = "" then name else prefix ^ "/" ^ name in
173 try
174 if Sys.is_directory full_path then
175 scan_dir rel_path full_path
176 else if List.exists (fun ext -> Filename.check_suffix name ext) extensions
177 || List.mem name files then
178 result := rel_path :: !result
179 with Sys_error _ -> () (* Skip files we can't access *))
180 with Sys_error _ -> () (* Skip directories we can't read *)
181 in
182 scan_dir "" lib_dir;
183 List.sort String.compare !result
184
185(** Scan a layer's fs directory for installed doc files.
186 Returns a list of relative paths within doc/ (e.g., ["hmap.0.8.1/index.mld"]).
187 Skips directories that can't be read (permission denied). *)
188let scan_installed_doc_files ~layer_dir =
189 let doc_dir = Path.(layer_dir / "fs" / "home" / "opam" / ".opam" / "default" / "doc") in
190 let result = ref [] in
191 let rec scan_dir prefix dir =
192 try
193 if Sys.file_exists dir && Sys.is_directory dir then
194 Sys.readdir dir |> Array.iter (fun name ->
195 let full_path = Path.(dir / name) in
196 let rel_path = if prefix = "" then name else prefix ^ "/" ^ name in
197 try
198 if Sys.is_directory full_path then
199 scan_dir rel_path full_path
200 else if Filename.check_suffix name ".mld"
201 || String.equal name "odoc-config.sexp" then
202 result := rel_path :: !result
203 with Sys_error _ -> () (* Skip files we can't access *))
204 with Sys_error _ -> () (* Skip directories we can't read *)
205 in
206 scan_dir "" doc_dir;
207 List.sort String.compare !result
208
209let create_opam_repository path =
210 let path = Path.(path / "opam-repository") in
211 let () = Os.mkdir path in
212 let () = Os.write_to_file Path.(path / "repo") {|opam-version: "2.0"|} in
213 path
214
215let opam_file opam_repositories pkg =
216 List.find_map
217 (fun opam_repository ->
218 let opam = Path.(opam_repository / "packages" / OpamPackage.name_to_string pkg / OpamPackage.to_string pkg / "opam") in
219 if Sys.file_exists opam then Some (OpamFilename.raw opam |> OpamFile.make |> OpamFile.OPAM.read) else None)
220 opam_repositories