Skip to content

Commit

Permalink
Added exception tests for AsyncVal
Browse files Browse the repository at this point in the history
  • Loading branch information
xperiandri committed Nov 5, 2023
1 parent a19ec8e commit 0810527
Show file tree
Hide file tree
Showing 3 changed files with 148 additions and 62 deletions.
151 changes: 89 additions & 62 deletions src/FSharp.Data.GraphQL.Shared/AsyncVal.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,8 @@ namespace FSharp.Data.GraphQL

open System
open System.Collections.Generic
open System.Linq
open System.Threading.Tasks

#nowarn "25"

Expand All @@ -15,185 +17,210 @@ type AsyncVal<'T> =
| Async of asynchronous : Async<'T>
| Failure of exn : Exception

static member Zero = Value(Unchecked.defaultof<'T>)
static member Zero = Value (Unchecked.defaultof<'T>)
override x.ToString () =
match x with
| Value v -> "AsyncVal(" + v.ToString() + ")"
| Value v -> "AsyncVal(" + v.ToString () + ")"
| Async _ -> "AsyncVal(Async<>)"
| Failure f -> "AsyncVal(Failure:" + f.Message + ")"

[<RequireQualifiedAccess>]
module AsyncVal =

/// Returns true if AsyncVal wraps an Async computation, otherwise false.
let inline isAsync (x: AsyncVal<'T>) = match x with | Async _ -> true | _ -> false
let inline isAsync (x : AsyncVal<'T>) = match x with | Async _ -> true | _ -> false

/// Returns true if AsyncVal contains immediate result, otherwise false.
let inline isSync (x: AsyncVal<'T>) = match x with | Value _ -> true | _ -> false
let inline isSync (x : AsyncVal<'T>) = match x with | Value _ -> true | _ -> false

/// Returns true if the AsyncVal failed, otherwise false
let inline isFailure (x: AsyncVal<'T>) = match x with | Failure _ -> true | _ -> false
let inline isFailure (x : AsyncVal<'T>) = match x with | Failure _ -> true | _ -> false

/// Returns value wrapped by current AsyncVal. If it's part of Async computation,
/// it's executed synchronously and then value is returned.
/// If the asyncVal failed, then the exception that caused the failure is raised
let get (x: AsyncVal<'T>) =
let get (x : AsyncVal<'T>) =
match x with
| Value v -> v
| Async a -> a |> Async.RunSynchronously
| Failure f -> f.Reraise()
| Failure f -> f.Reraise ()

/// Create new AsyncVal from Async computation.
let inline ofAsync (a: Async<'T>) = Async(a)
let inline ofAsync (a : Async<'T>) = Async (a)

/// Returns an AsyncVal wrapper around provided Async computation.
let inline wrap (v: 'T) = Value(v)
let inline wrap (v : 'T) = Value (v)

/// Converts AsyncVal to Async computation.
let toAsync (x: AsyncVal<'T>) =
let toAsync (x : AsyncVal<'T>) =
match x with
| Value v -> async.Return v
| Async a -> a
| Failure f -> async.Return (f.Reraise())
| Failure f -> async.Return (f.Reraise ())

/// Converts AsyncVal to Async computation.
let toTask (x : AsyncVal<'T>) =
match x with
| Value v -> Task.FromResult (v)
| Async a -> Async.StartAsTask (a)
| Failure f -> Task.FromException<'T> (f)

/// Returns an empty AsyncVal with immediatelly executed value.
let inline empty<'T> : AsyncVal<'T> = AsyncVal<'T>.Zero

/// Maps content of AsyncVal using provided mapping function, returning new
/// AsyncVal as the result.
let map (fn: 'T -> 'U) (x: AsyncVal<'T>) =
let map (fn : 'T -> 'U) (x : AsyncVal<'T>) =
match x with
| Value v -> Value(fn v)
| Value v -> Value (fn v)
| Async a ->
Async(async {
Async ( async {
let! result = a
return fn result
})
| Failure f -> Failure(f)
| Failure f -> Failure (f)


/// Applies rescue fn in case when contained Async value throws an exception.
let rescue path (fn: FieldPath -> exn -> IGQLError list) (x: AsyncVal<'t>) =
let rescue path (fn : FieldPath -> exn -> IGQLError list) (x : AsyncVal<'t>) =
match x with
| Value v -> Value(Ok v)
| Value v -> Value (Ok v)
| Async a ->
Async(async {
Async (async {
try
let! v = a
return Ok v
with e -> return fn path e |> Error
with e ->
return fn path e |> Error
})
| Failure f -> Value(fn path f |> Error)
| Failure f -> Value (fn path f |> Error)
|> map (Result.mapError (List.map (GQLProblemDetails.OfFieldExecutionError (path |> List.rev))))


/// Folds content of AsyncVal over provided initial state zero using provided fn.
/// Returns new AsyncVal as a result.
let fold (fn: 'State -> 'T -> 'State) (zero: 'State) (x: AsyncVal<'T>) : AsyncVal<'State> =
let fold (fn : 'State -> 'T -> 'State) (zero : 'State) (x : AsyncVal<'T>) : AsyncVal<'State> =
match x with
| Value v -> Value(fn zero v)
| Value v -> Value (fn zero v)
| Async a ->
Async(async{
Async (async {
let! res = a
return fn zero res
})
| Failure f -> Failure(f)
| Failure f -> Failure (f)


/// Binds AsyncVal using binder function to produce new AsyncVal.
let bind (binder: 'T -> AsyncVal<'U>) (x: AsyncVal<'T>) : AsyncVal<'U> =
let bind (binder : 'T -> AsyncVal<'U>) (x : AsyncVal<'T>) : AsyncVal<'U> =
match x with
| Value v -> binder v
| Async a ->
Async(async{
Async (async {
let! value = a
let bound = binder value
match bound with
| Value v -> return v
| Async a -> return! a
| Failure f -> return f.Reraise()
| Failure f -> return f.Reraise ()
})
| Failure f -> Failure(f)
| Failure f -> Failure (f)

/// Converts array of AsyncVals into AsyncVal with array results.
/// In case when are non-immediate values in provided array, they are
/// executed asynchronously, one by one with regard to their order in array.
/// Returned array maintain order of values.
/// If the array contains a Failure, then the entire array will not resolve
let collectSequential (values: AsyncVal<'T> []) : AsyncVal<'T []> =
let collectSequential (values : AsyncVal<'T>[]) : AsyncVal<'T[]> =
if values.Length = 0 then Value [||]
elif values |> Array.exists isAsync then
Async(async {
Async (async {
let results = Array.zeroCreate values.Length
let exceptions = ResizeArray values.Length
for i = 0 to values.Length - 1 do
let v = values.[i]
match v with
| Value v -> results.[i] <- v
| Async a ->
let! r = a
results.[i] <- r
| Failure f ->
results.[i] <- f.Reraise()
return results })
else Value (values |> Array.map (fun (Value v) -> v))
| Failure f -> exceptions.Add f
match exceptions.Count with
| 0 -> return results
| 1 -> return exceptions.First().Reraise ()
| _ -> return AggregateException exceptions |> raise
})
else
let exceptions =
values
|> Array.choose (function
| Failure f -> Some f
| _ -> None)
match exceptions.Length with
| 0 -> Value (values |> Array.map (fun (Value v) -> v))
| 1 -> Failure (exceptions.First ())
| _ -> Failure (AggregateException exceptions)

/// Converts array of AsyncVals into AsyncVal with array results.
/// In case when are non-immediate values in provided array, they are
/// executed all in parallel, in unordered fashion. Order of values
/// inside returned array is maintained.
/// If the array contains a Failure, then the entire array will not resolve
let collectParallel (values: AsyncVal<'T> []) : AsyncVal<'T []> =
let collectParallel (values : AsyncVal<'T>[]) : AsyncVal<'T[]> =
if values.Length = 0 then Value [||]
else
let indexes = List<_>(0)
let continuations = List<_>(0)
let indexes = List<_> (0)
let continuations = List<_> (0)
let results = Array.zeroCreate values.Length
let exceptions = ResizeArray values.Length
for i = 0 to values.Length - 1 do
let value = values.[i]
match value with
| Value v -> results.[i] <- v
| Async a ->
indexes.Add i
continuations.Add a
| Failure f ->
results.[i] <- f.Reraise()
if indexes.Count = 0
then Value(results)
else Async(async {
let! vals = continuations |> Async.Parallel
for i = 0 to indexes.Count - 1 do
results.[indexes.[i]] <- vals.[i]
return results })
| Failure f -> exceptions.Add f
match exceptions.Count with
| 1 -> AsyncVal.Failure (exceptions.First ())
| count when count > 1 -> AsyncVal.Failure (AggregateException exceptions)
| _ ->
if indexes.Count = 0 then Value (results)
else Async (async {
let! vals = continuations |> Async.Parallel
for i = 0 to indexes.Count - 1 do
results.[indexes.[i]] <- vals.[i]
return results
})

/// Converts array of AsyncVals of arrays into AsyncVal with array results
/// by calling collectParallel and then appending the results.
let appendParallel (values: AsyncVal<'T []> []) : AsyncVal<'T []> =
let appendParallel (values : AsyncVal<'T[]>[]) : AsyncVal<'T[]> =
values
|> collectParallel
|> map (Array.fold Array.append Array.empty)

/// Converts array of AsyncVals of arrays into AsyncVal with array results
/// by calling collectSequential and then appending the results.
let appendSequential (values: AsyncVal<'T []> []) : AsyncVal<'T []> =
let appendSequential (values : AsyncVal<'T[]>[]) : AsyncVal<'T[]> =
values
|> collectSequential
|> map (Array.fold Array.append Array.empty)

type AsyncValBuilder () =
member _.Zero () = AsyncVal.empty
member _.Return v = AsyncVal.wrap v
member _.ReturnFrom (v: AsyncVal<_>) = v
member _.ReturnFrom (a: Async<_>) = AsyncVal.ofAsync a
member _.Bind (v: AsyncVal<'T>, binder: 'T -> AsyncVal<'U>) =
AsyncVal.bind binder v
member _.Bind (a: Async<'T>, binder: 'T -> AsyncVal<'U>) =
Async(async {
member _.ReturnFrom (v : AsyncVal<_>) = v
member _.ReturnFrom (a : Async<_>) = AsyncVal.ofAsync a
member _.Bind (v : AsyncVal<'T>, binder : 'T -> AsyncVal<'U>) = AsyncVal.bind binder v
member _.Bind (a : Async<'T>, binder : 'T -> AsyncVal<'U>) =
Async (async {
let! value = a
let bound = binder value
match bound with
| Value v -> return v
| Async a -> return! a
| Failure f -> return f.Reraise() })
| Failure f -> return f.Reraise ()
})


[<AutoOpen>]
Expand All @@ -203,21 +230,21 @@ module AsyncExtensions =
let asyncVal = AsyncValBuilder ()

/// Active pattern used for checking if AsyncVal contains immediate value.
let (|Immediate|_|) (x: AsyncVal<'T>) = match x with | Value v -> Some v | _ -> None
let (|Immediate|_|) (x : AsyncVal<'T>) = match x with | Value v -> Some v | _ -> None

/// Active patter used for checking if AsyncVal wraps an Async computation.
let (|Async|_|) (x: AsyncVal<'T>) = match x with | Async a -> Some a | _ -> None
let (|Async|_|) (x : AsyncVal<'T>) = match x with | Async a -> Some a | _ -> None

type Microsoft.FSharp.Control.AsyncBuilder with

member _.ReturnFrom (v: AsyncVal<'T>) =
member _.ReturnFrom (v : AsyncVal<'T>) =
match v with
| Value v -> async.Return v
| Async a -> async.ReturnFrom a
| Failure f -> async.Return (raise f)

member _.Bind (v: AsyncVal<'T>, binder) =
member _.Bind (v : AsyncVal<'T>, binder) =
match v with
| Value v -> async.Bind(async.Return v, binder)
| Async a -> async.Bind(a, binder)
| Failure f -> async.Bind(async.Return (raise f), binder)
| Value v -> async.Bind (async.Return v, binder)
| Async a -> async.Bind (a, binder)
| Failure f -> async.Bind (async.Return (raise f), binder)
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
module FSharp.Data.GraphQL.Tests.AsyncValTests

open System
open System.Threading.Tasks
open FSharp.Data.GraphQL
open Xunit

Expand Down Expand Up @@ -41,6 +42,17 @@ let ``AsyncVal computation allows to bind async computations`` () =
AsyncVal.isSync v |> equals false
v |> AsyncVal.get |> equals 1

[<Fact>]
let ``AsyncVal computation allows to bind async computations preserving exception stack trace`` () : Task = task {
let! ex = throwsAsyncVal<Exception>(
asyncVal {
let! value = async { return failwith "test" }
return value
}
)
ex.StackTrace |> String.IsNullOrEmpty |> Assert.False
}

[<Fact>]
let ``AsyncVal computation allows to bind another AsyncVal`` () =
let v = asyncVal {
Expand Down Expand Up @@ -88,6 +100,28 @@ let ``AsyncVal sequential collection resolves all values in order of execution``
v |> AsyncVal.get |> equals [| 1; 2; 3; 4 |]
flag |> equals "b"

[<Fact>]
let ``AsyncVal sequential collection preserves exception stack trace for a single exception`` () = task {
let a = async { return failwith "test" }
let array = [| AsyncVal.wrap 1; AsyncVal.ofAsync a; AsyncVal.wrap 3 |]
let! ex = throwsAsyncVal<Exception>(array |> AsyncVal.collectSequential |> AsyncVal.map ignore)
ex.StackTrace |> String.IsNullOrEmpty |> Assert.False
}

[<Fact>]
let ``AsyncVal sequential collection collects all exceptions into AggregareException`` () = task {
let ex1 = Exception "test1"
let ex2 = Exception "test2"
let array = [| AsyncVal.wrap 1; AsyncVal.Failure ex1; AsyncVal.wrap 3; AsyncVal.Failure ex2 |]
//let a = async { return failwith "test" }
//let b = async { return failwith "test" }
//let array = [| AsyncVal.wrap 1; AsyncVal.ofAsync a; AsyncVal.wrap 3; AsyncVal.ofAsync b |]
let! ex = throwsAsyncVal<AggregateException>(array |> AsyncVal.collectSequential |> AsyncVal.map ignore)
ex.InnerExceptions |> Seq.length |> equals 2
ex.InnerExceptions[0] |> equals ex1
ex.InnerExceptions[1] |> equals ex2
}

[<Fact>]
let ``AsyncVal parallel collection resolves all values with no order of execution`` () =
let mutable flag = "none"
Expand All @@ -103,3 +137,25 @@ let ``AsyncVal parallel collection resolves all values with no order of executio
let v = array |> AsyncVal.collectParallel
v |> AsyncVal.get |> equals [| 1; 2; 3; 4 |]
flag |> equals "a"

[<Fact>]
let ``AsyncVal parallel collection preserves exception stack trace for a single exception`` () = task {
let a = async { return failwith "test" }
let array = [| AsyncVal.wrap 1; AsyncVal.ofAsync a; AsyncVal.wrap 3 |]
let! ex = throwsAsyncVal<Exception>(array |> AsyncVal.collectParallel |> AsyncVal.map ignore)
ex.StackTrace |> String.IsNullOrEmpty |> Assert.False
}

[<Fact>]
let ``AsyncVal parallel collection collects all exceptions into AggregareException`` () = task {
let ex1 = Exception "test1"
let ex2 = Exception "test2"
let array = [| AsyncVal.wrap 1; AsyncVal.Failure ex1; AsyncVal.wrap 3; AsyncVal.Failure ex2 |]
//let a = async { return failwith "test" }
//let b = async { return failwith "test" }
//let array = [| AsyncVal.wrap 1; AsyncVal.ofAsync a; AsyncVal.wrap 3; AsyncVal.ofAsync b |]
let! ex = throwsAsyncVal<AggregateException>(array |> AsyncVal.collectParallel |> AsyncVal.map ignore)
ex.InnerExceptions |> Seq.length |> equals 2
ex.InnerExceptions[0] |> equals ex1
ex.InnerExceptions[1] |> equals ex2
}
Loading

0 comments on commit 0810527

Please sign in to comment.