Merge pull request #3823 from rgrinberg/one-of-fields

Add Decoder.either & generalize <|>

src/dune_lang/decoder.ml

@@ -316,7 +316,7 @@ let enter t =
         result ctx (t ctx l)
       | sexp -> User_error.raise ~loc:(Ast.loc sexp) [ Pp.text "List expected" ])
 
-let ( <|> ) =
+let either =
   (* Before you read this code, close your eyes and internalise the fact that
      this code is temporary. It is a temporary state as part of a larger work to
      turn [Decoder.t] into a pure applicative. Once this is done, this function
@@ -331,10 +331,10 @@ let ( <|> ) =
       (approximate_how_much_input_a_failing_branch_consumed exn2)
   in
   fun a b ctx state ->
-    try a ctx state
+    try (a >>| Either.left) ctx state
     with exn_a -> (
       let exn_a = Exn_with_backtrace.capture exn_a in
-      try b ctx state
+      try (b >>| Either.right) ctx state
       with exn_b ->
         let exn_b = Exn_with_backtrace.capture exn_b in
         Exn_with_backtrace.reraise
@@ -344,6 +344,12 @@ let ( <|> ) =
           | Lt ->
             exn_b ) )
 
+let ( <|> ) x y =
+  let+ res = either x y in
+  match res with
+  | Left x -> x
+  | Right x -> x
+
 let fix f =
   let rec p = lazy (f r)
   and r ast = (Lazy.force p) ast in

src/dune_lang/decoder.mli

@@ -80,7 +80,10 @@ val loc : (Loc.t, _) parser
 (** [a <|> b] is either [a] or [b]. If [a] fails to parse the input, then try
     [b]. If [b] fails as well, raise the error from the parser that consumed the
     most input. *)
-val ( <|> ) : 'a t -> 'a t -> 'a t
+val ( <|> ) : ('a, 'k) parser -> ('a, 'k) parser -> ('a, 'k) parser
+
+val either :
+  ('a, 'k) parser -> ('b, 'k) parser -> (('a, 'b) Either.t, 'k) parser
 
 (** [atom_matching f] expects the next element to be an atom for which [f]
     returns [Some v]. [desc] is used to describe the atom in case of error. [f]

src/dune_rules/bindings.ml

@@ -40,15 +40,15 @@ let to_dyn dyn_of_a bindings =
 let decode elem =
   let+ l =
     repeat
-      ( enter
-          (let+ loc, name =
-             located
-               (atom_matching ~desc:"Atom of the form :<name>"
-                  (String.drop_prefix ~prefix:":"))
-           and+ values = repeat elem in
-           Left (loc, name, values))
-      <|> let+ value = elem in
-          Right value )
+      (either
+         (enter
+            (let+ loc, name =
+               located
+                 (atom_matching ~desc:"Atom of the form :<name>"
+                    (String.drop_prefix ~prefix:":"))
+             and+ values = repeat elem in
+             (loc, name, values)))
+         elem)
   in
   let rec loop vars acc = function
     | [] -> List.rev acc