Skip to content

Commit 02296e2

Browse files
forkiforki
committed
Create regression test for SAFE-Stack/SAFE-BookStore#283 
1 parent 5d88640 commit 02296e2

File tree

2 files changed

+317
-0
lines changed

2 files changed

+317
-0
lines changed

‎tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/ComputationExpressions/TaskCompuationExpression.fs‎

Lines changed: 316 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,316 @@
1+
// #Regression #Conformance #DataExpressions #ComputationExpressions
2+
// Regression test for Fhttps://github.com/SAFE-Stack/SAFE-BookStore/issues/283
3+
// <Expects status="success"></Expects>
4+
5+
// Tasks.fs - TPL task computation expressions for F#
6+
//
7+
// Written in 2016 by Robert Peele ([email protected])
8+
// Original: https://github.com/rspeele/TaskBuilder.fs/blob/master/TaskBuilder.fs
9+
//
10+
// To the extent possible under law, the author(s) have dedicated all copyright and related and neighboring rights
11+
// to this software to the public domain worldwide. This software is distributed without any warranty.
12+
//
13+
// You should have received a copy of the CC0 Public Domain Dedication along with this software.
14+
// If not, see <http://creativecommons.org/publicdomain/zero/1.0/>.
15+
//
16+
// This is a slightly modified version to better fit an ASP.NET Core Giraffe web application.
17+
18+
namespace Giraffe
19+
20+
open System
21+
open System.Threading.Tasks
22+
open System.Runtime.CompilerServices
23+
24+
// This module is not really obsolete, but it's not intended to be referenced directly from user code.
25+
// However, it can't be private because it is used within inline functions that *are* user-visible.
26+
// Marking it as obsolete is a workaround to hide it from auto-completion tools.
27+
[<Obsolete>]
28+
module TaskBuilder =
29+
/// Represents the state of a computation:
30+
/// either awaiting something with a continuation,
31+
/// or completed with a return value.
32+
type Step<'a> =
33+
| Await of ICriticalNotifyCompletion * (unit -> Step<'a>)
34+
| Return of 'a
35+
/// We model tail calls explicitly, but still can't run them without O(n) memory usage.
36+
| ReturnFrom of 'a Task
37+
/// Implements the machinery of running a `Step<'m, 'm>` as a task returning a continuation task.
38+
and StepStateMachine<'a>(firstStep) as this =
39+
let methodBuilder = AsyncTaskMethodBuilder<'a Task>()
40+
/// The continuation we left off awaiting on our last MoveNext().
41+
let mutable continuation = fun () -> firstStep
42+
/// Returns next pending awaitable or null if exiting (including tail call).
43+
let nextAwaitable() =
44+
try
45+
match continuation() with
46+
| Return r ->
47+
methodBuilder.SetResult(Task.FromResult(r))
48+
null
49+
| ReturnFrom t ->
50+
methodBuilder.SetResult(t)
51+
null
52+
| Await (await, next) ->
53+
continuation <- next
54+
await
55+
with
56+
| exn ->
57+
methodBuilder.SetException(exn)
58+
null
59+
let mutable self = this
60+
61+
/// Start execution as a `Task<Task<'a>>`.
62+
member __.Run() =
63+
methodBuilder.Start(&self)
64+
methodBuilder.Task
65+
66+
interface IAsyncStateMachine with
67+
/// Proceed to one of three states: result, failure, or awaiting.
68+
/// If awaiting, MoveNext() will be called again when the awaitable completes.
69+
member __.MoveNext() =
70+
let mutable await = nextAwaitable()
71+
if not (isNull await) then
72+
// Tell the builder to call us again when this thing is done.
73+
methodBuilder.AwaitUnsafeOnCompleted(&await, &self)
74+
member __.SetStateMachine(_) = () // Doesn't really apply since we're a reference type.
75+
76+
let unwrapException (agg : AggregateException) =
77+
let inners = agg.InnerExceptions
78+
if inners.Count = 1 then inners.[0]
79+
else agg :> Exception
80+
81+
/// Used to represent no-ops like the implicit empty "else" branch of an "if" expression.
82+
let zero = Return ()
83+
84+
/// Used to return a value.
85+
let inline ret (x : 'a) = Return x
86+
87+
type Binder<'out> =
88+
// We put the output generic parameter up here at the class level, so it doesn't get subject to
89+
// inline rules. If we put it all in the inline function, then the compiler gets confused at the
90+
// below and demands that the whole function either is limited to working with (x : obj), or must
91+
// be inline itself.
92+
//
93+
// let yieldThenReturn (x : 'a) =
94+
// task {
95+
// do! Task.Yield()
96+
// return x
97+
// }
98+
99+
static member inline GenericAwait< ^abl, ^awt, ^inp
100+
when ^abl : (member GetAwaiter : unit -> ^awt)
101+
and ^awt :> ICriticalNotifyCompletion
102+
and ^awt : (member get_IsCompleted : unit -> bool)
103+
and ^awt : (member GetResult : unit -> ^inp) >
104+
(abl : ^abl, continuation : ^inp -> 'out Step) : 'out Step =
105+
let awt = (^abl : (member GetAwaiter : unit -> ^awt)(abl)) // get an awaiter from the awaitable
106+
if (^awt : (member get_IsCompleted : unit -> bool)(awt)) then // shortcut to continue immediately
107+
continuation (^awt : (member GetResult : unit -> ^inp)(awt))
108+
else
109+
Await (awt, fun () -> continuation (^awt : (member GetResult : unit -> ^inp)(awt)))
110+
111+
static member inline GenericAwaitConfigureFalse< ^tsk, ^abl, ^awt, ^inp
112+
when ^tsk : (member ConfigureAwait : bool -> ^abl)
113+
and ^abl : (member GetAwaiter : unit -> ^awt)
114+
and ^awt :> ICriticalNotifyCompletion
115+
and ^awt : (member get_IsCompleted : unit -> bool)
116+
and ^awt : (member GetResult : unit -> ^inp) >
117+
(tsk : ^tsk, continuation : ^inp -> 'out Step) : 'out Step =
118+
let abl = (^tsk : (member ConfigureAwait : bool -> ^abl)(tsk, false))
119+
Binder<'out>.GenericAwait(abl, continuation)
120+
121+
/// Special case of the above for `Task<'a>`. Have to write this out by hand to avoid confusing the compiler
122+
/// trying to decide between satisfying the constraints with `Task` or `Task<'a>`.
123+
let inline bindTask (task : 'a Task) (continuation : 'a -> Step<'b>) =
124+
let awt = task.GetAwaiter()
125+
if awt.IsCompleted then // Proceed to the next step based on the result we already have.
126+
continuation(awt.GetResult())
127+
else // Await and continue later when a result is available.
128+
Await (awt, (fun () -> continuation(awt.GetResult())))
129+
130+
/// Special case of the above for `Task<'a>`, for the context-insensitive builder.
131+
/// Have to write this out by hand to avoid confusing the compiler thinking our built-in bind method
132+
/// defined on the builder has fancy generic constraints on inp and out parameters.
133+
let inline bindTaskConfigureFalse (task : 'a Task) (continuation : 'a -> Step<'b>) =
134+
let awt = task.ConfigureAwait(false).GetAwaiter()
135+
if awt.IsCompleted then // Proceed to the next step based on the result we already have.
136+
continuation(awt.GetResult())
137+
else // Await and continue later when a result is available.
138+
Await (awt, (fun () -> continuation(awt.GetResult())))
139+
140+
/// Chains together a step with its following step.
141+
/// Note that this requires that the first step has no result.
142+
/// This prevents constructs like `task { return 1; return 2; }`.
143+
let rec combine (step : Step<unit>) (continuation : unit -> Step<'b>) =
144+
match step with
145+
| Return _ -> continuation()
146+
| ReturnFrom t ->
147+
Await (t.GetAwaiter(), continuation)
148+
| Await (awaitable, next) ->
149+
Await (awaitable, fun () -> combine (next()) continuation)
150+
151+
/// Builds a step that executes the body while the condition predicate is true.
152+
let whileLoop (cond : unit -> bool) (body : unit -> Step<unit>) =
153+
if cond() then
154+
// Create a self-referencing closure to test whether to repeat the loop on future iterations.
155+
let rec repeat () =
156+
if cond() then
157+
let body = body()
158+
match body with
159+
| Return _ -> repeat()
160+
| ReturnFrom t -> Await(t.GetAwaiter(), repeat)
161+
| Await (awaitable, next) ->
162+
Await (awaitable, fun () -> combine (next()) repeat)
163+
else zero
164+
// Run the body the first time and chain it to the repeat logic.
165+
combine (body()) repeat
166+
else zero
167+
168+
/// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function
169+
/// to retrieve the step, and in the continuation of the step (if any).
170+
let rec tryWith(step : unit -> Step<'a>) (catch : exn -> Step<'a>) =
171+
try
172+
match step() with
173+
| Return _ as i -> i
174+
| ReturnFrom t ->
175+
let awaitable = t.GetAwaiter()
176+
Await(awaitable, fun () ->
177+
try
178+
awaitable.GetResult() |> Return
179+
with
180+
| exn -> catch exn)
181+
| Await (awaitable, next) -> Await (awaitable, fun () -> tryWith next catch)
182+
with
183+
| exn -> catch exn
184+
185+
/// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function
186+
/// to retrieve the step, and in the continuation of the step (if any).
187+
let rec tryFinally (step : unit -> Step<'a>) fin =
188+
let step =
189+
try step()
190+
// Important point: we use a try/with, not a try/finally, to implement tryFinally.
191+
// The reason for this is that if we're just building a continuation, we definitely *shouldn't*
192+
// execute the `fin()` part yet -- the actual execution of the asynchronous code hasn't completed!
193+
with
194+
| _ ->
195+
fin()
196+
reraise()
197+
match step with
198+
| Return _ as i ->
199+
fin()
200+
i
201+
| ReturnFrom t ->
202+
let awaitable = t.GetAwaiter()
203+
Await(awaitable, fun () ->
204+
try
205+
awaitable.GetResult() |> Return
206+
with
207+
| _ ->
208+
fin()
209+
reraise())
210+
| Await (awaitable, next) ->
211+
Await (awaitable, fun () -> tryFinally next fin)
212+
213+
/// Implements a using statement that disposes `disp` after `body` has completed.
214+
let inline using (disp : #IDisposable) (body : _ -> Step<'a>) =
215+
// A using statement is just a try/finally with the finally block disposing if non-null.
216+
tryFinally
217+
(fun () -> body disp)
218+
(fun () -> if not (isNull (box disp)) then disp.Dispose())
219+
220+
/// Implements a loop that runs `body` for each element in `sequence`.
221+
let forLoop (sequence : 'a seq) (body : 'a -> Step<unit>) =
222+
// A for loop is just a using statement on the sequence's enumerator...
223+
using (sequence.GetEnumerator())
224+
// ... and its body is a while loop that advances the enumerator and runs the body on each element.
225+
(fun e -> whileLoop e.MoveNext (fun () -> body e.Current))
226+
227+
/// Runs a step as a task -- with a short-circuit for immediately completed steps.
228+
let run (firstStep : unit -> Step<'a>) =
229+
try
230+
match firstStep() with
231+
| Return x -> Task.FromResult(x)
232+
| ReturnFrom t -> t
233+
| Await _ as step -> StepStateMachine<'a>(step).Run().Unwrap() // sadly can't do tail recursion
234+
// Any exceptions should go on the task, rather than being thrown from this call.
235+
// This matches C# behavior where you won't see an exception until awaiting the task,
236+
// even if it failed before reaching the first "await".
237+
with
238+
| exn ->
239+
let src = new TaskCompletionSource<_>()
240+
src.SetException(exn)
241+
src.Task
242+
243+
/// Builds a `System.Threading.Tasks.Task<'a>` similarly to a C# async/await method, but with
244+
/// all awaited tasks automatically configured *not* to resume on the captured context.
245+
/// This is often preferable when writing library code that is not context-aware, but undesirable when writing
246+
/// e.g. code that must interact with user interface controls on the same thread as its caller.
247+
type ContextInsensitiveTaskBuilder() =
248+
// These methods are consistent between the two builders.
249+
// Unfortunately, inline members do not work with inheritance.
250+
member inline __.Delay(f : unit -> Step<_>) = f
251+
member inline __.Run(f : unit -> Step<'m>) = run f
252+
member inline __.Zero() = zero
253+
member inline __.Return(x) = ret x
254+
member inline __.ReturnFrom(task : _ Task) = ReturnFrom task
255+
member inline __.Combine(step : unit Step, continuation) = combine step continuation
256+
member inline __.While(condition : unit -> bool, body : unit -> unit Step) = whileLoop condition body
257+
member inline __.For(sequence : _ seq, body : _ -> unit Step) = forLoop sequence body
258+
member inline __.TryWith(body : unit -> _ Step, catch : exn -> _ Step) = tryWith body catch
259+
member inline __.TryFinally(body : unit -> _ Step, fin : unit -> unit) = tryFinally body fin
260+
member inline __.Using(disp : #IDisposable, body : #IDisposable -> _ Step) = using disp body
261+
// End of consistent methods -- the following methods are different between
262+
// `TaskBuilder` and `ContextInsensitiveTaskBuilder`!
263+
264+
// We have to have a dedicated overload for Task<'a> so the compiler doesn't get confused.
265+
// Everything else can use bindGenericAwaitable via an extension member (defined later).
266+
member inline __.Bind(task : 'a Task, continuation : 'a -> 'b Step) : 'b Step =
267+
bindTaskConfigureFalse task continuation
268+
269+
// Async overload bind
270+
member inline __.Bind(work : 'a Async, continuation : 'a -> 'b Step) : 'b Step =
271+
let task = Async.StartAsTask work
272+
bindTaskConfigureFalse task continuation
273+
274+
// Don't warn about our use of the "obsolete" module we just defined (see notes at start of file).
275+
#nowarn "44"
276+
277+
[<AutoOpen>]
278+
module Tasks =
279+
/// Builds a `System.Threading.Tasks.Task<'a>` similarly to a C# async/await method, but with
280+
/// all awaited tasks automatically configured *not* to resume on the captured context.
281+
/// This is often preferable when writing library code that is not context-aware, but undesirable when writing
282+
/// e.g. code that must interact with user interface controls on the same thread as its caller.
283+
let task = TaskBuilder.ContextInsensitiveTaskBuilder()
284+
285+
// These are fallbacks when the Bind and ReturnFrom on the builder object itself don't apply.
286+
// This is how we support binding arbitrary task-like types.
287+
type TaskBuilder.ContextInsensitiveTaskBuilder with
288+
member inline this.ReturnFrom(taskLike) =
289+
TaskBuilder.Binder<_>.GenericAwait(taskLike, TaskBuilder.ret)
290+
member inline this.Bind(taskLike, continuation : _ -> 'a TaskBuilder.Step) : 'a TaskBuilder.Step =
291+
TaskBuilder.Binder<'a>.GenericAwait(taskLike, continuation)
292+
293+
[<AutoOpen>]
294+
module HigherPriorityBinds =
295+
// When it's possible for these to work, the compiler should prefer them since they shadow the ones above.
296+
type TaskBuilder.ContextInsensitiveTaskBuilder with
297+
member inline this.ReturnFrom(configurableTaskLike) =
298+
TaskBuilder.Binder<_>.GenericAwaitConfigureFalse(configurableTaskLike, TaskBuilder.ret)
299+
member inline this.Bind(configurableTaskLike, continuation : _ -> 'a TaskBuilder.Step) : 'a TaskBuilder.Step =
300+
TaskBuilder.Binder<'a>.GenericAwaitConfigureFalse(configurableTaskLike, continuation)
301+
302+
module Test =
303+
304+
type Book = {
305+
Name: string
306+
}
307+
308+
let get<'a> (connectionString:string) (name:string) = task {
309+
let book : 'a = { Name = name } |> unbox
310+
return book
311+
}
312+
313+
let t = task {
314+
let! book = get<Book> "abc" "The Neverending Story"
315+
printfn "%s" book.Name
316+
}

‎tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/ComputationExpressions/env.lst‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
SOURCE=CombineResults01.fs SCFLAGS=-a # CombineResults01.fs
22
SOURCE=ForLoop01.fs # ForLoop01.fs
33
SOURCE=Regressions01.fs # Regressions01.fs
4+
SOURCE=TaskCompuationExpression.fs # TaskCompuationExpression.fs
45
SOURCE=MinMaxValuesInLoop01.fs # MinMaxValuesInLoop01.fs
56
SOURCE=MinMaxValuesInLoop02.fs # MinMaxValuesInLoop02.fs
67

0 commit comments

Comments
 (0)