Implement MergeSources and BindReturn

src/AsyncWriterResult/Library.fs

@@ -27,6 +27,16 @@ module Async =
             return unwrappedF x
         }
 
+    let zip c1 c2 =
+        async {
+            let! ct = Async.CancellationToken
+            let x = Async.StartImmediateAsTask (c1, cancellationToken=ct)
+            let y = Async.StartImmediateAsTask (c2, cancellationToken=ct)
+            let! x' = Async.AwaitTask x
+            let! y' = Async.AwaitTask y
+            return x', y'
+        }
+
 
 module Result =
 
@@ -56,6 +66,11 @@ module Result =
 
         List.foldBack folder list (retn [])
 
+    let zip left right =
+        match left, right with
+        | Ok x1res, Ok x2res -> Ok(x1res, x2res)
+        | Error e, _ -> Error e
+        | _, Error e -> Error e
 
 
 type Writer<'w, 't> = Writer of (unit -> ('t * 'w))
@@ -86,6 +101,9 @@ module Writer =
         Writer
         <| fun () -> List.fold (fun (items, logs) (item, log) -> item :: items, log :: logs) ([], []) (List.map run l)
 
+    let zip (left: Writer<_, _>) (right: Writer<_, _>) =
+        bind left (fun l -> bind right (fun r -> retn (l, r)))
+
     let write log = Writer <| fun () -> (), [ log ]
 
 
@@ -132,6 +150,10 @@ module WriterResult =
         Writer
         <| fun () -> List.fold folder (Result.retn [], []) (List.map Writer.run list)
 
+    let zip left right =
+        Writer.zip left right
+        |> Writer.map (fun (r1, r2) -> Result.zip r1 r2)
+
     let write log =
         Writer <| fun () -> Result.retn (), [ log ]
 
@@ -216,6 +238,11 @@ module AsyncWriterResult =
         Async.Parallel list
         |> Async.map (List.ofArray >> WriterResult.collect)
 
+    let zip left right =
+        Async.zip left right
+        |> Async.map (fun (r1, r2) -> WriterResult.zip r1 r2)
+
+
 module AsyncWriter =
 
     let retn a = Writer.retn a |> Async.retn
@@ -228,6 +255,8 @@ type ResultBuilder() =
     member __.ReturnFrom(m: Result<_, _>) = m
     member __.Bind(m, f) = Result.bind f m
     member __.Zero() = Error()
+    member __.BindReturn(x, f) = Result.map f x
+    member __.MergeSources(x, y) = Result.zip x y
 
 let result = ResultBuilder()
 
@@ -237,6 +266,8 @@ type WriterBuilder() =
     member __.ReturnFrom(m: Writer<'w, 't>) = m
     member __.Bind(m, f) = Writer.bind m f
     member __.Zero() = __.Return()
+    member __.BindReturn(x, f) = Writer.map f x
+    member __.MergeSources(x, y) = Writer.zip x y
 
 let writer = WriterBuilder()
 
@@ -246,6 +277,8 @@ type WriterResultBuilder() =
     member __.ReturnFrom(m: Writer<'w, Result<'a, 'b>>) = m
     member __.Bind(m, f) = WriterResult.bind f m
     member __.Zero() = __.Return()
+    member __.BindReturn(x, f) = WriterResult.map f x
+    member __.MergeSources(x, y) = WriterResult.zip x y
     member __.Source(x: Writer<'w, Result<'a, 'b>>) = x
 
 let writerResult = WriterResultBuilder()
@@ -262,6 +295,8 @@ type AsyncWriterResultBuilder() =
     member __.ReturnFrom(m: Async<Writer<'w, Result<'a, 'b>>>) = m
     member __.Bind(m, f) = AsyncWriterResult.bind f m
     member __.Zero() = __.Return()
+    member __.BindReturn(x, f) = AsyncWriterResult.map f x
+    member __.MergeSources(x, y) = AsyncWriterResult.zip x y
     member __.Source(x: Async<Writer<'w, Result<'a, 'b>>>) = x
     member __.Source(x: Task<Writer<'w, Result<'a, 'b>>>) = x |> Async.AwaitTask
 

src/AsyncWriterResult/TaskWriterResult.fs

@@ -29,6 +29,9 @@ module Task =
             return unwrappedF x
         }
 
+    let zip left right =
+        bind (fun l -> bind (fun r -> retn (l, r)) right) left
+
 
 
 module TaskWriter =
@@ -39,7 +42,6 @@ module TaskWriter =
 
 
 
-
 type TaskWriterResult<'ok, 'error, 'log> = Task<Writer<'log list, Result<'ok, 'error>>>
 
 
@@ -107,11 +109,17 @@ module TaskWriterResult =
         Task.WhenAll tasks
         |> Task.map (List.ofArray >> WriterResult.collect)
 
+    let zip left right =
+        Task.zip left right
+        |> Task.map (fun (r1, r2) -> WriterResult.zip r1 r2)
+
     type TaskWriterResultBuilder() =
         member __.Return(x) = retn x
         member __.ReturnFrom(m: Task<Writer<'w, Result<'a, 'b>>>) = m
         member __.Bind(m, f) = bind f m
         member __.Zero() = __.Return()
+        member __.BindReturn(x, f) = map f x
+        member __.MergeSources(x, y) = zip x y
         member __.Source(x: Task<Writer<'w, Result<'a, 'b>>>) = x
         member __.Source(x: Async<Writer<'w, Result<'a, 'b>>>) = x |> Async.StartAsTask
 

tests/AsyncWriterResult.UnitTests/Tests.fs

@@ -1,13 +1,56 @@
 module Tests
 
 open Expecto
+open Task.TaskWriterResult
 
 let tests =
     testList "Group of tests"
-        [ test "A simple test"
-              { let subject = "Hello World"
-                Expect.equal subject "Hello World" "The strings should equal"
+        [ test "asyncWriterResult and! should run in parallel" {
+              let mutable acc : int list = []
+              let append x = acc <- acc @ [x]
+
+              asyncWriterResult {
+                  let! _ =
+                      async {
+                          append 1
+                          do! Async.Sleep 1500
+                          append 2
+                      }
+                  and! _ =
+                      async {
+                          append 3
+                          do! Async.Sleep 1000
+                          append 4
+                      }
+                  return ()
+              }
+              |> Async.RunSynchronously
+              |> ignore
+
+              Expect.equal acc [1; 3; 4; 2] ""
           }
 
-          testProperty "Reverse of reverse of a list is the original list" (fun (xs: list<int>) ->
-              List.rev (List.rev xs) = xs) ]
+          test "taskWriterResult and! should run in parallel" {
+              let mutable acc : int list = []
+              let append x = acc <- acc @ [x]
+
+              taskWriterResult {
+                  let! _ =
+                      task {
+                          append 1
+                          do! Async.Sleep 1500
+                          append 2
+                      }
+                  and! _ =
+                      task {
+                          append 3
+                          do! Async.Sleep 1000
+                          append 4
+                      }
+                  return ()
+              }
+              |> fun x -> x.Result
+              |> ignore
+
+              Expect.equal acc [1; 3; 4; 2] ""
+          } ]