+ Instances for Validation

fsprojects · Jan 25, 2024 · 714aa5a · 714aa5a
1 parent a5a3a74
commit 714aa5a
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 2 deletions.
diff --git a/src/FSharpPlus/Control/Monoid.fs b/src/FSharpPlus/Control/Monoid.fs
@@ -34,13 +34,15 @@ type Plus =
     static member        ``+`` (x: AggregateException, y: AggregateException, [<Optional>]_mthd: Plus    ) = new AggregateException (seq {yield! x.InnerExceptions; yield! y.InnerExceptions})
     static member        ``+`` (x: exn               , y: exn               , [<Optional>]_mthd: Plus    ) =
         let f (e: exn) = match e with :? AggregateException as a -> a.InnerExceptions :> seq<_> | _ -> Seq.singleton e
-        new AggregateException (seq {yield! f x; yield! f y}) :> exn
+        let left = f x
+        new AggregateException (seq { yield! left; yield! Seq.except left (f y) }) :> exn
     #else
     static member        ``+`` (x: StringBuilder     , y: StringBuilder     , [<Optional>]_mthd: Plus    ) = StringBuilder().Append(string x).Append(string y)
     static member        ``+`` (_: Id0               , _: Id0               , [<Optional>]_mthd: Plus    ) = Id0 ""
     static member        ``+`` (x: exn               , y: exn               , [<Optional>]_mthd: Plus    ) : exn =
         let f (e: exn) = match e with :? AggregateException as a -> a.Data0 :> seq<_> | _ -> Seq.singleton e
-        AggregateException (seq {yield! f x; yield! f y})
+        let left = f x
+        AggregateException (seq { yield! left; yield! Seq.except left (f y) }) :> exn
     #endif
 
     static member inline Invoke (x: 'Plus) (y: 'Plus) : 'Plus =

diff --git a/src/FSharpPlus/Data/Validation.fs b/src/FSharpPlus/Data/Validation.fs
@@ -49,6 +49,17 @@ module Validation =
         | Success _ , Failure e2 -> Failure e2
         | Success f , Success a  -> Success (f a)
 
+    let inline zip x y : Validation<'Error, 'T *'U> =
+        match (x: Validation<'Error, 'T>), (y: Validation<'Error, 'U>) with
+        #if !FABLE_COMPILER
+        | Failure e1, Failure e2 -> Failure (plus e1 e2)
+        #else
+        | Failure e1, Failure e2 -> Failure (e1 + e2)
+        #endif
+        | Failure e1, Success _  -> Failure e1
+        | Success _ , Failure e2 -> Failure e2
+        | Success x , Success y  -> Success (x, y)
+
     let inline map2 f x y : Validation<'Error,'V> =
         match (x: Validation<'Error,'T>), (y: Validation<'Error,'U>) with
         #if !FABLE_COMPILER
@@ -281,6 +292,21 @@ type Validation<'error, 't> with
     [<EditorBrowsable(EditorBrowsableState.Never)>]
     static member inline Lift3 (f, x: Validation<'Error, 'T>, y: Validation<_, 'U>, z: Validation<_, 'V>) : Validation<_, 'W> = Validation.map3 f x y z
 
+    // as ZipApplicative (same behavior)
+    [<EditorBrowsable(EditorBrowsableState.Never)>]
+    static member inline Zip (x: Validation<'Error, 'T>, y: Validation<'Error, 'U>) : Validation<'Error, 'T * 'U> = Validation.zip x y
+
+    [<EditorBrowsable(EditorBrowsableState.Never)>]
+    static member Pure x = Success x
+
+    static member inline (<.>)  (f: Validation<'Error, 'T -> 'U>, x: Validation<_, 'T>) : Validation<_, _> = Validation.apply f x
+
+    [<EditorBrowsable(EditorBrowsableState.Never)>]
+    static member inline Map2 (f, x: Validation<'Error, 'T>, y: Validation<'Error, 'U>) : Validation<'Error, 'V> = Validation.map2 f x y
+
+    [<EditorBrowsable(EditorBrowsableState.Never)>]
+    static member inline Map3 (f, x: Validation<'Error, 'T>, y: Validation<_, 'U>, z: Validation<_, 'V>) : Validation<_, 'W> = Validation.map3 f x y z
+
     // as Alternative (inherits from Applicative)
     #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4
     static member inline get_Empty () = Failure (getEmpty ())