Skip to content

Commit

Permalink
feature(pkg): introduce lock_directory stanza in workspace (#9319)
Browse files Browse the repository at this point in the history 
This allows us to decouple solver settings from contexts and share the
same lock directory in multiple contexts.

Signed-off-by: Rudi Grinberg <[email protected]>
  • Loading branch information
@rgrinberg
rgrinberg authored Nov 30, 2023
1 parent 67bbd0c commit 4356274
Show file tree
Hide file tree
Showing 14 changed files with 208 additions and 139 deletions.
69 changes: 30 additions & 39 deletions bin/pkg/pkg_common.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,32 @@ module Per_context = struct
|> Dune_pkg.Pkg_workspace.Repository.Name.Map.of_list_exn
;;

let make_solver workspace context_common ~version_preference_arg ~lock =
let lock_dir_path = Option.value lock ~default:Dune_pkg.Lock_dir.default_path in
let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
let solver_sys_vars =
Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.solver_sys_vars)
in
let version_preference_context =
Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.version_preference)
in
let repositories =
Option.map lock_dir ~f:(fun lock_dir -> lock_dir.repositories)
|> Option.value
~default:[ Dune_pkg.Pkg_workspace.Repository.Name.of_string "default" ]
in
{ lock_dir_path
; version_preference =
Version_preference.choose
~from_arg:version_preference_arg
~from_context:version_preference_context
; context_common
; solver_sys_vars
; repositories
; repos = repositories_of_workspace workspace
}
;;

