diff --git a/Fsdk.Tests/AsyncExtensions.fs b/Fsdk.Tests/AsyncExtensions.fs new file mode 100644 index 00000000..4298f359 --- /dev/null +++ b/Fsdk.Tests/AsyncExtensions.fs @@ -0,0 +1,512 @@ +namespace Fsdk.Tests + +open System +open System.Diagnostics + +open NUnit.Framework + +open Fsdk + +[] +type AsyncExtensions() = + + [] + member __.``basic test for WhenAny``() = + let shortJobRes = 1 + let shortTime = TimeSpan.FromSeconds 1. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return shortJobRes + } + + let longJobRes = 2 + let longTime = TimeSpan.FromSeconds 10. + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + return longJobRes + } + + let stopWatch = Stopwatch.StartNew() + + let res1 = + FSharpUtil.AsyncExtensions.WhenAny [ longJob; shortJob ] + |> Async.RunSynchronously + + Assert.That(res1, Is.EqualTo shortJobRes) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime) + stopWatch.Stop() + + let stopWatch = Stopwatch.StartNew() + + let res2 = + FSharpUtil.AsyncExtensions.WhenAny [ shortJob; longJob ] + |> Async.RunSynchronously + + Assert.That(res2, Is.EqualTo shortJobRes) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime) + stopWatch.Stop() + + [] + member __.``basic test for Async.Choice``() = + let shortTime = TimeSpan.FromSeconds 1. + + let shortFailingJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return None + } + + let shortSuccessfulJobRes = 2 + + let shortSuccessfulJob = + async { + do! + Async.Sleep( + int shortTime.TotalMilliseconds + + int shortTime.TotalMilliseconds + ) + + return Some shortSuccessfulJobRes + } + + let longJobRes = 3 + let longTime = TimeSpan.FromSeconds 10. + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + return Some longJobRes + } + + let stopWatch = Stopwatch.StartNew() + + let res1 = + Async.Choice + [ + longJob + shortFailingJob + shortSuccessfulJob + ] + |> Async.RunSynchronously + + Assert.That(res1, Is.EqualTo(Some shortSuccessfulJobRes)) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#1") + stopWatch.Stop() + + let stopWatch = Stopwatch.StartNew() + + let res2 = + Async.Choice + [ + longJob + shortSuccessfulJob + shortFailingJob + ] + |> Async.RunSynchronously + + Assert.That(res2, Is.EqualTo(Some shortSuccessfulJobRes)) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#2") + stopWatch.Stop() + + let stopWatch = Stopwatch.StartNew() + + let res3 = + Async.Choice + [ + shortFailingJob + longJob + shortSuccessfulJob + ] + |> Async.RunSynchronously + + Assert.That(res3, Is.EqualTo(Some shortSuccessfulJobRes)) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#3") + stopWatch.Stop() + + let stopWatch = Stopwatch.StartNew() + + let res4 = + Async.Choice + [ + shortFailingJob + shortSuccessfulJob + longJob + ] + |> Async.RunSynchronously + + Assert.That(res4, Is.EqualTo(Some shortSuccessfulJobRes)) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#4") + stopWatch.Stop() + + let stopWatch = Stopwatch.StartNew() + + let res5 = + Async.Choice + [ + shortSuccessfulJob + longJob + shortFailingJob + ] + |> Async.RunSynchronously + + Assert.That(res5, Is.EqualTo(Some shortSuccessfulJobRes)) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#5") + stopWatch.Stop() + + let stopWatch = Stopwatch.StartNew() + + let res6 = + Async.Choice + [ + shortSuccessfulJob + shortFailingJob + longJob + ] + |> Async.RunSynchronously + + Assert.That(res6, Is.EqualTo(Some shortSuccessfulJobRes)) + Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#6") + stopWatch.Stop() + + [] + member __.``basic test for WhenAnyAndAll``() = + let lockObj = Object() + let mutable asyncJobsPerformedCount = 0 + + let shortJobRes = 1 + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + lock + lockObj + (fun _ -> + asyncJobsPerformedCount <- asyncJobsPerformedCount + 1 + ) + + do! Async.Sleep(int shortTime.TotalMilliseconds) + return shortJobRes + } + + let longJobRes = 2 + let longTime = TimeSpan.FromSeconds 3. + + let longJob = + async { + lock + lockObj + (fun _ -> + asyncJobsPerformedCount <- asyncJobsPerformedCount + 1 + ) + + do! Async.Sleep(int longTime.TotalMilliseconds) + return longJobRes + } + + let stopWatch = Stopwatch.StartNew() + + let subJobs = + FSharpUtil.AsyncExtensions.WhenAnyAndAll [ longJob; shortJob ] + |> Async.RunSynchronously + + Assert.That(stopWatch.Elapsed, Is.LessThan longTime) + Assert.That(stopWatch.Elapsed, Is.GreaterThan shortTime) + let results = subJobs |> Async.RunSynchronously + Assert.That(results.Length, Is.EqualTo 2) + Assert.That(results.[0], Is.EqualTo longJobRes) + Assert.That(results.[1], Is.EqualTo shortJobRes) + stopWatch.Stop() + + Assert.That(asyncJobsPerformedCount, Is.EqualTo 2) + + // the below is to make sure that the jobs don't get executed a second time! + let stopWatch = Stopwatch.StartNew() + subJobs |> Async.RunSynchronously |> ignore> + Assert.That(asyncJobsPerformedCount, Is.EqualTo 2) + Assert.That(stopWatch.Elapsed, Is.LessThan shortTime) + + [] + member __.``AsyncParallel cancels all jobs if there's an exception in one'`` + () + = + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return failwith "pepe" + } + + let longJobRes = 2 + let mutable longJobFinished = false + let longTime = TimeSpan.FromSeconds 3. + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return longJobRes + } + + let result = + try + Async.Parallel [ longJob; shortJob ] + |> Async.RunSynchronously + |> Some + with + | _ -> None + + Assert.That(result, Is.EqualTo None) + Assert.That(longJobFinished, Is.EqualTo false, "#before") + Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0) + Assert.That(longJobFinished, Is.EqualTo false, "#after") + + [] + member __.``AsyncChoice cancels slower jobs (all jobs that were not the fastest)`` + () + = + let shortJobRes = 1 + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return Some shortJobRes + } + + let longJobRes = 2 + let mutable longJobFinished = false + let longTime = TimeSpan.FromSeconds 3. + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return Some longJobRes + } + + let result = + Async.Choice [ longJob; shortJob ] |> Async.RunSynchronously + + Assert.That(result, Is.EqualTo(Some shortJobRes)) + Assert.That(longJobFinished, Is.EqualTo false, "#before") + Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0) + Assert.That(longJobFinished, Is.EqualTo false, "#after") + + [] + member __.``AsyncExtensions-WhenAny cancels slower jobs (all jobs that were not the fastest)`` + () + = + let shortJobRes = 1 + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return shortJobRes + } + + let longJobRes = 2 + let mutable longJobFinished = false + let longTime = TimeSpan.FromSeconds 3. + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return longJobRes + } + + let result = + FSharpUtil.AsyncExtensions.WhenAny [ longJob; shortJob ] + |> Async.RunSynchronously + + Assert.That(result, Is.EqualTo shortJobRes) + Assert.That(longJobFinished, Is.EqualTo false, "#before") + Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0) + Assert.That(longJobFinished, Is.EqualTo false, "#after") + + [] + member __.``AsyncExtensions-WhenAnyAndAll doesn't cancel slower jobs``() = + let shortJobRes = 1 + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return shortJobRes + } + + let longJobRes = 2 + let mutable longJobFinished = false + let longTime = TimeSpan.FromSeconds 3. + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return longJobRes + } + + let jobs = + FSharpUtil.AsyncExtensions.WhenAnyAndAll [ longJob; shortJob ] + |> Async.RunSynchronously + + Assert.That(longJobFinished, Is.EqualTo false, "#before") + let results = jobs |> Async.RunSynchronously + Assert.That(results.[0], Is.EqualTo longJobRes) + Assert.That(results.[1], Is.EqualTo shortJobRes) + Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0) + Assert.That(longJobFinished, Is.EqualTo true, "#after") + + [] + member __.``Async.MixedParallel2 cancels all jobs if there's an exception in one'`` + () + = + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return failwith "pepe" + } + + let mutable longJobFinished = false + let longTime = TimeSpan.FromSeconds 3. + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return 1 + } + + let result = + try + FSharpUtil.AsyncExtensions.MixedParallel2 longJob shortJob + |> Async.RunSynchronously + |> Some + with + | _ -> None + + Assert.That(result, Is.EqualTo None) + Assert.That(longJobFinished, Is.EqualTo false, "#before") + Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0) + Assert.That(longJobFinished, Is.EqualTo false, "#after") + + [] + member __.``Async.MixedParallel3 cancels all jobs if there's an exception in one'`` + () + = + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return failwith "pepe" + } + + + let longTime = TimeSpan.FromSeconds 3. + + let mutable longJobFinished = false + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return 1 + } + + let mutable longJob2Finished = false + + let longJob2 = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return 2.0 + } + + let result = + try + FSharpUtil.AsyncExtensions.MixedParallel3 + longJob + shortJob + longJob2 + |> Async.RunSynchronously + |> Some + with + | _ -> None + + Assert.That(result, Is.EqualTo None) + Assert.That(longJobFinished, Is.EqualTo false, "#before") + Assert.That(longJob2Finished, Is.EqualTo false, "#before") + Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0) + Assert.That(longJobFinished, Is.EqualTo false, "#after") + Assert.That(longJob2Finished, Is.EqualTo false, "#before") + + [] + member __.``Async.MixedParallel4 cancels all jobs if there's an exception in one'`` + () + = + let shortTime = TimeSpan.FromSeconds 2. + + let shortJob = + async { + do! Async.Sleep(int shortTime.TotalMilliseconds) + return failwith "pepe" + } + + let longTime = TimeSpan.FromSeconds 3. + + let mutable longJobFinished = false + + let longJob = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return 1 + } + + let mutable longJob2Finished = false + + let longJob2 = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return 2.0 + } + + let mutable longJob3Finished = false + + let longJob3 = + async { + do! Async.Sleep(int longTime.TotalMilliseconds) + longJobFinished <- true + return 3I + } + + let result = + try + FSharpUtil.AsyncExtensions.MixedParallel4 + longJob + shortJob + longJob2 + longJob3 + |> Async.RunSynchronously + |> Some + with + | _ -> None + + Assert.That(result, Is.EqualTo None) + Assert.That(longJobFinished, Is.EqualTo false, "#before") + Assert.That(longJob2Finished, Is.EqualTo false, "#before - 2") + Assert.That(longJob3Finished, Is.EqualTo false, "#before - 3") + Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0) + Assert.That(longJobFinished, Is.EqualTo false, "#after") + Assert.That(longJob2Finished, Is.EqualTo false, "#after - 2") + Assert.That(longJob3Finished, Is.EqualTo false, "#after - 3") diff --git a/Fsdk.Tests/FSharpUtil.fs b/Fsdk.Tests/FSharpUtil.fs new file mode 100644 index 00000000..5503029a --- /dev/null +++ b/Fsdk.Tests/FSharpUtil.fs @@ -0,0 +1,77 @@ +namespace Fsdk.Tests + +open System +open System.Threading.Tasks + +open NUnit.Framework + +open Fsdk + +type UnexpectedTaskCanceledException(message: string, innerException) = + inherit TaskCanceledException(message, innerException) + +type TypeWithStringOverridenManually = + | FOO + | BAR + + override self.ToString() = + match self with + | FOO -> "FOO" + | BAR -> "BAR" + +type TypeWithNoToStringOverriden = + | FOO + | BAR + +[] +type FSharpUtilCoverage() = + + [] + member __.``find exception: basic test``() = + let innerEx = TaskCanceledException "bar" + let wrapperEx = Exception("foo", innerEx) + + let childFound = + FSharpUtil.FindException wrapperEx + + match childFound with + | None -> failwith "should find through inner classes" + | Some ex -> + Assert.That(Object.ReferenceEquals(ex, innerEx), Is.True) + Assert.That(Object.ReferenceEquals(ex.InnerException, null)) + + [] + member __.``find exception: it works with inherited classes (UnexpectedTaskCanceledException is child of TaskCanceledException)`` + () + = + let innerEx = TaskCanceledException "bar" + let inheritedEx = UnexpectedTaskCanceledException("foo", innerEx) + + let parentFound = + FSharpUtil.FindException inheritedEx + + match parentFound with + | None -> failwith "should work with derived classes" + | Some ex -> + Assert.That(Object.ReferenceEquals(ex, inheritedEx), Is.True) + Assert.That(Object.ReferenceEquals(ex.InnerException, innerEx)) + + [] + member __.``find exception: flattens (AggregateEx)``() = + let innerEx1 = TaskCanceledException "bar" :> Exception + let innerEx2 = UnexpectedTaskCanceledException("baz", null) :> Exception + let parent = AggregateException("foo", [| innerEx1; innerEx2 |]) + + let sibling1Found = + FSharpUtil.FindException parent + + match sibling1Found with + | None -> failwith "should work" + | Some ex -> Assert.That(Object.ReferenceEquals(ex, innerEx1), Is.True) + + let sibling2Found = + FSharpUtil.FindException parent + + match sibling2Found with + | None -> failwith "should find sibling 2 too" + | Some ex -> Assert.That(Object.ReferenceEquals(ex, innerEx2), Is.True) diff --git a/Fsdk.Tests/Fsdk.Tests.fsproj b/Fsdk.Tests/Fsdk.Tests.fsproj new file mode 100644 index 00000000..371496b5 --- /dev/null +++ b/Fsdk.Tests/Fsdk.Tests.fsproj @@ -0,0 +1,28 @@ + + + + net6.0 + + false + false + + + + + + + + + + + + + + + + + + + + + diff --git a/Fsdk.Tests/Program.fs b/Fsdk.Tests/Program.fs new file mode 100644 index 00000000..82efadee --- /dev/null +++ b/Fsdk.Tests/Program.fs @@ -0,0 +1,5 @@ +module Program = + + [] + let main _ = + 0 diff --git a/Fsdk/FSharpUtil.fs b/Fsdk/FSharpUtil.fs new file mode 100644 index 00000000..01782bd0 --- /dev/null +++ b/Fsdk/FSharpUtil.fs @@ -0,0 +1,333 @@ +namespace Fsdk + +open System +open System.Linq +open System.Threading.Tasks +open System.Runtime.ExceptionServices + + +// FIXME: replace all usages of the below with native FSharp.Core's Result type (https://docs.microsoft.com/en-us/dotnet/fsharp/language-reference/results) +// when the stockmono_* lanes can use at least F# v4.5 +type Either<'Val, 'Err when 'Err :> Exception> = + | FailureResult of 'Err + | SuccessfulValue of 'Val + +module FSharpUtil = + + type internal ResultWrapper<'T>(value: 'T) = + + // hack? + inherit Exception() + + member __.Value = value + + + type IErrorMsg = + abstract member Message: string + abstract member ChannelBreakdown: bool + + let UnwrapResult<'TRes, 'TError> + (result: Result<'TRes, 'TError>) + (msg: string) + : 'TRes = + match result with + | Ok value -> value + | Error err -> + let errorMsg = + match box err with + | :? IErrorMsg as e -> e.Message + | _ -> err.ToString() + + failwith <| sprintf "error unwrapping Result: %s: %s" msg errorMsg + + let UnwrapOption<'T> (opt: Option<'T>) (msg: string) : 'T = + match opt with + | Some value -> value + | None -> failwith <| sprintf "error unwrapping Option: %s" msg + + module AsyncExtensions = + let private makeBoxed(job: Async<'a>) : Async = + async { + let! result = job + return box result + } + + let MixedParallel2 (a: Async<'T1>) (b: Async<'T2>) : Async<'T1 * 'T2> = + async { + let! results = Async.Parallel [| makeBoxed a; makeBoxed b |] + return (unbox<'T1> results.[0]), (unbox<'T2> results.[1]) + } + + let MixedParallel3 + (a: Async<'T1>) + (b: Async<'T2>) + (c: Async<'T3>) + : Async<'T1 * 'T2 * 'T3> = + async { + let! results = + Async.Parallel + [| + makeBoxed a + makeBoxed b + makeBoxed c + |] + + return + (unbox<'T1> results.[0]), + (unbox<'T2> results.[1]), + (unbox<'T3> results.[2]) + } + + let MixedParallel4 + (a: Async<'T1>) + (b: Async<'T2>) + (c: Async<'T3>) + (d: Async<'T4>) + : Async<'T1 * 'T2 * 'T3 * 'T4> = + async { + let! results = + Async.Parallel + [| + makeBoxed a + makeBoxed b + makeBoxed c + makeBoxed d + |] + + return + (unbox<'T1> results.[0]), + (unbox<'T2> results.[1]), + (unbox<'T3> results.[2]), + (unbox<'T4> results.[3]) + } + + // efficient raise + let private RaiseResult(e: ResultWrapper<'T>) = + Async.FromContinuations(fun (_, econt, _) -> econt e) + + // like Async.Choice, but with no need for Option types + let WhenAny<'T>(jobs: seq>) : Async<'T> = + let wrap(job: Async<'T>) : Async> = + async { + let! res = job + return Some res + } + + async { + let wrappedJobs = jobs |> Seq.map wrap + let! combinedRes = Async.Choice wrappedJobs + + match combinedRes with + | Some x -> return x + | None -> return failwith "unreachable" + } + + // a mix between Async.WhenAny and Async.Choice + let WhenAnyAndAll<'T>(jobs: seq>) : Async>> = + let taskSource = TaskCompletionSource() + + let wrap(job: Async<'T>) = + async { + let! res = job + taskSource.TrySetResult() |> ignore + return res + } + + async { + let allJobsInParallel = + jobs |> Seq.map wrap |> Async.Parallel |> Async.StartChild + + let! allJobsStarted = allJobsInParallel + let! _ = Async.AwaitTask taskSource.Task + return allJobsStarted + } + + let rec private ListIntersectInternal list1 list2 offset acc currentIndex = + match list1, list2 with + | [], [] -> List.rev acc + | [], _ -> List.append (List.rev acc) list2 + | _, [] -> List.append (List.rev acc) list1 + | head1 :: tail1, head2 :: tail2 -> + if currentIndex % (int offset) = 0 then + ListIntersectInternal + list1 + tail2 + offset + (head2 :: acc) + (currentIndex + 1) + else + ListIntersectInternal + tail1 + list2 + offset + (head1 :: acc) + (currentIndex + 1) + + let ListIntersect<'T> + (list1: List<'T>) + (list2: List<'T>) + (offset: uint32) + : List<'T> = + ListIntersectInternal list1 list2 offset [] 1 + + let SeqTryHeadTail<'T>(sequence: seq<'T>) : Option<'T * seq<'T>> = + match Seq.tryHead sequence with + | None -> None + | Some head -> Some(head, Seq.tail sequence) + + let rec SeqAsyncTryPick<'T, 'U> + (sequence: seq<'T>) + (chooser: 'T -> Async>) + : Async> = + async { + match SeqTryHeadTail sequence with + | None -> return None + | Some(head, tail) -> + let! choiceOpt = chooser head + + match choiceOpt with + | None -> return! SeqAsyncTryPick tail chooser + | Some choice -> return Some choice + } + + let ListAsyncTryPick<'T, 'U> + (list: list<'T>) + (chooser: 'T -> Async>) + : Async> = + SeqAsyncTryPick (list |> Seq.ofList) chooser + + + let WithTimeout (timeSpan: TimeSpan) (job: Async<'R>) : Async> = + async { + let read = + async { + let! value = job + return value |> SuccessfulValue |> Some + } + + let delay = + async { + let total = int timeSpan.TotalMilliseconds + do! Async.Sleep total + return FailureResult <| TimeoutException() |> Some + } + + let! dummyOption = Async.Choice([ read; delay ]) + + match dummyOption with + | Some theResult -> + match theResult with + | SuccessfulValue r -> return Some r + | FailureResult _ -> return None + | None -> + // none of the jobs passed to Async.Choice returns None + return failwith "unreachable" + } + + // FIXME: we should not need this workaround anymore when this gets addressed: + // https://github.com/fsharp/fslang-suggestions/issues/660 + let ReRaise(ex: Exception) : Exception = + (ExceptionDispatchInfo.Capture ex).Throw() + failwith "Should be unreachable" + ex + + let rec public FindException<'T when 'T :> Exception> + (ex: Exception) + : Option<'T> = + let rec findExInSeq(sq: seq) = + match Seq.tryHead sq with + | Some head -> + let found = FindException head + + match found with + | Some ex -> Some ex + | None -> findExInSeq <| Seq.tail sq + | None -> None + + if null = ex then + None + else + match ex with + | :? 'T as specificEx -> Some(specificEx) + | :? AggregateException as aggEx -> + findExInSeq aggEx.InnerExceptions + | _ -> FindException<'T>(ex.InnerException) + + // Searches through an exception tree and ensures that all the leaves of + // the tree have type 'T. Returns these 'T exceptions as a sequence, or + // otherwise re-raises the original exception if there are any non-'T-based + // exceptions in the tree. + let public FindSingleException<'T when 'T :> Exception> + (ex: Exception) + : seq<'T> = + let rec findSingleExceptionOpt(ex: Exception) : Option> = + let rec findSingleExceptionInSeq + (sq: seq) + (acc: seq<'T>) + : Option> = + match Seq.tryHead sq with + | Some head -> + match findSingleExceptionOpt head with + | Some exs -> + findSingleExceptionInSeq + (Seq.tail sq) + (Seq.concat [ acc; exs ]) + | None -> None + | None -> Some acc + + let findSingleInnerException(ex: Exception) : Option> = + if null = ex.InnerException then + None + else + findSingleExceptionOpt ex.InnerException + + match ex with + | :? 'T as specificEx -> Some <| Seq.singleton specificEx + | :? AggregateException as aggEx -> + findSingleExceptionInSeq aggEx.InnerExceptions Seq.empty + | _ -> findSingleInnerException ex + + match findSingleExceptionOpt ex with + | Some exs -> exs + | None -> + ReRaise ex |> ignore + failwith "unreachable" + + type OptionBuilder() = + // see https://github.com/dsyme/fsharp-presentations/blob/master/design-notes/ces-compared.md#overview-of-f-computation-expressions + member x.Bind(v, f) = + Option.bind f v + + member x.Return v = + Some v + + member x.ReturnFrom o = + o + + member x.Zero() = + None + + let option = OptionBuilder() + + let Retry<'T, 'TException when 'TException :> Exception> + sourceFunc + retryCount + : Async<'T> = + async { + let rec retrySourceFunc currentRetryCount = + async { + try + return! sourceFunc() + with + | ex -> + match FindException<'TException> ex with + | Some ex -> + if currentRetryCount = 0 then + return raise <| ReRaise ex + + return! retrySourceFunc(currentRetryCount - 1) + | None -> return raise <| ReRaise ex + } + + return! retrySourceFunc retryCount + } diff --git a/Fsdk/Fsdk.fsproj b/Fsdk/Fsdk.fsproj index e8818068..704c7726 100644 --- a/Fsdk/Fsdk.fsproj +++ b/Fsdk/Fsdk.fsproj @@ -22,6 +22,7 @@ + diff --git a/fsx.sln b/fsx.sln index 021daa79..21ffa724 100644 --- a/fsx.sln +++ b/fsx.sln @@ -53,6 +53,8 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Tools", "Tools", "{FD764CDA Tools\gitPush1by1.fsx = Tools\gitPush1by1.fsx EndProjectSection EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Fsdk.Tests", "Fsdk.Tests\Fsdk.Tests.fsproj", "{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU