Improve scoped effect API

src/Orsak/Effects/Database.fs

@@ -1,16 +1,11 @@
 namespace Orsak.Effects
 
-open System.Threading
-open System.Runtime.CompilerServices
-
 #nowarn "57"
 //#nowarn "3559"
 
-open System
 open System.Data.Common
 open System.Threading.Tasks
 open Orsak
-open Orsak.ScopeAware
 open Orsak.Scoped
 open FSharp.Control
 
@@ -26,54 +21,79 @@ type DbTransactional(tran: DbTransaction) =
             do! this.Connection.DisposeAsync()
         }
 
+/// <summary>
+/// Pure transaction effect.
+/// </summary>
 type Transaction<'a, 'err> = Effect<DbTransactional, 'a, 'err>
 
+/// <summary>
+/// Effects created by trxAware have this type.
+/// </summary>
 type EnlistedTransaction<'r, 'a, 'err> = Effect<'r * DbTransactional, 'a, 'err>
 
 namespace Orsak.Scoped
 
 open Orsak
 open Orsak.Effects
+open System.Threading
 open System.Threading.Tasks
 
 [<AutoOpen>]
 module Builder =
-    let commitEff = Orsak.Scoped.TransactionalEffectBuilder<DbTransactional>()
+    let commitEff = Orsak.Scoped.CompletableScopeCreatingEffectBuilder<DbTransactional>()
 
     let trxAware = Orsak.ScopeAware.ScopeAwareEffectBuilder<DbTransactional>()
 
+(*
+    Using scoped effects:
+*)
 
-//define some kind of provider that should be scoped
+//define some kind of Effect that should be scoped
 [<Interface>]
 type IProgressScope =
     abstract member Progress: System.IProgress<float>
-    inherit System.IAsyncDisposable
+    inherit Scoped
 
+//type alias for convini
+type IProgressScopeProvider = ScopeProvider<IProgressScope>
 
 //builder for your scope
-//once outside the scope, it is just a regular effect
 module Builder2 =
+    //using this to create an effect, will create an IProgressScope at the start of the effect, and it will be available
+    //throught the effect, and disposed at the end of the effect
+    //the result will be just a normal effect, that requires a IProgressScopeProvider
     let pEff = Orsak.Scoped.ScopeCreatingEffectBuilder<IProgressScope>()
 
+    //using this allows access to the IProgressScope created by a another effect
+    //expects to be bound in pEff
+    //if bound in a normal eff, the resulting Effect will be specialized as an enlisted progress effect
     let enlistP = Orsak.ScopeAware.ScopeAwareEffectBuilder<IProgressScope>()
 
+open Builder2
+
 module Progress =
-    open System.Threading
-    open Orsak
-    let report (t: float) =
-        Effect.Create(fun (x: #IProgressScope) -> x.Progress.Report(t))
+    //Pure progress effect, no other effects allowed.
+    type Progress<'err> = Effect<IProgressScope, unit, 'err>
 
-    open Builder2
+    //Function for calling our scoped effect
+    let report (t: float) : Progress<_> =
+        //by not making x generic, we restrict how report is called. (No #)
+        //it can now only really be called through pEff or enlistP
+        Effect.Create(fun (x: IProgressScope) -> x.Progress.Report(t))
 
-    let reportWhenDone r (e: Effect<'r,_,_>) = enlistP {
+    let reportWhenDone total (e: Effect<'r,_,_>) = enlistP {
         let! result = e
-        do! report r
+        do! report total
         return result
     }
 
+    let reportWhenDone2 total (e: Effect<'r,_,_>) = eff {
+        let! a = reportWhenDone total e
+        return a
+    }
+
     let whenAll (effects: Effect<'r,_,_> array) = pEff {
         let total = float effects.Length
-
         let! result =
             effects
             |> Array.map(reportWhenDone total)
@@ -99,38 +119,47 @@ module Progress =
         return ()
     }
 
-//type alias for convini
-type IProgressScopeProvider = ScopeProvider<IProgressScope>
+//Implementation of the Scoped Effect
+type ProgressScope() =
+    let mutable Calls = 0.
+    //unique progress per scope.
+    let p = new System.Progress<float>(fun _x -> ())
+    do
+        p.ProgressChanged.Add(fun total ->
+            Calls <- Calls + 1.
+            let pcnt = Calls / total
+            System.Console.WriteLine(pcnt)
+        )
+    interface IProgressScope with
+        member this.Progress = p
+        member this.DisposeAsync() = ValueTask()
 
+(* Mixing in other effects *)
 type GuidGenerator =
     abstract member NewGuid: unit -> System.Guid
 
 type GuidProvider =
     abstract member Gen: GuidGenerator
 
-type Runner() =
-    //here we do not need a separat entity, so we can combine with runner.
-    interface IProgressScope with
-        member this.DisposeAsync() = ValueTask()
-        member this.Progress = new System.Progress<float>(fun _x -> ())
+module GuidGenerator =
+    let newGuid () =
+        Effect.Create(fun (p: #GuidProvider) -> p.Gen.NewGuid())
 
+
+
+type Runner() =
     interface IProgressScopeProvider with
-        member this.BeginScope() = ValueTask<_>(this :> IProgressScope)
+        member this.BeginScope() = ValueTask<IProgressScope>(ProgressScope())
 
     interface GuidProvider with
         member this.Gen = raise (System.NotImplementedException())
 
-module GuidGenerator =
-    let newGuid () =
-        Effect.Create(fun (p: #GuidProvider) -> p.Gen.NewGuid())
-
 module Test =
-
-    open Orsak
-
-    let test2() =
-        [| GuidGenerator.newGuid () |]
-        |> Progress.whenAllBatch 10
+    let test2() = eff {
+        return!
+            [| GuidGenerator.newGuid () |]
+            |> Progress.whenAllBatch 10
+    }
 
     let test() = task {
         match!

src/Orsak/ScopedEffect.fs

@@ -20,8 +20,7 @@ type ScopedEffectBuilder() =
 [<AutoOpen>]
 module Extension =
     type ScopedEffectBuilder with
-
-        member inline this.ReturnFrom<'Scope, 'Env, 'T, 'TOverall, 'Err>
+        member inline this.ReturnFrom<'Scope, 'Env, 'TOverall, 'Err>
             (eff: Effect<'Env, 'TOverall, 'Err>)
             : ScopedEffectCode<'Scope, 'Env, 'TOverall, 'TOverall, 'Err> =
             ScopedEffectCode<'Scope, 'Env, 'TOverall, 'TOverall, 'Err>(fun sm ->
@@ -47,7 +46,6 @@ module Extension =
                 else
                     EffBuilder.BindDynamic(&sm, task, this.Return))
 
-        //bad in this case
         [<NoEagerConstraintApplication>]
         member inline _.Bind<'Scope, 'Env, 'TOverall, 'TResult1, 'TResult2, 'Err>
             (
@@ -79,20 +77,22 @@ module Extension =
                         sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm)
                         false
                 else
-                    EffBuilder.BindDynamic(&sm, task, continuation))
+                    EffBuilder.BindDynamic(&sm, task, continuation))                    
+
+type Scoped = IAsyncDisposable
 
-type ScopeProvider<'Scope when 'Scope :> IAsyncDisposable> =
+type ScopeProvider<'Scope when 'Scope :> Scoped> =
     abstract member BeginScope: unit -> ValueTask<'Scope>
 
 ///A computation expression that knows how to start a scope local to the effect, and bind effects in that scope
 [<ExperimentalAttribute("")>]
-type ScopeCreatingEffectBuilder<'Scope when 'Scope :> IAsyncDisposable>() =
+type ScopeCreatingEffectBuilder<'Scope when 'Scope :> Scoped>() =
     inherit ScopedEffectBuilder()
 
     member inline this.Bind(ex: Effect<'Env * 'Scope, 'a, 'err>, cont) = eff.Bind(ex, cont)
 
     [<NoEagerConstraintApplication>]
-    member inline _.Bind<'Env, 'T, 'TOverall, 'TResult1, 'TResult2, 'Err>
+    member inline _.Bind<'Env, 'TOverall, 'TResult1, 'TResult2, 'Err>
         (
             eff: Effect<'Scope, 'TResult1, 'Err>,
             continuation: 'TResult1 -> ScopedEffectCode<'Scope, 'Env, 'TOverall, 'TResult2, 'Err>
@@ -141,13 +141,13 @@ type ExceptionHandler<'err> =
 
 type CompletableScope =
     abstract member Complete: unit -> ValueTask
-    inherit IAsyncDisposable
+    inherit Scoped
 
 type CompletableScopeProvider<'Scope when 'Scope :> CompletableScope> = ScopeProvider<'Scope>
 
 ///A computation expression that knows how to start a completable scope local to the effect, and bind effects in that scope
 [<ExperimentalAttribute("")>]
-type TransactionalEffectBuilder<'Scope when 'Scope :> CompletableScope>() =
+type CompletableScopeCreatingEffectBuilder<'Scope when 'Scope :> CompletableScope>() =
     inherit ScopedEffectBuilder()
 
     member inline this.Bind(ex: Effect<'Env * 'Scope, 'a, 'err>, cont) = eff.Bind(ex, cont)
@@ -180,7 +180,7 @@ type TransactionalEffectBuilder<'Scope when 'Scope :> CompletableScope>() =
                 EffBuilder.BindDynamic(&sm, task, this.Return))
 
     [<NoEagerConstraintApplication>]
-    member inline _.Bind<'Env, 'T, 'TOverall, 'TResult1, 'TResult2, 'Err>
+    member inline _.Bind<'Env, 'TOverall, 'TResult1, 'TResult2, 'Err>
         (
             scopedEff: Effect<'Scope, 'TResult1, 'Err>,
             continuation: 'TResult1 -> ScopedEffectCode<'Scope, 'Env, 'TOverall, 'TResult2, 'Err>
@@ -237,10 +237,11 @@ open Orsak.Scoped
 open Microsoft.FSharp.Core.CompilerServices
 open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers
 
+
 /// <summary>
 /// Allows for binding effects in a scope, but does not allow for starting a new scope.
 /// Typically would be run by binding them in a scoped effect. Not expected to be run by themselves, since the
-/// Effect.run must run it with an already started scope
+/// Effect.run must run it with an already started scope, and the scopes would generally be started implicitly.
 /// </summary>
 [<ExperimentalAttribute("")>]
 type ScopeAwareEffectBuilder<'Scope>() =

tests/Orsak.Tests/ScopedTests.fs

@@ -79,8 +79,6 @@ type Scoped() =
         tran.Commit()
         ()
 
-    let scopeAware = ScopeAwareEffectBuilder<DbTransactional>()
-
     //Mostly explores what is possible with this api
     //all the async usage is wasted with SQLite, but can be valuable with other providers.
     let read () : Transaction<_, _> =
@@ -105,7 +103,7 @@ type Scoped() =
         })
 
 
-    let readSingle () : EnlistedTransaction<_, _, _> = scopeAware {
+    let readSingle () : EnlistedTransaction<_, _, _> = trxAware {
         let! _now = Clock.utcNow ()
 
         let! list = read ()
@@ -122,7 +120,7 @@ type Scoped() =
 
     let readAndCommit () = commitEff { return! read () }
 
-    let readThenFail () = scopeAware {
+    let readThenFail () = trxAware {
         let! _now = Clock.utcNow ()
         let! list = read ()
         let value = Assert.Single(list)
@@ -142,7 +140,7 @@ type Scoped() =
             return Ok()
         })
 
-    let scopedInsert () = scopeAware {
+    let scopedInsert () = trxAware {
         do! insert ()
         return ()
     }