add alt_flat function

src/tyre.ml

@@ -81,6 +81,18 @@ let conv to_ from_ x : _ t =
 let seq a b : _ t = Seq (a, b)
 let alt a b : _ t = Alt (a, b)
 
+let alt_flat tyre1 tyre2 =
+  conv
+    (function `Left a -> a | `Right a -> a)
+    (fun _a -> failwith "alt_flat is not compatible with `eval`. Use `alt_flat_eval` instead.")
+    (alt tyre1 tyre2)
+
+let alt_flat_eval : type a. (a -> [`Left | `Right]) -> a t -> a t -> a t = fun from_ l r ->
+  conv
+    (function `Left a -> a | `Right a -> a)
+    (fun a -> match from_ a with `Left -> `Left a | `Right -> `Right a)
+    (alt l r)
+
 let prefix x a : _ t = Prefix (x, a)
 let suffix a x : _ t = Suffix (a, x)
 let opt a : _ t = Opt a
@@ -93,6 +105,8 @@ module Infix = struct
   let ( *>) = prefix
   let (<* ) = suffix
 
+  let ( <||> ) = alt_flat
+
 end
 include Infix
 

src/tyre.mli

@@ -1,6 +1,6 @@
 (** {1 Typed regular expressions} *)
 
-(** 
+(**
 Tyre is a set of combinators to build type-safe regular expressions, allowing automatic extraction and modification of matched groups.
 
 Tyre is bi-directional: a typed regular expressions can be used both for {{!matching}matching} and {{!eval}evaluation}. Multiple tyregexs can be combined in order to do {{!routing}routing} in similar manner as switches/pattern matching.
@@ -40,7 +40,7 @@ type 'a t
 (** {1 Combinators} *)
 
 val pcre : string -> string t
-(** [pcre s] is a tyregex that matches the PCRE [s] and return the 
+(** [pcre s] is a tyregex that matches the PCRE [s] and return the
     corresponding string.
     Groups in [s] are ignored.
 *)
@@ -73,6 +73,21 @@ val alt : 'a t -> 'b t -> [`Left of 'a | `Right of 'b] t
 (** [alt tyreL tyreR] matches either [tyreL] (and will then return [`Left v]) or [tyreR] (and will then return [`Right v]).
 *)
 
+
+val alt_flat : 'a t -> 'a t -> 'a t
+(** [alt_flat l r] matches either [l] or [r] and return the value of the one
+    that matched. Be warned : it is not compatible with [eval], use
+    {!alt_flat_eval} instead.
+
+    The reason is that when evaluating [alt_flat l r] with a value `v`, `eval`
+    has no way to know if the value could have been returned by [l] or by [r].
+    *)
+
+val alt_flat_eval : ('a -> [`Left | `Right]) -> 'a t -> 'a t -> 'a t
+(** [alt_flat_eval from_ l r] is [alt_flat l r] but uses [from_] when [eval] is
+  called on it. [from_ v] should indicate whether [v] is compatible with [l] or
+  with [r].*)
+
 (** {2 Repetitions} *)
 
 val rep : 'a t -> 'a Seq.t t
@@ -126,6 +141,10 @@ module Infix : sig
   val (<* ) : 'a t -> _ t -> 'a t
   (** [ t <* ti ] is [suffix t ti]. *)
 
+  val (<||>) : 'a t -> 'a t -> 'a t
+  (** [t <||> t' ] is [alt_flat t t']. Be warned : it is not compatible with
+      [eval], use {!alt_flat_eval} instead if you need to call {!eval}. *)
+
 end
 
 (** {2 Useful combinators} *)