diff --git a/src/FsToolkit.ErrorHandling.TaskResult/Task.fs b/src/FsToolkit.ErrorHandling.TaskResult/Task.fs index b4aff3b7..c7ebb255 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/Task.fs +++ b/src/FsToolkit.ErrorHandling.TaskResult/Task.fs @@ -12,12 +12,19 @@ module Task = return! f x } + let bindV (f : 'a -> Task<'b>) (x : ValueTask<'a>) = task { + let! x = x + return! f x + } + let apply f x = bind (fun f' -> bind (fun x' -> singleton(f' x')) x) f let map f x = x |> bind (f >> singleton) + let mapV f x = x |> bindV (f >> singleton) + let map2 f x y = (apply (apply (singleton f) x) y) diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs index 84010e7b..b2553903 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs @@ -25,3 +25,7 @@ module TaskOption = let apply f x = bind (fun f' -> bind (fun x' -> retn (f' x')) x) f + + let zip x1 x2 = + Task.zip x1 x2 + |> Task.map(fun (r1, r2) -> Option.zip r1 r2) diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs index 15c1dadd..d32ab0c2 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs @@ -9,6 +9,8 @@ open Ply [] module TaskOptionCE = type TaskOptionBuilder() = + member val internal SomeUnit = Some () + member inline _.Return (value: 'T) : Ply> = uply.Return <| option.Return value @@ -91,6 +93,8 @@ module TaskOptionCE = return result } + member inline this.BindReturn(x: Task>, f) = this.Bind(x, fun x -> this.Return(f x)) + member inline _.MergeSources(t1: Task>, t2: Task>) = TaskOption.zip t1 t2 member inline _.Run(f : unit -> Ply<'m>) = task.Run f /// @@ -99,11 +103,21 @@ module TaskOptionCE = /// member inline _.Source(task : Task>) : Task> = task + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(t : ValueTask>) : Task> = task { return! t } + /// /// Method lets us transform data types into our internal representation. /// member inline _.Source(async : Async>) : Task> = async |> Async.StartAsTask + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(p : Ply>) : Task> = task { return! p } + let taskOption = TaskOptionBuilder() [] @@ -121,11 +135,31 @@ module TaskOptionCEExtensions = /// Method lets us transform data types into our internal representation. /// member inline __.Source(r: Option<'t>) = Task.singleton r + /// /// Method lets us transform data types into our internal representation. /// member inline __.Source(a: Task<'t>) = a |> Task.map Some + /// + /// Method lets us transform data types into our internal representation. + /// + member inline x.Source(a: Task) = task { + do! a + return x.SomeUnit } + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline __.Source(a: ValueTask<'t>) = a |> Task.mapV Some + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline x.Source(a: ValueTask) = task { + do! a + return x.SomeUnit } + /// /// Method lets us transform data types into our internal representation. /// diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs index e4bb3f89..3a98cde1 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs @@ -102,11 +102,21 @@ module TaskResultCE = /// member inline _.Source(task : Task>) : Task> = task + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(t : ValueTask>) : Task> = task { return! t } + /// /// Method lets us transform data types into our internal representation. /// member inline _.Source(result : Async>) : Task> = result |> Async.StartAsTask + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(p : Ply>) : Task> = task { return! p } + let taskResult = TaskResultBuilder() // Having members as extensions gives them lower priority in @@ -145,4 +155,25 @@ module TaskResultCEExtensions = /// /// Method lets us transform data types into our internal representation. /// - member inline _.Source(t : Task) : Task> = task { return! t } |> Task.map Ok + member inline _.Source(t : Task) : Task> = task { + do! t + return Ok () } + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(task : ValueTask<_>) : Task> = task |> Task.mapV Ok + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(t : ValueTask) : Task> = task { + do! t + return Ok () } + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(p : Ply<_>) : Task> = task { + let! p = p + return Ok p } diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs index 16958e7c..9eee0375 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs @@ -55,13 +55,34 @@ let ceTests = } Expect.equal actual expected "Should return value wrapped in option" } - testCaseTask "ReturnFrom Task" <| task { + testCaseTask "ReturnFrom Task Generic" <| task { let expected = Some 42 let! actual = taskOption { return! (Task.FromResult 42) } Expect.equal actual expected "Should return value wrapped in option" } + testCaseTask "ReturnFrom Task" <| task { + let expected = Some () + let! actual = taskOption { + return! Task.CompletedTask + } + Expect.equal actual expected "Should return value wrapped in option" + } + testCaseTask "ReturnFrom ValueTask Generic" <| task { + let expected = Some 42 + let! actual = taskOption { + return! (ValueTask.FromResult 42) + } + Expect.equal actual expected "Should return value wrapped in option" + } + testCaseTask "ReturnFrom ValueTask" <| task { + let expected = Some () + let! actual = taskOption { + return! ValueTask.CompletedTask + } + Expect.equal actual expected "Should return value wrapped in option" + } testCaseTask "Bind Some" <| task { let expected = Some 42 let! actual = taskOption { @@ -102,7 +123,7 @@ let ceTests = } Expect.equal actual expected "Should bind value wrapped in option" } - testCaseTask "Bind Task" <| task { + testCaseTask "Bind Task Generic" <| task { let expected = Some 42 let! actual = taskOption { let! value = Task.FromResult 42 @@ -110,6 +131,30 @@ let ceTests = } Expect.equal actual expected "Should bind value wrapped in option" } + testCaseTask "Bind Task" <| task { + let expected = Some () + let! actual = taskOption { + let! value = Task.CompletedTask + return value + } + Expect.equal actual expected "Should bind value wrapped in option" + } + testCaseTask "Bind ValueTask Generic" <| task { + let expected = Some 42 + let! actual = taskOption { + let! value = ValueTask.FromResult 42 + return value + } + Expect.equal actual expected "Should bind value wrapped in option" + } + testCaseTask "Bind ValueTask" <| task { + let expected = Some () + let! actual = taskOption { + let! value = ValueTask.CompletedTask + return value + } + Expect.equal actual expected "Should bind value wrapped in option" + } testCaseTask "Zero/Combine/Delay/Run" <| task { let data = 42 let! actual = taskOption { @@ -193,3 +238,28 @@ let ceTests = } ] +[] +let ceTestsApplicative = + testList "TaskOptionCE applicative tests" [ + testCaseTask "Happy Path Option/AsyncOption/Ply/ValueTask" <| task { + let! actual = taskOption { + let! a = Some 3 + let! b = Some 1 |> Async.singleton + let! c = Unsafe.uply { return Some 3 } + let! d = ValueTask.FromResult (Some 5) + return a + b - c - d + } + Expect.equal actual (Some -4) "Should be ok" + } + testCaseTask "Fail Path Option/AsyncOption/Ply/ValueTask" <| task { + let! actual = taskOption { + let! a = Some 3 + and! b = Some 1 |> Async.singleton + and! c = Unsafe.uply { return None } + and! d = ValueTask.FromResult (Some 5) + return a + b - c - d + } + Expect.equal actual None "Should be ok" + } + ] + diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs index 30dfcae6..81591637 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs @@ -69,6 +69,23 @@ let ``TaskResultCE return! Tests`` = Expect.equal actual (Result.Ok ()) "Should be ok" } + testCaseTask "Return ValueTask Generic" <| task { + let innerData = "Foo" + let! actual = taskResult { return! ValueTask.FromResult innerData } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + testCaseTask "Return ValueTask" <| task { + let! actual = taskResult { return! ValueTask.CompletedTask } + + Expect.equal actual (Result.Ok ()) "Should be ok" + } + testCaseTask "Return Ply" <| task { + let innerData = "Foo" + let! actual = taskResult { return! Unsafe.uply { return innerData } } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } ] @@ -142,6 +159,31 @@ let ``TaskResultCE bind Tests`` = Expect.equal actual (Result.Ok ()) "Should be ok" } + testCaseTask "Bind ValueTask Generic" <| task { + let innerData = "Foo" + let! actual = taskResult { + let! data = ValueTask.FromResult innerData + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + testCaseTask "Bind ValueTask" <| task { + let! actual = taskResult { + do! ValueTask.CompletedTask + } + + Expect.equal actual (Result.Ok ()) "Should be ok" + } + testCaseTask "Bind Ply" <| task { + let innerData = "Foo" + let! actual = taskResult { + let! data = Unsafe.uply { return innerData } + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } ] @@ -346,14 +388,16 @@ let ``TaskResultCE applicative tests`` = Expect.equal actual (Ok 5) "Should be ok" } - testCaseTask "Happy Path Result/Choice/AsyncResult" <| task { + testCaseTask "Happy Path Result/Choice/AsyncResult/Ply/ValueTask" <| task { let! actual = taskResult { let! a = Ok 3 and! b = Choice1Of2 2 and! c = Ok 1 |> Async.singleton - return a + b - c + and! d = Unsafe.uply { return Ok 3 } + and! e = ValueTask.FromResult (Ok 5) + return a + b - c - d + e } - Expect.equal actual (Ok 4) "Should be ok" + Expect.equal actual (Ok 6) "Should be ok" } testCaseTask "Fail Path Result" <| task {