Structured-concurrency libraries

Ecosystem
17

I made the variants explicit. It turns out that there’s needed more logic for handling the failure case (thank you polymorphic variants :kissing: ).

open Lwt.Infix

let connect ip =
  Lwt_io.printlf "connecting to ip: %s" ip >>= fun () -> 
  Lwt_unix.sleep @@ 0.5 +. Random.float 5.5 >>= fun () ->
  if Random.float 1. > 0.3 then
    Lwt_io.printlf "failed connecting to ip: %s" ip >>= fun () -> 
    Lwt.return @@ `Failure ip
  else
    Lwt.return @@ `Response ip 

let never () = Lwt_mvar.(create_empty () |> take)

let rec happy_eye = function
  | [] -> Lwt_unix.sleep 3.0 >|= fun () -> `Timeout
  | ip :: rest -> 
    let attempt = connect ip 
    and impatient = Lwt_unix.sleep 0.2 >|= fun () -> `Impatient in
    Lwt.pick [
      (attempt >>= function
        | `Failure _ -> never ()
        | `Response _ as response -> Lwt.return response
      );
      (Lwt.choose [attempt; impatient] >>= function
        | `Impatient | `Failure _ -> happy_eye rest
        | `Response _ -> never ()
      );
    ]

let _ =
  Random.self_init ();
  let ips = [ "1"; "2"; "3"; "4" ] in
  Lwt_main.run begin
    happy_eye ips >>= function
    | `Timeout -> Lwt_io.printl "timeout"
    | `Response ip -> Lwt_io.printlf "response from ip: %s" ip
  end

Edit: I see now that this logic is actually equivalent with your pick_some @paurkedal , but I like the explicitness

Edit: Otoh, the advantage with pick_some is that one can’t make an error by inserting the never thread in the wrong place

1 Like