Makefile

@@ -25,7 +25,7 @@ ppx_inline_test \
 ppxlib \
 ctypes \
 "utop>=2.6.0" \
-"melange"
+"melange>=4.0.0-414"
 # Dependencies recommended for developing dune locally,
 # but not wanted in CI
 DEV_DEPS := \
@@ -74,13 +74,8 @@ install-ocamlformat:
 dev-depext:
 	opam depext -y $(TEST_DEPS)
 
-# branch v4-414-for-dune
-.PHONY: melange
-melange:
-	opam pin add -n melange.dev https://github.com/melange-re/melange.git#ab48cfcfe5f2c0ca4a4a4fcafceb73b95c2acb1d
-
 .PHONY: dev-deps
-dev-deps: melange
+dev-deps:
 	opam install -y $(TEST_DEPS)
 
 .PHONY: coverage-deps

flake.nix

@@ -8,8 +8,7 @@
       inputs.flake-utils.follows = "flake-utils";
     };
     melange = {
-      # branch v4-414-for-dune
-      url = "github:melange-re/melange?rev=ab48cfcfe5f2c0ca4a4a4fcafceb73b95c2acb1d";
+      url = "github:melange-re/melange/refs/tags/4.0.0-414";
       inputs.nixpkgs.follows = "nixpkgs";
       inputs.flake-utils.follows = "flake-utils";
     };

src/dune_pkg/package_universe.ml

@@ -28,35 +28,36 @@ let version_by_package_name local_packages (lock_dir : Lock_dir.t) =
   in
   let exception Duplicate_package of Package_name.t in
   try
-    Ok
-      (Package_name.Map.union
-         from_local_packages
-         from_lock_dir
-         ~f:(fun duplicate_package_name _ _ ->
-           raise (Duplicate_package duplicate_package_name)))
+    Package_name.Map.union
+      from_local_packages
+      from_lock_dir
+      ~f:(fun duplicate_package_name _ _ ->
+        raise (Duplicate_package duplicate_package_name))
   with
   | Duplicate_package duplicate_package_name ->
     let local_package = Package_name.Map.find_exn local_packages duplicate_package_name in
-    Error
-      (User_message.make
-         ~hints:lockdir_regenerate_hints
-         ~loc:local_package.loc
-         [ Pp.textf
-             "A package named %S is defined locally but is also present in the lockdir"
-             (Package_name.to_string local_package.name)
-         ])
+    User_error.raise
+      ~hints:lockdir_regenerate_hints
+      ~loc:local_package.loc
+      [ Pp.textf
+          "A package named %S is defined locally but is also present in the lockdir"
+          (Package_name.to_string local_package.name)
+      ]
 ;;
 
 let concrete_dependencies_of_local_package t local_package_name ~with_test =
   let local_package = Package_name.Map.find_exn t.local_packages local_package_name in
-  Local_package.(for_solver local_package |> For_solver.opam_filtered_dependency_formula)
-  |> Resolve_opam_formula.filtered_formula_to_package_names
-       ~with_test
-       (Solver_env.to_env t.solver_env)
-       t.version_by_package_name
-  |> Result.map_error ~f:(function
-    | `Formula_could_not_be_satisfied unsatisfied_formula_hints ->
-    User_message.make
+  match
+    Local_package.(
+      for_solver local_package |> For_solver.opam_filtered_dependency_formula)
+    |> Resolve_opam_formula.filtered_formula_to_package_names
+         ~with_test
+         (Solver_env.to_env t.solver_env)
+         t.version_by_package_name
+  with
+  | Ok s -> s
+  | Error (`Formula_could_not_be_satisfied unsatisfied_formula_hints) ->
+    User_error.raise
       ?hints:(Option.some_if with_test lockdir_regenerate_hints)
       ~loc:local_package.loc
       (Pp.textf
@@ -67,17 +68,16 @@ let concrete_dependencies_of_local_package t local_package_name ~with_test =
           else " when the solver variable 'with_test' is set to 'false'")
        :: List.map
             unsatisfied_formula_hints
-            ~f:Resolve_opam_formula.Unsatisfied_formula_hint.pp))
+            ~f:Resolve_opam_formula.Unsatisfied_formula_hint.pp)
 ;;
 
 let all_non_local_dependencies_of_local_packages t =
