pkg: Use filtered_formula to represent dependencies (ocaml#10918)

* pkg: Pass-through `filtered_formula` from opam files to solver

The `Dependency_set.t` representation can't deal with disjunctions but
in most cases that is not even necessary as the set gets turned into a
`filtered_formula` again. Thus it might be easier to keep the original
representation and implement the necessary dependency set functionality
on top of that.

Signed-off-by: Marek Kubica <[email protected]>

* Remove unused `Dependency_set`

Signed-off-by: Marek Kubica <[email protected]>

* Add a test showing that the disjunction in OPAM files is supported now

Signed-off-by: Marek Kubica <[email protected]>

* Move `filtered_formula` into our own module

Signed-off-by: Marek Kubica <[email protected]>

* Determine the hash from the Sexp

Signed-off-by: Marek Kubica <[email protected]>

* Move reachability into the formula

Signed-off-by: Marek Kubica <[email protected]>

* Add test for dependency formula changes

Signed-off-by: Marek Kubica <[email protected]>

* Clean up the awkward API

Signed-off-by: Marek Kubica <[email protected]>

* Promote expected hash changes

Signed-off-by: Marek Kubica <[email protected]>

* Update the test wording and show the difference

Signed-off-by: Marek Kubica <[email protected]>

* test(pkg): demonstrate unreachable packages being included

Signed-off-by: Rudi Grinberg <[email protected]>
Signed-off-by: Marek Kubica <[email protected]>

* Do not include post dependencies in reachable packages

Signed-off-by: Marek Kubica <[email protected]>

* Replace sexp by dyn

Signed-off-by: Marek Kubica <[email protected]>

* Promote expected hash changes

Signed-off-by: Marek Kubica <[email protected]>

* `post` deps are excluded now

Signed-off-by: Marek Kubica <[email protected]>

* Simplify

Signed-off-by: Marek Kubica <[email protected]>

* Use `Resolve_opam_formula` to determine dependencies

Signed-off-by: Marek Kubica <[email protected]>

Author: Leonidas-from-XIV

bin/describe/describe_pkg.ml

@@ -46,10 +46,11 @@ module Dependency_hash = struct
       >>| Package_name.Map.values
       >>| List.map ~f:Local_package.for_solver
     in
-    match
-      Local_package.(
-        For_solver.list_non_local_dependency_set local_packages |> Dependency_set.hash)
-    with
+    let hash =
+      Local_package.For_solver.non_local_dependencies local_packages
+      |> Local_package.Dependency_hash.of_dependency_formula
+    in
+    match hash with
     | None -> User_error.raise [ Pp.text "No non-local dependencies" ]
     | Some dependency_hash ->
       print_endline (Local_package.Dependency_hash.to_string dependency_hash)

bin/lock_dev_tool.ml

@@ -54,7 +54,8 @@ let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version ~extra_depe
   in
   { Dune_pkg.Local_package.name = local_package_name
   ; version = None
-  ; dependencies = dependency :: extra_dependencies
+  ; dependencies =
+      Dune_pkg.Dependency_formula.of_dependencies (dependency :: extra_dependencies)
   ; conflicts = []
   ; depopts = []
   ; pins = Package_name.Map.empty

src/dune_pkg/dependency_formula.ml

@@ -0,0 +1,37 @@
+open Import
+
+type t = OpamTypes.filtered_formula
+
+let of_dependencies deps = Package_dependency.list_to_opam_filtered_formula deps
+let to_filtered_formula v = v
+let of_filtered_formula v = v
+let to_dyn = Opam_dyn.filtered_formula
+let ands = OpamFormula.ands
+
+let remove_packages (v : OpamTypes.filtered_formula) pkgs =
+  OpamFormula.map_up_formula
+    (function
+      | Atom (name, _condition) as a ->
+        if let name = Package_name.of_opam_package_name name in
+           Package_name.Set.mem pkgs name
+        then Empty
+        else a
+      | x -> x)
+    v
+;;
+
+exception Found of Package_name.t
+
+let any_package_name (v : OpamTypes.filtered_formula) =
+  try
+    OpamFormula.iter
+      (fun (name, _condition) ->
+        let name = Package_name.of_opam_package_name name in
+        raise_notrace (Found name))
+      v;
+    None
+  with
+  | Found name -> Some name
+;;
+
+let has_entries v = v |> any_package_name |> Option.is_some

src/dune_pkg/dependency_formula.mli

@@ -0,0 +1,27 @@
+type t
+
+(** Create a dependency formula out of a [Package_dependency.t] list where
+    all packages are dependencies *)
+val of_dependencies : Package_dependency.t list -> t
+
+(** Convert to the OPAM data type *)
+val to_filtered_formula : t -> OpamTypes.filtered_formula
+
+(** Convert from the OPAM data type to this *)
+val of_filtered_formula : OpamTypes.filtered_formula -> t
+
+(** Create a Dyn representation of the dependency formula *)
+val to_dyn : t -> Dyn.t
+
+(* Join all dependencies in the list to a single conjunction *)
+val ands : t list -> t
+
+(** Remove a package from the entire formula *)
+val remove_packages : t -> Package_name.Set.t -> t
+
+(** Determine whether the dependency formula has any dependencies *)
+val has_entries : t -> bool
+
+(** Returns the [Package_name.t] of a dependency from the formula, if it
+    exists. *)
+val any_package_name : t -> Package_name.t option

src/dune_pkg/dune_pkg.ml

@@ -8,6 +8,7 @@ module Opam_solver = Opam_solver
 module OpamUrl = OpamUrl0
 module Package_variable = Package_variable
 module Package_dependency = Package_dependency
+module Dependency_formula = Dependency_formula
 module Rev_store = Rev_store
 module Solver_env = Solver_env
 module Solver_stats = Solver_stats

src/dune_pkg/local_package.ml

@@ -15,7 +15,7 @@ type pins = pin Package_name.Map.t
 type t =
   { name : Package_name.t
   ; version : Package_version.t option
-  ; dependencies : Package_dependency.t list
+  ; dependencies : Dependency_formula.t
   ; conflicts : Package_dependency.t list
   ; conflict_class : Package_name.t list
   ; depopts : Package_dependency.t list
@@ -38,55 +38,20 @@ module Dependency_hash = struct
         ~loc
         [ Pp.textf "Dependency hash is not a valid md5 hash: %s" hash ]
   ;;
-end
-
-module Dependency_set = struct
-  type t = Package_constraint.Set.t Package_name.Map.t
-
-  let empty = Package_name.Map.empty
-
-  let of_list =
-    List.fold_left ~init:empty ~f:(fun acc { Package_dependency.name; constraint_ } ->
-      Package_name.Map.update acc name ~f:(fun existing ->
-        match existing, constraint_ with
-        | None, None -> Some Package_constraint.Set.empty
-        | None, Some constraint_ -> Some (Package_constraint.Set.singleton constraint_)
-        | Some existing, None -> Some existing
-        | Some existing, Some constraint_ ->
-          Some (Package_constraint.Set.add existing constraint_)))
-  ;;
 
-  let union =
-    Package_name.Map.union ~f:(fun _name a b -> Some (Package_constraint.Set.union a b))
-  ;;
-
-  let union_all = List.fold_left ~init:empty ~f:union
-
-  let package_dependencies =
-    Package_name.Map.to_list_map ~f:(fun name constraints ->
-      let constraint_ =
-        if Package_constraint.Set.is_empty constraints
-        then None
-        else Some (Package_constraint.And (Package_constraint.Set.to_list constraints))
-      in
-      { Package_dependency.name; constraint_ })
-  ;;
-
-  let encode_for_hash t =
-    package_dependencies t |> Dune_lang.Encoder.list Package_dependency.encode
-  ;;
-
-  let hash t =
-    if Package_name.Map.is_empty t
-    then None
-    else Some (encode_for_hash t |> Dune_sexp.to_string |> Dune_digest.string)
+  let of_dependency_formula formula =
+    match Dependency_formula.has_entries formula with
+    | false -> None
+    | true ->
+      let hashable = formula |> Dependency_formula.to_dyn |> Dyn.to_string in
+      Some (string hashable)
   ;;
 end
 
 module For_solver = struct
   type t =
     { name : Package_name.t
-    ; dependencies : Package_dependency.t list
+    ; dependencies : Dependency_formula.t
     ; conflicts : Package_dependency.t list
     ; depopts : Package_dependency.t list
     ; conflict_class : Package_name.t list
@@ -98,8 +63,7 @@ module For_solver = struct
        them *)
     OpamFile.OPAM.empty
     |> OpamFile.OPAM.with_name (Package_name.to_opam_package_name name)
-    |> OpamFile.OPAM.with_depends
-         (Package_dependency.list_to_opam_filtered_formula dependencies)
+    |> OpamFile.OPAM.with_depends (Dependency_formula.to_filtered_formula dependencies)
     |> OpamFile.OPAM.with_conflicts
          (Package_dependency.list_to_opam_filtered_formula conflicts)
     |> OpamFile.OPAM.with_conflict_class
@@ -108,16 +72,13 @@ module For_solver = struct
          (Package_dependency.list_to_opam_filtered_formula depopts)
   ;;
 
-  let opam_filtered_dependency_formula { dependencies; _ } =
-    Package_dependency.list_to_opam_filtered_formula dependencies
-  ;;
-
-  let dependency_set { dependencies; _ } = Dependency_set.of_list dependencies
-  let list_dependency_set ts = List.map ts ~f:dependency_set |> Dependency_set.union_all
-
-  let list_non_local_dependency_set ts =
-    List.fold_left ts ~init:(list_dependency_set ts) ~f:(fun acc { name; _ } ->
-      Package_name.Map.remove acc name)
+  let non_local_dependencies local_deps =
+    let local_deps_names = Package_name.Set.of_list_map ~f:(fun d -> d.name) local_deps in
+    let formula =
+      List.map ~f:(fun { dependencies; _ } -> dependencies) local_deps
+      |> Dependency_formula.ands
+    in
+    Dependency_formula.remove_packages formula local_deps_names
   ;;
 end
 
@@ -134,9 +95,10 @@ let of_package (t : Dune_lang.Package.t) =
   let name = Package.name t in
   match Package.original_opam_file t with
   | None ->
+    let dependencies = t |> Package.depends |> Dependency_formula.of_dependencies in
     { name
     ; version
-    ; dependencies = Package.depends t
+    ; dependencies
     ; conflicts = Package.conflicts t
     ; depopts = Package.depopts t
     ; loc
@@ -148,7 +110,9 @@ let of_package (t : Dune_lang.Package.t) =
       Opam_file.read_from_string_exn ~contents:opam_file_string (Path.source file)
     in
     let convert_filtered_formula = Package_dependency.list_of_opam_filtered_formula loc in
-    let dependencies = convert_filtered_formula `And (OpamFile.OPAM.depends opam_file) in
+    let dependencies =
+      opam_file |> OpamFile.OPAM.depends |> Dependency_formula.of_filtered_formula
+    in
     let conflicts = convert_filtered_formula `And (OpamFile.OPAM.conflicts opam_file) in
     let depopts = convert_filtered_formula `Or (OpamFile.OPAM.depopts opam_file) in
     let conflict_class =

src/dune_pkg/local_package.mli

@@ -20,7 +20,7 @@ type pins = pin Package_name.Map.t
 type t =
   { name : Package_name.t
   ; version : Package_version.t option
-  ; dependencies : Package_dependency.t list
+  ; dependencies : Dependency_formula.t
   ; conflicts : Package_dependency.t list
   ; conflict_class : Package_name.t list
   ; depopts : Package_dependency.t list
@@ -36,32 +36,14 @@ module Dependency_hash : sig
   val to_string : t -> string
   val encode : t Encoder.t
   val decode : t Decoder.t
-end
-
-module Dependency_set : sig
-  (** A set of dependencies belonging to one or more local packages. Two
-      different local packages may depend on the same packages with different
-      version constraints provided that the two constraints intersect
-      (otherwise there will be no solution). In this case the conjunction of
-      both constraints will form the constraint associated with that
-      dependency. Package constraints are de-duplicated by comparing them only
-      on their syntax. *)
-  type t
-
-  (** Returns a hash of all dependencies in the set or [None] if the set is
-      empty. The reason for behaving differently when the set is empty is so
-      that callers are forced to explicitly handle the case where there are no
-      dependencies which will likely lead to better user experience. *)
-  val hash : t -> Dependency_hash.t option
-
-  val package_dependencies : t -> Package_dependency.t list
+  val of_dependency_formula : Dependency_formula.t -> t option
 end
 
 module For_solver : sig
   (** The minimum set of fields about a package needed by the solver. *)
   type t =
     { name : Package_name.t
-    ; dependencies : Package_dependency.t list
+    ; dependencies : Dependency_formula.t
     ; conflicts : Package_dependency.t list
     ; depopts : Package_dependency.t list
     ; conflict_class : Package_name.t list
@@ -73,14 +55,7 @@ module For_solver : sig
       on disk. *)
   val to_opam_file : t -> OpamFile.OPAM.t
 
-  (** Returns an opam dependency formula for this package *)
-  val opam_filtered_dependency_formula : t -> OpamTypes.filtered_formula
-
-  (** Returns the set of dependencies of all given local packages excluding
-      dependencies which are packages in the provided list. Pass this the list
-      of all local package in a project to get a set of all non-local
-      dependencies of the project. *)
-  val list_non_local_dependency_set : t list -> Dependency_set.t
+  val non_local_dependencies : t list -> Dependency_formula.t
 end
 
 val for_solver : t -> For_solver.t

src/dune_pkg/lock_dir.ml

@@ -380,8 +380,9 @@ let create_latest_version
      |> Code_error.raise "Invalid package table");
   let version = Syntax.greatest_supported_version_exn Dune_lang.Pkg.syntax in
   let dependency_hash =
-    Local_package.(
-      For_solver.list_non_local_dependency_set local_packages |> Dependency_set.hash)
+    local_packages
+    |> Local_package.For_solver.non_local_dependencies
+    |> Local_package.Dependency_hash.of_dependency_formula
     |> Option.map ~f:(fun dependency_hash -> Loc.none, dependency_hash)
   in
   let complete, used =

src/dune_pkg/opam_solver.ml

@@ -783,8 +783,21 @@ let reject_unreachable_packages =
     loop roots;
     !seen
   in
-  fun ~local_packages ~pkgs_by_name ->
+  fun solver_env ~local_packages ~pkgs_by_name ->
     let roots = Package_name.Map.keys local_packages in
+    let pkgs_by_version =
+      Package_name.Map.merge pkgs_by_name local_packages ~f:(fun name lhs rhs ->
+        match lhs, rhs with
+        | None, None -> assert false
+        | Some _, Some _ ->
+          Code_error.raise
+            "package is both local and returned by solver"
+            [ "name", Package_name.to_dyn name ]
+        | Some (lock_dir_pkg : Lock_dir.Pkg.t), None -> Some lock_dir_pkg.info.version
+        | None, Some _pkg ->
+          let version = Package_version.of_string "dev" in
+          Some version)
+    in
     let pkgs_by_name =
       Package_name.Map.merge pkgs_by_name local_packages ~f:(fun name lhs rhs ->
         match lhs, rhs with
@@ -795,8 +808,28 @@ let reject_unreachable_packages =
             [ "name", Package_name.to_dyn name ]
         | Some (pkg : Lock_dir.Pkg.t), None -> Some (List.map pkg.depends ~f:snd)
         | None, Some (pkg : Local_package.For_solver.t) ->
+          let formula = pkg.dependencies |> Dependency_formula.to_filtered_formula in
+          (* Use `dev` because at this point we don't have any version *)
+          let opam_package =
+            OpamPackage.of_string (sprintf "%s.dev" (Package_name.to_string pkg.name))
+          in
+          let env = add_self_to_filter_env opam_package (Solver_env.to_env solver_env) in
+          let resolved =
+            Resolve_opam_formula.filtered_formula_to_package_names
+              env
+              ~with_test:true
+              pkgs_by_version
+              formula
+          in
           let deps =
-            List.map pkg.dependencies ~f:(fun (d : Package_dependency.t) -> d.name)
+            match resolved with
+            | Ok { regular; post = _ } ->
+              (* discard post deps *)
+              regular
+            | Error _ ->
+              Code_error.raise
+                "can't find a valid solution for the dependencies"
+                [ "name", Package_name.to_dyn pkg.name ]
           in
           let depopts =
             List.filter_map pkg.depopts ~f:(fun (d : Package_dependency.t) ->
@@ -912,7 +945,9 @@ let solve_lock_dir
                       (Package_name.to_string name)
                       (Package_name.to_string dep_name)
                   ]));
-        let reachable = reject_unreachable_packages ~local_packages ~pkgs_by_name in
+        let reachable =
+          reject_unreachable_packages solver_env ~local_packages ~pkgs_by_name
+        in
         let pkgs_by_name =
           Package_name.Map.filteri pkgs_by_name ~f:(fun name _ ->
             Package_name.Set.mem reachable name)