Provisional implementation of a variant of CancellationToken implementation in CE

Author: abelbraaksma

src/FSharp.Control.TaskSeq.Test/TaskSeq.Do.Tests.fs

@@ -6,6 +6,7 @@ open FsUnit
 open Xunit
 
 open FSharp.Control
+open System.Threading
 
 [<Fact>]
 let ``CE taskSeq: use 'do'`` () =
@@ -57,6 +58,56 @@ let ``CE taskSeq: use 'do!' with a task-delay`` () =
     |> verifyEmpty
     |> Task.map (fun _ -> value |> should equal 2)
 
+//module CancellationToken =
+//    [<Fact>]
+//    let ``CE taskSeq: use 'do!' with a default cancellation-token`` () =
+//        let mutable value = 0
+
+//        taskSeq {
+//            do value <- value + 1
+//            do! CancellationToken()
+//            do value <- value + 1
+//        }
+//        |> verifyEmpty
+//        |> Task.map (fun _ -> value |> should equal 2)
+
+//    [<Fact>]
+//    let ``CE taskSeq: use 'do!' with a timer cancellation-token - explicit`` () = task {
+//        let mutable value = 0
+//        use tokenSource = new CancellationTokenSource(500)
+
+//        return!
+//            taskSeq {
+//                do! tokenSource.Token // this sets the token for this taskSeq
+//                do value <- value + 1
+//                do! Task.Delay(300, tokenSource.Token)
+//                do! Task.Delay(300, tokenSource.Token)
+//                do! Task.Delay(300, tokenSource.Token)
+//                do value <- value + 1
+//            }
+//            |> verifyEmpty
+//            |> Task.map (fun _ -> value |> should equal 2)
+//    }
+
+
+//    [<Fact>]
+//    let ``CE taskSeq: use 'do!' with a timer cancellation-token - implicit`` () = task {
+//        let mutable value = 0
+//        use tokenSource = new CancellationTokenSource(500)
+
+//        return!
+//            taskSeq {
+//                do! tokenSource.Token // this sets the token for this taskSeq
+//                do value <- value + 1
+//                do! Task.Delay(300)
+//                do! Task.Delay(300)
+//                do! Task.Delay(300)
+//                do value <- value + 1
+//            }
+//            |> verifyEmpty
+//            |> Task.map (fun _ -> value |> should equal 2)
+//    }
+
 [<Fact>]
 let ``CE taskSeq: use 'do!' with Async`` () =
     let mutable value = 0

src/FSharp.Control.TaskSeq/TaskSeqBuilder.fs

@@ -556,7 +556,7 @@ module LowPriority =
 
                 else
                     Debug.logInfo "at TaskLike bind: await further"
-
+                    sm.Data.cancellationToken.ThrowIfCancellationRequested()
                     sm.Data.awaiter <- awaiter
                     sm.Data.current <- ValueNone
                     false)
@@ -614,6 +614,10 @@ module HighPriority =
         //
         member inline _.Bind(task: Task<'T>, continuation: ('T -> ResumableTSC<'U>)) =
             ResumableTSC<'U>(fun sm ->
+                // WTF???
+                //let x = Func<Task<_>>(fun _ -> task)
+                //Task<'TResult>.Run(x, sm.Data.cancellationToken)
+
                 let mutable awaiter = task.GetAwaiter()
                 let mutable __stack_fin = true
 
@@ -635,7 +639,7 @@ module HighPriority =
 
                 else
                     Debug.logInfo "at Bind: await further"
-
+                    sm.Data.cancellationToken.ThrowIfCancellationRequested()
                     sm.Data.awaiter <- awaiter
                     sm.Data.current <- ValueNone
                     false)
@@ -672,10 +676,20 @@ module HighPriority =
                     sm.Data.current <- ValueNone
                     false)
 
-        // Binding to a cancellation token. This allows `do! someCancellationToken`
-        member inline _.Bind(myToken: CancellationToken, continuation: (unit -> ResumableTSC<'T>)) : ResumableTSC<'T> =
+        //// Binding to a cancellation token. This allows `do! someCancellationToken`
+        //member inline _.Bind(cancellationToken, continuation: (unit -> ResumableTSC<'T>)) : ResumableTSC<'T> =
+        //    ResumableTSC<'T>(fun sm ->
+        //        sm.Data.cancellationToken <- cancellationToken
+        //        (continuation ()).Invoke(&sm))
+
+        [<CustomOperation "cancellationToken">]
+        member inline _.SetCancellationToken
+            (
+                cancellationToken,
+                continuation: (unit -> ResumableTSC<'T>)
+            ) : ResumableTSC<'T> =
             ResumableTSC<'T>(fun sm ->
-                sm.Data.cancellationToken <- myToken
+                sm.Data.cancellationToken <- cancellationToken
                 (continuation ()).Invoke(&sm))
 
 [<AutoOpen>]

src/FSharp.Control.TaskSeq/TaskSeqBuilder.fsi

@@ -198,3 +198,8 @@ module HighPriority =
 
         member inline Bind: task: Task<'T> * continuation: ('T -> ResumableTSC<'U>) -> ResumableTSC<'U>
         member inline Bind: computation: Async<'T> * continuation: ('T -> ResumableTSC<'U>) -> ResumableTSC<'U>
+        //member inline Bind:
+        //    cancellationToken: CancellationToken * continuation: (unit -> ResumableTSC<'T>) -> ResumableTSC<'T>
+        [<CustomOperation "cancellationToken">]
+        member inline SetCancellationToken:
+            cancellationToken: CancellationToken * continuation: (unit -> ResumableTSC<'T>) -> ResumableTSC<'T>

src/FSharp.Control.TaskSeq/TaskSeqInternal.fs

@@ -67,10 +67,11 @@ module internal TaskSeqInternal =
         KeyNotFoundException("The predicate function or index did not satisfy any item in the async sequence.")
         |> raise
 
-    let inline withCancellationToken (cancellationToken: CancellationToken) (source: taskSeq<'T>) = taskSeq {
-        do! cancellationToken
-        yield! source
-    }
+    //let inline withCancellationToken (cancellationToken2: CancellationToken) (source: taskSeq<'T>) = taskSeq {
+    //    // COMPILE ERROR HERE
+    //    cancellationToken cancellationToken2
+    //    yield! source
+    //}
 
     let isEmpty (source: taskSeq<_>) =
         checkNonNull (nameof source) source