Skip to content

Commit bc2d29f

Browse files
AlizterAlizter
committed
feat(pkg): autolocking
Signed-off-by: Ali Caglayan <[email protected]>
1 parent 4421b9d commit bc2d29f

File tree

12 files changed

+704
-62
lines changed

12 files changed

+704
-62
lines changed

‎src/dune_pkg/opam_repo.ml‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -128,6 +128,34 @@ let revision t =
128128
| Directory _ -> Code_error.raise "not a git repo" []
129129
;;
130130

131+
let content_digest t =
132+
match t.source with
133+
| Repo repo ->
134+
Rev_store.At_rev.rev repo |> Rev_store.Object.to_hex |> Dune_digest.string
135+
| Directory path ->
136+
(match Path.lstat path with
137+
| Error e ->
138+
User_error.raise
139+
[ Pp.textf "Can't stat path %s" (Path.to_string path)
140+
; Pp.textf "reason: %s" (Unix_error.Detailed.to_string_hum e)
141+
]
142+
| Ok stats ->
143+
(match
144+
Dune_digest.Stats_for_digest.of_unix_stats stats
145+
|> Dune_digest.path_with_stats ~allow_dirs:true path
146+
with
147+
| Ok digest -> digest
148+
| Error (Unix_error e) ->
149+
User_error.raise
150+
[ Pp.textf "Can't digest path %S:" (Path.to_string path)
151+
; Unix_error.Detailed.pp e
152+
]
153+
| Error Unexpected_kind ->
154+
User_error.raise
155+
[ Pp.textf "Can't digest path %S: unexpected file kind" (Path.to_string path)
156+
]))
157+
;;
158+
131159
let load_opam_package_from_dir ~(dir : Path.t) package =
132160
let opam_file_path = Paths.opam_file package in
133161
match Path.exists (Path.append_local dir opam_file_path) with

‎src/dune_pkg/opam_repo.mli‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,15 @@ val of_git_repo : Loc.t -> OpamUrl.t -> t Fiber.t
2626
val revision : t -> Rev_store.At_rev.t
2727
val serializable : t -> Serializable.t option
2828

29+
(** [content_digest t] digests the contents of an opam repository. For a Git
30+
repository, this is a digest of the commit SHA. For a directory-based
31+
repository, this is a digest of the directory's contents.
32+
33+
Raises [User_error] in the directory case if the path cannot be accessed or
34+
digested due to permission errors, the directory being deleted or modified
35+
between stat and digest, or other filesystem errors. *)
36+
val content_digest : t -> Dune_digest.t
37+
2938
module Key : sig
3039
type t
3140

‎src/dune_pkg/package_universe.ml‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -134,14 +134,16 @@ let check_for_unnecessary_packges_in_lock_dir
134134
])
135135
;;
136136

