jon.recoil.org
A fork of mtelver's day10 project
1type rejection =
2 | UserConstraint of OpamFormula.atom
3 | Unavailable
4
5let ( / ) = Filename.concat
6
7let with_dir path fn =
8 let ch = Unix.opendir path in
9 Fun.protect ~finally:(fun () -> Unix.closedir ch) (fun () -> fn ch)
10
11let list_dir path =
12 let rec aux acc ch =
13 match Unix.readdir ch with
14 | name when name.[0] <> '.' -> aux (name :: acc) ch
15 | _ -> aux acc ch
16 | exception End_of_file -> acc
17 in
18 with_dir path (aux [])
19
20type t = {
21 env : string -> OpamVariable.variable_contents option;
22 packages_dirs : string list;
23 pins : (OpamPackage.Version.t * OpamFile.OPAM.t) OpamPackage.Name.Map.t;
24 constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *)
25 test : OpamPackage.Name.Set.t;
26 prefer_oldest : bool;
27 doc : bool; (* Whether to filter in {with-doc} deps *)
28 post : bool; (* Whether to filter in {post} deps *)
29}
30
31let load t pkg =
32 let { OpamPackage.name; version = _ } = pkg in
33 match OpamPackage.Name.Map.find_opt name t.pins with
34 | Some (_, opam) -> opam
35 | None ->
36 List.find_map
37 (fun packages_dir ->
38 let opam = packages_dir / OpamPackage.Name.to_string name / OpamPackage.to_string pkg / "opam" in
39 if Sys.file_exists opam then Some opam else None)
40 t.packages_dirs
41 |> Option.get |> OpamFilename.raw |> OpamFile.make |> OpamFile.OPAM.read
42
43let user_restrictions t name = OpamPackage.Name.Map.find_opt name t.constraints
44let dev = OpamPackage.Version.of_string "dev"
45
46let std_env ?(ocaml_native = true) ?sys_ocaml_version ?opam_version ~arch ~os ~os_distribution ~os_family ~os_version () = function
47 | "arch" -> Some (OpamTypes.S arch)
48 | "os" -> Some (OpamTypes.S os)
49 | "os-distribution" -> Some (OpamTypes.S os_distribution)
50 | "os-version" -> Some (OpamTypes.S os_version)
51 | "os-family" -> Some (OpamTypes.S os_family)
52 | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
53 | "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v)
54 | "ocaml:native" -> Some (OpamTypes.B ocaml_native)
55 | "enable-ocaml-beta-repository" -> None (* Fake variable? *)
56 | _ ->
57 None
58
59let env t pkg v =
60 if List.mem v OpamPackageVar.predefined_depends_variables then None
61 else
62 match OpamVariable.Full.to_string v with
63 | "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg)))
64 | x -> t.env x
65
66let filter_deps t pkg f =
67 let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in
68 let test = OpamPackage.Name.Set.mem (OpamPackage.name pkg) t.test in
69 f |> OpamFilter.partial_filter_formula (env t pkg) |> OpamFilter.filter_deps ~build:true ~post:t.post ~test ~doc:t.doc ~dev ~dev_setup:false ~default:false
70
71let version_compare t (v1, v1_avoid, _) (v2, v2_avoid, _) =
72 match (v1_avoid, v2_avoid) with
73 | true, true
74 | false, false ->
75 if t.prefer_oldest then OpamPackage.Version.compare v1 v2 else OpamPackage.Version.compare v2 v1
76 | true, false -> 1
77 | false, true -> -1
78
79let candidates t name =
80 match OpamPackage.Name.Map.find_opt name t.pins with
81 | Some (version, opam) -> [ (version, Ok opam) ]
82 | None ->
83 let versions =
84 List.concat_map
85 (fun packages_dir ->
86 try packages_dir / OpamPackage.Name.to_string name |> list_dir with
87 | Unix.Unix_error (Unix.ENOENT, _, _) -> [])
88 t.packages_dirs
89 |> List.sort_uniq compare
90 in
91 let user_constraints = user_restrictions t name in
92 versions
93 |> List.filter_map (fun dir ->
94 match OpamPackage.of_string_opt dir with
95 | Some pkg ->
96 List.find_opt (fun packages_dir -> Sys.file_exists (packages_dir / OpamPackage.Name.to_string name / dir / "opam")) t.packages_dirs
97 |> Option.map (fun _ -> OpamPackage.version pkg)
98 | _ -> None)
99 |> List.filter_map (fun v ->
100 let pkg = OpamPackage.create name v in
101 let opam = load t pkg in
102 let avoid = OpamFile.OPAM.has_flag Pkgflag_AvoidVersion opam in
103 let available = OpamFile.OPAM.available opam in
104 match OpamFilter.eval_to_bool ~default:false (env t pkg) available with
105 | true -> Some (v, avoid, opam)
106 | false -> None)
107 (* https://github.com/ocaml-opam/opam-0install-cudf/issues/5 cf 4.12.1 *)
108 |> (fun l -> if List.for_all (fun (_, avoid, _) -> avoid) l then [] else l)
109 |> List.sort (version_compare t)
110 |> List.map (fun (v, _, opam) ->
111 match user_constraints with
112 | Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> (v, Error (UserConstraint (name, Some test)))
113 | _ -> (v, Ok opam))
114
115let pp_rejection f = function
116 | UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x)
117 | Unavailable -> Fmt.string f "Availability condition not satisfied"
118
119let create ?(prefer_oldest = false) ?(test = OpamPackage.Name.Set.empty) ?(pins = OpamPackage.Name.Map.empty) ?(doc = false) ?(post = true) ~constraints ~env packages_dirs =
120 { env; packages_dirs; pins; constraints; test; prefer_oldest; doc; post }
121
122(** Create a new context with different doc/post settings.
123 This is used to compute compile vs link deps separately. *)
124let with_doc_post ~doc ~post t =
125 { t with doc; post }
126
127(** Extract x-extra-doc-deps from an opam file.
128 Same implementation as in odoc_gen.ml but needed here to extend packages.
129 Handles both simple package names and package names with constraints. *)
130let get_extra_doc_deps opamfile =
131 let open OpamParserTypes.FullPos in
132 let extensions = OpamFile.OPAM.extensions opamfile in
133 match OpamStd.String.Map.find_opt "x-extra-doc-deps" extensions with
134 | None -> OpamPackage.Name.Set.empty
135 | Some value ->
136 let extract_name item =
137 match item.pelem with
138 | String name -> Some name
139 | Option (inner, _) ->
140 (match inner.pelem with
141 | String name -> Some name
142 | _ -> None)
143 | _ -> None
144 in
145 let extract_names acc v =
146 match v.pelem with
147 | List { pelem = items; _ } ->
148 List.fold_left (fun acc item ->
149 match extract_name item with
150 | Some name ->
151 OpamPackage.Name.Set.add (OpamPackage.Name.of_string name) acc
152 | None -> acc
153 ) acc items
154 | _ -> acc
155 in
156 extract_names OpamPackage.Name.Set.empty value
157
158(** Create an extended context where x-extra-doc-deps are added to each package's
159 regular depends. This is used for doc link solving - x-extra-doc-deps packages
160 need to be in the solution to be available during doc linking.
161
162 The approach:
163 1. For each pinned package, read its opam file to get x-extra-doc-deps
164 2. Create a new opam file with those deps added to the depends formula
165 3. Create a new context with the extended pins *)
166let extend_with_extra_doc_deps t =
167 let new_pins = OpamPackage.Name.Map.mapi (fun _name (version, opam) ->
168 let extra_deps = get_extra_doc_deps opam in
169 if OpamPackage.Name.Set.is_empty extra_deps then
170 (version, opam)
171 else begin
172 (* Add x-extra-doc-deps to the depends formula *)
173 let depends = OpamFile.OPAM.depends opam in
174 let extra_formula =
175 OpamPackage.Name.Set.fold (fun dep_name acc ->
176 (* Add each extra dep as an unconditional dependency *)
177 let atom = OpamFormula.Atom (dep_name, OpamFormula.Empty) in
178 OpamFormula.And (acc, atom)
179 ) extra_deps OpamFormula.Empty
180 in
181 let new_depends = match extra_formula with
182 | OpamFormula.Empty -> depends
183 | _ -> OpamFormula.And (depends, extra_formula)
184 in
185 let new_opam = OpamFile.OPAM.with_depends new_depends opam in
186 (version, new_opam)
187 end
188 ) t.pins in
189 { t with pins = new_pins }