-  let open Result.O in
-  let+ all_dependencies_of_local_packages =
+  let all_dependencies_of_local_packages =
     Package_name.Map.keys t.local_packages
-    |> Result.List.map ~f:(fun p ->
+    |> List.map ~f:(fun p ->
       concrete_dependencies_of_local_package ~with_test:true t p
-      |> Result.map ~f:Package_name.Set.of_list)
-    |> Result.map ~f:Package_name.Set.union_all
+      |> Package_name.Set.of_list)
+    |> Package_name.Set.union_all
   in
   Package_name.Set.diff
     all_dependencies_of_local_packages
@@ -108,24 +108,23 @@ let check_for_unnecessary_packges_in_lock_dir
       locked_transitive_closure_of_local_package_dependencies
   in
   if Package_name.Set.is_empty unneeded_packages_in_lock_dir
-  then Ok ()
+  then ()
   else (
     let packages =
       Package_name.Set.to_list unneeded_packages_in_lock_dir
       |> List.map ~f:(Package_name.Map.find_exn t.lock_dir.packages)
     in
-    Error
-      (User_message.make
-         ~hints:lockdir_regenerate_hints
-         [ Pp.text
-             "The lockdir contains packages which are not among the transitive \
-              dependencies of any local package:"
-         ; Pp.enumerate packages ~f:(fun (package : Lock_dir.Pkg.t) ->
-             Pp.textf
-               "%s.%s"
-               (Package_name.to_string package.info.name)
-               (Package_version.to_string package.info.version))
-         ]))
+    User_error.raise
+      ~hints:lockdir_regenerate_hints
+      [ Pp.text
+          "The lockdir contains packages which are not among the transitive dependencies \
+           of any local package:"
+      ; Pp.enumerate packages ~f:(fun (package : Lock_dir.Pkg.t) ->
+          Pp.textf
+            "%s.%s"
+            (Package_name.to_string package.info.name)
+            (Package_version.to_string package.info.version))
+      ])
 ;;
 
 let validate_dependency_hash { local_packages; lock_dir; _ } =
@@ -145,68 +144,66 @@ let validate_dependency_hash { local_packages; lock_dir; _ } =
   in
   let dependency_hash = Local_package.Dependency_set.hash non_local_dependencies in
   match lock_dir.dependency_hash, dependency_hash with
-  | None, None -> Ok ()
+  | None, None -> ()
   | Some (loc, lock_dir_dependency_hash), None ->
-    Error
-      (User_error.make
-         ~loc
-         ~hints:regenerate_lock_dir_hints
-         [ Pp.textf
-             "This project has no non-local dependencies yet the lockfile contains a \
-              dependency hash: %s"
-             (Local_package.Dependency_hash.to_string lock_dir_dependency_hash)
-         ])
+    User_error.raise
+      ~loc
+      ~hints:regenerate_lock_dir_hints
+      [ Pp.textf
+          "This project has no non-local dependencies yet the lockfile contains a \
+           dependency hash: %s"
+          (Local_package.Dependency_hash.to_string lock_dir_dependency_hash)
+      ]
   | None, Some _ ->
     let any_non_local_dependency : Package_dependency.t =
       List.hd (Local_package.Dependency_set.package_dependencies non_local_dependencies)
     in
-    Error
-      (User_error.make
-         ~hints:regenerate_lock_dir_hints
-         [ Pp.text
-             "This project has at least one non-local dependency but the lockdir doesn't \
-              contain a dependency hash."
-         ; Pp.textf
-             "An example of a non-local dependency of this project is: %s"
-             (Package_name.to_string any_non_local_dependency.name)
-         ])
+    User_error.raise
+      ~hints:regenerate_lock_dir_hints
+      [ Pp.text
+          "This project has at least one non-local dependency but the lockdir doesn't \
+           contain a dependency hash."
+      ; Pp.textf
+          "An example of a non-local dependency of this project is: %s"
+          (Package_name.to_string any_non_local_dependency.name)
+      ]
   | Some (loc, lock_dir_dependency_hash), Some non_local_dependency_hash ->
     if Local_package.Dependency_hash.equal
          lock_dir_dependency_hash
          non_local_dependency_hash
-    then Ok ()
+    then ()
     else