137-
let up_to_date local_packages ~dependency_hash:saved_dependency_hash =
137+
let dependency_digest local_packages =
138138
let local_packages =
139139
Package_name.Map.values local_packages |> List.map ~f:Local_package.for_solver
140140
in
141-
let dependency_hash =
142-
Local_package.For_solver.non_local_dependencies local_packages
143-
|> Local_package.Dependency_hash.of_dependency_formula
144-
in
141+
Local_package.For_solver.non_local_dependencies local_packages
142+
|> Local_package.Dependency_hash.of_dependency_formula
143+
;;
144+
145+
let up_to_date local_packages ~dependency_hash:saved_dependency_hash =
146+
let dependency_hash = dependency_digest local_packages in
145147
match saved_dependency_hash, dependency_hash with
146148
| None, None -> `Valid
147149
| Some lock_dir_dependency_hash, Some non_local_dependencies_hash

‎src/dune_pkg/package_universe.mli‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,10 @@ val create
1414
-> Lock_dir.t
1515
-> (t, User_message.t) result
1616

17+
val dependency_digest
18+
: Local_package.t Package_name.Map.t
19+
-> Local_package.Dependency_hash.t option
20+
1721
(** Verifies if the dependencies described in the project file are still
1822
synchronized with the dependencies selected in the lock directroy. If it is
1923
not the case, it returns the hash of the new dependency set. *)

‎src/dune_pkg/resolved_package.ml‎

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,11 @@ let opam_file = function
3838
| Rest t -> t.opam_file
3939
;;
4040

41+
let extra_files = function
42+
| Dune -> None
43+
| Rest t -> Some t.extra_files
44+
;;
45+
4146
let add_opam_package_to_opam_file package opam_file =
4247
opam_file
4348
|> OpamFile.OPAM.with_version (OpamPackage.version package)
@@ -188,3 +193,71 @@ let get_opam_package_files resolved_packages =
188193
| Some _ -> Some (Option.value files ~default:[]))
189194
|> Int.Map.values
190195
;;
196+
197+
let digest_extra_files : extra_files -> Dune_digest.t = function
198+
| Inside_files_dir path_opt ->
199+
(match path_opt with
200+
| None ->
201+
Sexp.List [ Atom "inside_files_dir"; Atom "none" ]
202+
|> Sexp.to_string
203+
|> Dune_digest.string
204+
| Some path ->
205+
(match Path.lstat path with
206+
| Error e ->
207+
User_error.raise
208+
[ Pp.textf "Can't stat path %s" (Path.to_string path)
209+
; Pp.textf "reason: %s" (Unix_error.Detailed.to_string_hum e)
210+
]
211+
| Ok stats ->
212+
let stats_for_digest = Dune_digest.Stats_for_digest.of_unix_stats stats in
213+
(match Dune_digest.path_with_stats ~allow_dirs:true path stats_for_digest with
214+
| Ok digest -> digest
215+
| Error (Unix_error e) ->
216+
User_error.raise
217+
[ Pp.textf "Can't digest path %S:" (Path.to_string path)
218+
; Unix_error.Detailed.pp e
219+
]
220+
| Error Unexpected_kind ->
221+
User_error.raise
222+
[ Pp.textf
223+
"Can't digest path %S: unexpected file kind"
224+
(Path.to_string path)
225+
])))
226+
| Git_files (path_opt, rev) ->
227+
let path_str =
228+
match path_opt with
229+
| None -> "None"
230+
| Some p -> sprintf "Some %s" (Path.Local.to_string p)
231+
in
232+
Sexp.List
233+
[ Atom "git_files"
234+
; Atom path_str
235+
; Atom (Rev_store.At_rev.rev rev |> Rev_store.Object.to_hex)
236+
]
237+
|> Sexp.to_string
238+
|> Dune_digest.string
239+
;;
240+
241+
let digest res_pkg =
242+
(* We are explicitly ignoring [loc] here because we don't need to take into
243+
account the location of the opam file. *)
244+
Sexp.record
245+
[ "opam_file", Atom (OpamFile.OPAM.write_to_string (opam_file res_pkg))
246+
; ( "package"
247+
, let opam_pkg = package res_pkg in
248+
Sexp.record
249+
[ "name", Atom (OpamPackage.name opam_pkg |> OpamPackage.Name.to_string)
250+
; "version", Atom (OpamPackage.version opam_pkg |> OpamPackage.Version.to_string)
251+
] )
252+
; "dune_build", Atom (dune_build res_pkg |> Bool.to_string)
253+
; ( "extra_files"
254+
, Atom
255+
(extra_files res_pkg
256+
|> Option.map ~f:digest_extra_files
257+
|> Dune_digest.Feed.compute_digest
258+
(Dune_digest.Feed.option Dune_digest.Feed.digest)
259+
|> Dune_digest.to_string) )
260+
]
261+
|> Sexp.to_string
262+
|> Dune_digest.string
263+
;;

‎src/dune_pkg/resolved_package.mli‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,3 +35,12 @@ val local_package
3535
val get_opam_package_files
3636
: t list
3737
-> (File_entry.t list list, User_message.t) result Fiber.t
38+
39+
(** [digest t] computes a digest of the resolved package contents, excluding the
40+
source location. For directory-based extra files, the digest of the
41+
directory contents is included. For git-based extra files, the commit SHA is
42+
included.
43+
44+
Raises [User_error] if extra files in a directory cannot be accessed or
45+
digested due to permission errors, filesystem errors. *)
46+
val digest : t -> Dune_digest.t

‎src/dune_rules/lock_action.ml‎

Lines changed: 202 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,202 @@
1+
open Import
2+
3+
include struct
4+
open Dune_pkg
5+
module Solver_env = Solver_env
6+
module Opam_repo = Opam_repo
7+
module Local_package = Local_package
8+
module Resolved_package = Resolved_package
9+
module Version_preference = Version_preference
10+
module Package_universe = Package_universe
11+
module Package_dependency = Package_dependency
12+
module Opam_solver = Opam_solver
13+
module Sys_poll = Sys_poll
14+
end
15+
16+
module Spec = struct
17+
type ('path, 'target) t =
18+
{ target : 'target
19+
; lock_dir : 'path
20+
; packages : Local_package.t Package.Name.Map.t
21+
; repos : Opam_repo.t list
22+
; solver_env_from_context : Solver_env.t
23+
; unset_solver_vars : Package_variable_name.Set.t
24+
; constraints : Package_dependency.t list
25+
; selected_depopts : Package.Name.t list
26+
; pins : Resolved_package.t Package.Name.Map.t
27+
; version_preference : Version_preference.t
28+
}
29+
30+
let name = "lock"
31+
let version = 1
32+
let bimap t f g = { t with lock_dir = f t.lock_dir; target = g t.target }
33+
let is_useful_to ~memoize = memoize
34+
35+
let encode
36+
{ target
37+
; lock_dir
38+
; packages
39+
; repos
40+
; solver_env_from_context
41+
; unset_solver_vars
42+
; constraints
43+
; selected_depopts
44+
; pins
45+
; version_preference
46+
}
47+
encode_path
48+
encode_target
49+
=
50+
Sexp.record
51+
[ "target", encode_target target
52+
; "lock_dir", encode_path lock_dir
53+
; ( "packages"
54+
, match Package_universe.dependency_digest packages with
55+
| None -> Atom "no packages"
56+
| Some hash ->
57+
List [ Atom "hash"; Atom (Local_package.Dependency_hash.to_string hash) ] )
58+
; ( "repos"
59+
, List
60+
(List.map repos ~f:(fun repo ->
61+
Sexp.Atom (Opam_repo.content_digest repo |> Dune_digest.to_string))) )
62+
; ( "solver_env_from_context"
63+
, Atom
64+
(Dune_digest.Feed.compute_digest
65+
Solver_env.digest_feed
66+
solver_env_from_context
67+
|> Dune_digest.to_string) )
68+
; ( "unset_solver_vars"
69+
, List
70+
(Package_variable_name.Set.to_list unset_solver_vars
71+
|> List.sort ~compare:Package_variable_name.compare
72+
|> List.map ~f:(fun var -> Sexp.Atom (Package_variable_name.to_string var)))
73+
)
74+
; ( "constraints"
75+
, List
76+
(List.sort constraints ~compare:(fun a b ->
77+
Dune_lang.Package_name.compare
78+
a.Package_dependency.name
79+
b.Package_dependency.name)
80+
|> List.map ~f:(fun { Package_dependency.name; constraint_ } ->
81+
let name = Dune_lang.Package_name.to_string name in
82+
let constraint_ =
83+
match constraint_ with
84+
| None -> "no constraints"
85+
| Some c -> Package_dependency.Constraint.to_dyn c |> Dyn.to_string
86+
in
87+
Sexp.List [ Sexp.Atom name; Sexp.Atom constraint_ ])) )
88+
; ( "selected_depopts"
89+
, List
90+
(List.sort selected_depopts ~compare:Dune_lang.Package_name.compare
91+
|> List.map ~f:(fun pkg_name ->
92+
Sexp.Atom (Dune_lang.Package_name.to_string pkg_name))) )
93+
; ( "pins"
94+
, List
95+
(Dune_lang.Package_name.Map.to_list pins
96+
|> List.sort ~compare:(fun (a, _) (b, _) ->
97+
Dune_lang.Package_name.compare a b)
98+
|> List.map ~f:(fun (pkg_name, resolved_pkg) ->
99+
let name = Dune_lang.Package_name.to_string pkg_name in
100+
let digest =
101+
Resolved_package.digest resolved_pkg |> Dune_digest.to_string
102+
in
103+
Sexp.List [ Sexp.Atom name; Sexp.Atom digest ])) )
104+
; ( "version_preference"
105+
, Atom
106+
(match version_preference with
107+
| Oldest -> "oldest"
108+
| Newest -> "newest") )
109+
]
110+
;;
111+
112+
let action
113+
{ target
114+
; lock_dir = _
115+
; packages
116+
; repos
117+
; solver_env_from_context
118+
; unset_solver_vars
119+
; constraints
120+
; selected_depopts
121+
; pins
122+
; version_preference
123+
}
124+
~ectx:_
125+
~eenv:{ Action.Ext.Exec.env; _ }
126+
=
127+
let open Fiber.O in
128+
let* () = Fiber.return () in
129+
let local_packages = Package.Name.Map.map packages ~f:Local_package.for_solver in
130+
let portable_lock_dir =
131+
match Config.get Compile_time.portable_lock_dir with
132+
| `Enabled -> true
133+
| `Disabled -> false
134+
in
135+
let* solver_env =
136+
let open Fiber.O in
137+
let+ solver_env_from_current_system =
138+
Sys_poll.make ~path:(Env_path.path env) |> Sys_poll.solver_env_from_current_system
139+
in
140+
let solver_env =
141+
[ Some solver_env_from_current_system; Some solver_env_from_context ]
142+
|> List.filter_opt
143+
|> List.fold_left ~init:Solver_env.with_defaults ~f:Solver_env.extend
144+
in
145+
Solver_env.unset_multi solver_env unset_solver_vars
146+
in
147+
let* solver_result =
148+
Opam_solver.solve_lock_dir
149+
solver_env
150+
version_preference
151+
repos
152+
~pins
153+
~local_packages
154+
~constraints
155+
~selected_depopts
156+
~portable_lock_dir
157+
in
158+
(* CR-somday Alizter: Consolidate with the rest of the error logic. *)
159+
match solver_result with
160+
| Error (`Manifest_error _diagnostic) -> assert false
161+
| Error (`Solve_error _diagnostic) -> assert false
162+
| Ok { pinned_packages; files; lock_dir; _ } ->
163+
let lock_dir_path = Path.build target in
164+
let+ lock_dir =
165+
Dune_pkg.Lock_dir.compute_missing_checksums ~pinned_packages lock_dir
166+
in
167+
Dune_pkg.Lock_dir.Write_disk.prepare
168+
~portable_lock_dir
169+
~lock_dir_path
170+
~files
171+
lock_dir
172+
|> Dune_pkg.Lock_dir.Write_disk.commit
173+
;;
174+
end
175+
176+
module A = Action_ext.Make (Spec)
177+
178+
let action
179+
~target
180+
~lock_dir
181+
~packages
182+
~repos
183+
~solver_env_from_context
184+
~unset_solver_vars
185+
~constraints
186+
~selected_depopts
187+
~pins
188+
~version_preference
189+
=
190+
A.action
191+
{ Spec.target
192+
; lock_dir
193+
; packages
194+
; repos
195+
; solver_env_from_context
196+
; unset_solver_vars
197+
; constraints
198+
; selected_depopts
199+
; pins
200+
; version_preference
201+
}
202+
;;

‎src/dune_rules/lock_action.mli‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
open Import
2+
3+
val action
4+
: target:Path.Build.t
5+
-> lock_dir:Path.t
6+
-> packages:Dune_pkg.Local_package.t Package.Name.Map.t
7+
-> repos:Dune_pkg.Opam_repo.t list
8+
-> solver_env_from_context:Dune_pkg.Solver_env.t
9+
-> unset_solver_vars:Package_variable_name.Set.t
10+
-> constraints:Dune_pkg.Package_dependency.t list
11+
-> selected_depopts:Dune_pkg.Package_name.t list
12+
-> pins:Dune_pkg.Resolved_package.t Dune_lang.Package_name.Map.t
13+
-> version_preference:Dune_pkg.Version_preference.t
14+
-> Action.t

0 commit comments

Comments
 (0)