Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Extra Task, ValueTask, Ply CE sources #135

Merged
merged 2 commits into from
Aug 2, 2021
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 7 additions & 0 deletions src/FsToolkit.ErrorHandling.TaskResult/Task.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

TheAngryByrd marked this conversation as resolved.
Show resolved Hide resolved
let map2 f x y =
(apply (apply (singleton f) x) y)

Expand Down
4 changes: 4 additions & 0 deletions src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
34 changes: 34 additions & 0 deletions src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,8 @@ open Ply
[<AutoOpen>]
module TaskOptionCE =
type TaskOptionBuilder() =
member val internal SomeUnit = Some ()

member inline _.Return (value: 'T)
: Ply<Option<_>> =
uply.Return <| option.Return value
Expand Down Expand Up @@ -91,6 +93,8 @@ module TaskOptionCE =
return result
}

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

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

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(t : ValueTask<Option<_>>) : Task<Option<_>> = task { return! t }

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(async : Async<Option<_>>) : Task<Option<_>> = async |> Async.StartAsTask

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(p : Ply<Option<_>>) : Task<Option<_>> = task { return! p }

let taskOption = TaskOptionBuilder()

[<AutoOpen>]
Expand All @@ -121,11 +135,31 @@ module TaskOptionCEExtensions =
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline __.Source(r: Option<'t>) = Task.singleton r

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline __.Source(a: Task<'t>) = a |> Task.map Some

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline x.Source(a: Task) = task {
do! a
return x.SomeUnit }

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline __.Source(a: ValueTask<'t>) = a |> Task.mapV Some

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline x.Source(a: ValueTask) = task {
do! a
return x.SomeUnit }

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
Expand Down
33 changes: 32 additions & 1 deletion src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs
Original file line number Diff line number Diff line change
Expand Up @@ -102,11 +102,21 @@ module TaskResultCE =
/// </summary>
member inline _.Source(task : Task<Result<_,_>>) : Task<Result<_,_>> = task

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(t : ValueTask<Result<_,_>>) : Task<Result<_,_>> = task { return! t }

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(result : Async<Result<_,_>>) : Task<Result<_,_>> = result |> Async.StartAsTask

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(p : Ply<Result<_,_>>) : Task<Result<_,_>> = task { return! p }

let taskResult = TaskResultBuilder()

// Having members as extensions gives them lower priority in
Expand Down Expand Up @@ -145,4 +155,25 @@ module TaskResultCEExtensions =
/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(t : Task) : Task<Result<_,_>> = task { return! t } |> Task.map Ok
member inline _.Source(t : Task) : Task<Result<_,_>> = task {
do! t
return Ok () }

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(task : ValueTask<_>) : Task<Result<_,_>> = task |> Task.mapV Ok

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(t : ValueTask) : Task<Result<_,_>> = task {
do! t
return Ok () }

/// <summary>
/// Method lets us transform data types into our internal representation.
/// </summary>
member inline _.Source(p : Ply<_>) : Task<Result<_,_>> = task {
let! p = p
return Ok p }
74 changes: 72 additions & 2 deletions tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 {
Expand Down Expand Up @@ -102,14 +123,38 @@ 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
return value
}
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 {
Expand Down Expand Up @@ -193,3 +238,28 @@ let ceTests =
}
]

[<Tests>]
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"
}
]

50 changes: 47 additions & 3 deletions tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
}
]


Expand Down Expand Up @@ -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"
}
]


Expand Down Expand Up @@ -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 {
Expand Down