-      Error
-        (User_error.make
-           ~loc
-           ~hints:regenerate_lock_dir_hints
-           [ Pp.text
-               "Dependency hash in lockdir does not match the hash of non-local \
-                dependencies of this project. The lockdir expects the the non-local \
-                dependencies to hash to:"
-           ; Pp.text (Local_package.Dependency_hash.to_string lock_dir_dependency_hash)
-           ; Pp.text "...but the non-local dependencies of this project hash to:"
-           ; Pp.text (Local_package.Dependency_hash.to_string non_local_dependency_hash)
-           ])
+      User_error.raise
+        ~loc
+        ~hints:regenerate_lock_dir_hints
+        [ Pp.text
+            "Dependency hash in lockdir does not match the hash of non-local \
+             dependencies of this project. The lockdir expects the the non-local \
+             dependencies to hash to:"
+        ; Pp.text (Local_package.Dependency_hash.to_string lock_dir_dependency_hash)
+        ; Pp.text "...but the non-local dependencies of this project hash to:"
+        ; Pp.text (Local_package.Dependency_hash.to_string non_local_dependency_hash)
+        ]
 ;;
 
 let validate t =
-  let open Result.O in
-  let* () = validate_dependency_hash t in
+  validate_dependency_hash t;
   all_non_local_dependencies_of_local_packages t
-  >>= check_for_unnecessary_packges_in_lock_dir t
+  |> check_for_unnecessary_packges_in_lock_dir t
 ;;
 
 let create local_packages lock_dir =
-  let open Result.O in
-  let* version_by_package_name = version_by_package_name local_packages lock_dir in
-  let solver_env =
-    Solver_stats.Expanded_variable_bindings.to_solver_env
-      lock_dir.expanded_solver_variable_bindings
-  in
-  let t = { local_packages; lock_dir; version_by_package_name; solver_env } in
-  let+ () = validate t in
-  t
+  try
+    let version_by_package_name = version_by_package_name local_packages lock_dir in
+    let solver_env =
+      Solver_stats.Expanded_variable_bindings.to_solver_env
+        lock_dir.expanded_solver_variable_bindings
+    in
+    let t = { local_packages; lock_dir; version_by_package_name; solver_env } in
+    let () = validate t in
+    Ok t
+  with
+  | User_error.E e -> Error e
 ;;
 
 let local_transitive_dependency_closure_without_test =
@@ -216,7 +213,6 @@ let local_transitive_dependency_closure_without_test =
       Top_closure.top_closure
         ~deps:(fun a ->
           concrete_dependencies_of_local_package t a ~with_test:false
-          |> User_error.ok_exn
           |> List.filter ~f:(Package_name.Map.mem t.local_packages))
         ~key:Fun.id
         start
@@ -239,18 +235,18 @@ let transitive_dependency_closure_without_test t start =
       |> Package_name.Set.union_map ~f:(fun name ->
         let all_deps =
           concrete_dependencies_of_local_package t name ~with_test:false
-          |> User_error.ok_exn
           |> Package_name.Set.of_list
         in
         Package_name.Set.diff all_deps local_package_names)
     in
-    Lock_dir.transitive_dependency_closure
-      t.lock_dir
-      Package_name.Set.(
-        union
-          non_local_immediate_dependencies_of_local_transitive_dependency_closure
-          (diff start local_package_names))
-    |> function
+    match
+      Lock_dir.transitive_dependency_closure
+        t.lock_dir
+        Package_name.Set.(
+          union
+            non_local_immediate_dependencies_of_local_transitive_dependency_closure
+            (diff start local_package_names))
+    with
     | Ok x -> x
     | Error (`Missing_packages missing_packages) ->
       Code_error.raise
@@ -284,8 +280,8 @@ let all_dependencies t package ~traverse =
   check_contains_package t package;
   let immediate_deps =
     match concrete_dependencies_of_local_package t package ~with_test:true with
-    | Ok x -> Package_name.Set.of_list x
-    | Error e ->
+    | x -> Package_name.Set.of_list x
+    | exception User_error.E e ->
       Code_error.raise
         "Invalid package universe which should have already been validated"
         [ "error", Dyn.string (User_message.to_string e) ]
@@ -302,7 +298,6 @@ let non_test_dependencies t package ~traverse =
   match traverse with
   | `Immediate ->
     concrete_dependencies_of_local_package t package ~with_test:false
-    |> User_error.ok_exn
     |> Package_name.Set.of_list
   | `Transitive ->
     let closure =