Skip to content

Copy the lock directories to the build folder and read package rules from there #12394

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 6 commits into from
Oct 2, 2025
Merged

Copy the lock directories to the build folder and read package rules from there #12394

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
cc9940a
Copy lock dirs into build folder before loading
Leonidas-from-XIV Aug 20, 2025
1f7193d
Disable tests of dev-tools that lock & build in the same call
Leonidas-from-XIV Sep 17, 2025
c1b4c4b
Do not generate duplicate rules for lock dirs
Leonidas-from-XIV Sep 17, 2025
192f49e
Fix `ocamlformat-patch-extra-files.t`
Leonidas-from-XIV Sep 18, 2025
5a2d40a
Don't require all lock dir packages to contain file dirs
Leonidas-from-XIV Sep 18, 2025
54268d6
Relocate error messages
Leonidas-from-XIV Sep 19, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
73 changes: 41 additions & 32 deletions bin/lock_dev_tool.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,8 @@ let solve ~dev_tool ~local_packages =
Workspace.add_repo workspace Dune_pkg.Pkg_workspace.Repository.binary_packages
| `Disabled -> workspace
in
let lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in
(* as we want to write to the source, we're using the source lock dir here *)
let lock_dir = Dune_rules.Lock_dir.dev_tool_source_lock_dir dev_tool |> Path.source in
Memo.of_reproducible_fiber
@@ Pkg.Lock.solve
workspace
Expand Down Expand Up @@ -173,37 +174,45 @@ let extra_dependencies dev_tool =

let lockdir_status dev_tool =
let open Memo.O in
let dev_tool_lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in
match Lock_dir.read_disk dev_tool_lock_dir with
| Error _ -> Memo.return `No_lockdir
| Ok { packages; _ } ->
(match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with
| false -> Memo.return `Lockdir_ok
| true ->
let* platform =
Pkg.Pkg_common.poll_solver_env_from_current_system ()
|> Memo.of_reproducible_fiber
in
let packages = Lock_dir.Packages.pkgs_on_platform_by_name packages ~platform in
(match Package_name.Map.find packages compiler_package_name with
| None -> Memo.return `No_compiler_lockfile_in_lockdir
| Some { info; _ } ->
let+ ocaml_compiler_version = locked_ocaml_compiler_version () in
(match Package_version.equal info.version ocaml_compiler_version with
| true -> `Lockdir_ok
| false ->
`Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed
(User_message.make
[ Pp.textf
"The version of the compiler package (%S) in this project's \
lockdir has changed to %s (formerly the compiler version was %s). \
The dev-tool %S will be re-locked and rebuilt with this version \
of the compiler."
(Package_name.to_string compiler_package_name)
(Package_version.to_string ocaml_compiler_version)
(Package_version.to_string info.version)
(Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string)
]))))
let dev_tool_lock_dir = Dune_rules.Lock_dir.dev_tool_source_lock_dir dev_tool in
let* lock_dir_exists =
Dune_engine.Fs_memo.dir_exists (In_source_dir dev_tool_lock_dir)
Copy link
Member

@rgrinberg rgrinberg Sep 5, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You should be using Source_tree (or at least Fs_memo) to inspect the source tree.

Copy link
Collaborator Author

@Leonidas-from-XIV Leonidas-from-XIV Sep 8, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

But this is using Fs_memo?

in
match lock_dir_exists with
| false -> Memo.return `No_lockdir
| true ->
let dev_tool_lock_dir = Path.source dev_tool_lock_dir in
(match Lock_dir.read_disk dev_tool_lock_dir with
| Error _ -> Memo.return `No_lockdir
| Ok { packages; _ } ->
(match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with
| false -> Memo.return `Lockdir_ok
| true ->
let* platform =
Pkg.Pkg_common.poll_solver_env_from_current_system ()
|> Memo.of_reproducible_fiber
in
let packages = Lock_dir.Packages.pkgs_on_platform_by_name packages ~platform in
(match Package_name.Map.find packages compiler_package_name with
| None -> Memo.return `No_compiler_lockfile_in_lockdir
| Some { info; _ } ->
let+ ocaml_compiler_version = locked_ocaml_compiler_version () in
(match Package_version.equal info.version ocaml_compiler_version with
| true -> `Lockdir_ok
| false ->
`Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed
(User_message.make
[ Pp.textf
"The version of the compiler package (%S) in this project's \
lockdir has changed to %s (formerly the compiler version was \
%s). The dev-tool %S will be re-locked and rebuilt with this \
version of the compiler."
(Package_name.to_string compiler_package_name)
(Package_version.to_string ocaml_compiler_version)
(Package_version.to_string info.version)
(Dune_pkg.Dev_tool.package_name dev_tool
|> Package_name.to_string)
])))))
;;

