From 8df9e6cb4a01630408bd1ed18e37d5f92993d4f6 Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Tue, 20 Jun 2023 17:02:20 +0200
Subject: [PATCH] fix(opam): honor precedence in constraints
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fixes #3431

The printer in opam-file-format does not insert parentheses on its own,
but it is possible to use the Group constructor with a singleton to
force insertion of parentheses.

Signed-off-by: Etienne Millon <me@emillon.org>
Co-authored-by: Charlène Gros <charlene@tarides.com>
---
 CHANGES.md                                    |  3 +
 src/dune_rules/package.ml                     | 58 +++++++++++++------
 .../test-cases/opam-constraints.t             |  8 +--
 3 files changed, 48 insertions(+), 21 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 891c35308c89..a909ec74945e 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -57,6 +57,9 @@ Unreleased
 - Add `(build_if)` to the `(test)` stanza. When it evaluates to false, the
   executable is not built. (#7899, fixes #6938, @emillon)
 
+- Add necessary parentheses in generated opam constraints (#7682, fixes #3431,
+  @Lucccyo)
+
 3.8.2 (2023-06-16)
 ------------------
 
diff --git a/src/dune_rules/package.ml b/src/dune_rules/package.ml
index f8910654f0d7..f05324d91174 100644
--- a/src/dune_rules/package.ml
+++ b/src/dune_rules/package.ml
@@ -250,25 +250,49 @@ module Dependency = struct
     <|> let+ name = Name.decode in
         { name; constraint_ = None }
 
-  let rec opam_constraint : Constraint.t -> OpamParserTypes.FullPos.value =
-    let open OpamParserTypes.FullPos in
-    function
-    | Bvar v -> Constraint.Var.to_opam v
-    | Uop (op, x) ->
-      nopos (Prefix_relop (Op.to_relop op, Constraint.Var.to_opam x))
-    | Bop (op, x, y) ->
-      nopos
-        (Relop
-           (Op.to_relop op, Constraint.Var.to_opam x, Constraint.Var.to_opam y))
-    | And [ c ] -> opam_constraint c
-    | And (c :: cs) ->
-      nopos (Logop (nopos `And, opam_constraint c, opam_constraint (And cs)))
-    | Or [ c ] -> opam_constraint c
-    | Or (c :: cs) ->
-      nopos (Logop (nopos `Or, opam_constraint c, opam_constraint (And cs)))
-    | And [] | Or [] ->
+  type context =
+    | Root
+    | Ctx_and
+    | Ctx_or
+
+  (** The printer in opam-file-format does not insert parentheses on its own,
+      but it is possible to use the [Group] constructor with a singleton to
+      force insertion of parentheses. *)
+  let group e = nopos (Group (nopos [ e ]) : OpamParserTypes.FullPos.value_kind)
+
+  let group_if b e = if b then group e else e
+
+  let op_list op = function
+    | [] ->
       User_error.raise
         [ Pp.textf "logical operations with no arguments are not supported" ]
+    | v :: vs ->
+      List.fold_left ~init:v vs ~f:(fun a b ->
+          nopos (OpamParserTypes.FullPos.Logop (nopos op, a, b)))
+
+  let opam_constraint t : OpamParserTypes.FullPos.value =
+    let open OpamParserTypes.FullPos in
+    let rec opam_constraint context = function
+      | Constraint.Bvar v -> Constraint.Var.to_opam v
+      | Uop (op, x) ->
+        nopos (Prefix_relop (Op.to_relop op, Constraint.Var.to_opam x))
+      | Bop (op, x, y) ->
+        nopos
+          (Relop
+             (Op.to_relop op, Constraint.Var.to_opam x, Constraint.Var.to_opam y))
+      | And cs -> List.map cs ~f:(opam_constraint Ctx_and) |> op_list `And
+      | Or cs ->
+        let inner_ctx = Ctx_or in
+        let group_needed =
+          match context with
+          | Root -> false
+          | Ctx_and -> true
+          | Ctx_or -> false
+        in
+        List.map cs ~f:(opam_constraint inner_ctx)
+        |> op_list `Or |> group_if group_needed
+    in
+    opam_constraint Root t
 
   let opam_depend { name; constraint_ } =
     let constraint_ = Option.map ~f:opam_constraint constraint_ in
diff --git a/test/blackbox-tests/test-cases/opam-constraints.t b/test/blackbox-tests/test-cases/opam-constraints.t
index ad3c57eac9a3..ce993818d7b7 100644
--- a/test/blackbox-tests/test-cases/opam-constraints.t
+++ b/test/blackbox-tests/test-cases/opam-constraints.t
@@ -23,9 +23,9 @@ constraints.
   >   ; or
   >   (p_or2 (or :a :b))
   >   (p_or1 (or :a))
-  >   (p_or3 (or :a :b :c)) ; buggy output
+  >   (p_or3 (or :a :b :c))
   >   ; mixed operations
-  >   (p_and_in_or (or :a (and :b :c))) ; buggy output, see #3431
+  >   (p_and_in_or (or :a (and :b :c)))
   >   (p_or_in_and (and :a (or :b :c)))
   >   ))
   > EOF
@@ -49,9 +49,9 @@ constraints.
     "p_and3" {a & b & c}
     "p_or2" {a | b}
     "p_or1" {a}
-    "p_or3" {a | b & c}
+    "p_or3" {a | b | c}
     "p_and_in_or" {a | b & c}
-    "p_or_in_and" {a & b | c}
+    "p_or_in_and" {a & (b | c)}
   ]
   build: [
     ["dune" "subst"] {pinned}