Skip to content

Commit c1ebe74

Browse files
wallymathieuwallymathieu
authored
+ Trace for testing overloads (#557)
1 parent 06f04c8 commit c1ebe74

File tree

8 files changed

+205
-85
lines changed

8 files changed

+205
-85
lines changed

‎FSharpPlus.sln

Lines changed: 65 additions & 34 deletions
Large diffs are not rendered by default.

‎appveyor.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ install:
1616
build_script:
1717
- cmd: dotnet restore ./FSharpPlus.sln
1818
- cmd: dotnet build -c Release ./FSharpPlus.sln
19-
- cmd: dotnet test -c Release tests/FSharpPlus.Tests
19+
- cmd: dotnet test -c Test tests/FSharpPlus.Tests
2020
- ps: if ($env:VersionSuffix) { dotnet pack build.proj --version-suffix $env:VersionSuffix } else { dotnet pack build.proj }
2121
test: off
2222
artifacts:

‎build.proj

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515

1616
<Target Name="Test">
1717
<Exec Command='dotnet build src/FSharpPlus.TypeLevel' WorkingDirectory="$(RepoRootDir)" IgnoreStandardErrorWarningFormat="true" />
18-
<Exec Command='dotnet test --blame-hang-timeout 30s tests/FSharpPlus.Tests -c Release --logger:trx' WorkingDirectory="$(RepoRootDir)" IgnoreStandardErrorWarningFormat="true" />
18+
<Exec Command='dotnet test --blame-hang-timeout 30s tests/FSharpPlus.Tests -c Test --logger:trx' WorkingDirectory="$(RepoRootDir)" IgnoreStandardErrorWarningFormat="true" />
1919
</Target>
2020

2121
<!-- dotnet msbuild -target:AllDocs build.proj -->

‎src/FSharpPlus/Control/Traversable.fs

Lines changed: 105 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -33,87 +33,145 @@ type Traverse =
3333
static member inline InvokeOnInstance f (t: ^a) = (^a : (static member Traverse : _*_ -> 'R) t, f)
3434

3535
static member inline Traverse (t: '``Traversable<'T>`` , f: 'T->'``Functor<'U>``, [<Optional>]_output: '``Functor<'Traversable<'U>>``, [<Optional>]_impl: Default4) =
36-
let mapped = Map.Invoke f t : '``Traversable<'Functor<'U>>``
37-
(^``Traversable<'T>`` : (static member Sequence : _ -> _) mapped) : '``Functor<'Traversable<'U>>``
38-
39-
static member inline Traverse (t: Id<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Default3) = Map.Invoke Id.create (f (Id.run t))
36+
#if TEST_TRACE
37+
Traces.add "Traverse 'Traversable, 'T->Functor<'U>"
38+
#endif
39+
let mapped = Map.Invoke f t : '``Traversable<'Functor<'U>>``
40+
(^``Traversable<'T>`` : (static member Sequence : _ -> _) mapped) : '``Functor<'Traversable<'U>>``
41+
42+
static member inline Traverse (t: Id<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Default3) =
43+
#if TEST_TRACE
44+
Traces.add "Traverse Id"
45+
#endif
46+
Map.Invoke Id.create (f (Id.run t))
4047

4148
static member inline Traverse (t: _ seq, f, [<Optional>]_output: 'R, [<Optional>]_impl: Default3) =
49+
#if TEST_TRACE
50+
Traces.add "Traverse seq"
51+
#endif
4252
let cons x y = seq {yield x; yield! y}
4353
let cons_f x ys = Map.Invoke (cons: 'a->seq<_>->seq<_>) (f x) <*> ys
4454
Seq.foldBack cons_f t (result Seq.empty)
4555

4656
static member inline Traverse (t: _ NonEmptySeq, f, [<Optional>]_output: 'R, [<Optional>]_impl: Default3) =
57+
#if TEST_TRACE
58+
Traces.add "Traverse NonEmptySeq"
59+
#endif
4760
let cons x y = seq {yield x; yield! y}
4861
let cons_f x ys = Map.Invoke (cons: 'a->seq<_>->seq<_>) (f x) <*> ys
4962
Map.Invoke NonEmptySeq.ofSeq (Seq.foldBack cons_f t (result Seq.empty))
5063

5164
static member inline Traverse (t: seq<'T>, f: 'T->'``Functor<'U>``, [<Optional>]_output: '``Functor<seq<'U>>``, [<Optional>]_impl: Default2) =
52-
let mapped = Seq.map f t
53-
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq) : '``Functor<seq<'U>>``
65+
#if TEST_TRACE
66+
Traces.add "Traverse seq, 'T->Functor<'U>"
67+
#endif
68+
let mapped = Seq.map f t
69+
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq) : '``Functor<seq<'U>>``
5470

5571
static member inline Traverse (t: NonEmptySeq<'T>, f: 'T->'``Functor<'U>``, [<Optional>]_output: '``Functor<NonEmptySeq<'U>>``, [<Optional>]_impl: Default2) =
56-
let mapped = NonEmptySeq.map f t
57-
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, NonEmptySeq.ofList) : '``Functor<NonEmptySeq<'U>>``
58-
59-
static member inline Traverse (t: ^a , f, [<Optional>]_output: 'R, [<Optional>]_impl: Default1) = Traverse.InvokeOnInstance f t : 'R
72+
#if TEST_TRACE
73+
Traces.add "Traverse NonEmptySeq, 'T->Functor<'U>"
74+
#endif
75+
let mapped = NonEmptySeq.map f t
76+
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, NonEmptySeq.ofList) : '``Functor<NonEmptySeq<'U>>``
77+
78+
static member inline Traverse (t: ^a , f, [<Optional>]_output: 'R, [<Optional>]_impl: Default1) =
79+
#if TEST_TRACE
80+
Traces.add "Traverse ^a"
81+
#endif
82+
Traverse.InvokeOnInstance f t : 'R
6083
static member inline Traverse (_: ^a when ^a : null and ^a :struct, _, _: 'R , _impl: Default1) = id
6184

6285
#if !FABLE_COMPILER
6386
static member Traverse (t: 't seq, f: 't->Async<'u>, [<Optional>]_output: Async<seq<'u>>, [<Optional>]_impl: Traverse) : Async<seq<_>> = async {
64-
let! ct = Async.CancellationToken
65-
return seq {
66-
use enum = t.GetEnumerator ()
67-
while enum.MoveNext() do
68-
yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) }}
87+
#if TEST_TRACE
88+
Traces.add "Traverse 't seq, 't->Async<'u>"
89+
#endif
90+
91+
let! ct = Async.CancellationToken
92+
return seq {
93+
use enum = t.GetEnumerator ()
94+
while enum.MoveNext() do
95+
yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) }}
6996
#endif
7097

7198
#if !FABLE_COMPILER
7299
static member Traverse (t: 't NonEmptySeq, f: 't->Async<'u>, [<Optional>]_output: Async<NonEmptySeq<'u>>, [<Optional>]_impl: Traverse) : Async<NonEmptySeq<_>> = async {
73-
let! ct = Async.CancellationToken
74-
return seq {
75-
use enum = t.GetEnumerator ()
76-
while enum.MoveNext() do
77-
yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) } |> NonEmptySeq.unsafeOfSeq }
100+
#if TEST_TRACE
101+
Traces.add "Traverse 't NonEmptySeq, 't->Async<'u>"
102+
#endif
103+
104+
let! ct = Async.CancellationToken
105+
return seq {
106+
use enum = t.GetEnumerator ()
107+
while enum.MoveNext() do
108+
yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) } |> NonEmptySeq.unsafeOfSeq }
78109
#endif
79110

80-
static member Traverse (t: Id<'t> , f: 't->option<'u>, [<Optional>]_output: option<Id<'u>>, [<Optional>]_impl: Traverse) = Option.map Id.create (f (Id.run t))
81-
static member inline Traverse (t: option<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None
82-
static member inline Traverse (t: voption<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R = match t with ValueSome x -> Map.Invoke ValueSome (f x) | _ -> result ValueNone
111+
static member Traverse (t: Id<'t> , f: 't->option<'u>, [<Optional>]_output: option<Id<'u>>, [<Optional>]_impl: Traverse) =
112+
#if TEST_TRACE
113+
Traces.add "Traverse Id, 't->option<'u>"
114+
#endif
115+
Option.map Id.create (f (Id.run t))
116+
static member inline Traverse (t: option<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R =
117+
#if TEST_TRACE
118+
Traces.add "Traverse option"
119+
#endif
120+
match t with Some x -> Map.Invoke Some (f x) | _ -> result None
121+
static member inline Traverse (t: voption<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R =
122+
#if TEST_TRACE
123+
Traces.add "Traverse voption"
124+
#endif
125+
match t with ValueSome x -> Map.Invoke ValueSome (f x) | _ -> result ValueNone
83126

84127
static member inline Traverse (t:Map<_,_> , f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R =
85-
let insert_f m k v = Map.Invoke (Map.add k) v <*> m
86-
Map.fold insert_f (result Map.empty) (Map.mapValues f t)
128+
#if TEST_TRACE
129+
Traces.add "Traverse Map"
130+
#endif
131+
let insert_f m k v = Map.Invoke (Map.add k) v <*> m
132+
Map.fold insert_f (result Map.empty) (Map.mapValues f t)
87133

88134
static member inline Traverse (t: Result<'T,'Error>, f: 'T->'``Functor<'U>``, [<Optional>]_output: '``Functor<Result<'U,'Error>>``, [<Optional>]_impl: Traverse) : '``Functor<Result<'U,'Error>>`` =
89-
match t with
90-
| Ok a -> Map.Invoke Result<'U,'Error>.Ok (f a)
91-
| Error e -> Return.Invoke (Result<'U,'Error>.Error e)
135+
#if TEST_TRACE
136+
Traces.add "Traverse Result, 'T->Functor<'U>"
137+
#endif
138+
match t with
139+
| Ok a -> Map.Invoke Result<'U,'Error>.Ok (f a)
140+
| Error e -> Return.Invoke (Result<'U,'Error>.Error e)
92141

93142
static member inline Traverse (t: Choice<'T,'Error>, f: 'T->'``Functor<'U>``, [<Optional>]_output: '``Functor<Choice<'U,'Error>>``, [<Optional>]_impl: Traverse) : '``Functor<Choice<'U,'Error>>`` =
94-
match t with
95-
| Choice1Of2 a -> Map.Invoke Choice<'U,'Error>.Choice1Of2 (f a)
96-
| Choice2Of2 e -> Return.Invoke (Choice<'U,'Error>.Choice2Of2 e)
143+
#if TEST_TRACE
144+
Traces.add "Traverse Choice, 'T->Functor<'U>"
145+
#endif
146+
match t with
147+
| Choice1Of2 a -> Map.Invoke Choice<'U,'Error>.Choice1Of2 (f a)
148+
| Choice2Of2 e -> Return.Invoke (Choice<'U,'Error>.Choice2Of2 e)
97149

98150
static member inline Traverse (t:list<_> ,f , [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R =
99-
let rec loop acc = function
100-
| [] -> acc
101-
| x::xs ->
102-
let v = f x
103-
loop (v::acc) xs
104-
let cons_f x xs = Map.Invoke List.cons xs <*> x
105-
List.fold cons_f (result []) (loop [] t)
151+
#if TEST_TRACE
152+
Traces.add "Traverse list"
153+
#endif
154+
let rec loop acc = function
155+
| [] -> acc
156+
| x::xs ->
157+
let v = f x
158+
loop (v::acc) xs
159+
let cons_f x xs = Map.Invoke List.cons xs <*> x
160+
List.fold cons_f (result []) (loop [] t)
106161

107162
static member inline Traverse (t:_ [] ,f , [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R =
108-
let cons x y = Array.append [|x|] y
109-
let rec loop acc = function
110-
| [||] -> acc
111-
| xxs ->
112-
let x, xs = Array.head xxs, Array.tail xxs
113-
let v = f x
114-
loop (cons v acc) xs
115-
let cons_f x xs = Map.Invoke cons xs <*> x
116-
Array.fold cons_f (result [||]) (loop [||] t)
163+
#if TEST_TRACE
164+
Traces.add "Traverse []"
165+
#endif
166+
let cons x y = Array.append [|x|] y
167+
let rec loop acc = function
168+
| [||] -> acc
169+
| xxs ->
170+
let x, xs = Array.head xxs, Array.tail xxs
171+
let v = f x
172+
loop (cons v acc) xs
173+
let cons_f x xs = Map.Invoke cons xs <*> x
174+
Array.fold cons_f (result [||]) (loop [||] t)
117175

118176
static member inline Invoke (f: 'T->'``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` =
119177
let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member Traverse : _*_*_*_ -> _) b, f, c, a)

‎src/FSharpPlus/FSharpPlus.fsproj

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,10 @@
1919
<GenerateAssemblyConfigurationAttribute>false</GenerateAssemblyConfigurationAttribute>
2020
<GenerateAssemblyFileVersionAttribute>false</GenerateAssemblyFileVersionAttribute>
2121
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
22-
<Configurations>Debug;Release;Fable;Fable3</Configurations>
22+
<Configurations>Debug;Release;Fable;Fable3;Test</Configurations>
2323
<Platforms>AnyCPU</Platforms>
2424
<LangVersion>6.0</LangVersion>
25+
<DefineConstants Condition=" '$(Configuration)' == 'Test'">$(DefineConstants);TEST_TRACE</DefineConstants>
2526
<DefineConstants Condition=" '$(Configuration)' == 'Fable'">$(DefineConstants);FABLE_COMPILER</DefineConstants>
2627
<DefineConstants Condition=" '$(Configuration)' == 'Fable3'">$(DefineConstants);FABLE_COMPILER;FABLE_COMPILER_3</DefineConstants>
2728
<DefineConstants Condition=" '$(Configuration)' == 'Fable4'">$(DefineConstants);FABLE_COMPILER;FABLE_COMPILER_4</DefineConstants>

‎src/FSharpPlus/Internals.fs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,13 @@
11
namespace FSharpPlus.Internals
22

3+
#if TEST_TRACE
4+
module Traces =
5+
let private effects = ResizeArray<string> []
6+
let reset () = effects.Clear ()
7+
let add x = effects.Add (x)
8+
let get () = effects |> Seq.toList
9+
#endif
10+
311
/// <namespacedoc>
412
/// <summary>
513
/// Internal to the library - please ignore

‎tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,9 @@
88
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
99
<LangVersion Condition=" '$(Configuration)' == 'Fable' OR '$(Configuration)' == 'Fable3' ">6.0</LangVersion>
1010
<IsPackable>false</IsPackable>
11-
<Configurations>Debug;Release;Fable</Configurations>
11+
<Configurations>Debug;Release;Fable;Test</Configurations>
1212
<Platforms>AnyCPU</Platforms>
13+
<DefineConstants Condition=" '$(Configuration)' == 'Test'">$(DefineConstants);TEST_TRACE</DefineConstants>
1314
<DefineConstants Condition=" '$(Configuration)' == 'Fable'">$(DefineConstants);FABLE_COMPILER</DefineConstants>
1415
<TargetFramework>net7.0</TargetFramework>
1516
</PropertyGroup>

‎tests/FSharpPlus.Tests/Traversals.fs

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,9 @@ open Helpers
1212
open FSharpPlus.Math.Applicative
1313
open CSharpLib
1414
open System.Threading.Tasks
15+
#if TEST_TRACE
16+
open FSharpPlus.Internals
17+
#endif
1518

1619
module Traversable =
1720

@@ -251,9 +254,15 @@ module Traversable =
251254

252255
[<Test>]
253256
let traverseTask () =
257+
#if TEST_TRACE
258+
Traces.reset()
259+
#endif
254260
let a = traverse Task.FromResult [1;2]
255261
CollectionAssert.AreEqual ([1;2], a.Result)
256262
Assert.IsInstanceOf<Option<list<int>>> (Some a.Result)
263+
#if TEST_TRACE
264+
CollectionAssert.AreEqual (["Traverse list"], Traces.get())
265+
#endif
257266
let b = map Task.FromResult [1;2] |> sequence
258267
CollectionAssert.AreEqual ([1;2], b.Result)
259268
Assert.IsInstanceOf<Option<list<int>>> (Some b.Result)
@@ -266,6 +275,9 @@ module Traversable =
266275

267276
[<Test>]
268277
let traverseMap () =
278+
#if TEST_TRACE
279+
Traces.reset()
280+
#endif
269281
let m = Map.ofList [("a", 1); ("b", 2); ("c", 3)]
270282
let r1 = traverse (fun i -> if i = 2 then None else Some i) m
271283
let r2 = traverse Some m
@@ -278,14 +290,23 @@ module Traversable =
278290
Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]]
279291
let actual = sequence m1
280292
CollectionAssert.AreEqual (expected, actual)
293+
#if TEST_TRACE
294+
CollectionAssert.AreEqual (["Traverse Map";"Traverse Map"], Traces.get())
295+
#endif
281296

282297
[<Test>]
283298
let traverseResults () =
299+
#if TEST_TRACE
300+
Traces.reset()
301+
#endif
284302
let a = sequence (if true then Ok [1] else Error "no")
285303
let b = traverse id (if true then Ok [1] else Error "no")
286304
let expected: Result<int, string> list = [Ok 1]
287305
CollectionAssert.AreEqual (expected, a)
288306
CollectionAssert.AreEqual (expected, b)
307+
#if TEST_TRACE
308+
CollectionAssert.AreEqual (["Traverse Result, 'T->Functor<'U>"], Traces.get())
309+
#endif
289310

290311

291312
module Bitraversable =

0 commit comments

Comments
 (0)