(* [lock_dev_tool_at_version dev_tool version] generates the lockdir for the
Expand Down
7 changes: 5 additions & 2 deletions bin/tools/tools_common.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,11 @@ let build_dev_tool_directly common dev_tool =
let open Fiber.O in
let+ result =
Build.run_build_system ~common ~request:(fun _build_system ->
Action_builder.path (dev_tool_exe_path dev_tool))
let open Action_builder.O in
dev_tool
|> Lock_dev_tool.lock_dev_tool
|> Action_builder.of_memo
>>> Action_builder.path (dev_tool_exe_path dev_tool))
in
match result with
| Error `Already_reported -> raise Dune_util.Report_error.Already_reported
Expand All @@ -41,7 +45,6 @@ let lock_and_build_dev_tool ~common ~config dev_tool =
build_dev_tool_via_rpc dev_tool)
| Ok () ->
Scheduler.go_with_rpc_server ~common ~config (fun () ->
let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in
build_dev_tool_directly common dev_tool)
;;

Expand Down
7 changes: 7 additions & 0 deletions src/dune_lang/action.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,13 @@ val encode : t Encoder.t
val decode_dune_file : t Decoder.t
val decode_pkg : t Decoder.t

val map
: t
-> string_with_vars:(String_with_vars.t -> String_with_vars.t)
-> slang:(Slang.t -> Slang.t)
-> blang:(Slang.Blang.t -> Slang.Blang.t)
-> t

(** Raises User_error on invalid action. *)
val validate : loc:Loc.t -> t -> unit

Expand Down
182 changes: 90 additions & 92 deletions src/dune_pkg/lock_dir.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -516,6 +516,24 @@ module Depexts = struct
let remove_locs t = { t with enabled_if = Enabled_if.remove_locs t.enabled_if }
end

let in_source_tree path =
match (path : Path.t) with
| In_source_tree s -> s
| In_build_dir b ->
let in_source = Path.drop_build_context_exn path in
(match Path.Source.explode in_source with
| "default" :: ".lock" :: components ->
Path.Source.L.relative Path.Source.root components
| _otherwise ->
Code_error.raise
"Unexpected location of lock directory in build directory"
[ "path", Path.Build.to_dyn b; "in_source", Path.Source.to_dyn in_source ])
| External e ->
Code_error.raise
"External path returned when loading a lock dir"
[ "path", Path.External.to_dyn e ]
;;

module Pkg = struct
type t =
{ build_command : Build_command.t Conditional_choice.t
Expand Down Expand Up @@ -862,8 +880,22 @@ module Pkg = struct
let files_dir package_name maybe_package_version ~lock_dir =
match files_dir_generic package_name maybe_package_version ~lock_dir with
| In_source_tree _ as path -> path
| other ->
Code_error.raise "file_dir is not a source path" [ "path", Path.to_dyn other ]
| In_build_dir _ as path -> path
| External e ->
Code_error.raise
"file_dir is an external path, this is unsupported"
[ "path", Path.External.to_dyn e ]
;;

let source_files_dir package_name maybe_package_version ~lock_dir =
let source = in_source_tree lock_dir in
let package_name = Package_name.to_string package_name in
match maybe_package_version with
| Some package_version ->
Path.Source.relative
source
(sprintf "%s.%s.files" package_name (Package_version.to_string package_version))
| None -> Path.Source.relative source (sprintf "%s.files" package_name)
;;

(* Combine the platform-specific parts of a pair of [t]s, raising a code
Expand Down Expand Up @@ -1159,11 +1191,6 @@ let create_latest_version
}
;;

let dev_tool_lock_dir_path dev_tool =
let dev_tools_path = Path.(relative root "dev-tools.locks") in
Path.relative dev_tools_path (Package_name.to_string (Dev_tool.package_name dev_tool))
;;

let metadata_filename = "lock.dune"

module Metadata = Dune_sexp.Versioned_file.Make (Unit)
Expand Down Expand Up @@ -1451,7 +1478,6 @@ module Make_load (Io : sig
val parallel_map : 'a list -> f:('a -> 'b t) -> 'b list t
val readdir_with_kinds : Path.t -> (Filename.t * Unix.file_kind) list t
val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a t
val stats_kind : Path.t -> (File_kind.t, Unix_error.Detailed.t) result t
Copy link
Member

@rgrinberg rgrinberg Sep 5, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

How come this function went away?

Copy link
Collaborator Author

@Leonidas-from-XIV Leonidas-from-XIV Sep 16, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It was only used in check_path which was used to get information about a lock dir path. But given lock dirs are read from the build directory and created by copy rules (so either they exist because the rule exists or they don't which makes the build fail), there is nothing useful that check_path could communicate to the user anymore.

end) =
struct
let load_metadata metadata_file_path =
Expand Down Expand Up @@ -1534,36 +1560,6 @@ struct
package_name
;;

let check_path lock_dir_path =
let open Io.O in
Io.stats_kind lock_dir_path
>>| function
| Ok S_DIR -> Ok ()
| Error (Unix.ENOENT, _, _) ->
Error
(User_error.make
~hints:
[ Pp.concat
~sep:Pp.space
[ Pp.text "Run"
; User_message.command "dune pkg lock"
; Pp.text "to generate it."
]
|> Pp.hovbox
]
[ Pp.textf "%s does not exist." (Path.to_string lock_dir_path) ])
| Error e ->
Error
(User_error.make
[ Pp.textf "%s is not accessible" (Path.to_string lock_dir_path)
; Pp.textf "reason: %s" (Unix_error.Detailed.to_string_hum e)
])
| _ ->
Error
(User_error.make
[ Pp.textf "%s is not a directory." (Path.to_string lock_dir_path) ])
;;

let check_packages packages ~lock_dir_path =
match validate_packages packages with
| Ok () -> Ok ()
Expand Down Expand Up @@ -1600,56 +1596,52 @@ struct

let load lock_dir_path =
let open Io.O in
let* result = check_path lock_dir_path in
match result with
| Error e -> Io.return (Error e)
| Ok () ->
let* ( version
, dependency_hash
, ocaml
, repos
, expanded_solver_variable_bindings
, solved_for_platforms )
=
load_metadata (Path.relative lock_dir_path metadata_filename)
in
let portable_lock_dir, solved_for_platforms =
match solved_for_platforms with
| Some x -> true, x
| None -> false, (Loc.none, [])
in
let+ packages =
Io.readdir_with_kinds lock_dir_path
>>| List.filter_map ~f:(fun (name, (kind : Unix.file_kind)) ->
match kind with
| S_REG -> Package_filename.to_package_name_and_version name |> Result.to_option
| _ ->
(* TODO *)
None)
>>= Io.parallel_map ~f:(fun (package_name, maybe_package_version) ->
let _loc, solved_for_platforms = solved_for_platforms in
let+ pkg =
load_pkg
~portable_lock_dir
~version
~lock_dir_path
~solved_for_platforms
package_name
maybe_package_version
in
pkg)
>>| Packages.of_pkg_list
in
check_packages packages ~lock_dir_path
|> Result.map ~f:(fun () ->
{ version
; dependency_hash
; packages
; ocaml
; repos
; expanded_solver_variable_bindings
; solved_for_platforms
})
let* ( version
, dependency_hash
, ocaml
, repos
, expanded_solver_variable_bindings
, solved_for_platforms )
=
load_metadata (Path.relative lock_dir_path metadata_filename)
in
let portable_lock_dir, solved_for_platforms =
match solved_for_platforms with
| Some x -> true, x
| None -> false, (Loc.none, [])
in
let+ packages =
Io.readdir_with_kinds lock_dir_path
>>| List.filter_map ~f:(fun (name, (kind : Unix.file_kind)) ->
match kind with
| S_REG -> Package_filename.to_package_name_and_version name |> Result.to_option
| _ ->
(* TODO *)
None)
>>= Io.parallel_map ~f:(fun (package_name, maybe_package_version) ->
let _loc, solved_for_platforms = solved_for_platforms in
let+ pkg =
load_pkg
~portable_lock_dir
~version
~lock_dir_path
~solved_for_platforms
package_name
maybe_package_version
in
pkg)
>>| Packages.of_pkg_list
in
check_packages packages ~lock_dir_path
|> Result.map ~f:(fun () ->
{ version
; dependency_hash
; packages
; ocaml
; repos
; expanded_solver_variable_bindings
; solved_for_platforms
})
;;

let load_exn lock_dir_path =
Expand All @@ -1661,10 +1653,6 @@ end
module Load_immediate = Make_load (struct
include Monad.Id

let stats_kind file =
file |> Path.stat |> Result.map ~f:(fun { Unix.st_kind; _ } -> st_kind)
;;

let parallel_map xs ~f = List.map xs ~f

let readdir_with_kinds path =
Expand Down Expand Up @@ -1752,6 +1740,15 @@ let merge_conditionals a b =
{ a with packages; solved_for_platforms }
;;

let loc_in_source_tree loc =
loc
|> Loc.map_pos ~f:(fun ({ pos_fname; _ } as pos) ->
let path = Path.of_string pos_fname in
let new_path = in_source_tree path in
let pos_fname = Path.Source.to_string new_path in
{ pos with pos_fname })
;;

let check_if_solved_for_platform { solved_for_platforms; _ } ~platform =
let loc, solved_for_platforms = solved_for_platforms in
if List.is_empty solved_for_platforms
Expand All @@ -1763,6 +1760,7 @@ let check_if_solved_for_platform { solved_for_platforms; _ } ~platform =
match Solver_env_disjunction.matches_platform solved_for_platforms ~platform with
| true -> ()
| false ->
let loc = loc_in_source_tree loc in
User_error.raise
~loc
[ Pp.text
Expand Down
Loading
Loading