diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index b129817e0..be58003a9 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -15,15 +15,19 @@ type Sequence = static member inline InvokeOnInstance (t: '``Traversable<'Functor<'T>>``) = (^``Traversable<'Functor<'T>>`` : (static member Sequence : _ -> _) t) : '``Functor<'Traversable<'T>>`` [] - static member inline ForInfiniteSequences (t: seq<_>, isFailure, conversion) = + static member inline ForInfiniteSequences (t: seq<_>, []isFailure, []conversion, []result) = let add x y = y :: x let mutable go = true - let mutable r = result [] + 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 - r <- Map.Invoke add r <*> e.Current - Map.Invoke (List.rev >> conversion) r + 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 Traverse = inherit Default1 @@ -63,14 +67,14 @@ type Traverse = Traces.add "Traverse seq, 'T -> Functor<'U>" #endif let mapped = Seq.map f t - Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq) : '``Functor>`` + Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq, Return.Invoke) : '``Functor>`` static member inline Traverse (t: NonEmptySeq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = #if TEST_TRACE Traces.add "Traverse NonEmptySeq, 'T -> Functor<'U>" #endif let mapped = NonEmptySeq.map f t - Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, NonEmptySeq.ofList) : '``Functor>`` + Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, NonEmptySeq.ofList, Return.Invoke) : '``Functor>`` static member inline Traverse (t: ^a, f, []_output: 'R, []_impl: Default1) : 'R = #if TEST_TRACE @@ -186,7 +190,7 @@ type Sequence with Seq.foldBack cons_f t (result Seq.empty) static member inline Sequence (t: seq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = - Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, List.toSeq) + Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, List.toSeq, Return.Invoke) static member Sequence (t: seq> , []_output: option> , []_impl: Default3) : option> = Option.Sequential t #if !FABLE_COMPILER @@ -194,18 +198,18 @@ type Sequence with #endif static member Sequence (t: seq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Sequential t static member Sequence (t: seq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Sequential t - static member Sequence (t: seq> , []_output: list> , []_impl: Default3) : list> = Sequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq) - static member Sequence (t: seq<'t []> , []_output: seq<'t> [] , []_impl: Default3) : seq<'t> [] = Sequence.ForInfiniteSequences (t, Array.isEmpty, List.toSeq) + static member Sequence (t: seq> , []_output: list> , []_impl: Default3) : list> = Sequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq, List.singleton) + static member Sequence (t: seq<'t []> , []_output: seq<'t> [] , []_impl: Default3) : seq<'t> [] = Sequence.ForInfiniteSequences (t, Array.isEmpty, List.toSeq, Array.singleton) #if !FABLE_COMPILER static member Sequence (t: seq> , []_output: Async> , []_impl: Default3) : Async> = Async.SequentialLazy t #endif - static member inline Sequence (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, NonEmptySeq.ofList) + static member inline Sequence (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>``, []_impl: Default4) : '``Applicative>`` = Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) static member Sequence (t: NonEmptySeq> , []_output: option> , []_impl: Default3) : option> = Option.Sequential t |> Option.map NonEmptySeq.unsafeOfSeq static member Sequence (t: NonEmptySeq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Sequential t |> Result.map NonEmptySeq.unsafeOfSeq static member Sequence (t: NonEmptySeq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Sequential t |> Choice.map NonEmptySeq.unsafeOfSeq - static member Sequence (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = Sequence.ForInfiniteSequences(t, List.isEmpty , NonEmptySeq.ofList) - static member Sequence (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = Sequence.ForInfiniteSequences(t, Array.isEmpty, NonEmptySeq.ofList) + static member Sequence (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = Sequence.ForInfiniteSequences(t, List.isEmpty , NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + static member Sequence (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = Sequence.ForInfiniteSequences(t, Array.isEmpty, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) #if !FABLE_COMPILER static member Sequence (t: NonEmptySeq> , []_output: Async> , []_impl: Default3) = Async.SequentialLazy t |> Async.map NonEmptySeq.unsafeOfSeq : Async> #endif @@ -217,7 +221,7 @@ type Sequence with #if !FABLE_COMPILER static member inline Sequence (t: voption<_>, []_output: 'R, []_impl: Sequence) : 'R = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> result ValueNone #endif - static member inline Sequence (t: list<_> , []_output: 'R, []_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, id) + static member inline Sequence (t: list<_> , []_output: 'R, []_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, id, Return.Invoke) static member inline Sequence (t: Map<_,_> , []_output: 'R, []_impl: Sequence) : 'R = let insert_f k x ys = Map.Invoke (Map.add k) x <*> ys @@ -233,7 +237,7 @@ type Sequence with | Choice1Of2 a -> Map.Invoke Choice<'T,'Error>.Choice1Of2 a | Choice2Of2 e -> Return.Invoke (Choice<'T,'Error>.Choice2Of2 e) - static member inline Sequence (t: _ [] , []_output: 'R , []_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, Array.ofList) + static member inline Sequence (t: _ [] , []_output: 'R , []_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, Array.ofList, Return.Invoke) static member inline Sequence (t: Id<'``Functor<'T>``> , []_output: '``Functor>`` , []_impl: Sequence) : '``Functor>`` = Traverse.Invoke id t diff --git a/tests/FSharpPlus.Tests/Asyncs.fs b/tests/FSharpPlus.Tests/Asyncs.fs index 4f252c25a..f70a47589 100644 --- a/tests/FSharpPlus.Tests/Asyncs.fs +++ b/tests/FSharpPlus.Tests/Asyncs.fs @@ -103,7 +103,7 @@ module Async = let t123 = Async.map3 (fun x y z -> [x; y; z]) t1 t2 t3 let t123' = transpose [t1; t2; t3] - let t123'' = sequence [t1; t2; t3] : Async + let t123'' = sequence [t1; t2; t3] CollectionAssert.AreEquivalent ((Async.AsTaskAndWait t123).Exception.InnerExceptions, (Async.AsTaskAndWait t123').Exception.InnerExceptions, "Async.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is the same as transpose [t1; t2; t3]") CollectionAssert.AreNotEquivalent ((Async.AsTaskAndWait t123).Exception.InnerExceptions, (Async.AsTaskAndWait t123'').Exception.InnerExceptions, "Async.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is not the same as sequence [t1; t2; t3]") diff --git a/tests/FSharpPlus.Tests/Traversals.fs b/tests/FSharpPlus.Tests/Traversals.fs index 51f892f3c..5008f2273 100644 --- a/tests/FSharpPlus.Tests/Traversals.fs +++ b/tests/FSharpPlus.Tests/Traversals.fs @@ -115,7 +115,7 @@ module Traversable = // It hangs if we try to share this value between tests let expectedEffects = [ - """f(x) <*> Right 0""" + // map does this -> """f(x) <*> Right 0""" """f(x) <*> Right 1""" """f(x) <*> Right 2""" """f(x) <*> Right 3""" @@ -180,7 +180,7 @@ module Traversable = // It hangs if we try to share this value between tests let expectedEffects = [ - """f(x) <*> Right 0""" + // map does this -> """f(x) <*> Right 0""" """f(x) <*> Right 1""" """f(x) <*> Right 2""" """f(x) <*> Right 3""" diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs index 5e5fc5b7c..63a240d0d 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs @@ -135,7 +135,7 @@ let traversable = testList "Traversable" [ let expectedEffects = [ - """f(x) <*> Right 0""" + // map does this -> """f(x) <*> Right 0""" """f(x) <*> Right 1""" """f(x) <*> Right 2""" """f(x) <*> Right 3""" @@ -243,7 +243,7 @@ let traversable = testList "Traversable" [ testCase "e" (fun () -> let expectedEffects = [ - """f(x) <*> Right 0""" + // map does this -> """f(x) <*> Right 0""" """f(x) <*> Right 1""" """f(x) <*> Right 2""" """f(x) <*> Right 3""" @@ -262,7 +262,7 @@ let traversable = testList "Traversable" [ testCase "f" (fun () -> let expectedEffects = [ - """f(x) <*> Right 0""" + // map does this -> """f(x) <*> Right 0""" """f(x) <*> Right 1""" """f(x) <*> Right 2""" """f(x) <*> Right 3"""