Source file opamBuiltin0install.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
open OpamCudfSolverSig
let log ?level f = OpamConsole.log "0install" ?level f
let name = "builtin-0install"
let ext = ref None
let is_present () = true
let command_name = None
let preemptive_check = false
let default_criteria = {
crit_default = "";
crit_upgrade = "";
crit_fixup = "";
crit_best_effort_prefix = None;
}
let not_relop = function
| `Eq -> `Neq
| `Neq -> `Eq
| `Geq -> `Lt
| `Gt -> `Leq
| `Leq -> `Gt
| `Lt -> `Geq
let keep_installed ~drop_installed_packages request pkgname =
not drop_installed_packages &&
not (List.exists (fun (pkg, _) -> String.equal pkg pkgname) request.Cudf.install) &&
not (List.exists (fun (pkg, _) -> String.equal pkg pkgname) request.Cudf.upgrade) &&
not (List.exists (fun (pkg, _) -> String.equal pkg pkgname) request.Cudf.remove)
let add_spec pkg req c (pkgs, constraints) =
let pkgs = (pkg, req) :: pkgs in
let constraints = match c with
| None -> constraints
| Some c -> (pkg, c) :: constraints
in
(pkgs, constraints)
let essential spec (pkg, c) = add_spec pkg `Essential c spec
let recommended spec (pkg, c) = add_spec pkg `Recommended c spec
let restricts (pkgs, constraints) (pkg, c) =
let constraints = match c with
| None -> (pkg, (`Lt, 1)) :: (pkg, (`Gt, 1)) :: constraints
| Some (relop, v) -> (pkg, (not_relop relop, v)) :: constraints
in
(pkgs, constraints)
let create_spec ~drop_installed_packages universe request =
let spec = ([], []) in
let spec = List.fold_left essential spec request.Cudf.install in
let spec = List.fold_left essential spec request.Cudf.upgrade in
let spec = List.fold_left restricts spec request.Cudf.remove in
Cudf.fold_packages_by_name (fun spec pkgname pkgs ->
match List.find_opt (fun pkg -> pkg.Cudf.installed) pkgs with
| Some {Cudf.keep = `Keep_version; version; _} -> essential spec (pkgname, Some (`Eq, version))
| Some {Cudf.keep = `Keep_package; _} -> essential spec (pkgname, None)
| Some {Cudf.keep = `Keep_feature; _} -> assert false
| Some {Cudf.keep = `Keep_none; _} ->
if keep_installed ~drop_installed_packages request pkgname then
recommended spec (pkgname, None)
else
spec
| None -> spec
) spec universe
let reconstruct_universe universe selections =
Opam_0install_cudf.packages_of_result selections |>
List.fold_left (fun pkgs (pkg, v) ->
let pkg = Cudf.lookup_package universe (pkg, v) in
{pkg with was_installed = pkg.installed; installed = true} :: pkgs
) [] |>
Cudf.load_universe
type options = {
drop_installed_packages : bool;
prefer_oldest : bool;
}
let parse_criteria criteria =
let default = {drop_installed_packages = false; prefer_oldest = false} in
match criteria with
| "" -> default
| "+removed" -> {drop_installed_packages = true; prefer_oldest = false}
| "+count[version-lag,solution]" -> {drop_installed_packages = false; prefer_oldest = true}
| "+removed,+count[version-lag,solution]" ->
{drop_installed_packages = true; prefer_oldest = true}
| _ ->
OpamConsole.warning "Criteria '%s' is not supported by the 0install solver" criteria;
default
let call ~criteria ?timeout:_ (preamble, universe, request) =
let {drop_installed_packages; prefer_oldest} = parse_criteria criteria in
let timer = OpamConsole.timer () in
let pkgs, constraints = create_spec ~drop_installed_packages universe request in
let context = Opam_0install_cudf.create ~prefer_oldest ~constraints universe in
match Opam_0install_cudf.solve context pkgs with
| Ok selections ->
let universe = reconstruct_universe universe selections in
log "Solution found. Solve took %.2f s" (timer ());
(Some preamble, universe)
| Error problem ->
log "No solution. Solve took %.2f s" (timer ());
log ~level:3 "%a" (OpamConsole.slog Opam_0install_cudf.diagnostics) problem;
raise Dose_common.CudfSolver.Unsat