diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 0f728439c..a48b6c509 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -81,8 +81,8 @@ type Traverse = static member inline Traverse (t: option<_>, f, []_output: 'R, []_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None static member inline Traverse (t:Map<_,_> , f, []_output: 'R, []_impl: Traverse) : 'R = - let insert_f k x ys = Map.Invoke (Map.add k) (f x) <*> ys - Map.foldBack insert_f t (result Map.empty) + let insert_f m k v = Map.Invoke (Map.add k) v <*> m + Map.fold insert_f (result Map.empty) (Map.mapValues f t) static member inline Traverse (t: Result<'T,'Error>, f: 'T->'``Functor<'U>``, []_output: '``Functor>``, []_impl: Traverse) : '``Functor>`` = match t with @@ -95,13 +95,24 @@ type Traverse = | Choice2Of2 e -> Return.Invoke (Choice<'U,'Error>.Choice2Of2 e) static member inline Traverse (t:list<_> ,f , []_output: 'R, []_impl: Traverse) : 'R = - let cons_f x ys = Map.Invoke List.cons (f x) <*> ys - List.foldBack cons_f t (result []) + 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 (result []) (loop [] t) static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = - let cons x y = Array.append [|x|] y - let cons_f x ys = Map.Invoke cons (f x) <*> ys - Array.foldBack cons_f t (result [||]) + 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 (result [||]) (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 Traverse : _*_*_*_ -> _) b, f, c, a) diff --git a/tests/FSharpPlus.Tests/General.fs b/tests/FSharpPlus.Tests/General.fs index 9cbf68de3..81f2df4a9 100644 --- a/tests/FSharpPlus.Tests/General.fs +++ b/tests/FSharpPlus.Tests/General.fs @@ -1261,6 +1261,14 @@ module Traversable = let _ = Seq.sequence [ZipList [1]; ZipList []; ZipList (seq {failwith "sholdn't get here"})] |> toList () + [] + let traverse_Order () = + SideEffects.reset() + let mapper v = SideEffects.add <| sprintf "mapping %d" v + let _ = traverse (Option.map mapper) [Some 1; Some 2] + SideEffects.are ["mapping 1"; "mapping 2"] + + [] let traversableForNonPrimitive () = let nel = nelist { Some 1 } diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs index 6749ffebd..52da97e16 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs @@ -92,6 +92,14 @@ let traversable = testList "Traversable" [ #endif #if !FABLE_COMPILER || FABLE_COMPILER_3 + testList "traverse_Order" [ + testCase "nelist" (fun () -> + SideEffects.reset() + let mapper v = SideEffects.add <| sprintf "mapping %d" v + let _ = traverse (Option.map mapper) [Some 1; Some 2] + SideEffects.are ["mapping 1"; "mapping 2"] + )] + testList "traversableForNonPrimitive" [ testCase "nelist" (fun () -> let nel = nelist { Some 1 }