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 -> ()

module Bcc = struct
  let _recipients = Dllist.create ()

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

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

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