Skip to content

Commit

Permalink
Implement MergeSources and BindReturn (#4)
Browse files Browse the repository at this point in the history
* Implement MergeSources and BindReturn

* Make  execute in parallel
michaelwinch authored Apr 25, 2024
1 parent 74847e9 commit 274fb6c
Showing 3 changed files with 92 additions and 6 deletions.
35 changes: 35 additions & 0 deletions src/AsyncWriterResult/Library.fs
Original file line number Diff line number Diff line change
@@ -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

10 changes: 9 additions & 1 deletion src/AsyncWriterResult/TaskWriterResult.fs
Original file line number Diff line number Diff line change
@@ -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

53 changes: 48 additions & 5 deletions tests/AsyncWriterResult.UnitTests/Tests.fs
Original file line number Diff line number Diff line change
@@ -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] ""
} ]

0 comments on commit 274fb6c

Please sign in to comment.