let choose ~context_name_arg ~all_contexts_arg ~version_preference_arg =
let open Fiber.O in
match context_name_arg, all_contexts_arg with
Expand All @@ -82,26 +108,8 @@ module Per_context = struct
"Unknown build context: %s"
(Dune_engine.Context_name.to_string context_name |> String.maybe_quoted)
]
| Some
(Default
{ lock
; version_preference = version_preference_context
; solver_sys_vars
; repositories
; base = context_common
; _
}) ->
[ { lock_dir_path = Option.value lock ~default:Lock_dir.default_path
; version_preference =
Version_preference.choose
~from_arg:version_preference_arg
~from_context:version_preference_context
; solver_sys_vars
; repositories
; context_common
; repos = repositories_of_workspace workspace
}
]
| Some (Default { lock; base = context_common; _ }) ->
[ make_solver workspace context_common ~version_preference_arg ~lock ]
| Some (Opam _) ->
User_error.raise
[ Pp.textf
Expand All @@ -111,25 +119,8 @@ module Per_context = struct
| None, true ->
let+ workspace = Memo.run (Workspace.workspace ()) in
List.filter_map workspace.contexts ~f:(function
| Workspace.Context.Default
{ lock
; version_preference = version_preference_context
; base = context_common
; solver_sys_vars
; repositories
} ->
let lock_dir_path = Option.value lock ~default:Dune_pkg.Lock_dir.default_path in
Some
{ lock_dir_path
; version_preference =
Version_preference.choose
~from_arg:version_preference_arg
~from_context:version_preference_context
; context_common
; solver_sys_vars
; repositories
; repos = repositories_of_workspace workspace
}
| Workspace.Context.Default { lock; base = context_common } ->
Some (make_solver workspace context_common ~version_preference_arg ~lock)
| Opam _ -> None)
;;
end
Expand Down
3 changes: 1 addition & 2 deletions src/dune_rules/context.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -599,8 +599,7 @@ module Group = struct
match context with
| Opam { base; switch } ->
create_for_opam builder ~switch ~loc:base.loc ~targets:base.targets
| Default
{ lock; version_preference = _; solver_sys_vars = _; repositories = _; base } ->
| Default { lock; base } ->
let builder =
match builder.findlib_toolchain with
| Some _ -> builder
Expand Down
147 changes: 95 additions & 52 deletions src/dune_rules/workspace.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,73 @@ open Import
open Dune_lang.Decoder
module Repository = Dune_pkg.Pkg_workspace.Repository

module Lock_dir = struct
type t =
{ path : Path.Source.t
; version_preference : Dune_pkg.Version_preference.t option
; solver_sys_vars : Dune_pkg.Solver_env.Variable.Sys.Bindings.t option
; repositories : Dune_pkg.Pkg_workspace.Repository.Name.t list
}

let to_dyn { path; version_preference; solver_sys_vars; repositories } =
Dyn.record
[ "path", Path.Source.to_dyn path
; ( "version_preference"
, Dyn.option Dune_pkg.Version_preference.to_dyn version_preference )
; ( "solver_sys_vars"
, Dyn.option Dune_pkg.Solver_env.Variable.Sys.Bindings.to_dyn solver_sys_vars )
; ( "repositories"
, Dyn.list Dune_pkg.Pkg_workspace.Repository.Name.to_dyn repositories )
]
;;

let hash { path; version_preference; solver_sys_vars; repositories } =
Poly.hash (path, version_preference, solver_sys_vars, repositories)
;;

let equal { path; version_preference; solver_sys_vars; repositories } t =
Path.Source.equal path t.path
&& Option.equal
Dune_pkg.Version_preference.equal
version_preference
t.version_preference
&& Option.equal
Dune_pkg.Solver_env.Variable.Sys.Bindings.equal
solver_sys_vars
t.solver_sys_vars
&& List.equal Dune_pkg.Pkg_workspace.Repository.Name.equal repositories t.repositories
;;

let decode =
let repositories_of_ordered_set ordered_set =
Dune_lang.Ordered_set_lang.eval
ordered_set
~parse:(fun ~loc string ->
Dune_pkg.Pkg_workspace.Repository.Name.parse_string_exn (loc, string))
~eq:Dune_pkg.Pkg_workspace.Repository.Name.equal
~standard:[ Dune_pkg.Pkg_workspace.Repository.Name.of_string "default" ]
in
let decode =
let+ path =
field_o "path" (Dune_lang.Path.Local.decode ~dir:Path.root)
>>| function
| None -> Path.Source.(relative root "dune.lock")
| Some p -> Path.as_in_source_tree_exn p
and+ solver_sys_vars =
field_o "solver_sys_vars" Dune_pkg.Solver_env.Variable.Sys.Bindings.decode
and+ version_preference =
field_o "version_preference" Dune_pkg.Version_preference.decode
and+ repositories = Dune_lang.Ordered_set_lang.field "repositories" in
{ path
; solver_sys_vars
; version_preference
; repositories = repositories_of_ordered_set repositories
}
in
fields decode
;;
end

(* workspace files use the same version numbers as dune-project files for
simplicity *)
let syntax = Stanza.syntax
Expand Down Expand Up @@ -280,33 +347,14 @@ module Context = struct
type t =
{ base : Common.t
; lock : Path.Source.t option
; version_preference : Dune_pkg.Version_preference.t option
; solver_sys_vars : Dune_pkg.Solver_env.Variable.Sys.Bindings.t option
; repositories : Dune_pkg.Pkg_workspace.Repository.Name.t list
}

let to_dyn { base; lock; version_preference; solver_sys_vars; repositories } =
let to_dyn { base; lock } =
Dyn.record
[ "base", Common.to_dyn base
; "lock", Dyn.(option Path.Source.to_dyn) lock
; ( "version_preference"
, Dyn.option Dune_pkg.Version_preference.to_dyn version_preference )
; ( "solver_sys_vars"
, Dyn.option Dune_pkg.Solver_env.Variable.Sys.Bindings.to_dyn solver_sys_vars )
; ( "repositories"
, Dyn.list Dune_pkg.Pkg_workspace.Repository.Name.to_dyn repositories )
]
[ "base", Common.to_dyn base; "lock", Dyn.(option Path.Source.to_dyn) lock ]
;;

let decode =
let repositories_of_ordered_set ordered_set =
Dune_lang.Ordered_set_lang.eval
ordered_set
~parse:(fun ~loc string ->
Dune_pkg.Pkg_workspace.Repository.Name.parse_string_exn (loc, string))
~eq:Dune_pkg.Pkg_workspace.Repository.Name.equal
~standard:[ Dune_pkg.Pkg_workspace.Repository.Name.of_string "default" ]
in
let+ common = Common.decode
and+ name =
field_o "name" (Dune_lang.Syntax.since syntax (1, 10) >>> Context_name.decode)
Expand All @@ -316,12 +364,7 @@ module Context = struct
2. allow external paths
*)
field_o "lock" (Dune_lang.Path.Local.decode ~dir:(Path.source Path.Source.root))
and+ version_preference =
field_o "version_preference" Dune_pkg.Version_preference.decode
and+ solver_sys_vars =
field_o "solver_sys_vars" Dune_pkg.Solver_env.Variable.Sys.Bindings.decode
and+ repositories_osl = Dune_lang.Ordered_set_lang.field "repositories" in
let repositories = repositories_of_ordered_set repositories_osl in
in
let lock = Option.map lock ~f:Path.as_in_source_tree_exn in
fun ~profile_default ~instrument_with_default ~x ->
let common = common ~profile_default ~instrument_with_default in
Expand All @@ -332,24 +375,11 @@ module Context = struct
in
let name = Option.value ~default name in
let base = { common with targets = Target.add common.targets x; name } in
{ base; lock; version_preference; solver_sys_vars; repositories }
{ base; lock }
;;

let equal { base; lock; version_preference; solver_sys_vars; repositories } t =
Common.equal base t.base
&& Option.equal Path.Source.equal lock t.lock
&& Option.equal
Dune_pkg.Version_preference.equal
version_preference
t.version_preference
&& Option.equal
Dune_pkg.Solver_env.Variable.Sys.Bindings.equal
solver_sys_vars
t.solver_sys_vars
&& List.equal
Dune_pkg.Pkg_workspace.Repository.Name.equal
repositories
t.repositories
let equal { base; lock } t =
Common.equal base t.base && Option.equal Path.Source.equal lock t.lock
;;
end

