From 274fb6ce77297c2546462b64f9a54ce294727ecf Mon Sep 17 00:00:00 2001 From: Michael Winch Date: Thu, 25 Apr 2024 16:07:39 +0100 Subject: [PATCH] Implement MergeSources and BindReturn (#4) * Implement MergeSources and BindReturn * Make execute in parallel --- src/AsyncWriterResult/Library.fs | 35 ++++++++++++++ src/AsyncWriterResult/TaskWriterResult.fs | 10 +++- tests/AsyncWriterResult.UnitTests/Tests.fs | 53 ++++++++++++++++++++-- 3 files changed, 92 insertions(+), 6 deletions(-) diff --git a/src/AsyncWriterResult/Library.fs b/src/AsyncWriterResult/Library.fs index a951bdb..527f41d 100644 --- a/src/AsyncWriterResult/Library.fs +++ b/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>>) = 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>>) = x member __.Source(x: Task>>) = x |> Async.AwaitTask diff --git a/src/AsyncWriterResult/TaskWriterResult.fs b/src/AsyncWriterResult/TaskWriterResult.fs index c972b8e..79f7b8f 100644 --- a/src/AsyncWriterResult/TaskWriterResult.fs +++ b/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>> @@ -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>>) = 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>>) = x member __.Source(x: Async>>) = x |> Async.StartAsTask diff --git a/tests/AsyncWriterResult.UnitTests/Tests.fs b/tests/AsyncWriterResult.UnitTests/Tests.fs index 73bafbb..fecade3 100644 --- a/tests/AsyncWriterResult.UnitTests/Tests.fs +++ b/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) -> - 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] "" + } ]