Skip to content

Commit 0e7d954

Browse files
keramsTheAngryByrd
kerams
authored and
TheAngryByrd
committed
Extra Task, ValueTask, Ply CE sources
1 parent cd3d93d commit 0e7d954

File tree

6 files changed

+196
-6
lines changed

6 files changed

+196
-6
lines changed

‎src/FsToolkit.ErrorHandling.TaskResult/Task.fs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,12 +12,19 @@ module Task =
1212
return! f x
1313
}
1414

15+
let bindV (f : 'a -> Task<'b>) (x : ValueTask<'a>) = task {
16+
let! x = x
17+
return! f x
18+
}
19+
1520
let apply f x =
1621
bind (fun f' ->
1722
bind (fun x' -> singleton(f' x')) x) f
1823

1924
let map f x = x |> bind (f >> singleton)
2025

26+
let mapV f x = x |> bindV (f >> singleton)
27+
2128
let map2 f x y =
2229
(apply (apply (singleton f) x) y)
2330

‎src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,3 +25,7 @@ module TaskOption =
2525
let apply f x =
2626
bind (fun f' ->
2727
bind (fun x' -> retn (f' x')) x) f
28+
29+
let zip x1 x2 =
30+
Task.zip x1 x2
31+
|> Task.map(fun (r1, r2) -> Option.zip r1 r2)

‎src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,8 @@ open Ply
99
[<AutoOpen>]
1010
module TaskOptionCE =
1111
type TaskOptionBuilder() =
12+
member val internal SomeUnit = Some ()
13+
1214
member inline _.Return (value: 'T)
1315
: Ply<Option<_>> =
1416
uply.Return <| option.Return value
@@ -91,6 +93,8 @@ module TaskOptionCE =
9193
return result
9294
}
9395

96+
member inline this.BindReturn(x: Task<Option<'T>>, f) = this.Bind(x, fun x -> this.Return(f x))
97+
member inline _.MergeSources(t1: Task<Option<'T>>, t2: Task<Option<'T1>>) = TaskOption.zip t1 t2
9498
member inline _.Run(f : unit -> Ply<'m>) = task.Run f
9599

96100
/// <summary>
@@ -99,11 +103,21 @@ module TaskOptionCE =
99103
/// </summary>
100104
member inline _.Source(task : Task<Option<_>>) : Task<Option<_>> = task
101105

106+
/// <summary>
107+
/// Method lets us transform data types into our internal representation.
108+
/// </summary>
109+
member inline _.Source(t : ValueTask<Option<_>>) : Task<Option<_>> = task { return! t }
110+
102111
/// <summary>
103112
/// Method lets us transform data types into our internal representation.
104113
/// </summary>
105114
member inline _.Source(async : Async<Option<_>>) : Task<Option<_>> = async |> Async.StartAsTask
106115

116+
/// <summary>
117+
/// Method lets us transform data types into our internal representation.
118+
/// </summary>
119+
member inline _.Source(p : Ply<Option<_>>) : Task<Option<_>> = task { return! p }
120+
107121
let taskOption = TaskOptionBuilder()
108122

109123
[<AutoOpen>]
@@ -121,11 +135,31 @@ module TaskOptionCEExtensions =
121135
/// Method lets us transform data types into our internal representation.
122136
/// </summary>
123137
member inline __.Source(r: Option<'t>) = Task.singleton r
138+
124139
/// <summary>
125140
/// Method lets us transform data types into our internal representation.
126141
/// </summary>
127142
member inline __.Source(a: Task<'t>) = a |> Task.map Some
128143

144+
/// <summary>
145+
/// Method lets us transform data types into our internal representation.
146+
/// </summary>
147+
member inline x.Source(a: Task) = task {
148+
do! a
149+
return x.SomeUnit }
150+
151+
/// <summary>
152+
/// Method lets us transform data types into our internal representation.
153+
/// </summary>
154+
member inline __.Source(a: ValueTask<'t>) = a |> Task.mapV Some
155+
156+
/// <summary>
157+
/// Method lets us transform data types into our internal representation.
158+
/// </summary>
159+
member inline x.Source(a: ValueTask) = task {
160+
do! a
161+
return x.SomeUnit }
162+
129163
/// <summary>
130164
/// Method lets us transform data types into our internal representation.
131165
/// </summary>

‎src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs

Lines changed: 32 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -102,11 +102,21 @@ module TaskResultCE =
102102
/// </summary>
103103
member inline _.Source(task : Task<Result<_,_>>) : Task<Result<_,_>> = task
104104

105+
/// <summary>
106+
/// Method lets us transform data types into our internal representation.
107+
/// </summary>
108+
member inline _.Source(t : ValueTask<Result<_,_>>) : Task<Result<_,_>> = task { return! t }
109+
105110
/// <summary>
106111
/// Method lets us transform data types into our internal representation.
107112
/// </summary>
108113
member inline _.Source(result : Async<Result<_,_>>) : Task<Result<_,_>> = result |> Async.StartAsTask
109114

115+
/// <summary>
116+
/// Method lets us transform data types into our internal representation.
117+
/// </summary>
118+
member inline _.Source(p : Ply<Result<_,_>>) : Task<Result<_,_>> = task { return! p }
119+
110120
let taskResult = TaskResultBuilder()
111121

112122
// Having members as extensions gives them lower priority in
@@ -145,4 +155,25 @@ module TaskResultCEExtensions =
145155
/// <summary>
146156
/// Method lets us transform data types into our internal representation.
147157
/// </summary>
148-
member inline _.Source(t : Task) : Task<Result<_,_>> = task { return! t } |> Task.map Ok
158+
member inline _.Source(t : Task) : Task<Result<_,_>> = task {
159+
do! t
160+
return Ok () }
161+
162+
/// <summary>
163+
/// Method lets us transform data types into our internal representation.
164+
/// </summary>
165+
member inline _.Source(task : ValueTask<_>) : Task<Result<_,_>> = task |> Task.mapV Ok
166+
167+
/// <summary>
168+
/// Method lets us transform data types into our internal representation.
169+
/// </summary>
170+
member inline _.Source(t : ValueTask) : Task<Result<_,_>> = task {
171+
do! t
172+
return Ok () }
173+
174+
/// <summary>
175+
/// Method lets us transform data types into our internal representation.
176+
/// </summary>
177+
member inline _.Source(p : Ply<_>) : Task<Result<_,_>> = task {
178+
let! p = p
179+
return Ok p }

‎tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs

Lines changed: 72 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -55,13 +55,34 @@ let ceTests =
5555
}
5656
Expect.equal actual expected "Should return value wrapped in option"
5757
}
58-
testCaseTask "ReturnFrom Task" <| task {
58+
testCaseTask "ReturnFrom Task Generic" <| task {
5959
let expected = Some 42
6060
let! actual = taskOption {
6161
return! (Task.FromResult 42)
6262
}
6363
Expect.equal actual expected "Should return value wrapped in option"
6464
}
65+
testCaseTask "ReturnFrom Task" <| task {
66+
let expected = Some ()
67+
let! actual = taskOption {
68+
return! Task.CompletedTask
69+
}
70+
Expect.equal actual expected "Should return value wrapped in option"
71+
}
72+
testCaseTask "ReturnFrom ValueTask Generic" <| task {
73+
let expected = Some 42
74+
let! actual = taskOption {
75+
return! (ValueTask.FromResult 42)
76+
}
77+
Expect.equal actual expected "Should return value wrapped in option"
78+
}
79+
testCaseTask "ReturnFrom ValueTask" <| task {
80+
let expected = Some ()
81+
let! actual = taskOption {
82+
return! ValueTask.CompletedTask
83+
}
84+
Expect.equal actual expected "Should return value wrapped in option"
85+
}
6586
testCaseTask "Bind Some" <| task {
6687
let expected = Some 42
6788
let! actual = taskOption {
@@ -102,14 +123,38 @@ let ceTests =
102123
}
103124
Expect.equal actual expected "Should bind value wrapped in option"
104125
}
105-
testCaseTask "Bind Task" <| task {
126+
testCaseTask "Bind Task Generic" <| task {
106127
let expected = Some 42
107128
let! actual = taskOption {
108129
let! value = Task.FromResult 42
109130
return value
110131
}
111132
Expect.equal actual expected "Should bind value wrapped in option"
112133
}
134+
testCaseTask "Bind Task" <| task {
135+
let expected = Some ()
136+
let! actual = taskOption {
137+
let! value = Task.CompletedTask
138+
return value
139+
}
140+
Expect.equal actual expected "Should bind value wrapped in option"
141+
}
142+
testCaseTask "Bind ValueTask Generic" <| task {
143+
let expected = Some 42
144+
let! actual = taskOption {
145+
let! value = ValueTask.FromResult 42
146+
return value
147+
}
148+
Expect.equal actual expected "Should bind value wrapped in option"
149+
}
150+
testCaseTask "Bind ValueTask" <| task {
151+
let expected = Some ()
152+
let! actual = taskOption {
153+
let! value = ValueTask.CompletedTask
154+
return value
155+
}
156+
Expect.equal actual expected "Should bind value wrapped in option"
157+
}
113158
testCaseTask "Zero/Combine/Delay/Run" <| task {
114159
let data = 42
115160
let! actual = taskOption {
@@ -193,3 +238,28 @@ let ceTests =
193238
}
194239
]
195240

241+
[<Tests>]
242+
let ceTestsApplicative =
243+
testList "TaskOptionCE applicative tests" [
244+
testCaseTask "Happy Path Option/AsyncOption/Ply/ValueTask" <| task {
245+
let! actual = taskOption {
246+
let! a = Some 3
247+
let! b = Some 1 |> Async.singleton
248+
let! c = Unsafe.uply { return Some 3 }
249+
let! d = ValueTask.FromResult (Some 5)
250+
return a + b - c - d
251+
}
252+
Expect.equal actual (Some -4) "Should be ok"
253+
}
254+
testCaseTask "Fail Path Option/AsyncOption/Ply/ValueTask" <| task {
255+
let! actual = taskOption {
256+
let! a = Some 3
257+
and! b = Some 1 |> Async.singleton
258+
and! c = Unsafe.uply { return None }
259+
and! d = ValueTask.FromResult (Some 5)
260+
return a + b - c - d
261+
}
262+
Expect.equal actual None "Should be ok"
263+
}
264+
]
265+

‎tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs

Lines changed: 47 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,23 @@ let ``TaskResultCE return! Tests`` =
6969

7070
Expect.equal actual (Result.Ok ()) "Should be ok"
7171
}
72+
testCaseTask "Return ValueTask Generic" <| task {
73+
let innerData = "Foo"
74+
let! actual = taskResult { return! ValueTask.FromResult innerData }
75+
76+
Expect.equal actual (Result.Ok innerData) "Should be ok"
77+
}
78+
testCaseTask "Return ValueTask" <| task {
79+
let! actual = taskResult { return! ValueTask.CompletedTask }
80+
81+
Expect.equal actual (Result.Ok ()) "Should be ok"
82+
}
83+
testCaseTask "Return Ply" <| task {
84+
let innerData = "Foo"
85+
let! actual = taskResult { return! Unsafe.uply { return innerData } }
86+
87+
Expect.equal actual (Result.Ok innerData) "Should be ok"
88+
}
7289
]
7390

7491

@@ -142,6 +159,31 @@ let ``TaskResultCE bind Tests`` =
142159

143160
Expect.equal actual (Result.Ok ()) "Should be ok"
144161
}
162+
testCaseTask "Bind ValueTask Generic" <| task {
163+
let innerData = "Foo"
164+
let! actual = taskResult {
165+
let! data = ValueTask.FromResult innerData
166+
return data
167+
}
168+
169+
Expect.equal actual (Result.Ok innerData) "Should be ok"
170+
}
171+
testCaseTask "Bind ValueTask" <| task {
172+
let! actual = taskResult {
173+
do! ValueTask.CompletedTask
174+
}
175+
176+
Expect.equal actual (Result.Ok ()) "Should be ok"
177+
}
178+
testCaseTask "Bind Ply" <| task {
179+
let innerData = "Foo"
180+
let! actual = taskResult {
181+
let! data = Unsafe.uply { return innerData }
182+
return data
183+
}
184+
185+
Expect.equal actual (Result.Ok innerData) "Should be ok"
186+
}
145187
]
146188

147189

@@ -346,14 +388,16 @@ let ``TaskResultCE applicative tests`` =
346388
Expect.equal actual (Ok 5) "Should be ok"
347389
}
348390

349-
testCaseTask "Happy Path Result/Choice/AsyncResult" <| task {
391+
testCaseTask "Happy Path Result/Choice/AsyncResult/Ply/ValueTask" <| task {
350392
let! actual = taskResult {
351393
let! a = Ok 3
352394
and! b = Choice1Of2 2
353395
and! c = Ok 1 |> Async.singleton
354-
return a + b - c
396+
and! d = Unsafe.uply { return Ok 3 }
397+
and! e = ValueTask.FromResult (Ok 5)
398+
return a + b - c - d + e
355399
}
356-
Expect.equal actual (Ok 4) "Should be ok"
400+
Expect.equal actual (Ok 6) "Should be ok"
357401
}
358402

359403
testCaseTask "Fail Path Result" <| task {

0 commit comments

Comments
 (0)