Non sequential Applicatives (#559)

Author: gusty

docsrc/content/abstraction-traversable.fsx

@@ -21,8 +21,20 @@ Minimal complete definition
  * ``traverse f x`` | ``sequence x``
 *)
 (**
-    static member Traverse (t:'Traversable<'T>, f: 'T -> 'Functor<'U>) : 'Functor<'Traversable<'U>>
-    static member Sequence (t:'Traversable<'Functor<'T>>) : 'Functor<'Traversable<'T>>
+    static member Traverse (t: 'Traversable<'T>, f: 'T -> 'Applicative<'U>) : 'Applicative<'Traversable<'U>>
+    static member Sequence (t: 'Traversable<'Applicative<'T>>) : 'Applicative<'Traversable<'T>>
+*)
+(**
+
+
+Other operations
+----------------
+
+ * ``gather f x`` | ``transpose x`` (same as traverse and sequence but operating on ZipApplicatives)
+*)
+(**
+    static member Gather (t: 'Traversable<'T>, f: 'T -> 'ZipApplicative<'U>) : 'ZipApplicative<'Traversable<'U>>
+    static member Transpose (t: 'Traversable<'ZipApplicative<'T>>) : 'ZipApplicative<'Traversable<'T>>
 *)
 (**
 

docsrc/content/abstraction-zipapplicative.fsx

@@ -0,0 +1,138 @@
+(*** hide ***)
+// This block of code is omitted in the generated HTML documentation. Use 
+// it to define helpers that you do not want to show in the documentation.
+#r @"../../src/FSharpPlus/bin/Release/netstandard2.0/FSharpPlus.dll"
+
+(**
+ZipApplicative
+==============
+A functor with application, providing operations to embed pure expressions (``pur``), run computations pointwise and/or paralell and combine their results (``<.>``).
+___
+Minimal complete definition
+---------------------------
+ * ``pur x`` &nbsp; . &nbsp; ``result x``
+ * ``(<.>) f x``
+*)
+(**
+    static member Pure (x: 'T) : 'ZipApplicative<'T>
+    static member (<.>) (f: 'ZipApplicative<'T -> 'U>, x: 'ZipApplicative<'T>) : 'ZipApplicative<'U>
+*)
+(**
+
+
+Other operations
+----------------
+
+* ``zip``
+*)
+(**
+   static member Zip (x1: 'ZipApplicative<'T1>, x2: 'ZipApplicative<'T2>) : 'ZipApplicative<'T1 * 'T2>
+*)
+(**
+* ``map2``
+*)
+(**
+   static member Map2 (f: 'T1 -> 'T2 -> 'T, x1: 'ZipApplicative<'T1>, x2: 'ZipApplicative<'T2>) : 'ZipApplicative<'T>
+*)
+
+(**
+* ``map3``
+*)
+(**
+   static member Map3 (f: 'T1 -> 'T2 -> 'T3 -> 'T, x1: 'ZipApplicative<'T1>, x2: 'ZipApplicative<'T2>, x3: 'ZipApplicative<'T3>) : 'ZipApplicative<'T>
+*)
+
+(**
+
+
+Rules
+-----
+*)
+(**
+    pur id <.> v = v
+    pur (<<) <.> u <.> v <.> w = u <.> (v <.> w)
+    pur f <*> pur x = pur (f x)
+    u <*> pur y = pur ((|>) y) <.> u
+*)
+(**
+Related Abstractions
+--------------------
+ - [Functor](abstraction-functor.html): A zipApplicative is a functor whose ``map`` operation can be splitted in ``pur`` and ``(<.>)`` operations,
+ 
+ - [ZipApplicative](abstraction-applicative.html) : ZipApplicatives are applicatives which usually don't form a [Monad](abstraction-monad.html).
+
+Concrete implementations
+------------------------
+From F#
+ 
+ -  ``seq<'T>``
+ -  ``list<'T>``
+ -  ``option<'T>``   *
+ -  ``voption<'T>``  *
+ -  ``Lazy<'T>``     *
+ -  ``Async<'T>``
+ -  ``Result<'T, 'U>``
+ -  ``Choice<'T, 'U>``
+ -  ``KeyValuePair<'Key, 'T>``  *
+ -  ``'Monoid * 'T``            *
+ -  ``ValueTuple<'Monoid, 'T>`` *
+ -  ``Task<'T>``
+ -  ``ValueTask<'T>``
+ -  ``'R -> 'T``        *
+ -  ``Expr<'T>``        *
+ 
+ 
+From F#+
+
+ -  [``NonEmptySeq<'T>``]
+ -  [``NonEmptyList<'T>``](type-nonempty.html)
+ -  [``Compose<'ZipApplicative1<'ZipApplicative2<'T>>>``](type-compose.html)
+
+ (*) The operation is the same as that for the normal applicative
+ 
+
+Only for <*> operation:
+ -  ``array<'T>``
+ -  ``ResizeArray<'T>``
+ -  ``Map<'Key, 'T>``
+ -  ``Dictionary<'Key, 'T>``
+ -  ``IDictionary<'Key, 'T>``
+ -  ``IReadOnlyDictionary<'Key, 'T>``
+
+
+ [Suggest another](https://github.com/fsprojects/FSharpPlus/issues/new) concrete implementation
+
+Examples
+--------
+*)
+
+
+(**
+```f#
+#r @"nuget: FSharpPlus"
+```
+*)
+
+open FSharpPlus
+
+
+// pointwise operations
+
+let arr1 = (+) <!> [|1;2;3|] <*> [|10;20;30|]
+let arr2 = (+) <!> [|1;2;3|] <.> [|10;20;30|]
+
+// val arr1: int array = [|11; 21; 31; 12; 22; 32; 13; 23; 33|]
+// val arr2: int array = [|11; 22; 33|]
+
+
+// Validations
+
+let validated = app2 {
+    let! x = async { return Ok 1 }
+    and! y = async { return Ok 2 }
+    and! z = async { return Error ["Error"] }
+    return x + y + z
+}
+
+validated |> Async.RunSynchronously
+// val it: Result<int,string list> = Error ["Error"]

src/FSharpPlus/Builders.fs

@@ -210,20 +210,45 @@ module GenericBuilders =
         member        _.Run x : '``Applicative1<Applicative2<Applicative3<'T>>>`` = x
 
 
+    /// Generic ZipApplicative CE builder.
+    type ZipApplicativeBuilder<'``applicative<'t>``> () =
+        member        _.ReturnFrom (expr) = expr   : '``applicative<'t>``
+        member inline _.Return (x: 'T) = pur x : '``Applicative<'T>``
+        member inline _.Yield  (x: 'T) = pur x : '``Applicative<'T>``
+        member inline _.BindReturn(x, [<InlineIfLambda>]f) = map f x : '``Applicative<'U>``
+        member inline _.MergeSources  (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``) : '``Applicative<'T * 'U>`` = map2 tuple2 t1 t2
+        member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = map3 tuple3 t1 t2 t3
+        member        _.Run f : '``Applicative<'T>`` = f
+
+    /// Generic 2 layers ZipApplicative CE builder.
+    type ZipApplicativeBuilder2<'``applicative1<applicative2<'t>>``> () =
+        member        _.ReturnFrom expr : '``applicative1<applicative2<'t>>`` = expr
+        member inline _.Return (x: 'T) : '``Applicative1<Applicative2<'T>>`` = (pur >> pur) x
+        member inline _.Yield  (x: 'T) : '``Applicative1<Applicative2<'T>>`` = (pur >> pur) x
+        member inline _.BindReturn (x: '``Applicative1<Applicative2<'T>>``, [<InlineIfLambda>]f: _ -> _) : '``Applicative1<Applicative2<'U>>`` = (map >> map) f x
+        member inline _.MergeSources  (t1, t2)     : '``Applicative1<Applicative2<'T>>`` = (map2 >> map2) tuple2 t1 t2
+        member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1<Applicative2<'T>>`` = (map3 >> map3) tuple3 t1 t2 t3
+        member        _.Run x : '``Applicative1<Applicative2<'T>>`` = x
 
     /// Creates a (lazy) monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information)
     let monad<'``monad<'t>``> = new MonadFxBuilder<'``monad<'t>``> ()
 
     /// Creates a strict monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information)
     let monad'<'``monad<'t>``> = new MonadFxStrictBuilder<'``monad<'t>``> ()
 
-    /// Creates an applicative computation expression.
+    /// Creates a (sequential) applicative computation expression.
     let applicative<'``Applicative<'T>``> = ApplicativeBuilder<'``Applicative<'T>``> ()
 
-    /// Creates an applicative computation expression which compose effects of two Applicatives.
+    /// Creates a (sequential) applicative computation expression which compose effects of two Applicatives.
     let applicative2<'``Applicative1<Applicative2<'T>>``> = ApplicativeBuilder2<'``Applicative1<Applicative2<'T>>``> ()
 
-    /// Creates an applicative computation expression which compose effects of three Applicatives.
+    /// Creates a (sequential) applicative computation expression which compose effects of three Applicatives.
     let applicative3<'``Applicative1<Applicative2<Applicative3<'T>>>``> = ApplicativeBuilder3<'``Applicative1<Applicative2<Applicative3<'T>>>``> ()
 
+    /// Creates a (non sequential) applicative computation expression.
+    let app<'``ZipApplicative<'T>``> = ZipApplicativeBuilder<'``ZipApplicative<'T>``> ()
+
+    /// Creates a (non sequential) applicative computation expression which compose effects of two Applicatives.
+    let app2<'``ZipApplicative1<ZipApplicative2<'T>>``> = ZipApplicativeBuilder2<'``ZipApplicative1<ZipApplicative2<'T>>``> ()
+
 #endif

src/FSharpPlus/Control/Applicative.fs

@@ -109,12 +109,12 @@ type Lift2 =
     static member inline Lift2 (f, ((a: 'Monoid, x: 'T)   , (b: 'Monoid, y: 'U)   ), _mthd: Lift2) = Plus.Invoke a b, f x y
     static member inline Lift2 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U)), _mthd: Lift2) = struct (Plus.Invoke a b, f x y)
     #if !FABLE_COMPILER
-    static member        Lift2 (f, (x: Task<'T>           , y: Task<'U>           ), _mthd: Lift2) = Task.map2  f x y
+    static member        Lift2 (f, (x: Task<'T>           , y: Task<'U>           ), _mthd: Lift2) = Task.lift2  f x y
     #endif
     #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER
-    static member        Lift2 (f, (x: ValueTask<'T>      , y: ValueTask<'U>      ), _mthd: Lift2) = ValueTask.map2  f x y
+    static member        Lift2 (f, (x: ValueTask<'T>      , y: ValueTask<'U>      ), _mthd: Lift2) = ValueTask.lift2  f x y
     #endif
-    static member        Lift2 (f, (x                     , y                     ), _mthd: Lift2) = Async.map2  f x y
+    static member        Lift2 (f, (x                     , y                     ), _mthd: Lift2) = Async.lift2  f x y
     static member        Lift2 (f, (x                     , y                     ), _mthd: Lift2) = Option.map2 f x y
 
     #if !FABLE_COMPILER
@@ -158,12 +158,12 @@ type Lift3 =
     static member inline Lift3 (f, ((a: 'Monoid, x: 'T)   , (b: 'Monoid, y: 'U)   , (c: 'Monoid, z: 'U)    ), _mthd: Lift3) = Plus.Invoke (Plus.Invoke a b) c, f x y z
     static member inline Lift3 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U), struct (c: 'Monoid, z: 'U)), _mthd: Lift3) = struct (Plus.Invoke (Plus.Invoke a b) c, f x y z)
     #if !FABLE_COMPILER
-    static member        Lift3 (f, (x: Task<'T>           , y: Task<'U>           , z: Task<'V>            ), _mthd: Lift3) = Task.map3  f x y z
+    static member        Lift3 (f, (x: Task<'T>           , y: Task<'U>           , z: Task<'V>            ), _mthd: Lift3) = Task.lift3  f x y z
     #endif
     #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER
-    static member        Lift3 (f, (x: ValueTask<'T>      , y: ValueTask<'U>      , z: ValueTask<'V>       ), _mthd: Lift3) = ValueTask.map3  f x y z
+    static member        Lift3 (f, (x: ValueTask<'T>      , y: ValueTask<'U>      , z: ValueTask<'V>       ), _mthd: Lift3) = ValueTask.lift3  f x y z
     #endif
-    static member        Lift3 (f, (x                     , y                     , z                      ), _mthd: Lift3) = Async.map3  f x y z
+    static member        Lift3 (f, (x                     , y                     , z                      ), _mthd: Lift3) = Async.lift3  f x y z
     static member        Lift3 (f, (x                     , y                     , z                      ), _mthd: Lift3) = Option.map3 f x y z
 
     #if !FABLE_COMPILER

src/FSharpPlus/Control/Functor.fs

@@ -217,8 +217,9 @@ type Zip =
     static member Zip ((x: 'T []                      , y: 'U []                     , _output: ('T*'U) []                   ), _mthd: Zip) = Array.zipShortest       x y
     static member Zip ((x: ResizeArray<'T>            , y: ResizeArray<'U>           , _output: ResizeArray<'T*'U>           ), _mthd: Zip) = ResizeArray.zipShortest x y
     static member Zip ((x: option<'T>                 , y: option<'U>                , _output: option<'T*'U>                ), _mthd: Zip) = Option.zip              x y
-    static member Zip ((x: voption<'T>                , y: voption<'U>              , _output: voption<'T*'U>                ), _mthd: Zip) = ValueOption.zip         x y
-    static member Zip ((x: Result<'T, 'Error>         , y: Result<'U, 'Error>        , _output: Result<'T * 'U, 'Error>      ), _mthd: Zip) = Result.zip              x y
+    static member Zip ((x: voption<'T>                , y: voption<'U>               , _output: voption<'T*'U>               ), _mthd: Zip) = ValueOption.zip         x y
+    static member inline Zip ((x: Result<'T, 'Error>  , y: Result<'U, 'Error>        , _output: Result<'T * 'U, 'Error>      ), _mthd: Zip) = Result.apply2With Plus.Invoke (fun a b -> a, b) x y
+    static member inline Zip ((x: Choice<'T, 'Error>  , y: Choice<'U, 'Error>        , _output: Choice<'T * 'U, 'Error>      ), _mthd: Zip) = Choice.apply2With Plus.Invoke (fun a b -> a, b) x y
     static member Zip ((x: Async<'T>                  , y: Async<'U>                 , _output: Async<'T*'U>                 ), _mthd: Zip) = Async.zip               x y
     #if !FABLE_COMPILER
     static member Zip ((x: Task<'T>                   , y: Task<'U>                  , _output: Task<'T*'U>                  ), _mthd: Zip) = Task.zip                x y

src/FSharpPlus/Control/MonadOps.fs

@@ -8,6 +8,8 @@ module internal MonadOps =
     let inline (>>=) x f = Bind.Invoke x f
     let inline result  x = Return.Invoke x
     let inline (<*>) f x = Apply.Invoke f x
+    let inline pur x = Pure.Invoke x
+    let inline (<.>) f x = ZipApply.Invoke f x
     let inline (<|>) x y = Append.Invoke x y
     let inline (>=>) (f: 'a->'``Monad<'b>``) (g: 'b->'``Monad<'c>``) (x: 'a) : '``Monad<'c>`` = f x >>= g
 

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 =
@@ -116,13 +118,13 @@ type Plus with
 #if !FABLE_COMPILER
 type Plus with    
 
-    static member inline ``+`` (x: 'a Task, y: 'a Task, [<Optional>]_mthd: Plus) = Task.map2 Plus.Invoke x y
+    static member inline ``+`` (x: 'a Task, y: 'a Task, [<Optional>]_mthd: Plus) = Task.lift2 Plus.Invoke x y
 #endif
 
 #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER
 type Plus with    
 
-    static member inline ``+`` (x: 'a ValueTask, y: 'a ValueTask, [<Optional>]_mthd: Plus) = ValueTask.map2 Plus.Invoke x y
+    static member inline ``+`` (x: 'a ValueTask, y: 'a ValueTask, [<Optional>]_mthd: Plus) = ValueTask.lift2 Plus.Invoke x y
 
 #endif
 
@@ -138,7 +140,7 @@ type Plus with
 
     static member inline ``+`` (f: 'T->'Monoid, g: 'T->'Monoid, [<Optional>]_mthd: Plus) = (fun x -> Plus.Invoke (f x) (g x)) : 'T->'Monoid
 
-    static member inline ``+`` (x: 'S Async   , y: 'S Async   , [<Optional>]_mthd: Plus) = Async.map2 Plus.Invoke x y
+    static member inline ``+`` (x: 'S Async   , y: 'S Async   , [<Optional>]_mthd: Plus) = Async.lift2 Plus.Invoke x y
 
     static member inline ``+`` (x: 'a Expr    , y: 'a Expr    , [<Optional>]_mthd: Plus) : 'a Expr =
                     let inline f (x: 'a)  : 'a -> 'a = Plus.Invoke x