Work distribution: porting from AsyncSeq

I’m trying to port code from this blog post http://theimowski.com/blog/2016/04-27-dynamic-load-balancing-in-f/index.html:

open System

#r @"packages/FSharp.Control.AsyncSeq/lib/net45/FSharp.Control.AsyncSeq.dll"
open FSharp.Control

#r @"packages/FSharpx.Async/lib/net40/FSharpx.Async.dll"
open FSharpx.Control

let process machine input =
    let url = sprintf "http://%s/webservice/endpoint" machine

    async {
        // call a web service with a given input (file)
        return! callService url input
    }

let renditions (machines: string list) (inputs: string list) =

    let workersCount = 4
    let renditionsCount = inputs.Length

    asyncSeq {
        let queue = BlockingQueueAgent<_>(renditionsCount)
        let results = BlockingQueueAgent<_>(renditionsCount)

        let rec worker machine  = async {
            let! input = queue.AsyncGet()
            let! result = process machine input 

            do! results.AsyncAdd (result)
            do! worker machine
        }

        for input in inputs do
            do! queue.AsyncAdd(input)

        for machine in machines do
            for i in 0 .. workersCount - 1 do
                worker machine |> Async.Start

        for i in 0 .. renditionsCount - 1 do 
            let! result = results.AsyncGet()
            yield result
    }
    |> AsyncSeq.toArrayAsync
    |> Async.RunSynchronously

My attempt (I don’t use operators to keep it readable for normal people):

let callService url input =
    job {
        Console.WriteLine (sprintf "Calling %s with %s..." url input)
        do! timeOutMillis 500
        return input
    }

let process' machine input =
    let url = sprintf "http://%s/webservice/endpoint" machine

    job {
        // call a web service with a given input (file)
        return! callService url input
    }

let renditions (machines: string list) (inputs: string[]) =
    job {
        let! inputCh = Ch.create()
        let! finished = IVar.create()

        do! job { for input in inputs do
                    do! Ch.give inputCh input
                    Console.WriteLine (sprintf "%s has been given to input channel." input) }
            |> Job.queue

        let! resultVar = MVar.createFull (ResizeArray())

        let worker machine =
            Job.foreverServer <| 
                job {
                    let! input = Ch.take inputCh
                    let! res = process' machine input 
                    let! results = MVar.take resultVar
                    results.Add res
                    do! MVar.fill resultVar results
                    if results.Count = inputs.Length then
                        do! IVar.fill finished ()
                }

        let workersCount = 4

        for machine in machines do
            for _ in 1..workersCount do
                do! worker machine |> Job.queue

        do! IVar.read finished
        return! MVar.take resultVar |> Job.map Seq.toList
    }
    |> run

renditions ["host1"; "host2"] (Array.init 10 string)

I’m not sure it’s OK in any sense. I tried to use Streams, but they don’t seem to fit to the task at all. Any suggestions?

[polytypic]

Here is another version of renditions compatible with vasily-kirichenko’s process':

let renditions (machines: seq<string>) (inputs: seq<string>) =
  let workersCount = 4

  let inn = Ch()
  let out = Ch()

  inputs |> Seq.iterJob (Ch.give inn) |> start

  for _ in 1..workersCount do
    for machine in machines do
      inn >>= process' machine >>= Ch.give out
      |> Job.forever |> server

  inputs |> Seq.mapJob (fun _ -> out) |> run

I don’t recommend using run as above, but this matches the type of the original.

Note that outputs are not produced in the same order as inputs.

[vasily-kirichenko]

Hopac Streams:

module Stream =
    let distributeJob (jobs: ('x -> Job<'y>) seq) (s: Stream<'x>) : Stream<'y> =
        let inCh = Ch()
        let inStreamClosed = IVar()
        let outCh = Ch()

        job {
            do! Stream.iterJob (Ch.give inCh) s >>=. IVar.fill inStreamClosed () |> Job.start
            for j in jobs do
                do! (inCh >>= j >>= Ch.give outCh) |> Job.foreverServer
        } |> start

        Stream.unfoldJob (fun _ -> 
            outCh ^-> fun x -> Some(x, ()) 
            <|>
            inStreamClosed ^-> fun _ -> None
        ) ()

let renditions (machines: string list) (inputs: string[]) =
    let workersCount = 2

    let workers = 
        machines 
        |> List.replicate workersCount
        |> List.concat
        |> List.map process'

    inputs
    |> Stream.ofSeq
    |> Stream.distributeJob workers
    |> Stream.toSeq
    |> run

renditions ["host1"; "host2"] (Array.init 10 string)