diff --git a/docsrc/content/abstraction-traversable.fsx b/docsrc/content/abstraction-traversable.fsx index 411cb8a52..85068e440 100644 --- a/docsrc/content/abstraction-traversable.fsx +++ b/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>> *) (** diff --git a/docsrc/content/abstraction-zipapplicative.fsx b/docsrc/content/abstraction-zipapplicative.fsx new file mode 100644 index 000000000..8510c2bdb --- /dev/null +++ b/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``   .   ``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 = Error ["Error"] diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 0936ae1df..092c361d4 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -210,6 +210,25 @@ module GenericBuilders = member _.Run x : '``Applicative1>>`` = 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, []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>``> () = + member _.ReturnFrom expr : '``applicative1>`` = expr + member inline _.Return (x: 'T) : '``Applicative1>`` = (pur >> pur) x + member inline _.Yield (x: 'T) : '``Applicative1>`` = (pur >> pur) x + member inline _.BindReturn (x: '``Applicative1>``, []f: _ -> _) : '``Applicative1>`` = (map >> map) f x + member inline _.MergeSources (t1, t2) : '``Applicative1>`` = (map2 >> map2) tuple2 t1 t2 + member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>`` = (map3 >> map3) tuple3 t1 t2 t3 + member _.Run x : '``Applicative1>`` = 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>``> () @@ -217,13 +236,19 @@ module GenericBuilders = /// 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>``> = ApplicativeBuilder2<'``Applicative1>``> () - /// 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>>``> = ApplicativeBuilder3<'``Applicative1>>``> () + /// 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>``> = ZipApplicativeBuilder2<'``ZipApplicative1>``> () + #endif diff --git a/src/FSharpPlus/Control/Applicative.fs b/src/FSharpPlus/Control/Applicative.fs index 54675adcd..11f5aeb8d 100644 --- a/src/FSharpPlus/Control/Applicative.fs +++ b/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 diff --git a/src/FSharpPlus/Control/Functor.fs b/src/FSharpPlus/Control/Functor.fs index 2058fd069..8bf8e61f8 100644 --- a/src/FSharpPlus/Control/Functor.fs +++ b/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 diff --git a/src/FSharpPlus/Control/MonadOps.fs b/src/FSharpPlus/Control/MonadOps.fs index 9e7409f20..f7e1b7059 100644 --- a/src/FSharpPlus/Control/MonadOps.fs +++ b/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 diff --git a/src/FSharpPlus/Control/Monoid.fs b/src/FSharpPlus/Control/Monoid.fs index a4aaa8126..145a8341b 100644 --- a/src/FSharpPlus/Control/Monoid.fs +++ b/src/FSharpPlus/Control/Monoid.fs @@ -34,13 +34,15 @@ type Plus = static member ``+`` (x: AggregateException, y: AggregateException, []_mthd: Plus ) = new AggregateException (seq {yield! x.InnerExceptions; yield! y.InnerExceptions}) static member ``+`` (x: exn , y: exn , []_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 , []_mthd: Plus ) = StringBuilder().Append(string x).Append(string y) static member ``+`` (_: Id0 , _: Id0 , []_mthd: Plus ) = Id0 "" static member ``+`` (x: exn , y: exn , []_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, []_mthd: Plus) = Task.map2 Plus.Invoke x y + static member inline ``+`` (x: 'a Task, y: 'a Task, []_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, []_mthd: Plus) = ValueTask.map2 Plus.Invoke x y + static member inline ``+`` (x: 'a ValueTask, y: 'a ValueTask, []_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, []_mthd: Plus) = (fun x -> Plus.Invoke (f x) (g x)) : 'T->'Monoid - static member inline ``+`` (x: 'S Async , y: 'S Async , []_mthd: Plus) = Async.map2 Plus.Invoke x y + static member inline ``+`` (x: 'S Async , y: 'S Async , []_mthd: Plus) = Async.lift2 Plus.Invoke x y static member inline ``+`` (x: 'a Expr , y: 'a Expr , []_mthd: Plus) : 'a Expr = let inline f (x: 'a) : 'a -> 'a = Plus.Invoke x diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 9b4363c3d..957126000 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -244,4 +244,246 @@ type Sequence with let inline call (a: 'a, b: 'b) = call_3 (a, b, Unchecked.defaultof<'R>) : 'R call (Unchecked.defaultof, t) -#endif + + +// Pointwise/Parallel traversables + + +type Transpose = + inherit Default1 + static member inline InvokeOnInstance (t: '``Traversable<'Functor<'T>>``) = (^``Traversable<'Functor<'T>>`` : (static member Transpose : _ -> _) t) : '``Functor<'Traversable<'T>>`` + + [] + static member inline ForInfiniteSequences (t: seq<_>, []isFailure, []conversion, []result) = + let add x y = y :: x + let mutable go = true + let mutable r = Unchecked.defaultof<_> + let mutable isEmpty = true + use e = t.GetEnumerator () + while go && e.MoveNext () do + if isFailure e.Current then go <- false + if isEmpty then r <- Map.Invoke List.singleton e.Current + else r <- Map.Invoke add r <.> e.Current + isEmpty <- false + if isEmpty then result (conversion []) + else Map.Invoke (List.rev >> conversion) r + +type Gather = + inherit Default1 + static member inline InvokeOnInstance f (t: ^a) = (^a : (static member Gather : _ * _ -> 'R) t, f) + + static member inline Gather (t: '``Traversable<'T>``, f: 'T -> '``Functor<'U>``, []_output: '``Functor<'Traversable<'U>>``, []_impl: Default4) = + #if TEST_TRACE + Traces.add "Gather 'Traversable, 'T -> Functor<'U>" + #endif + let mapped = Map.Invoke f t : '``Traversable<'Functor<'U>>`` + (^``Traversable<'T>`` : (static member Transpose : _ -> _) mapped) : '``Functor<'Traversable<'U>>`` + + static member inline Gather (t: Id<_>, f, []_output: 'R, []_impl: Default3) = + #if TEST_TRACE + Traces.add "Gather Id" + #endif + Map.Invoke Id.create (f (Id.run t)) + + static member inline Gather (t: _ seq, f, []_output: 'R, []_impl: Default3) = + #if TEST_TRACE + Traces.add "Gather seq" + #endif + let cons x y = seq {yield x; yield! y} + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) <.> ys + Seq.foldBack cons_f t (Pure.Invoke Seq.empty) + + static member inline Gather (t: _ NonEmptySeq, f, []_output: 'R, []_impl: Default3) = + #if TEST_TRACE + Traces.add "Gather NonEmptySeq" + #endif + let cons x y = seq {yield x; yield! y} + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) <.> ys + Map.Invoke NonEmptySeq.ofSeq (Seq.foldBack cons_f t (Pure.Invoke Seq.empty)) + + static member inline Gather (t: seq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = + #if TEST_TRACE + Traces.add "Gather seq, 'T -> Functor<'U>" + #endif + let mapped = Seq.map f t + Transpose.ForInfiniteSequences (mapped, IsZipLeftZero.Invoke, List.toSeq, Pure.Invoke) : '``Functor>`` + + static member inline Gather (t: NonEmptySeq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = + #if TEST_TRACE + Traces.add "Gather NonEmptySeq, 'T -> Functor<'U>" + #endif + let mapped = NonEmptySeq.map f t + Transpose.ForInfiniteSequences (mapped, IsZipLeftZero.Invoke, NonEmptySeq.ofList, Pure.Invoke) : '``Functor>`` + + static member inline Gather (t: ^a, f, []_output: 'R, []_impl: Default1) : 'R = + #if TEST_TRACE + Traces.add "Gather ^a" + #endif + Gather.InvokeOnInstance f t + static member inline Gather (_: ^a when ^a : null and ^a :struct, _, _: 'R, _impl: Default1) = id + + #if !FABLE_COMPILER + static member Gather (t: 't seq, f: 't -> Async<'u>, []_output: Async>, []_impl: Gather) : Async> = async { + #if TEST_TRACE + Traces.add "Gather 't seq, 't -> Async<'u>" + #endif + + let! ct = Async.CancellationToken + return seq { + use enum = t.GetEnumerator () + while enum.MoveNext() do + yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) }} + #endif + + #if !FABLE_COMPILER + static member Gather (t: 't NonEmptySeq, f: 't -> Async<'u>, []_output: Async>, []_impl: Gather) : Async> = async { + #if TEST_TRACE + Traces.add "Gather 't NonEmptySeq, 't -> Async<'u>" + #endif + + let! ct = Async.CancellationToken + return seq { + use enum = t.GetEnumerator () + while enum.MoveNext() do + yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) } |> NonEmptySeq.unsafeOfSeq } + #endif + + static member Gather (t: Id<'t>, f: 't -> option<'u>, []_output: option>, []_impl: Gather) = + #if TEST_TRACE + Traces.add "Gather Id, 't -> option<'u>" + #endif + Option.map Id.create (f (Id.run t)) + + static member inline Gather (t: option<_>, f, []_output: 'R, []_impl: Gather) : 'R = + #if TEST_TRACE + Traces.add "Gather option" + #endif + match t with Some x -> Map.Invoke Some (f x) | _ -> Pure.Invoke None + + static member inline Gather (t: voption<_>, f, []_output: 'R, []_impl: Gather) : 'R = + #if TEST_TRACE + Traces.add "Gather voption" + #endif + match t with ValueSome x -> Map.Invoke ValueSome (f x) | _ -> Pure.Invoke ValueNone + + static member inline Gather (t:Map<_,_> , f, []_output: 'R, []_impl: Gather) : 'R = + #if TEST_TRACE + Traces.add "Gather Map" + #endif + let insert_f m k v = Map.Invoke (Map.add k) v <.> m + Map.fold insert_f (Pure.Invoke Map.empty) (Map.mapValues f t) + + static member inline Gather (t: Result<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Gather) : '``Functor>`` = + #if TEST_TRACE + Traces.add "Gather Result, 'T -> Functor<'U>" + #endif + match t with + | Ok a -> Map.Invoke Result<'U, 'Error>.Ok (f a) + | Error e -> Pure.Invoke (Result<'U, 'Error>.Error e) + + static member inline Gather (t: Choice<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Gather) : '``Functor>`` = + #if TEST_TRACE + Traces.add "Gather Choice, 'T -> Functor<'U>" + #endif + match t with + | Choice1Of2 a -> Map.Invoke Choice<'U,'Error>.Choice1Of2 (f a) + | Choice2Of2 e -> Pure.Invoke (Choice<'U,'Error>.Choice2Of2 e) + + static member inline Gather (t:list<_>,f , []_output: 'R, []_impl: Gather) : 'R = + #if TEST_TRACE + Traces.add "Gather list" + #endif + let rec loop acc = function + | [] -> acc + | x::xs -> + let v = f x + loop (v::acc) xs + let cons_f x xs = Map.Invoke List.cons xs <.> x + List.fold cons_f (Pure.Invoke []) (loop [] t) + + static member inline Gather (t:_ [],f , []_output: 'R, []_impl: Gather) : 'R = + #if TEST_TRACE + Traces.add "Gather []" + #endif + let cons x y = Array.append [|x|] y + let rec loop acc = function + | [||] -> acc + | xxs -> + let x, xs = Array.head xxs, Array.tail xxs + let v = f x + loop (cons v acc) xs + let cons_f x xs = Map.Invoke cons xs <.> x + Array.fold cons_f (Pure.Invoke [||]) (loop [||] t) + + static member inline Invoke (f: 'T -> '``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = + let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member Gather : _*_*_*_ -> _) b, f, c, a) + let inline call (a: 'a, b: 'b, f) = call_3 (a, b, Unchecked.defaultof<'R>, f) : 'R + call (Unchecked.defaultof, t, f) + + +type Transpose with + + static member inline Transpose (t: _ seq, []_output: 'R, []_impl: Default5) : 'R = + let cons x y = seq { yield x; yield! y } + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) x <.> ys + Seq.foldBack cons_f t (Pure.Invoke Seq.empty) + + static member inline Transpose (t: seq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = + Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, List.toSeq, Pure.Invoke) + + static member Transpose (t: seq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t + #if !FABLE_COMPILER + static member Transpose (t: seq> , []_output: voption> , []_impl: Default3) : voption> = ValueOption.Sequence t + #endif + static member inline Transpose (t: seq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) + static member inline Transpose (t: seq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) + static member Transpose (t: seq> , []_output: list> , []_impl: Default3) : list> = Transpose.ForInfiniteSequences (t, List.isEmpty, List.toSeq, List.singleton >> List.cycle) + + #if !FABLE_COMPILER + static member Transpose (t: seq> , []_output: Async> , []_impl: Default3) : Async> = Async.Parallel t |> Async.map Array.toSeq + #endif + static member inline Transpose (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>``, []_impl: Default4) : '``Applicative>`` = Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + static member Transpose (t: NonEmptySeq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t |> Option.map NonEmptySeq.unsafeOfSeq + static member inline Transpose (t: NonEmptySeq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) |> Result.map NonEmptySeq.unsafeOfSeq + static member inline Transpose (t: NonEmptySeq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) |> Choice.map NonEmptySeq.unsafeOfSeq + static member Transpose (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = Transpose.ForInfiniteSequences (t, List.isEmpty , NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + static member Transpose (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = Transpose.ForInfiniteSequences (t, Array.isEmpty, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + #if !FABLE_COMPILER + static member Transpose (t: NonEmptySeq> , []_output: Async> , []_impl: Default3) = Async.Parallel t |> Async.map NonEmptySeq.unsafeOfSeq : Async> + #endif + + static member inline Transpose (t: ^a , []_output: 'R, []_impl: Default2) : 'R = Gather.InvokeOnInstance id t + static member inline Transpose (t: ^a , []_output: 'R, []_impl: Default1) : 'R = Transpose.InvokeOnInstance t + + static member inline Transpose (t: option<_> , []_output: 'R, []_impl: Transpose) : 'R = match t with Some x -> Map.Invoke Some x | _ -> Pure.Invoke None + #if !FABLE_COMPILER + static member inline Transpose (t: voption<_>, []_output: 'R, []_impl: Transpose) : 'R = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> Pure.Invoke ValueNone + #endif + static member inline Transpose (t: list<_> , []_output: 'R, []_impl: Transpose) : 'R = Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, id, Pure.Invoke) + + static member inline Transpose (t: Map<_,_> , []_output: 'R, []_impl: Transpose) : 'R = + let insert_f k x ys = Map.Invoke (Map.add k) x <.> ys + Map.foldBack insert_f t (Pure.Invoke Map.empty) + + static member inline Transpose (t: Result<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: Transpose) : '``Functor>`` = + match t with + | Ok a -> Map.Invoke Result<'T,'Error>.Ok a + | Error e -> Pure.Invoke (Result<'T,'Error>.Error e) + + static member inline Transpose (t: Choice<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: Transpose) : '``Functor>`` = + match t with + | Choice1Of2 a -> Map.Invoke Choice<'T,'Error>.Choice1Of2 a + | Choice2Of2 e -> Pure.Invoke (Choice<'T,'Error>.Choice2Of2 e) + + static member inline Transpose (t: _ [] , []_output: 'R , []_impl: Transpose) : 'R = Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, Array.ofList, Pure.Invoke) + + static member inline Transpose (t: Id<'``Functor<'T>``> , []_output: '``Functor>`` , []_impl: Transpose) : '``Functor>`` = Gather.Invoke id t + + static member inline Transpose (t: ResizeArray<'``Functor<'T>``>, []_output: '``Functor>``, []_impl: Transpose) : '``Functor>``= Gather.Invoke id t + + static member inline Invoke (t: '``Traversable<'Applicative<'T>>``) : '``Applicative<'Traversable<'T>>`` = + let inline call_3 (a: ^a, b: ^b, c: ^c) = ((^a or ^b or ^c) : (static member Transpose : _*_*_ -> _) b, c, a) + let inline call (a: 'a, b: 'b) = call_3 (a, b, Unchecked.defaultof<'R>) : 'R + call (Unchecked.defaultof, t) + +#endif \ No newline at end of file diff --git a/src/FSharpPlus/Control/ZipApplicative.fs b/src/FSharpPlus/Control/ZipApplicative.fs new file mode 100644 index 000000000..3569acbad --- /dev/null +++ b/src/FSharpPlus/Control/ZipApplicative.fs @@ -0,0 +1,261 @@ +namespace FSharpPlus.Control + +open System +open System.Text +open System.Runtime.InteropServices +open System.Collections.Generic +open System.Threading.Tasks +open Microsoft.FSharp.Quotations + +open FSharpPlus.Internals +open FSharpPlus.Internals.Prelude +open FSharpPlus +open FSharpPlus.Data + + +[] +module ZipApplivativeConts = + let []MessagePure = "'Pure' operation is not defined for " + let []Code = 10707 + +open ZipApplivativeConts + +type Pure = + inherit Default1 + static member inline InvokeOnInstance (x: 'T) = (^``ZipApplicative<'T>`` : (static member Pure : ^T -> ^``ZipApplicative<'T>``) x) + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + + static member inline Invoke (x: 'T) : '``ZipApplicative<'T>`` = + let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member Pure : _*_ -> _) output, mthd) + call (Unchecked.defaultof, Unchecked.defaultof<'``ZipApplicative<'T>``>) x + + static member Pure (_: seq<'a> , _: Default2 ) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> + static member Pure (_: NonEmptySeq<'a> , _: Default2 ) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> + static member Pure (_: IEnumerator<'a> , _: Default2 ) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> + static member inline Pure (_: 'R , _: Default1 ) = fun (x: 'T) -> Pure.InvokeOnInstance x : 'R + static member Pure (x: Lazy<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) : _ -> Lazy<'a> + #if !FABLE_COMPILER + static member Pure (_: 'T Task , _: Pure) = fun x -> Task.FromResult x : 'T Task + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member Pure (_: 'T ValueTask , _: Pure) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + #endif + static member Pure (x: option<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member Pure (x: voption<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member Pure (_: list<'a> , _: Pure) = fun x -> List.cycle [x] : list<'a> + + [] + static member Pure (x: 'a [] , _: Pure) = Return.Return (x, Unchecked.defaultof) + + static member Pure (x: 'r -> 'a , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member inline Pure (x: 'm * 'a , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member inline Pure (x: struct ('m * 'a), _: Pure) = Return.Return (x, Unchecked.defaultof) + static member Pure (_: 'a Async , _: Pure) = fun (x: 'a) -> async.Return x + static member inline Pure (_: Result<'t, 'e> , _: Pure) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Ok x : Result<'t, 'e> + static member inline Pure (_: Choice<'t, 'e> , _: Pure) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Choice1Of2 x : Choice<'t, 'e> + #if !FABLE_COMPILER + static member Pure (x: Expr<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) + #endif + + [.", Code, IsError = true)>] + static member Pure (x: ResizeArray<'a>, _: Pure ) = Return.Return (x, Unchecked.defaultof) + + //Restricted + [] + static member Pure (_: string , _: Pure ) = fun (x: char) -> string x : string + [] + static member Pure (_: StringBuilder , _: Pure ) = fun (x: char) -> new StringBuilder (string x) : StringBuilder + [] + static member Pure (_: 'a Set , _: Pure ) = fun (x: 'a ) -> Set.singleton x + static member Pure (_: 'a Set2 , _: Pure ) = fun (_: 'a ) -> Set2() : 'a Set2 + +#endif + +type ZipApply = + inherit Default1 + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + + static member ``<.>`` (struct (f: Lazy<'T->'U> , x: Lazy<'T> ), []_output: Lazy<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: seq<_> , x: seq<'T> ), []_output: seq<'U> , []_mthd: ZipApply) = Seq.map2 (<|) f x + static member ``<.>`` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T> ), []_output: NonEmptySeq<'U> , []_mthd: ZipApply) = NonEmptySeq.map2 (<|) f x + static member ``<.>`` (struct (f: IEnumerator<_> , x: IEnumerator<'T> ), []_output: IEnumerator<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: list<_> , x: list<'T> ), []_output: list<'U> , []_mthd: ZipApply) = List.map2Shortest (<|) f x + static member ``<.>`` (struct (f: _ [] , x: 'T [] ), []_output: 'U [] , []_mthd: ZipApply) = Array.map2Shortest (<|) f x + static member ``<.>`` (struct (f: 'r -> _ , x: _ -> 'T ), []_output: 'r -> 'U , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: 'Monoid * _ , x: ('Monoid * 'T) ), []_output: 'Monoid * 'U , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: struct ('Monoid * _), x: struct ('Monoid * 'T)), []_output: struct ('Monoid * 'U), []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + #if !FABLE_COMPILER + static member ``<.>`` (struct (f: Task<_> , x: Task<'T> ), []_output: Task<'U> , []_mthd: ZipApply) = Task.map2 (<|) f x + #endif + #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER + static member ``<.>`` (struct (f: ValueTask<_> , x: ValueTask<'T> ), []_output: ValueTask<'U> , []_mthd: ZipApply) = ValueTask.map2 (<|) f x + #endif + static member ``<.>`` (struct (f: Async<_> , x: Async<'T> ), []_output: Async<'U> , []_mthd: ZipApply) : Async<'U> = Async.map2 (<|) f x + static member ``<.>`` (struct (f: option<_> , x: option<'T> ), []_output: option<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: voption<_> , x: voption<'T> ), []_output: voption<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: Result<_,'E> , x: Result<'T,'E> ), []_output: Result<'b,'E> , []_mthd: ZipApply) : Result<'U, 'E> = Result.apply2With Plus.Invoke (<|) f x + static member inline ``<.>`` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), []_output: Choice<'b,'E> , []_mthd: ZipApply) : Choice<'U, 'E> = Choice.apply2With Plus.Invoke (<|) f x + static member inline ``<.>`` (struct (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>), []_output: KeyValuePair<'Key,'U>, []_mthd: Default2) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: KeyValuePair2<_,_> , x: KeyValuePair2<_,'T> ) , _output: KeyValuePair2<_,'U> , _mthd: Default2) : KeyValuePair2<'Key,'U> = + let a, b = f.Key, x.Key + let f, x = f.Value, x.Value + KeyValuePair2 (Plus.Invoke a b, f x) + + + static member ``<.>`` (struct (f: Map<'Key,_> , x: Map<'Key,'T> ), []_output: Map<'Key,'U> , []_mthd: ZipApply) : Map<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: Dictionary<'Key,_> , x: Dictionary<'Key,'T> ), []_output: Dictionary<'Key,'U> , []_mthd: ZipApply) : Dictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: IDictionary<'Key,_> , x: IDictionary<'Key,'T> ), []_output: IDictionary<'Key,'U> , []_mthd: ZipApply) : IDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> ), []_output: IReadOnlyDictionary<'Key,'U>, []_mthd: ZipApply) : IReadOnlyDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + + #if !FABLE_COMPILER + static member ``<.>`` (struct (f: Expr<'T->'U>, x: Expr<'T>), []_output: Expr<'U>, []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + #endif + static member ``<.>`` (struct (f: ('T->'U) ResizeArray, x: 'T ResizeArray), []_output: 'U ResizeArray, []_mthd: ZipApply) = ResizeArray.map2Shortest (<|) f x + + static member inline Invoke (f: '``ZipApplicative<'T -> 'U>``) (x: '``ZipApplicative<'T>``) : '``ZipApplicative<'U>`` = + let inline call (mthd: ^M, input1: ^I1, input2: ^I2, output: ^R) = + ((^M or ^I1 or ^I2 or ^R) : (static member ``<.>`` : struct (_*_) * _ * _ -> _) (struct (input1, input2)), output, mthd) + call(Unchecked.defaultof, f, x, Unchecked.defaultof<'``ZipApplicative<'U>``>) + +#endif + + static member inline InvokeOnInstance (f: '``ZipApplicative<'T->'U>``) (x: '``ZipApplicative<'T>``) : '``ZipApplicative<'U>`` = + ((^``ZipApplicative<'T->'U>`` or ^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>``) : (static member (<.>) : _*_ -> _) (f, x)) + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + +type ZipApply with + static member inline ``<.>`` (struct (_: ^t when ^t : null and ^t: struct, _: ^u when ^u : null and ^u: struct), _output: ^r when ^r : null and ^r: struct, _mthd: Default1) = id + static member inline ``<.>`` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, []_mthd: Default1) : '``Applicative<'U>`` = + ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<.>) : _*_ -> _) f, x) + + +type Map2 = + inherit Default1 + + static member Map2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Map2 (f, (x: seq<_> , y: seq<_> ), _mthd: Map2) = Seq.map2 f x y + static member Map2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: Map2) = NonEmptySeq.map2 f x y + static member Map2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Map2 (f, (x , y ), _mthd: Map2) = List.map2Shortest f x y + static member Map2 (f, (x: _ [] , y: _ [] ), _mthd: Map2) = Array.map2Shortest f x y + static member Map2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline Map2 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline Map2 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U)), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: Map2) = Task.map2 f x y + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member Map2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: Map2) = ValueTask.map2 f x y + #endif + static member Map2 (f, (x , y ), _mthd: Map2) = Async.map2 f x y + static member Map2 (f, (x: option<_> , y: option<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + + #if !FABLE_COMPILER + static member Map2 (f, (x: voption<_> , y: voption<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #endif + static member inline Map2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: Map2) = Result.apply2With Plus.Invoke f x y + static member inline Map2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: Map2) = Choice.map2 f x y + static member Map2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Map2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #endif + static member Map2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: Map2) = ResizeArray.map2Shortest f x y + + static member inline Invoke (f: 'T -> 'U -> 'V) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) : '``ZipApplicative<'V>`` = + let inline call (mthd : ^M, input1: ^I1, input2: ^I2, _output: ^R) = + ((^M or ^I1 or ^I2 or ^R) : (static member Map2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) + call (Unchecked.defaultof, x, y, Unchecked.defaultof<'``ZipApplicative<'V>``>) + + static member inline InvokeOnInstance (f: 'T -> 'U -> 'V) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) = + ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>``) : (static member Map2 : _*_*_ -> _) f, x, y) + +type Map2 with + static member inline Map2 (f, (x, y), _mthd: Default2) = (((Pure.InvokeOnInstance f, x) ||> ZipApply.InvokeOnInstance), y) ||> ZipApply.InvokeOnInstance + + static member inline Map2 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct), _mthd: Default1) = id + static member inline Map2 (f: 'T -> 'U -> 'V, (x: '``ZipApplicative<'T>``, y: '``ZipApplicative<'U>``), _mthd: Default1) = ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>`` ) : (static member Map2 : _*_*_ -> _) f, x, y) + +type Map3 = + inherit Default1 + + static member Map3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Map3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: Map3) = Seq.map3 f x y z + static member Map3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: Map3) = NonEmptySeq.map3 f x y z + static member Map3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Map3 (f, (x , y , z ), _mthd: Map3) = List.map3Shortest f x y z + static member Map3 (f, (x: _ [] , y: _ [] , z: _ [] ), _mthd: Map3) = Array.map3Shortest f x y z + static member Map3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline Map3 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U , z: 'Monoid * 'V ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline Map3 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U), z: struct ('Monoid* 'T)), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: Map3) = Task.map3 f x y z + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member Map3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: Map3) = ValueTask.map3 f x y z + #endif + static member Map3 (f, (x , y , z ), _mthd: Map3) = Async.map3 f x y z + static member Map3 (f, (x: option<_> , y: option<_> , z: option<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + + #if !FABLE_COMPILER + static member Map3 (f, (x: voption<_> , y: voption<_> , z: voption<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #endif + static member inline Map3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: Map3) = Result.apply3With Plus.Invoke f x y z + static member inline Map3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: Map3) = Choice.apply3With Plus.Invoke f x y z + static member Map3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Map3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #endif + static member Map3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: Map3) = ResizeArray.map3Shortest f x y z + + static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) (z: '``ZipApplicative<'V>``) : '``ZipApplicative<'W>`` = + let inline call (mthd: ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = + ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member Map3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) + call (Unchecked.defaultof, x, y, z, Unchecked.defaultof<'``ZipApplicative<'W>``>) + + static member inline InvokeOnInstance (f: 'T -> 'U -> 'V -> 'W) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) (z: '``ZipApplicative<'V>``)= + ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>`` or ^``ZipApplicative<'V>``) : (static member Map3 : _*_*_*_ -> _) f, x, y, z) + +type Map3 with + static member inline Map3 (f, (x, y, z), _mthd: Default3) = ((((Pure.InvokeOnInstance f, x) ||> ZipApply.InvokeOnInstance), y) ||> ZipApply.InvokeOnInstance, z) ||> ZipApply.InvokeOnInstance + static member inline Map3 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct, _: ^v when ^v : null and ^v: struct), _mthd: Default1) = id + static member inline Map3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ZipApplicative<'T>``, y: '``ZipApplicative<'U>``, z: '``ZipApplicative<'V>``) , _mthd: Default1) = ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>`` or ^``ZipApplicative<'V>`` ) : (static member Map3 : _*_*_*_ -> _) f, x, y, z) + +type IsZipLeftZero = + inherit Default1 + + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = Seq.isEmpty t.Value + static member IsZipLeftZero (_: ref>, _mthd: IsZipLeftZero) = false + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = List.isEmpty t.Value + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = Array.isEmpty t.Value + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + #if !FABLE_COMPILER + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + #endif + static member IsZipLeftZero (_: ref> , _mthd: IsZipLeftZero) = false + static member IsZipLeftZero (_: ref> , _mthd: IsZipLeftZero) = false + + static member inline Invoke (x: '``ZipApplicative<'T>``) : bool = + let inline call (mthd: ^M, input: ^I) = + ((^M or ^I) : (static member IsZipLeftZero : _*_ -> _) ref input, mthd) + call(Unchecked.defaultof, x) + + static member inline InvokeOnInstance (x: '``ZipApplicative<'T>``) : bool = + ((^``ZipApplicative<'T>``) : (static member IsZipLeftZero : _ -> _) x) + +type IsZipLeftZero with + + static member inline IsZipLeftZero (_: ref<'T> when 'T : struct , _mthd: Default4) = false + static member inline IsZipLeftZero (_: ref<'T> when 'T : not struct, _mthd: Default3) = false + + // empty <.> f = empty ==> empty is left zero for <.> + static member inline IsZipLeftZero (t: ref<'``Alternative<'T>``> , _mthd: Default2) = (t.Value = Empty.InvokeOnInstance ()) + + static member inline IsZipLeftZero (t: ref<'``ZipApplicative<'T>``> , _mthd: Default1) = (^``ZipApplicative<'T>`` : (static member IsZipLeftZero : _ -> _) t.Value) + static member inline IsZipLeftZero (_: ref< ^t> when ^t: null and ^t: struct, _: Default1) = () + +#endif diff --git a/src/FSharpPlus/Data/Identity.fs b/src/FSharpPlus/Data/Identity.fs index e722c2a54..406b7d71a 100644 --- a/src/FSharpPlus/Data/Identity.fs +++ b/src/FSharpPlus/Data/Identity.fs @@ -22,13 +22,17 @@ module Identity = type Identity<'t> with static member Return x = Identity x : Identity<'T> + static member Pure x = Identity x : Identity<'T> static member Lift2 (f, Identity (x: 'T), Identity (y: 'U)) = Identity (f x y) : Identity<'V> static member Lift3 (f, Identity (x: 'T), Identity (y: 'U), Identity (z: 'V)) : Identity<'W> = Identity (f x y z) static member Map (Identity x, f : 'T->'U) = Identity (f x) : Identity<'U> + static member Map2 (f, Identity (x: 'T), Identity (y: 'U)) = Identity (f x y) : Identity<'V> + static member Map3 (f, Identity (x: 'T), Identity (y: 'U), Identity (z: 'V)) : Identity<'W> = Identity (f x y z) static member Zip (Identity x, Identity y) = Identity (x, y) : Identity<'T * 'U> static member (<*>) (Identity (f: 'T -> 'U), Identity (x: 'T)) : Identity<'U> = Identity (f x) + static member (<.>) (Identity (f: 'T -> 'U), Identity (x: 'T)) : Identity<'U> = Identity (f x) static member (>>=) (Identity x, f: 'T -> Identity<'U>) : Identity<'U> = f x diff --git a/src/FSharpPlus/Data/Monoids.fs b/src/FSharpPlus/Data/Monoids.fs index 69da14a38..5d4cef0d5 100644 --- a/src/FSharpPlus/Data/Monoids.fs +++ b/src/FSharpPlus/Data/Monoids.fs @@ -180,6 +180,15 @@ type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``> static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> + // ZipApplicative + static member inline (<.>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = + Compose ((((<.>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <.> x: '``ApplicativeF<'ApplicativeG<'U>``) + + static member inline Map2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = + Compose (Map2.Invoke (Map2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) + + static member inline Map3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = + Compose (Map3.Invoke (Map3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) /// Basic operations on Compose [] diff --git a/src/FSharpPlus/Data/NonEmptyList.fs b/src/FSharpPlus/Data/NonEmptyList.fs index 38281c520..9c9e5bbfb 100644 --- a/src/FSharpPlus/Data/NonEmptyList.fs +++ b/src/FSharpPlus/Data/NonEmptyList.fs @@ -86,6 +86,11 @@ module NonEmptyList = /// to each of the elements of the two non empty list pairwise. /// If one list is shorter, excess elements are discarded from the right end of the longer list. let map2Shortest f l1 l2 = { Head = f l1.Head l2.Head; Tail = List.map2Shortest f l1.Tail l2.Tail } + + /// Safely build a new non empty list whose elements are the results of applying the given function + /// to each of the elements of the three non empty list pointwise. + /// If one list is shorter, excess elements are discarded from the right end of the longer list. + let map3Shortest f l1 l2 l3 = { Head = f l1.Head l2.Head l3.Head; Tail = List.map3Shortest f l1.Tail l2.Tail l3.Tail } /// Build a new non empty list whose elements are the results of applying the given function with index /// to each of the elements of the non empty list. @@ -143,6 +148,18 @@ module NonEmptyList = /// let inline sequence (source: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = traverse id source + /// + /// Maps each element of the list to an action, evaluates these actions from left to right, pointwise, and/or in parallel then collect results. + /// + let inline gather (f: 'T -> '``ZipFunctor<'U>``) (source: NonEmptyList<'T>) = + Transpose.ForInfiniteSequences (Seq.map f source, IsZipLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") + + /// + /// Evaluates each action in the list from left to right, pointwise, and/or in parallel then collect results. + /// + let inline transpose (source: NonEmptyList<'``ZipFunctor<'T>``>) : '``Functor>`` = + Transpose.ForInfiniteSequences (source, IsZipLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") + #endif /// Returns the average of the elements in the list. @@ -246,9 +263,18 @@ type NonEmptyList<'t> with let r = NonEmptyList.toList f NonEmptyList.toList x {Head = r.Head; Tail = r.Tail} + static member Pure (x: 'a) = { Head = x; Tail = List.cycle [x] } + static member (<.>) (f: NonEmptyList<'T->'U>, x: NonEmptyList<'T>) = NonEmptyList.map2Shortest (<|) f x + static member Lift2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.ofList (List.lift2 f (NonEmptyList.toList x) (NonEmptyList.toList y)) static member Lift3 (f: 'T -> 'U -> 'V -> 'W, x, y, z) = NonEmptyList.ofList (List.lift3 f (NonEmptyList.toList x) (NonEmptyList.toList y) (NonEmptyList.toList z)) + [] + static member Map2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.map2Shortest f x y + + [] + static member Map3 (f: 'T -> 'U -> 'V -> 'W, x, y, z) = NonEmptyList.map3Shortest f x y z + static member Extract {Head = h; Tail = _} = h : 't #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 @@ -277,6 +303,12 @@ type NonEmptyList<'t> with [] static member inline Sequence (s: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = NonEmptyList.sequence s + [] + static member inline Gather (s: NonEmptyList<'T>, f: 'T -> '``Functor<'U>``) : '``Functor>`` = NonEmptyList.gather f s + + [] + static member inline Transpose (s: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = NonEmptyList.transpose s + static member Replace (source: NonEmptyList<'T>, oldValue: NonEmptyList<'T>, newValue: NonEmptyList<'T>, _impl: Replace ) = let lst = source |> NonEmptyList.toSeq |> Seq.replace oldValue newValue |> Seq.toList {Head = lst.Head; Tail = lst.Tail} diff --git a/src/FSharpPlus/Data/Validation.fs b/src/FSharpPlus/Data/Validation.fs index 4cc176805..34e621fe8 100644 --- 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 [] 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) + [] + static member inline Zip (x: Validation<'Error, 'T>, y: Validation<'Error, 'U>) : Validation<'Error, 'T * 'U> = Validation.zip x y + + [] + static member Pure x = Success x + + static member inline (<.>) (f: Validation<'Error, 'T -> 'U>, x: Validation<_, 'T>) : Validation<_, _> = Validation.apply f x + + [] + static member inline Map2 (f, x: Validation<'Error, 'T>, y: Validation<'Error, 'U>) : Validation<'Error, 'V> = Validation.map2 f x y + + [] + 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 ()) diff --git a/src/FSharpPlus/Extensions/Async.fs b/src/FSharpPlus/Extensions/Async.fs index 71f918b45..93be71b0d 100644 --- a/src/FSharpPlus/Extensions/Async.fs +++ b/src/FSharpPlus/Extensions/Async.fs @@ -10,36 +10,36 @@ module Async = let map f x = async.Bind (x, async.Return << f) /// Creates an async workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Workflows are run in sequence, for parallel use pmap2. + /// Workflows are run in sequence. /// The mapping function. /// First async workflow. /// Second async workflow. - let map2 f x y = async { + let lift2 f x y = async { let! a = x let! b = y return f a b} /// Creates an async workflow from three workflows 'x', 'y' and 'z', mapping its results with 'f'. - /// Workflows are run in sequence, for parallel use pmap3. + /// Workflows are run in sequence. /// The mapping function. /// First async workflow. /// Second async workflow. /// third async workflow. - let map3 f x y z = async { + let lift3 f x y z = async { let! a = x let! b = y let! c = z return f a b c} /// Creates an async workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift2 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First async workflow. /// Second async workflow. #if FABLE_COMPILER - let pmap2 f x y = map2 f x y + let map2 f x y = lift2 f x y #else - let pmap2 f x y = async { + let map2 f x y = async { let! ct = Async.CancellationToken let x = Async.StartImmediateAsTask (x, ct) let y = Async.StartImmediateAsTask (y, ct) @@ -49,15 +49,15 @@ module Async = #endif /// Creates an async workflow from three workflows 'x', 'y' and 'z', mapping its results with 'f'. - /// Similar to map3 but workflows are run in parallel. + /// Similar to lift3 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First async workflow. /// Second async workflow. /// third async workflow. #if FABLE_COMPILER - let pmap3 f x y z = map3 f x y z + let map3 f x y z = lift3 f x y z #else - let pmap3 f x y z = async { + let map3 f x y z = async { let! ct = Async.CancellationToken let x = Async.StartImmediateAsTask (x, ct) let y = Async.StartImmediateAsTask (y, ct) @@ -69,11 +69,25 @@ module Async = #endif /// Creates an async workflow from two workflows 'x' and 'y', tupling its results. - let zip x y = async { + let zipSequentially x y = async { let! a = x let! b = y return a, b} + /// Creates an async workflow from two workflows 'x' and 'y', tupling its results. + /// Similar to zipSequentially but although workflows are started in sequence they might end independently in different order. + #if FABLE_COMPILER + let zip x y = zipSequentially x y + #else + let zip x y = async { + let! ct = Async.CancellationToken + let x = Async.StartImmediateAsTask (x, ct) + let y = Async.StartImmediateAsTask (y, ct) + let! x' = Async.AwaitTask x + let! y' = Async.AwaitTask y + return x', y' } + #endif + /// Flatten two nested asyncs into one. let join x = async.Bind (x, id) diff --git a/src/FSharpPlus/Extensions/Choice.fs b/src/FSharpPlus/Extensions/Choice.fs index 630a87843..1230ed116 100644 --- a/src/FSharpPlus/Extensions/Choice.fs +++ b/src/FSharpPlus/Extensions/Choice.fs @@ -82,3 +82,16 @@ module Choice = try Choice1Of2 (f x) with e -> Choice2Of2 e + + let apply2With combiner f (x: Choice<'T, 'Error>) (y: Choice<'U, 'Error>) : Choice<'V, 'Error> = + match x, y with + | Choice1Of2 a, Choice1Of2 b -> Choice1Of2 (f a b) + | Choice2Of2 e, Choice1Of2 _ | Choice1Of2 _, Choice2Of2 e -> Choice2Of2 e + | Choice2Of2 e1, Choice2Of2 e2 -> Choice2Of2 (combiner e1 e2) + + let apply3With combiner f (x: Choice<'T, 'Error>) (y: Choice<'U, 'Error>) (z: Choice<'V, 'Error>) : Choice<'W, 'Error> = + match x, y, z with + | Choice1Of2 a, Choice1Of2 b, Choice1Of2 c -> Choice1Of2 (f a b c) + | Choice2Of2 e, Choice1Of2 _, Choice1Of2 _ | Choice1Of2 _, Choice2Of2 e, Choice1Of2 _ | Choice1Of2 _, Choice1Of2 _, Choice2Of2 e -> Choice2Of2 e + | Choice1Of2 _, Choice2Of2 e1, Choice2Of2 e2 | Choice2Of2 e1, Choice1Of2 _, Choice2Of2 e2 | Choice2Of2 e1, Choice2Of2 e2, Choice1Of2 _ -> Choice2Of2 (combiner e1 e2) + | Choice2Of2 e1, Choice2Of2 e2, Choice2Of2 e3 -> Choice2Of2 (combiner (combiner e1 e2) e3) \ No newline at end of file diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs index 1d22dd65b..59af7fc4d 100644 --- a/src/FSharpPlus/Extensions/Extensions.fs +++ b/src/FSharpPlus/Extensions/Extensions.fs @@ -207,7 +207,24 @@ module Extensions = | ValueNone -> Choice1Of2 (accumulator.Close () |> Array.toSeq) | ValueSome x -> Choice2Of2 x #endif - + + /// Returns all Errors combined, otherwise a sequence of all elements. + static member Parallel (combiner, t: seq>) = + let mutable error = ValueNone + let res = Seq.toArray (seq { + use e = t.GetEnumerator () + while e.MoveNext () do + match e.Current, error with + | Choice1Of2 v, ValueNone -> yield v + | Choice2Of2 e, ValueNone -> error <- ValueSome e + | Choice2Of2 e, ValueSome x -> error <- ValueSome (combiner x e) + | _ -> () }) + + match error with + | ValueNone -> Choice1Of2 (Array.toSeq res) + | ValueSome e -> Choice2Of2 e + + type Result<'t, 'error> with /// Returns the first Error if it contains an Error element, otherwise a list of all elements @@ -236,3 +253,19 @@ module Extensions = | ValueNone -> Ok (accumulator.Close () |> Array.toSeq) | ValueSome x -> Error x #endif + + /// Returns all Errors combined, otherwise a sequence of all elements. + static member Parallel (combiner, t: seq>) = + let mutable error = ValueNone + let res = Seq.toArray (seq { + use e = t.GetEnumerator () + while e.MoveNext () do + match e.Current, error with + | Ok v , ValueNone -> yield v + | Error e, ValueNone -> error <- ValueSome e + | Error e, ValueSome x -> error <- ValueSome (combiner x e) + | _ -> () }) + + match error with + | ValueNone -> Ok (Array.toSeq res) + | ValueSome e -> Error e diff --git a/src/FSharpPlus/Extensions/List.fs b/src/FSharpPlus/Extensions/List.fs index 9eb953785..b023a44cc 100644 --- a/src/FSharpPlus/Extensions/List.fs +++ b/src/FSharpPlus/Extensions/List.fs @@ -345,6 +345,22 @@ module List = loop (ls, rs) loop (list1, list2) #endif + + let map3Shortest mapping (list1: list<'T1>) (list2: list<'T2>) (list3: list<'T3>) : list<'U> = + #if FABLE_COMPILER + let rec loop acc = function + | (l1::l1s, l2::l2s, l3::l3s) -> loop ((mapping l1 l2 l3)::acc) (l1s, l2s, l3s) + | (_, _, _) -> acc + loop [] (list1, list2, list3) |> List.rev + #else + let mutable coll = new ListCollector<'U> () + let rec loop = function + | ([], _, _) | (_, [], _)| (_, _, []) -> coll.Close () + | (l1::l1s, l2::l2s, l3::l3s) -> + coll.Add (mapping l1 l2 l3) + loop (l1s, l2s, l3s) + loop (list1, list2, list3) + #endif /// /// Zip safely two lists. If one list is shorter, excess elements are discarded from the right end of the longer list. @@ -447,3 +463,27 @@ module List = if List.length lst > i && i >= 0 then lst.[0..i-1] @ x::lst.[i+1..] else lst + + #if !FABLE_COMPILER + open System.Reflection + + /// Creates an infinite list which cycles the element of the source. + let cycle lst = + let last = ref lst + let rec copy = function + | [] -> failwith "empty list" + | [z] -> + let v = [z] + last.Value <- v + v + | x::xs -> x::copy xs + let cycled = copy lst + let strs = last.Value.GetType().GetFields(BindingFlags.NonPublic ||| BindingFlags.Instance) |> Array.map (fun field -> field.Name) + let tailField = last.Value.GetType().GetField(Array.find(fun (s:string) -> s.ToLower().Contains("tail")) strs, BindingFlags.NonPublic ||| BindingFlags.Instance) + tailField.SetValue(last.Value, cycled) + cycled + #else + let cycle lst = lst + // TODO does it get garbage collected ? Is there a way to implement it in fable ? + #endif + diff --git a/src/FSharpPlus/Extensions/Result.fs b/src/FSharpPlus/Extensions/Result.fs index 00efe40d4..832535aac 100644 --- a/src/FSharpPlus/Extensions/Result.fs +++ b/src/FSharpPlus/Extensions/Result.fs @@ -159,3 +159,16 @@ module Result = List.iter (function Ok e -> coll1.Add e | Error e -> coll2.Add e) source coll1.Close (), coll2.Close () #endif + + let apply2With combiner f (x: Result<'T,'Error>) (y: Result<'U,'Error>) : Result<'V,'Error> = + match x, y with + | Ok a, Ok b -> Ok (f a b) + | Error e, Ok _ | Ok _, Error e -> Error e + | Error e1, Error e2 -> Error (combiner e1 e2) + + let apply3With combiner f (x: Result<'T,'Error>) (y: Result<'U,'Error>) (z: Result<'V,'Error>) : Result<'W,'Error> = + match x, y, z with + | Ok a, Ok b, Ok c -> Ok (f a b c) + | Error e, Ok _, Ok _ | Ok _, Error e, Ok _ | Ok _, Ok _, Error e -> Error e + | Ok _, Error e1, Error e2 | Error e1, Ok _, Error e2 | Error e1, Error e2, Ok _ -> Error (combiner e1 e2) + | Error e1, Error e2, Error e3 -> Error (combiner (combiner e1 e2) e3) diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index 1b87d8653..666aab75d 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -45,7 +45,7 @@ module Task = /// The mapping function. /// First task workflow. /// Second task workflow. - let map2 (f: 'T -> 'U -> 'V) (x: Task<'T>) (y: Task<'U>) : Task<'V> = + let lift2 (f: 'T -> 'U -> 'V) (x: Task<'T>) (y: Task<'U>) : Task<'V> = if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion then try Task.FromResult (f x.Result y.Result) with e -> @@ -97,7 +97,7 @@ module Task = /// First task workflow. /// Second task workflow. /// Third task workflow. - let map3 (f : 'T -> 'U -> 'V -> 'W) (x : Task<'T>) (y : Task<'U>) (z: Task<'V>) : Task<'W> = + let lift3 (f : 'T -> 'U -> 'V -> 'W) (x : Task<'T>) (y : Task<'U>) (z: Task<'V>) : Task<'W> = if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion && z.Status = TaskStatus.RanToCompletion then try Task.FromResult (f x.Result y.Result z.Result) with e -> @@ -135,22 +135,22 @@ module Task = tcs.Task /// Creates a task workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift2 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First task workflow. /// Second task workflow. - let pmap2 f x y = task { + let map2 f x y = task { let! x' = x let! y' = y return f x' y' } /// Creates a task workflow from three workflows 'x', 'y' and z, mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift3 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First task workflow. /// Second task workflow. /// Third task workflow. - let pmap3 f x y z = task { + let map3 f x y z = task { let! x' = x let! y' = y let! z' = z @@ -207,7 +207,7 @@ module Task = tcs.Task /// Creates a task workflow from two workflows 'x' and 'y', tupling its results. - let zip (x: Task<'T>) (y: Task<'U>) : Task<'T * 'U> = + let zipSequentially (x: Task<'T>) (y: Task<'U>) : Task<'T * 'U> = if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion then Task.FromResult (x.Result, y.Result) else @@ -241,6 +241,13 @@ module Task = | Completed r' -> tcs.SetResult (r, r')) |> ignore) |> ignore tcs.Task + /// Creates a task workflow from two workflows 'x' and 'y', tupling its results. + /// Similar to zipSequentially but although workflows are started in sequence they might end independently in different order. + let zip x y = task { + let! x' = x + let! y' = y + return x', y' } + /// Flattens two nested tasks into one. let join (source: Task>) : Task<'T> = source.Unwrap() diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs index 669470975..b2f8b3299 100644 --- a/src/FSharpPlus/Extensions/ValueTask.fs +++ b/src/FSharpPlus/Extensions/ValueTask.fs @@ -39,7 +39,7 @@ module ValueTask = /// The mapping function. /// First ValueTask workflow. /// Second ValueTask workflow. - let map2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = + let lift2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = let tcs = TaskCompletionSource<'V> () continueTask tcs x (fun x -> continueTask tcs y (fun y -> @@ -53,7 +53,7 @@ module ValueTask = /// First ValueTask workflow. /// Second ValueTask workflow. /// Third ValueTask workflow. - let map3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = + let lift3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = let tcs = TaskCompletionSource<'W> () continueTask tcs x (fun x -> continueTask tcs y (fun y -> @@ -63,12 +63,12 @@ module ValueTask = tcs.Task |> ValueTask<'W> /// Creates a task workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift2 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First ValueTask workflow. /// Second ValueTask workflow. /// Third ValueTask workflow. - let pmap2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = + let map2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = task { let! x' = x let! y' = y @@ -77,12 +77,12 @@ module ValueTask = |> ValueTask<'V> /// Creates a ValueTask workflow from three workflows 'x', 'y' and z, mapping its results with 'f'. - /// Similar to map3 but workflows are run in parallel. + /// Similar to lift3 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First ValueTask workflow. /// Second ValueTask workflow. /// Third ValueTask workflow. - let pmap3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = + let map3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = task { let! x' = x let! y' = y @@ -104,12 +104,22 @@ module ValueTask = tcs.Task |> ValueTask<'U> /// Creates a ValueTask workflow from two workflows 'x' and 'y', tupling its results. - let zip (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'T * 'U> = + let zipSequentially (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'T * 'U> = let tcs = TaskCompletionSource<'T * 'U> () continueTask tcs x (fun x -> continueTask tcs y (fun y -> tcs.SetResult (x, y))) tcs.Task |> ValueTask<'T * 'U> + + /// Creates a ValueTask workflow from two workflows 'x' and 'y', tupling its results. + /// Similar to zipSequentially but although workflows are started in sequence they might end independently in different order. + let zip (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'T * 'U> = + task { + let! x' = x + let! y' = y + return x', y' + } + |> ValueTask<'T * 'U> /// Flattens two nested ValueTask into one. let join (source: ValueTask>) : ValueTask<'T> = diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index 3966a355d..3e8b0704d 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -66,6 +66,7 @@ + @@ -114,16 +115,16 @@ - - - - - - - - + + + + + + + + - - - + + + diff --git a/src/FSharpPlus/Math/Applicative.fs b/src/FSharpPlus/Math/Applicative.fs index c21311508..ad781f40f 100644 --- a/src/FSharpPlus/Math/Applicative.fs +++ b/src/FSharpPlus/Math/Applicative.fs @@ -64,4 +64,57 @@ module Applicative = let inline ( >=. ) (x: 'T) (y: '``Functor<'T>``) = map ((>=) x) y : '``Functor`` let inline ( .>=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>=) x <*> y : '``Applicative`` +/// Math Operators ready to use over (non sequential) Applicative Functors. +module ZipApplicative = + + let inline ( ~-. ) (x: '``Functor<'T>``) = map ((~-)) x : '``Functor<'T>`` + + let inline ( .+ ) (x: '``Functor<'T>``) (y: 'T) = map ((+)/> y) x : '``Functor<'T>`` + let inline ( +. ) (x: 'T) (y: '``Functor<'T>``) = map ((+) x) y : '``Functor<'T>`` + let inline ( .+. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (+) x <.> y : '``Applicative<'T>`` + + let inline ( .- ) (x: '``Functor<'T>``) (y: 'T) = map ((-)/> y) x : '``Functor<'T>`` + let inline ( -. ) (x: 'T) (y: '``Functor<'T>``) = map ((-) x) y : '``Functor<'T>`` + let inline ( .-. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (-) x <.> y : '``Applicative<'T>`` + + let inline ( .* ) (x: '``Functor<'T>``) (y: 'T) = map ((*)/> y) x : '``Functor<'T>`` + let inline ( *. ) (x: 'T) (y: '``Functor<'T>``) = map ((*) x) y : '``Functor<'T>`` + let inline ( .*. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (*) x <.> y : '``Applicative<'T>`` + + let inline ( .% ) (x: '``Functor<'T>``) (y: 'T) = map ((%)/> y) x : '``Functor<'T>`` + let inline ( %. ) (x: 'T) (y: '``Functor<'T>``) = map ((%) x) y : '``Functor<'T>`` + let inline ( .%. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (%) x <.> y : '``Applicative<'T>`` + + let inline ( ./ ) (x: '``Functor<'T>``) (y: 'T) = map ((/)/> y) x : '``Functor<'T>`` + let inline ( /. ) (x: 'T) (y: '``Functor<'T>``) = map ((/) x) y : '``Functor<'T>`` + let inline ( ./. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (/) x <.> y : '``Applicative<'T>`` + + let inline ( .= ) (x: '``Functor<'T>``) (y: 'T) = map ((=)/> y) x : '``Functor`` + let inline ( =. ) (x: 'T) (y: '``Functor<'T>``) = map ((=) x) y : '``Functor`` + let inline ( .=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (=) x <.> y : '``Applicative`` + + let inline ( .> ) (x: '``Functor<'T>``) (y: 'T) = map ((>)/> y) x : '``Functor`` + let inline ( >. ) (x: 'T) (y: '``Functor<'T>``) = map ((>) x) y : '``Functor`` + let inline ( .>. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>) x <.> y : '``Applicative`` + + let inline ( .< ) (x: '``Functor<'T>``) (y: 'T) = map ((<)/> y) x : '``Functor`` + let inline ( <. ) (x: 'T) (y: '``Functor<'T>``) = map ((<) x) y : '``Functor`` + let inline ( .<. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<) x <.> y : '``Applicative`` + + let inline (.|| ) (x: '``Functor``) (y: bool) = map ((||)/> y) x : '``Functor`` + let inline ( ||.) (x: bool) (y: '``Functor``) = map ((||) x) y : '``Functor`` + let inline (.||.) (x: '``Applicative``) (y: '``Applicative``) = (||) x <.> y : '``Applicative`` + + let inline (.&& ) (x: '``Functor``) (y: bool) = map ((&&)/> y) x : '``Functor`` + let inline ( &&.) (x: bool) (y: '``Functor``) = map ((&&) x) y : '``Functor`` + let inline (.&&.) (x: '``Applicative``) (y: '``Applicative``) = (&&) x <.> y : '``Applicative`` + + let inline ( .<= ) (x: '``Functor<'T>``) (y: 'T) = map ((<=)/> y) x : '``Functor`` + let inline ( <=. ) (x: 'T) (y: '``Functor<'T>``) = map ((<=) x) y : '``Functor`` + let inline ( .<=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<=) x <.> y : '``Applicative`` + + let inline ( .>= ) (x: '``Functor<'T>``) (y: 'T) = map ((>=)/> y) x : '``Functor`` + let inline ( >=. ) (x: 'T) (y: '``Functor<'T>``) = map ((>=) x) y : '``Functor`` + let inline ( .>=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>=) x <.> y : '``Applicative`` + #endif \ No newline at end of file diff --git a/src/FSharpPlus/Operators.fs b/src/FSharpPlus/Operators.fs index 81a099789..af10987cf 100644 --- a/src/FSharpPlus/Operators.fs +++ b/src/FSharpPlus/Operators.fs @@ -219,6 +219,32 @@ module Operators = let inline opt (v: '``Alternative<'T>``) : '``Alternative>`` = (Some : 'T -> _) v result (None: option<'T>) + /// + /// Lifts a value into a ZipFunctor. Same as return in (zip) Computation Expressions. + /// + /// Applicative + let inline pur (x: 'T) : '``ZipFunctor<'T>`` = Pure.Invoke x + + /// + /// Apply a lifted argument to a lifted function: f </> arg. + /// Same as <*> but for non sequential applicatives. + /// + /// Applicative + let inline (<.>) (f: '``ZipApplicative<'T -> 'U>``) (x: '``ZipApplicative<'T>``) : '``ZipApplicative<'U>`` = ZipApply.Invoke f x : '``ZipApplicative<'U>`` + + /// + /// Applies 2 lifted arguments to a non-lifted function with pointwise and/or parallel semantics. + /// + /// Applicative + let inline map2 (f: 'T->'U->'V) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) : '``ZipApplicative<'V>`` = Map2.Invoke f x y + + /// + /// Applies 3 lifted arguments to a non-lifted function with pointwise and/or parallel semantics. + /// + /// Applicative + let inline map3 (f: 'T->'U->'V->'W) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) (z: '``ZipApplicative<'V>``) : '``ZipApplicative<'W>`` = Map3.Invoke f x y z + + // Monad ----------------------------------------------------------- @@ -697,6 +723,21 @@ module Operators = /// Traversable let inline sequence (t: '``Traversable<'Functor<'T>>``) : '``Functor<'Traversable<'T>>`` = Sequence.Invoke t + + // Traversable (Parallel / Pointwise) + + /// + /// Map each element of a structure to an action, evaluate these actions from left to right, pointwise, and/or in parallel, and collect the results. + /// + /// Traversable + let inline gather (f: 'T->'``ZipFunctor<'U>``) (t: '``Traversable<'T>``) : '``ZipFunctor<'Traversable<'U>>`` = Gather.Invoke f t + + /// + /// Evaluate each action in the structure from left to right, pointwise, and/or in parallel, and collect the results. + /// + /// Traversable + let inline transpose (t: '``Traversable<'ZipFunctor<'T>>``) : '``ZipFunctor<'Traversable<'T>>`` = Transpose.Invoke t + // Bifoldable diff --git a/tests/FSharpPlus.Tests/Applicatives.fs b/tests/FSharpPlus.Tests/Applicatives.fs new file mode 100644 index 000000000..0de55822c --- /dev/null +++ b/tests/FSharpPlus.Tests/Applicatives.fs @@ -0,0 +1,35 @@ +namespace FSharpPlus.Tests + +open System +open System.Collections.ObjectModel +open FSharpPlus +open FSharpPlus.Data +open NUnit.Framework +open Helpers + +module Applicatives = + + [] + let pureAndZipApply () = + let res9n5 = map ((+) 1) [8;4] + CollectionAssert.AreEqual ([9; 5], res9n5) + + let red20n30 = pur (+) <.> pur 10 <.> NonEmptySeq.ofList [10;20] + CollectionAssert.AreEqual (NonEmptySeq.ofList [20; 30], red20n30) + + + [] + let zipApply () = + let arr1 = app2 { + let! x1 = async { return [|1; 2; 3|] } + and! x2 = async { return [|10; 20; 30|] } + and! x3 = async { return [|100; 200; 300|] } + and! x4 = async { return [|1000; 2000; 3000|] } + return x1 + x2 + x3 + x4 } + CollectionAssert.AreEqual ([|1111; 2222; 3333|], arr1 |> Async.RunSynchronously) + + let arr2 = (+) [|1;2;3|] <.> [|10;20;30|] + CollectionAssert.AreEqual ([|11; 22; 33|], arr2) + + let arr3 = (+) Compose (async { return [|1;2;3|] } ) <.> Compose (async { return [|10;20;30|] }) + CollectionAssert.AreEqual ([|11; 22; 33|], arr3 |> Compose.run |> Async.RunSynchronously) diff --git a/tests/FSharpPlus.Tests/Extensions.fs b/tests/FSharpPlus.Tests/Extensions.fs index dfd5809c6..1ddc7b33a 100644 --- a/tests/FSharpPlus.Tests/Extensions.fs +++ b/tests/FSharpPlus.Tests/Extensions.fs @@ -385,10 +385,10 @@ module Extensions = Choice.map3 (fun x y z -> x + y + z) (result 1: Choice) (result 3) (throw 5) |> areEqual (throw 5: Choice) // Async - Async.map3 (fun x y z -> x + y + z) (async {return 1}) (async {return 3}) (async {return 5}) |> Async.RunSynchronously |> areEqual 9 + Async.lift3 (fun x y z -> x + y + z) (async {return 1}) (async {return 3}) (async {return 5}) |> Async.RunSynchronously |> areEqual 9 // Task - Task.map3 (fun x y z -> x + y + z) (async {return 1} |> Async.StartAsTask) (async {return 3} |> Async.StartAsTask) (async {return 5} |> Async.StartAsTask) + Task.lift3 (fun x y z -> x + y + z) (async {return 1} |> Async.StartAsTask) (async {return 3} |> Async.StartAsTask) (async {return 5} |> Async.StartAsTask) |> Async.AwaitTask |> Async.RunSynchronously |> areEqual 9 // List diff --git a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj index a8089a3ec..3276b9565 100644 --- a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj +++ b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj @@ -18,6 +18,7 @@ + diff --git a/tests/FSharpPlus.Tests/Task.fs b/tests/FSharpPlus.Tests/Task.fs index 1f82b29a0..e9c5e62aa 100644 --- a/tests/FSharpPlus.Tests/Task.fs +++ b/tests/FSharpPlus.Tests/Task.fs @@ -36,14 +36,14 @@ module Task = let a = Task.map string x1 require a.IsCompleted "Task.map didn't short-circuit" - let b = Task.zip x1 x2 - require b.IsCompleted "Task.zip didn't short-circuit" + let b = Task.zipSequentially x1 x2 + require b.IsCompleted "Task.zipSequentially didn't short-circuit" - let c = Task.map2 (+) x1 x2 - require c.IsCompleted "Task.map2 didn't short-circuit" + let c = Task.lift2 (+) x1 x2 + require c.IsCompleted "Task.lift2 didn't short-circuit" - let d = Task.map3 (fun x y z -> x + y + z) x1 x2 x3 - require d.IsCompleted "Task.map3 didn't short-circiut" + let d = Task.lift3 (fun x y z -> x + y + z) x1 x2 x3 + require d.IsCompleted "Task.lift3 didn't short-circiut" [] let erroredTasks () = @@ -71,16 +71,16 @@ module Task = let r02 = Task.map (mapping true) (x1 ()) r02.Exception.InnerExceptions |> areEquivalent [TestException "I was told to fail"] - let r03 = Task.zip (e1 ()) (x2 ()) + let r03 = Task.zipSequentially (e1 ()) (x2 ()) r03.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r04 = Task.zip (e1 ()) (e2 ()) + let r04 = Task.zipSequentially (e1 ()) (e2 ()) r04.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r05 = Task.map2 (mapping2 false) (e1 ()) (x2 ()) + let r05 = Task.lift2 (mapping2 false) (e1 ()) (x2 ()) r05.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r06 = Task.map2 (mapping2 false) (e1 ()) (e2 ()) + let r06 = Task.lift2 (mapping2 false) (e1 ()) (e2 ()) r06.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] let r07 = Task.bind (binding true) (e1 ()) @@ -139,17 +139,17 @@ module Task = | AggregateException [e] -> failwithf "Something else came in: %A" e | AggregateException e -> failwithf "Many errors came in: %A" e - let r15 = Task.map3 (mapping3 false) (e1 ()) (e2 ()) (e3 ()) + let r15 = Task.lift3 (mapping3 false) (e1 ()) (e2 ()) (e3 ()) r15.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r16 = Task.map3 (mapping3 false) (e1 ()) (x2 ()) (e3 ()) + let r16 = Task.lift3 (mapping3 false) (e1 ()) (x2 ()) (e3 ()) r16.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r17 = Task.map3 (mapping3 false) (e1 ()) (e2 ()) (x3 ()) + let r17 = Task.lift3 (mapping3 false) (e1 ()) (e2 ()) (x3 ()) r17.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r18 = Task.map3 (mapping3 false) (e1 ()) (x2 ()) (x3 ()) + let r18 = Task.lift3 (mapping3 false) (e1 ()) (x2 ()) (x3 ()) r18.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r19 = Task.map3 (mapping3 false) (x1 ()) (e2 ()) (e3 ()) + let r19 = Task.lift3 (mapping3 false) (x1 ()) (e2 ()) (e3 ()) r19.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 2"] - let r20 = Task.map3 (mapping3 false) (x1 ()) (x2 ()) (e3 ()) + let r20 = Task.lift3 (mapping3 false) (x1 ()) (x2 ()) (e3 ()) r20.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 3"] module TaskBuilderTests = diff --git a/tests/FSharpPlus.Tests/Traversals.fs b/tests/FSharpPlus.Tests/Traversals.fs index c45cdcec2..51f892f3c 100644 --- a/tests/FSharpPlus.Tests/Traversals.fs +++ b/tests/FSharpPlus.Tests/Traversals.fs @@ -333,4 +333,40 @@ module Bitraversable = let _Const2 = bitraverse List.singleton List.singleton d let _Const3 = bitraverse NonEmptyList.singleton NonEmptyList.singleton e - () \ No newline at end of file + () + +module ZipApplicatives = + + [] + let transposeOptions () = + let a1 = nelist { Some 1; Some 2; Some 3 } + let a2 = transpose a1 + let a3 = transpose a2 + let b1 = [ Some 1; Some 2; Some 3 ] + let b2 = transpose b1 + let b3 = transpose b2 + let c1 = [| Some 1; Some 2; Some 3 |] + let c2 = transpose c1 + CollectionAssert.AreEqual (a1, a3) + CollectionAssert.AreEqual (b1, b3) + Assert.AreEqual (Some [|1; 2; 3|], c2) + + [] + let transposeCollections () = + let a1 = nelist { [1; 2]; [3; 4; 0]; [5; 6] } + let a2 = transpose a1 + let a3 = transpose a2 + let a4 = transpose a3 + let b1 = [ [1; 2]; [3; 4; 0]; [5; 6] ] + let b2 = transpose b1 + let b3 = transpose b2 + let b4 = transpose b3 + let c1 = [| Some 1; Some 2; Some 3 |] + let c2 = transpose c1 + let d1 = List.empty + let d2 = transpose d1 + let d3 = transpose d2 + CollectionAssert.AreEqual (a2, a4) + CollectionAssert.AreEqual (b2, b4) + Assert.AreEqual (Some [|1; 2; 3|], c2) + CollectionAssert.AreEqual (d1, d3) \ No newline at end of file