Expand Down Expand Up @@ -413,9 +443,6 @@ module Context = struct
let default ~x ~profile ~instrument_with =
Default
{ lock = None
; version_preference = None
; solver_sys_vars = None
; repositories = [ Dune_pkg.Pkg_workspace.Repository.Name.of_string "default" ]
; base =
{ loc = Loc.of_pos __POS__
; targets = [ Option.value x ~default:Target.Native ]
Expand Down Expand Up @@ -451,34 +478,42 @@ type t =
; env : Dune_env.Stanza.t option
; config : Dune_config.t
; repos : Dune_pkg.Pkg_workspace.Repository.t list
; lock_dirs : Lock_dir.t list
}

let to_dyn { merlin_context; contexts; env; config; repos } =
let to_dyn { merlin_context; contexts; env; config; repos; lock_dirs } =
let open Dyn in
record
[ "merlin_context", option Context_name.to_dyn merlin_context
; "contexts", list Context.to_dyn contexts
; "env", option Dune_env.Stanza.to_dyn env
; "config", Dune_config.to_dyn config
; "repos", list Repository.to_dyn repos
; "solver", (list Lock_dir.to_dyn) lock_dirs
]
;;

let equal { merlin_context; contexts; env; config; repos } w =
let equal { merlin_context; contexts; env; config; repos; lock_dirs } w =
Option.equal Context_name.equal merlin_context w.merlin_context
&& List.equal Context.equal contexts w.contexts
&& Option.equal Dune_env.Stanza.equal env w.env
&& Dune_config.equal config w.config
&& List.equal Repository.equal repos w.repos
&& List.equal Lock_dir.equal lock_dirs w.lock_dirs
;;

let hash { merlin_context; contexts; env; config; repos } =
let hash { merlin_context; contexts; env; config; repos; lock_dirs } =
Poly.hash
( Option.hash Context_name.hash merlin_context
, List.hash Context.hash contexts
, Option.hash Dune_env.Stanza.hash env
, Dune_config.hash config
, List.hash Repository.hash repos )
, List.hash Repository.hash repos
, List.hash Lock_dir.hash lock_dirs )
;;

let find_lock_dir t path =
List.find t.lock_dirs ~f:(fun lock_dir -> Path.Source.equal lock_dir.path path)
;;

include Dune_lang.Versioned_file.Make (struct
Expand Down Expand Up @@ -628,7 +663,8 @@ let step1 clflags =
"instrument_with"
(lazy_ (Dune_lang.Syntax.since Stanza.syntax (2, 7) >>> repeat Lib_name.decode))
~default:(lazy []))
and+ config_from_workspace_file = Dune_config.decode_fields_of_workspace_file in
and+ config_from_workspace_file = Dune_config.decode_fields_of_workspace_file
and+ lock_dirs = multi_field "lock_dir" Lock_dir.decode in
let+ contexts = multi_field "context" (lazy_ Context.decode) in
let config =
create_final_config
Expand Down Expand Up @@ -694,7 +730,13 @@ let step1 clflags =
then Some Context_name.default
else None
in
{ merlin_context; contexts = top_sort (List.rev contexts); env; config; repos })
{ merlin_context
; contexts = top_sort (List.rev contexts)
; env
; config
; repos
; lock_dirs
})
in
{ Step1.t; config }
;;
Expand Down Expand Up @@ -724,6 +766,7 @@ let default clflags =
; env = None
; config
; repos = [ Repository.default ]
; lock_dirs = []
}
;;

Expand Down
17 changes: 14 additions & 3 deletions src/dune_rules/workspace.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,18 @@

open Import

module Lock_dir : sig
type t =
{ path : Path.Source.t
; version_preference : Dune_pkg.Version_preference.t option
; solver_sys_vars : Dune_pkg.Solver_env.Variable.Sys.Bindings.t option
; repositories : Dune_pkg.Pkg_workspace.Repository.Name.t list
}

val equal : t -> t -> bool
val to_dyn : t -> Dyn.t
end

module Context : sig
module Target : sig
type t =
Expand Down Expand Up @@ -47,9 +59,6 @@ module Context : sig
type t =
{ base : Common.t
; lock : Path.Source.t option
; version_preference : Dune_pkg.Version_preference.t option
; solver_sys_vars : Dune_pkg.Solver_env.Variable.Sys.Bindings.t option
; repositories : Dune_pkg.Pkg_workspace.Repository.Name.t list
}
end

Expand Down Expand Up @@ -81,11 +90,13 @@ type t = private
; env : Dune_env.Stanza.t option
; config : Dune_config.t
; repos : Dune_pkg.Pkg_workspace.Repository.t list
; lock_dirs : Lock_dir.t list
}

val equal : t -> t -> bool
val to_dyn : t -> Dyn.t
val hash : t -> int
val find_lock_dir : t -> Path.Source.t -> Lock_dir.t option

module Clflags : sig
type t =
Expand Down
Loading

0 comments on commit 4356274

Please sign in to comment.