From 37cf1b14e6ba4cea8277230b07e395a9e49ad0d3 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Mon, 15 May 2023 23:15:05 +1000 Subject: [PATCH 1/2] Update vendored opam Signed-off-by: Stephen Sherratt --- vendor/opam/src/state/opamEnv.ml | 138 +------------------ vendor/opam/src/state/opamEnv.mli | 14 -- vendor/opam/src/state/opamGlobalState.ml | 2 +- vendor/opam/src/state/opamRepositoryState.ml | 5 +- vendor/opam/src/state/opamStateConfig.ml | 10 +- vendor/opam/src/state/opamStateConfig.mli | 4 +- vendor/update-opam.sh | 2 +- 7 files changed, 12 insertions(+), 163 deletions(-) diff --git a/vendor/opam/src/state/opamEnv.ml b/vendor/opam/src/state/opamEnv.ml index 044835ad014..cf2db258cb9 100644 --- a/vendor/opam/src/state/opamEnv.ml +++ b/vendor/opam/src/state/opamEnv.ml @@ -468,7 +468,7 @@ let eval_string gt ?(set_opamswitch=false) switch = let opamroot_env = OpamStd.Option.Op.( OpamStateConfig.E.root () +! - OpamFilename.Dir.to_string OpamStateConfig.(default.root_dir) + OpamFilename.Dir.to_string OpamStateConfig.(Lazy.force default.root_dir) ) in if opamroot_cur <> opamroot_env then Some opamroot_cur @@ -530,19 +530,6 @@ let init_file = function | SH_pwsh _ | SH_win_cmd -> (* N/A because not present in `shells_list` yet *) "init.sh" -let complete_script = function - | SH_sh | SH_bash -> Some OpamScript.complete - | SH_zsh -> Some OpamScript.complete_zsh - | SH_csh | SH_fish -> None - | SH_pwsh _ | SH_win_cmd -> None - -let env_hook_script_base = function - | SH_sh | SH_bash -> Some OpamScript.env_hook - | SH_zsh -> Some OpamScript.env_hook_zsh - | SH_csh -> Some OpamScript.env_hook_csh - | SH_fish -> Some OpamScript.env_hook_fish - | SH_pwsh _ | SH_win_cmd -> None - let export_in_shell shell = let make_comment comment_opt = OpamStd.Option.to_string (Printf.sprintf "# %s\n") comment_opt @@ -593,12 +580,6 @@ let export_in_shell shell = | SH_pwsh _ -> pwsh | SH_win_cmd -> win_cmd -let env_hook_script shell = - OpamStd.Option.map (fun script -> - export_in_shell shell ("OPAMNOENVNOTICE", "true", None) - ^ script) - (env_hook_script_base shell) - let source root shell f = let fname = OpamFilename.to_string (OpamPath.init root // f) in match shell with @@ -686,32 +667,6 @@ let write_init_shell_scripts root = in List.iter (write_script (OpamPath.init root)) scripts -let write_static_init_scripts root ?completion ?env_hook ?(inplace=false) () = - write_init_shell_scripts root; - let update_scripts filef scriptf enable = - let scripts = - OpamStd.List.filter_map (fun shell -> - match filef shell, scriptf shell with - | Some f, Some s -> Some (f, s) - | _ -> None) - shells_list - in - match enable, inplace with - | Some true, _ -> - List.iter (write_script (OpamPath.init root)) scripts - | _, true -> - List.iter (fun ((f,_) as fs) -> - if OpamFilename.exists (OpamPath.init root // f) then - write_script (OpamPath.init root) fs) - scripts - | Some false, _ -> - List.iter (fun (f,_) -> - OpamFilename.remove (OpamPath.init root // f)) scripts - | None, _ -> () - in - update_scripts complete_file complete_script completion; - update_scripts env_hook_file env_hook_script env_hook - let write_custom_init_scripts root custom = let hookdir = OpamPath.hooks_dir root in let kind = `MD5 in @@ -828,97 +783,6 @@ let check_and_print_env_warning st = (OpamConsole.colorise `bold (eval_string st.switch_global (Some st.switch))) -let setup - root ~interactive ?dot_profile ?update_config ?env_hook ?completion - ?inplace shell = - let opam_root_msg = - let current = OpamFilename.prettify_dir root in - if root = OpamStateConfig.(default.root_dir) then - current - else - let default = OpamFilename.prettify_dir OpamStateConfig.(default.root_dir) in - Printf.sprintf "your opam root\n (%s by default; currently %s)" default current - in - let shell, update_dot_profile, env_hook = - match update_config, dot_profile, interactive with - | Some false, _, _ -> shell, None, env_hook - | _, None, _ -> invalid_arg "OpamEnv.setup" - | Some true, Some dot_profile, _ -> shell, Some dot_profile, env_hook - | None, _, false -> shell, None, env_hook - | None, Some dot_profile, true -> - OpamConsole.header_msg "Required setup - please read"; - - OpamConsole.msg - "\n\ - \ In normal operation, opam only alters files within %s.\n\ - \n\ - \ However, to best integrate with your system, some environment variables\n\ - \ should be set. If you allow it to, this initialisation step will update\n\ - \ your %s configuration by adding the following line to %s:\n\ - \n\ - \ %s\ - \n\ - \ You can always re-run this setup with 'opam init' later.\n\n" - opam_root_msg - (OpamConsole.colorise `bold @@ string_of_shell shell) - (OpamConsole.colorise `cyan @@ OpamFilename.prettify dot_profile) - (OpamConsole.colorise `bold @@ source root shell (init_file shell)); - if OpamCoreConfig.answer_is_yes () then begin - OpamConsole.warning "Shell not updated in non-interactive mode: use --shell-setup"; - shell, None, env_hook - end else - let rec menu shell dot_profile default = - let opam_env_inv = - OpamConsole.colorise `bold @@ shell_eval_invocation shell (opam_env_invocation shell) - in - match - OpamConsole.menu "Do you want opam to configure %s?" - (OpamConsole.colorise `bold (string_of_shell shell)) - ~default ~no:`No ~options:[ - `Yes, Printf.sprintf "Yes, update %s" - (OpamConsole.colorise `cyan (OpamFilename.prettify dot_profile)); - `No_hooks, Printf.sprintf "Yes, but don't setup any hooks. You'll \ - have to run %s whenever you change \ - your current 'opam switch'" - opam_env_inv; - `Change_shell, "Select a different shell"; - `Change_file, "Specify another config file to update instead"; - `No, Printf.sprintf "No, I'll remember to run %s when I need opam" - opam_env_inv; - ] - with - | `No -> shell, None, env_hook - | `Yes -> shell, Some dot_profile, Some true - | `No_hooks -> shell, Some dot_profile, Some false - | `Change_shell -> - let shell = OpamConsole.menu ~default:shell ~no:shell - "Please select a shell to configure" - ~options: (List.map (fun s -> s, string_of_shell s) OpamStd.Sys.all_shells) - in - menu shell (OpamFilename.of_string (OpamStd.Sys.guess_dot_profile shell)) - default - | `Change_file -> - let open OpamStd.Option.Op in - let dot_profile = - (OpamConsole.read "Enter the name of the file to update:" - >>| (fun f -> - if Filename.is_implicit f then Filename.concat (OpamStd.Sys.home ()) f - else f) - >>| OpamFilename.of_string) - +! dot_profile - in - menu shell dot_profile `Yes - in - let default = match env_hook with - | Some true -> `Yes - | Some false -> `No_hooks - | None -> `No - in - menu shell dot_profile default - in - update_user_setup root ?dot_profile:update_dot_profile shell; - write_static_init_scripts root ?completion ?env_hook ?inplace () - let hook_env root = let hook_vnam = OpamVariable.of_string "hooks" in let hook_vval = Some (OpamVariable.dirname (OpamPath.hooks_dir root)) in diff --git a/vendor/opam/src/state/opamEnv.mli b/vendor/opam/src/state/opamEnv.mli index 3e9c9e021d7..30e895f981a 100644 --- a/vendor/opam/src/state/opamEnv.mli +++ b/vendor/opam/src/state/opamEnv.mli @@ -99,13 +99,6 @@ val env_expansion: ?opam:OpamFile.OPAM.t -> 'a switch_state -> env_update -> env (** {2 Shell and initialisation support} *) -(** Sets the opam configuration in the user shell, after detailing the process - and asking the user if either [update_config] or [shell_hook] are unset *) -val setup: - dirname -> interactive:bool -> ?dot_profile:filename -> - ?update_config:bool -> ?env_hook:bool -> ?completion:bool -> ?inplace:bool -> - shell -> unit - (* (\** Display the global and user configuration for OPAM. *\) * val display_setup: dirname -> dot_profile:filename -> shell -> unit *) @@ -113,13 +106,6 @@ val setup: val update_user_setup: dirname -> ?dot_profile:filename -> shell -> unit -(** Write the generic scripts in ~/.opam/opam-init needed to import state for - various shells. If specified, completion and env_hook files can also be - written or removed (the default is to keep them as they are). If [inplace] - is true, they are updated if they exist. *) -val write_static_init_scripts: - dirname -> ?completion:bool -> ?env_hook:bool -> ?inplace:bool -> unit -> unit - (** Write into [OpamPath.hooks_dir] the given custom scripts (listed as (filename, content)), normally provided by opamrc ([OpamFile.InitConfig]) *) val write_custom_init_scripts: diff --git a/vendor/opam/src/state/opamGlobalState.ml b/vendor/opam/src/state/opamGlobalState.ml index 2503dc93e6d..357bc23333d 100644 --- a/vendor/opam/src/state/opamGlobalState.ml +++ b/vendor/opam/src/state/opamGlobalState.ml @@ -43,7 +43,7 @@ let load_config lock_kind global_lock root = let inferred_from_system = "Inferred from system" let load lock_kind = - let root = OpamStateConfig.(!r.root_dir) in + let root = Lazy.force OpamStateConfig.(!r.root_dir) in log "LOAD-GLOBAL-STATE %@ %a" (slog OpamFilename.Dir.to_string) root; (* Always take a global read lock, this is only used to prevent concurrent ~/.opam format changes *) diff --git a/vendor/opam/src/state/opamRepositoryState.ml b/vendor/opam/src/state/opamRepositoryState.ml index f3f84343bb5..bca3c55e4d5 100644 --- a/vendor/opam/src/state/opamRepositoryState.ml +++ b/vendor/opam/src/state/opamRepositoryState.ml @@ -28,7 +28,7 @@ module Cache = struct end) let remove () = - let root = OpamStateConfig.(!r.root_dir) in + let root = Lazy.force OpamStateConfig.(!r.root_dir) in let cache_dir = OpamPath.state_cache_dir root in let remove_cache_file file = if OpamFilename.check_suffix file ".cache" then @@ -301,10 +301,9 @@ let check_last_update () = if OpamCoreConfig.(!r.debug_level) < 0 then () else let last_update = OpamFilename.written_since - (OpamPath.state_cache (OpamStateConfig.(!r.root_dir))) + (OpamPath.state_cache (Lazy.force OpamStateConfig.(!r.root_dir))) in if last_update > float_of_int (3600*24*21) then OpamConsole.note "It seems you have not updated your repositories \ for a while. Consider updating them with:\n%s\n" (OpamConsole.colorise `bold "opam update"); - diff --git a/vendor/opam/src/state/opamStateConfig.ml b/vendor/opam/src/state/opamStateConfig.ml index 6d1eea5ac7a..2e9015ea937 100644 --- a/vendor/opam/src/state/opamStateConfig.ml +++ b/vendor/opam/src/state/opamStateConfig.ml @@ -52,7 +52,7 @@ module E = struct end type t = { - root_dir: OpamFilename.Dir.t; + root_dir: OpamFilename.Dir.t lazy_t; current_switch: OpamSwitch.t option; switch_from: provenance; jobs: int Lazy.t; @@ -70,7 +70,7 @@ type t = { } let default = { - root_dir = ( + root_dir = lazy ( (* On Windows, if a .opam directory is found in %HOME% or %USERPROFILE% then then we'll use it. Otherwise, we use %LOCALAPPDATA%. *) let home_location = @@ -144,7 +144,7 @@ let setk k t = let (+) x opt = match opt with Some x -> x | None -> x in k { - root_dir = t.root_dir + root_dir; + root_dir = OpamCompat.Lazy.map (fun r -> r + root_dir) t.root_dir; current_switch = (match current_switch with None -> t.current_switch | s -> s); switch_from = t.switch_from + switch_from; @@ -202,7 +202,7 @@ let opamroot ?root_dir () = let open OpamStd.Option.Op in (root_dir >>+ fun () -> OpamStd.Env.getopt "OPAMROOT" >>| OpamFilename.Dir.of_string) - +! default.root_dir + +! (Lazy.force default.root_dir) let is_newer_raw = function | Some v -> @@ -396,7 +396,7 @@ let load_defaults ?lock_kind root_dir = let get_switch_opt () = match !r.current_switch with | Some s -> - Some (resolve_local_switch !r.root_dir s) + Some (resolve_local_switch (Lazy.force !r.root_dir) s) | None -> None let get_switch () = diff --git a/vendor/opam/src/state/opamStateConfig.mli b/vendor/opam/src/state/opamStateConfig.mli index 85498a23eff..0e0502bec6c 100644 --- a/vendor/opam/src/state/opamStateConfig.mli +++ b/vendor/opam/src/state/opamStateConfig.mli @@ -37,10 +37,10 @@ module E : sig end type t = private { - root_dir: OpamFilename.Dir.t; + root_dir: OpamFilename.Dir.t Lazy.t; current_switch: OpamSwitch.t option; switch_from: provenance; - jobs: int Lazy.t; + jobs: int lazy_t; dl_jobs: int; build_test: bool; build_doc: bool; diff --git a/vendor/update-opam.sh b/vendor/update-opam.sh index 078fc3860ef..a11e98e93c0 100755 --- a/vendor/update-opam.sh +++ b/vendor/update-opam.sh @@ -1,6 +1,6 @@ #!/usr/bin/env bash -version=cc62e68712e04def2716a1808d515160b2917b19 +version=69bcb51db15e27563583bddb8edf5c505ae6e10f set -e -o pipefail From 2ab6ac75bd4c34a8da4a7236e128a3984e8aef6f Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Mon, 15 May 2023 23:23:57 +1000 Subject: [PATCH 2/2] Conservative implementation of lockfile generation Adds a command `dune pkg lock` which generates a lock directory. Currently the user must specify a path to a local checkout of opam-repository, there is no way to override opam variables (though it's possible to clear them all), and only a subset of lockfile fields are set. Signed-off-by: Stephen Sherratt --- bin/dune | 4 +- bin/main.ml | 1 + bin/pkg.ml | 115 +++++++++ bin/pkg.mli | 3 + boot/libs.ml | 5 + doc/dune.inc | 9 + src/dune_pkg/dune | 4 +- src/dune_pkg/dune_pkg.ml | 1 + src/dune_pkg/lock_dir.ml | 135 +++++++++-- src/dune_pkg/lock_dir.mli | 4 + src/dune_pkg/opam.ml | 218 ++++++++++++++++++ src/dune_pkg/opam.mli | 38 +++ src/dune_rules/dune_rules.ml | 1 + src/dune_rules/package.ml | 51 ++++ src/dune_rules/package.mli | 13 ++ .../packages/bar/bar.0.0.1/opam | 1 + .../packages/bar/bar.0.4.0/opam | 1 + .../packages/bar/bar.0.5.0/opam | 1 + .../packages/baz/baz.0.0.1/opam | 1 + .../packages/baz/baz.0.1.0/opam | 1 + .../packages/foo/foo.0.0.1/opam | 5 + .../mock-opam-repository/repo | 1 + .../pkg/lockfile-generation.t/run.t | 73 ++++++ 23 files changed, 663 insertions(+), 23 deletions(-) create mode 100644 bin/pkg.ml create mode 100644 bin/pkg.mli create mode 100644 src/dune_pkg/opam.ml create mode 100644 src/dune_pkg/opam.mli create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.0.1/opam create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.4.0/opam create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.5.0/opam create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.0.1/opam create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.1.0/opam create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/foo/foo.0.0.1/opam create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/repo create mode 100644 test/blackbox-tests/test-cases/pkg/lockfile-generation.t/run.t diff --git a/bin/dune b/bin/dune index c5db0a4ee82..a3d95349215 100644 --- a/bin/dune +++ b/bin/dune @@ -25,6 +25,7 @@ dune_engine dune_util dune_upgrader + dune_pkg cmdliner threads ; Kept to keep implicit_transitive_deps false working in 4.x @@ -39,7 +40,8 @@ dune_rules_rpc dune_rpc_private dune_rpc_client - spawn) + spawn + opam_format) (bootstrap_info bootstrap-info)) ; Installing the dune binary depends on the kind of build: diff --git a/bin/main.ml b/bin/main.ml index a66ba690729..f898f96476d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -36,6 +36,7 @@ let all : _ Cmdliner.Cmd.t list = ; Internal.group ; Init.group ; Promotion.group + ; Pkg.group ] in terms @ groups diff --git a/bin/pkg.ml b/bin/pkg.ml new file mode 100644 index 00000000000..f28734e2636 --- /dev/null +++ b/bin/pkg.ml @@ -0,0 +1,115 @@ +open Stdune +open Import +module Lock_dir = Dune_pkg.Lock_dir + +module Lock = struct + module Repo = struct + open Dune_pkg.Opam.Repo + + let term = + let+ opam_repository_path = + Arg.( + required + & opt (some string) None + & info [ "opam-repository-path" ] ~docv:"PATH" + ~doc: + "Path to a local opam repository. This should be a directory \ + containing a valid opam repository such as the one at \ + https://github.com/ocaml/opam-repository.") + in + of_opam_repo_dir_path opam_repository_path + end + + module Env = struct + module Source = struct + type t = + | Global + | Pure + + let to_string = function + | Global -> "global" + | Pure -> "pure" + + let default = Global + + let term = + let all = [ Global; Pure ] in + let all_with_strings = List.map all ~f:(fun t -> (to_string t, t)) in + let all_strings = List.map all_with_strings ~f:fst in + let doc = + sprintf + "How to initialize the opam environment. Possible values are %s. \ + '%s' will use the environment associated with the current opam \ + switch. '%s' will use an empty environment. The default is '%s'." + (String.enumerate_and all_strings) + (to_string Global) (to_string Pure) (to_string default) + in + Arg.( + value + & opt (some (enum all_with_strings)) None + & info [ "opam-env" ] ~doc) + end + + open Dune_pkg.Opam.Env + + let term = + let+ source = Source.term in + match Option.value source ~default:Source.default with + | Global -> global () + | Pure -> empty + end + + (* Converts the package table found inside a [Dune_project.t] into the + package table expected by the dependency solver *) + let opam_file_map_of_dune_package_map + (dune_package_map : Package.t Package.Name.Map.t) : + OpamFile.OPAM.t OpamTypes.name_map = + Package.Name.Map.to_list_map dune_package_map + ~f:(fun dune_package_name dune_package -> + let opam_package_name = + Package.Name.to_opam_package_name dune_package_name + in + let opam_file = Package.to_opam_file dune_package in + (opam_package_name, opam_file)) + |> OpamPackage.Name.Map.of_list + + let term = + let+ (common : Common.t) = Common.term + and+ env = Env.term + and+ repo = Repo.term in + let config = Common.init common in + Scheduler.go ~common ~config (fun () -> + let open Fiber.O in + let* source_dir = Memo.run (Source_tree.root ()) in + let project = Source_tree.Dir.project source_dir in + let dune_package_map = Dune_project.packages project in + let opam_file_map = + opam_file_map_of_dune_package_map dune_package_map + in + let lock_dir_path = Lock_dir.path in + let summary, lock_dir = + Dune_pkg.Opam.solve_lock_dir ~env ~repo ~lock_dir_path opam_file_map + in + Console.print_user_message + (Dune_pkg.Opam.Summary.selected_packages_message summary); + Lock_dir.write_disk ~lock_dir_path lock_dir; + Fiber.return ()) + + let info = + let doc = "Create a lockfile" in + Cmd.info "lock" ~doc + + let command = Cmd.v info term +end + +let info = + let doc = "Experimental package management" in + let man = + [ `S "DESCRIPTION" + ; `P {|Commands for doing package management with dune|} + ; `Blocks Common.help_secs + ] + in + Cmd.info "pkg" ~doc ~man + +let group = Cmd.group info [ Lock.command ] diff --git a/bin/pkg.mli b/bin/pkg.mli new file mode 100644 index 00000000000..d4c5902fcd6 --- /dev/null +++ b/bin/pkg.mli @@ -0,0 +1,3 @@ +open Import + +val group : unit Cmd.t diff --git a/boot/libs.ml b/boot/libs.ml index e5f6942b7ea..6f80ffd3d7d 100644 --- a/boot/libs.ml +++ b/boot/libs.ml @@ -59,6 +59,11 @@ let local_libraries = ; ("src/dune_file_watcher", Some "Dune_file_watcher", false, None) ; ("src/dune_engine", Some "Dune_engine", false, None) ; ("vendor/opam/src/repository", None, false, None) + ; ("vendor/opam/src/state", None, false, None) + ; ("vendor/0install-solver/src/solver", Some "Zeroinstall_solver", false, + None) + ; ("vendor/fmt/src", None, false, None) + ; ("vendor/opam-0install/lib", Some "Opam_0install", false, None) ; ("src/dune_pkg", Some "Dune_pkg", false, None) ; ("src/dune_vcs", Some "Dune_vcs", false, None) ; ("src/dune_threaded_console", Some "Dune_threaded_console", false, None) diff --git a/doc/dune.inc b/doc/dune.inc index 4114e955041..62dc3bd1d2c 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -170,6 +170,15 @@ (package dune) (files dune-ocaml-merlin.1)) +(rule + (with-stdout-to dune-pkg.1 + (run dune pkg --help=groff))) + +(install + (section man) + (package dune) + (files dune-pkg.1)) + (rule (with-stdout-to dune-printenv.1 (run dune printenv --help=groff))) diff --git a/src/dune_pkg/dune b/src/dune_pkg/dune index d55160d720d..cd28813aa0d 100644 --- a/src/dune_pkg/dune +++ b/src/dune_pkg/dune @@ -9,6 +9,8 @@ dune_lang opam_core opam_repository - opam_format) + opam_format + opam_state + opam_0install) (instrumentation (backend bisect_ppx))) diff --git a/src/dune_pkg/dune_pkg.ml b/src/dune_pkg/dune_pkg.ml index 9115c3b9b02..a6c0b092b9c 100644 --- a/src/dune_pkg/dune_pkg.ml +++ b/src/dune_pkg/dune_pkg.ml @@ -1,3 +1,4 @@ module Fetch = Fetch module Checksum = Checksum module Lock_dir = Lock_dir +module Opam = Opam diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 10899c0abc5..df9b5d9365b 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -9,20 +9,30 @@ module Source = struct ; checksum : (Loc.t * Checksum.t) option } + module Fields = struct + let copy = "copy" + + let fetch = "fetch" + + let url = "url" + + let checksum = "checksum" + end + let decode = let open Dune_lang.Decoder in sum - [ ( "copy" + [ ( Fields.copy , located string >>| fun (loc, source) path -> External_copy ( loc , if Filename.is_relative source then Path.External.relative path source else Path.External.of_string source ) ) - ; ( "fetch" + ; ( Fields.fetch , enter @@ fields - @@ let+ url = field "url" (located string) - and+ checksum = field_o "checksum" (located string) in + @@ let+ url = field Fields.url (located string) + and+ checksum = field_o Fields.checksum (located string) in let checksum = match checksum with | None -> None @@ -33,6 +43,18 @@ module Source = struct in fun _ -> Fetch { url; checksum } ) ] + + let encode t = + let open Dune_lang.Encoder in + match t with + | External_copy (_loc, path) -> + constr Fields.copy string (Path.External.to_string path) + | Fetch { url = _loc, url; checksum } -> + record + [ (Fields.url, string url) + ; ( Fields.checksum + , (option Checksum.encode) (Option.map checksum ~f:snd) ) + ] end module Pkg_info = struct @@ -51,20 +73,25 @@ module Env_update = struct ; value : 'a } + let op_by_string = + [ ("=", OpamParserTypes.Eq) + ; ("+=", PlusEq) + ; ("=+", EqPlus) + ; (":=", ColonEq) + ; ("=:", EqColon) + ; ("=+=", EqPlusEq) + ] + let decode = let open Dune_lang.Decoder in - let env_update_op = - enum - [ ("=", OpamParserTypes.Eq) - ; ("+=", PlusEq) - ; ("=+", EqPlus) - ; (":=", ColonEq) - ; ("=:", EqColon) - ; ("=+=", EqPlusEq) - ] - in + let env_update_op = enum op_by_string in let+ op, var, value = triple env_update_op string String_with_vars.decode in { op; var; value } + + let encode { op; var; value } = + let open Dune_lang.Encoder in + let env_update_op = enum op_by_string in + triple env_update_op string String_with_vars.encode (op, var, value) end module Pkg = struct @@ -77,17 +104,33 @@ module Pkg = struct ; exported_env : String_with_vars.t Env_update.t list } + module Fields = struct + let version = "version" + + let install = "install" + + let build = "build" + + let deps = "deps" + + let source = "source" + + let dev = "dev" + + let exported_env = "exported_env" + end + let decode = let open Dune_lang.Decoder in enter @@ fields - @@ let+ version = field ~default:"dev" "version" string - and+ install_command = field_o "install" Dune_lang.Action.decode_pkg - and+ build_command = field_o "build" Dune_lang.Action.decode_pkg - and+ deps = field ~default:[] "deps" (repeat Package_name.decode) - and+ source = field_o "source" Source.decode - and+ dev = field_b "dev" + @@ let+ version = field ~default:"dev" Fields.version string + and+ install_command = field_o Fields.install Dune_lang.Action.decode_pkg + and+ build_command = field_o Fields.build Dune_lang.Action.decode_pkg + and+ deps = field ~default:[] Fields.deps (repeat Package_name.decode) + and+ source = field_o Fields.source Source.decode + and+ dev = field_b Fields.dev and+ exported_env = - field "exported_env" ~default:[] (repeat Env_update.decode) + field Fields.exported_env ~default:[] (repeat Env_update.decode) in fun ~lock_dir name -> let info = @@ -99,6 +142,25 @@ module Pkg = struct { Pkg_info.name; version; dev; source } in { build_command; deps; install_command; info; exported_env; lock_dir } + + let encode + { build_command + ; install_command + ; deps + ; info = { Pkg_info.name = _; version; dev; source } + ; lock_dir = _ + ; exported_env + } = + let open Dune_lang.Encoder in + record_fields + [ field Fields.version string version + ; field_o Fields.install Dune_lang.Action.encode install_command + ; field_o Fields.build Dune_lang.Action.encode build_command + ; field_l Fields.deps Package_name.encode deps + ; field_o Fields.source Source.encode source + ; field_b Fields.dev dev + ; field_l Fields.exported_env Env_update.encode exported_env + ] end type t = @@ -106,6 +168,10 @@ type t = ; packages : Pkg.t Package_name.Map.t } +let create_latest_version packages = + let version = Syntax.greatest_supported_version Dune_lang.Pkg.syntax in + { version; packages } + let path = Path.Source.(relative root "dune.lock") let metadata = "lock.dune" @@ -113,3 +179,30 @@ let metadata = "lock.dune" module Metadata = Dune_sexp.Versioned_file.Make (Unit) let () = Metadata.Lang.register Dune_lang.Pkg.syntax () + +let encode_metadata t = + let open Dune_lang.Encoder in + list sexp + [ string "lang" + ; string (Syntax.name Dune_lang.Pkg.syntax) + ; Dune_lang.Syntax.Version.encode t.version + ] + +let file_contents_by_path t = + (metadata, [ encode_metadata t ]) + :: (Package_name.Map.to_list t.packages + |> List.map ~f:(fun (name, pkg) -> + (Package_name.to_string name, Pkg.encode pkg))) + +let write_disk ~lock_dir_path t = + let lock_dir_path = Path.source lock_dir_path in + Path.rm_rf lock_dir_path; + Path.mkdir_p lock_dir_path; + file_contents_by_path t + |> List.iter ~f:(fun (path_within_lock_dir, contents) -> + let path = Path.relative lock_dir_path path_within_lock_dir in + Option.iter (Path.parent path) ~f:Path.mkdir_p; + let contents_string = + List.map contents ~f:Dune_lang.to_string |> String.concat ~sep:"\n" + in + Io.write_file path contents_string) diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index e0b0c055431..e4cab8d4be1 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -50,8 +50,12 @@ type t = ; packages : Pkg.t Package_name.Map.t } +val create_latest_version : Pkg.t Package_name.Map.t -> t + val path : Path.Source.t val metadata : Filename.t module Metadata : Dune_sexp.Versioned_file.S with type data := unit + +val write_disk : lock_dir_path:Path.Source.t -> t -> unit diff --git a/src/dune_pkg/opam.ml b/src/dune_pkg/opam.ml new file mode 100644 index 00000000000..c0ad4e4c375 --- /dev/null +++ b/src/dune_pkg/opam.ml @@ -0,0 +1,218 @@ +open Stdune +module Package_name = Dune_lang.Package_name + +module Repo = struct + let ( / ) = Filename.concat + + type t = { packages_dir_path : Filename.t } + + let validate_repo_file opam_repo_dir_path = + try + OpamFilename.raw (opam_repo_dir_path / "repo") + |> OpamFile.make |> OpamFile.Repo.read |> ignore + with OpamSystem.Internal_error message -> + User_error.raise [ Pp.text message ] + + let of_opam_repo_dir_path opam_repo_dir_path = + if not (Sys.file_exists opam_repo_dir_path) then + User_error.raise + [ Pp.textf "%s does not exist" (String.maybe_quoted opam_repo_dir_path) + ]; + if not (Sys.is_directory opam_repo_dir_path) then + User_error.raise + [ Pp.textf "%s is not a directory" + (String.maybe_quoted opam_repo_dir_path) + ]; + let packages_dir_path = opam_repo_dir_path / "packages" in + if + not + (Sys.file_exists packages_dir_path && Sys.is_directory packages_dir_path) + then + User_error.raise + [ Pp.textf + "%s doesn't look like a path to an opam repository as it lacks a \ + subdirectory named \"packages\"" + (String.maybe_quoted opam_repo_dir_path) + ]; + validate_repo_file opam_repo_dir_path; + { packages_dir_path } + + (* Return the path to an "opam" file describing a particular package + (name and version) from this opam repository. *) + let get_opam_file_path t opam_package = + t.packages_dir_path + / OpamPackage.name_to_string opam_package + / OpamPackage.to_string opam_package + / "opam" + + (* Reads an opam package definition from an "opam" file in this repository + corresponding to a package (name and version). *) + let load_opam_package t opam_package = + let opam_file_path = get_opam_file_path t opam_package in + if not (Sys.file_exists opam_file_path) then + User_error.raise + [ Pp.textf + "Couldn't find package file for \"%s\". It was expected to be \ + located in %s but this file does not exist" + (OpamPackage.to_string opam_package) + (String.maybe_quoted opam_file_path) + ]; + OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw opam_file_path)) +end + +module Env = struct + type t = OpamVariable.variable_contents OpamVariable.Map.t + + let empty : t = OpamVariable.Map.empty + + let global () : t = + OpamGlobalState.with_ `Lock_none (fun global_state -> + OpamVariable.Map.filter_map + (fun _variable (contents, _description) -> Lazy.force contents) + global_state.global_variables) + + let find_by_name (t : t) ~name = + OpamVariable.Map.find_opt (OpamVariable.of_string name) t +end + +(* A custom solver context based on [Opam_0install.Dir_context] with a set + of local packages (ie. the packages defined in the current project). + When looking up a package during solving, the local packages are + searched before falling back to packages defined in a directory in the + style of opam-repository. *) +module Solver_context = struct + module Dir_context = Opam_0install.Dir_context + + (* Version to use for local packages with no version number *) + let local_package_default_version = OpamPackage.Version.of_string "LOCAL" + + type t = + { dir_context : Dir_context.t + ; local_packages : OpamFile.OPAM.t OpamPackage.Name.Map.t + } + + type rejection = Dir_context.rejection + + let pp_rejection = Dir_context.pp_rejection + + let candidates t name = + match OpamPackage.Name.Map.find_opt name t.local_packages with + | None -> Dir_context.candidates t.dir_context name + | Some opam_file -> + let version = + Option.value opam_file.version ~default:local_package_default_version + in + [ (version, Ok opam_file) ] + + let user_restrictions t = Dir_context.user_restrictions t.dir_context + + let filter_deps t = Dir_context.filter_deps t.dir_context + + let create ~env ~repo ~local_packages = + let env name = Env.find_by_name env ~name in + let { Repo.packages_dir_path } = repo in + let dir_context = + Dir_context.create ~prefer_oldest:true + ~constraints:OpamPackage.Name.Map.empty ~env packages_dir_path + in + { dir_context; local_packages } +end + +module Solver = Opam_0install.Solver.Make (Solver_context) + +module Summary = struct + type t = { opam_packages_to_lock : OpamPackage.t list } + + let selected_packages_message t = + User_message.make + (Pp.tag User_message.Style.Success + (Pp.text "Selected the following packages:") + :: List.map t.opam_packages_to_lock ~f:(fun package -> + Pp.text (OpamPackage.to_string package))) +end + +let opam_package_to_lock_file_pkg ~repo ~local_packages ~lock_dir_path + opam_package = + let name = OpamPackage.name opam_package in + let version = + OpamPackage.version opam_package |> OpamPackage.Version.to_string + in + let dev = OpamPackage.Name.Map.mem name local_packages in + let info = + { Lock_dir.Pkg_info.name = + Package_name.of_string (OpamPackage.Name.to_string name) + ; version + ; dev + ; source = None + } + in + let opam_file = + match OpamPackage.Name.Map.find_opt name local_packages with + | None -> Repo.load_opam_package repo opam_package + | Some local_package -> local_package + in + (* This will collect all the atoms from the package's dependency formula regardless of conditions *) + let deps = + OpamFormula.fold_right + (fun acc (name, _condition) -> name :: acc) + [] opam_file.depends + |> List.map ~f:(fun name -> + Package_name.of_string (OpamPackage.Name.to_string name)) + in + { Lock_dir.Pkg.build_command = None + ; install_command = None + ; deps + ; info + ; lock_dir = lock_dir_path + ; exported_env = [] + } + +let solve_package_list local_packages ~env ~repo = + let context = Solver_context.create ~env ~repo ~local_packages in + let result = + try + (* [Solver.solve] returns [Error] when it's unable to find a solution to + the dependencies, but can also raise exceptions, for example if opam + is unable to parse an opam file in the package repository. To prevent + an unexpected opam exception from crashing dune, we catch all + exceptions raised by the solver and report them as [User_error]s + instead. *) + Solver.solve context (OpamPackage.Name.Map.keys local_packages) + with + | OpamPp.(Bad_format _ | Bad_format_list _ | Bad_version _) as bad_format -> + User_error.raise [ Pp.text (OpamPp.string_of_bad_format bad_format) ] + | unexpected_exn -> + Code_error.raise "Unexpected exception raised while solving dependencies" + [ ("exception", Exn.to_dyn unexpected_exn) ] + in + match result with + | Error e -> User_error.raise [ Pp.text (Solver.diagnostics e) ] + | Ok packages -> Solver.packages_of_result packages + +let solve_lock_dir ~env ~repo ~lock_dir_path local_packages = + let is_local_package package = + OpamPackage.Name.Map.mem (OpamPackage.name package) local_packages + in + let opam_packages_to_lock = + solve_package_list local_packages ~env ~repo + (* don't include local packages in the lock dir *) + |> List.filter ~f:(Fun.negate is_local_package) + in + let summary = { Summary.opam_packages_to_lock } in + let lock_dir = + List.map opam_packages_to_lock ~f:(fun opam_package -> + let pkg = + opam_package_to_lock_file_pkg ~repo ~local_packages ~lock_dir_path + opam_package + in + (pkg.info.name, pkg)) + |> Package_name.Map.of_list + |> function + | Error (name, _pkg1, _pkg2) -> + Code_error.raise + (sprintf "Solver selected multiple packages named \"%s\"" + (Package_name.to_string name)) + [] + | Ok pkgs_by_name -> Lock_dir.create_latest_version pkgs_by_name + in + (summary, lock_dir) diff --git a/src/dune_pkg/opam.mli b/src/dune_pkg/opam.mli new file mode 100644 index 00000000000..c27e4f96071 --- /dev/null +++ b/src/dune_pkg/opam.mli @@ -0,0 +1,38 @@ +open Stdune + +module Repo : sig + (** An opam repository *) + type t + + (** Create a [t] from a path to a local directory containing a opam + repository. Raises an exception if the directory is not a valid opam + repository. *) + val of_opam_repo_dir_path : Filename.t -> t +end + +module Env : sig + (** An opam environment consisting of assignments to variables (e.g. "arch" + and "os") *) + type t + + (** An environment containing no variables *) + val empty : t + + (** Create an environment matching that of the global opam installation. *) + val global : unit -> t +end + +module Summary : sig + (** Some intermediate state from the solve exposed for logging purposes *) + type t + + (** A message listing selected packages *) + val selected_packages_message : t -> User_message.t +end + +val solve_lock_dir : + env:Env.t + -> repo:Repo.t + -> lock_dir_path:Path.Source.t + -> OpamFile.OPAM.t OpamTypes.name_map + -> Summary.t * Lock_dir.t diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index dfc374df65f..426bcae86cc 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -61,6 +61,7 @@ module Sub_dirs = Sub_dirs module Package = Package module Section = Section module Dialect = Dialect +module Pkg_rules = Pkg_rules module Install_rules = struct let install_file = Install_rules.install_file diff --git a/src/dune_rules/package.ml b/src/dune_rules/package.ml index c7f1528b77e..28ed43cec1a 100644 --- a/src/dune_rules/package.ml +++ b/src/dune_rules/package.ml @@ -19,6 +19,11 @@ module Name = struct let version_fn (t : t) = to_string t ^ ".version" + let of_opam_package_name opam_package_name = + OpamPackage.Name.to_string opam_package_name |> of_string + + let to_opam_package_name t = to_string t |> OpamPackage.Name.of_string + module Infix = Comparator.Operators (String) module Map_traversals = Memo.Make_map_traversals (Map) end @@ -92,6 +97,10 @@ module Dependency = struct | Lt -> nopos `Lt | Neq -> nopos `Neq + let to_relop_pelem op = + let ({ pelem; _ } : OpamParserTypes.FullPos.relop) = to_relop op in + pelem + let encode x = let f (_, op) = equal x op in (* Assumes the [map] is complete, so exception is impossible *) @@ -122,6 +131,10 @@ module Dependency = struct in nopos value_kind + let to_opam_filter = function + | Literal literal -> OpamTypes.FString literal + | Var var -> OpamTypes.FIdent ([], OpamVariable.of_string var, None) + let to_dyn = function | Literal v -> Dyn.String v | Var v -> Dyn.String (":" ^ v) @@ -182,6 +195,23 @@ module Dependency = struct Bvar (Var (String.drop s 1)) | _ -> sum (ops @ logops)) + let rec to_opam_condition = function + | Bvar var -> OpamTypes.Atom (OpamTypes.Filter (Var.to_opam_filter var)) + | Uop (op, var) -> + OpamTypes.Atom + (OpamTypes.Constraint (Op.to_relop_pelem op, Var.to_opam_filter var)) + | Bop (op, lhs, rhs) -> + OpamTypes.Atom + (OpamTypes.Filter + (OpamTypes.FOp + ( Var.to_opam_filter lhs + , Op.to_relop_pelem op + , Var.to_opam_filter rhs ))) + | And conjunction -> + OpamFormula.ands (List.map conjunction ~f:to_opam_condition) + | Or disjunction -> + OpamFormula.ors (List.map disjunction ~f:to_opam_condition) + let rec to_dyn = let open Dyn in function @@ -240,6 +270,17 @@ module Dependency = struct | None -> pkg | Some c -> nopos (OpamParserTypes.FullPos.Option (pkg, nopos [ c ])) + let list_to_opam_filtered_formula ts = + List.map ts ~f:(fun { name; constraint_ } -> + let opam_package_name = Name.to_opam_package_name name in + let condition = + match constraint_ with + | None -> OpamTypes.Empty + | Some constraint_ -> Constraint.to_opam_condition constraint_ + in + OpamFormula.Atom (opam_package_name, condition)) + |> OpamFormula.ands + let to_dyn { name; constraint_ } = let open Dyn in record @@ -816,3 +857,13 @@ let missing_deps (t : t) ~effective_deps = |> Name.Set.of_list in Name.Set.diff effective_deps specified_deps + +let to_opam_file t = + let opam_package_name = name t |> Name.to_opam_package_name in + let depends = Dependency.list_to_opam_filtered_formula t.depends in + (* Currently this just creates an opam file with fields needed for dependency + solving with opam_0install but could easily be extended with more fields. + *) + OpamFile.OPAM.empty + |> OpamFile.OPAM.with_name opam_package_name + |> OpamFile.OPAM.with_depends depends diff --git a/src/dune_rules/package.mli b/src/dune_rules/package.mli index c3a1f08a9c2..97843b4b03f 100644 --- a/src/dune_rules/package.mli +++ b/src/dune_rules/package.mli @@ -13,6 +13,10 @@ module Name : sig val of_opam_file_basename : string -> t option + val of_opam_package_name : OpamTypes.name -> t + + val to_opam_package_name : t -> OpamTypes.name + module Map_traversals : sig val parallel_iter : 'a Map.t -> f:(t -> 'a -> unit Memo.t) -> unit Memo.t @@ -37,6 +41,8 @@ module Dependency : sig | Gt | Lt | Neq + + val to_relop : t -> OpamParserTypes.FullPos.relop end module Constraint : sig @@ -53,6 +59,8 @@ module Dependency : sig | Bop of Op.t * Var.t * Var.t | And of t list | Or of t list + + val to_dyn : t -> Dyn.t end type t = @@ -184,3 +192,8 @@ val default : Name.t -> Path.Source.t -> t val load_opam_file : Path.Source.t -> Name.t -> t Memo.t val missing_deps : t -> effective_deps:Name.Set.t -> Name.Set.t + +(** [to_opam_file t] returns an [OpamFile.OPAM.t] whose fields are based on the + fields of [t]. Note that this does not actually create a corresponding file + on disk. *) +val to_opam_file : t -> OpamFile.OPAM.t diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.0.1/opam b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.0.1/opam new file mode 100644 index 00000000000..013b84db617 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.0.1/opam @@ -0,0 +1 @@ +opam-version: "2.0" diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.4.0/opam b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.4.0/opam new file mode 100644 index 00000000000..013b84db617 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.4.0/opam @@ -0,0 +1 @@ +opam-version: "2.0" diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.5.0/opam b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.5.0/opam new file mode 100644 index 00000000000..013b84db617 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/bar/bar.0.5.0/opam @@ -0,0 +1 @@ +opam-version: "2.0" diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.0.1/opam b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.0.1/opam new file mode 100644 index 00000000000..013b84db617 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.0.1/opam @@ -0,0 +1 @@ +opam-version: "2.0" diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.1.0/opam b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.1.0/opam new file mode 100644 index 00000000000..013b84db617 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/baz/baz.0.1.0/opam @@ -0,0 +1 @@ +opam-version: "2.0" diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/foo/foo.0.0.1/opam b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/foo/foo.0.0.1/opam new file mode 100644 index 00000000000..99014682463 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/packages/foo/foo.0.0.1/opam @@ -0,0 +1,5 @@ +opam-version: "2.0" +depends: [ + "baz" {>= "0.1"} + "bar" {>= "0.2"} +] diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/repo b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/repo new file mode 100644 index 00000000000..013b84db617 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/mock-opam-repository/repo @@ -0,0 +1 @@ +opam-version: "2.0" diff --git a/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/run.t b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/run.t new file mode 100644 index 00000000000..b1d72fdd2c1 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/lockfile-generation.t/run.t @@ -0,0 +1,73 @@ +Simple example of generating a lock file with Dune + +Generate a `dune-project` file. + $ cat >dune-project < (lang dune 3.8) + > (package + > (name lockfile_generation_test) + > (depends + > foo + > (bar (>= "0.3")) + > )) + > EOF + +Run the solver and generate a lock directory. + $ dune pkg lock --opam-env=pure --opam-repository=mock-opam-repository + Selected the following packages: + bar.0.4.0 + baz.0.1.0 + foo.0.0.1 + +Print the name and contents of each file in the lock directory separated by +"---", sorting by filename for consistency. + $ find dune.lock -type f | sort | xargs -I{} sh -c "printf '{}:\n\n'; cat {}; printf '\n\n---\n\n'" + dune.lock/bar: + + (version 0.4.0) + + --- + + dune.lock/baz: + + (version 0.1.0) + + --- + + dune.lock/foo: + + (version 0.0.1) + (deps baz bar) + + --- + + dune.lock/lock.dune: + + (lang package 0.1) + + --- + + +Regenerate the `dune-project` file introducing an unsatisfiable constraint. + $ cat >dune-project < (lang dune 3.8) + > (package + > (name lockfile_generation_test) + > (depends + > foo + > (bar (>= "0.6")) + > )) + > EOF + +Run the solver again. This time it will fail. + $ dune pkg lock --opam-env=pure --opam-repository=mock-opam-repository + Error: Can't find all required versions. + Selected: baz.0.1.0 foo.0.0.1 lockfile_generation_test.LOCAL + - bar -> (problem) + foo 0.0.1 requires >= 0.2 + lockfile_generation_test LOCAL requires >= 0.6 + Rejected candidates: + bar.0.5.0: Incompatible with restriction: >= 0.6 + bar.0.4.0: Incompatible with restriction: >= 0.6 + bar.0.0.1: Incompatible with restriction: >= 0.2 + [1] +