talircd/lib/server/outbox.ml

open! Import

type t = {
  stream : Irc.Msg.t Lwt_stream.t;
  push : Irc.Msg.t option -> unit;
  mutable bcc : t Dllist.node option;
}

let make () =
  let stream, push = Lwt_stream.create () in
  { stream; push; bcc = None }

let stream t = t.stream
let send t msg = try t.push (Some msg) with Lwt_stream.Closed -> ()
let close t = try t.push None with Lwt_stream.Closed -> ()

type bcc = { recipients : t Dllist.t }

let make_bcc () = {
  recipients = Dllist.create ();
}

let excl obx =
  Option.iter Dllist.remove obx.bcc;
  obx.bcc <- None

let incl bcc obx =
  Option.iter Dllist.remove obx.bcc;
  obx.bcc <- Some (Dllist.add_r obx bcc.recipients)

let rec send_all bcc msg =
  match Dllist.take_l bcc.recipients with
  | obx ->
    obx.bcc <- None;
    send obx msg;
    send_all bcc msg
  | exception Dllist.Empty ->
    ()