(* Publication *)
(* $Id$ *)

exception No_issue;;

type 'a simple_magazine =
  < unsubscribe : int -> unit;
    with_last_issue : ('a -> unit) -> unit;
    publish : [`Everyone|`Except of int] -> 'a -> unit >
;;

class ['a] subscription (magazine : 'a simple_magazine) (key : int) ~callback =
  object(self)
    val mutable callback : 'a -> unit = callback
    method cancel : unit = magazine#unsubscribe key
    method receive (x : 'a) = callback x
    method with_last_issue (f : 'a -> unit) : unit = magazine#with_last_issue f
    method set_callback f = callback <- f
    method publish x = magazine#publish (`Except key) x
    method tick =
      try
        self#with_last_issue callback
      with
      | No_issue -> ()
  end
;;

class ['a,'b] bundle (s1 : 'a subscription) (s2 : 'b subscription) ~callback =
  object(self)
    val mutable a = None
    val mutable b = None
    val mutable callback : ('a * 'b) -> unit = callback
    initializer
      s1#set_callback (fun x ->
        a <- Some x;
        self#tick);
      s2#set_callback (fun y ->
        b <- Some y;
        self#tick)
    method cancel : unit = s1#cancel; s2#cancel
    method with_last_issue (f : ('a * 'b) -> unit) : unit =
      s1#with_last_issue (fun x -> s2#with_last_issue (fun y -> f (x, y)))
    method tick =
      match a,b with
      | (None,_)|(_,None) -> ()
      | (Some x, Some y) -> callback (x, y)
    method set_callback f = callback <- f
  end
;;

let breakme () = ()

let id = ref 0

class ['a] magazine =
  let id = incr id; !id in
  let mutex = Mutex.create () in
  let under_lock f =
    breakme ();
    Mutex.lock mutex;
    try
      let r = f () in
      Mutex.unlock mutex;
      r
    with
    | x ->
       Mutex.unlock mutex;
       raise x
  in
  object(self)
    val mutable issue : 'a option = None
    val mutable subscribers = []
    val mutable id = 0

    method publish who x =
      under_lock (fun () ->
        issue <- Some x;
        List.iter (fun (id,s) ->
          if
            match who with
            | `Everyone -> true
            | `Except key -> id <> key
          then
            s#receive x) subscribers)

    method with_last_issue f =
      match issue with
      | None -> raise No_issue
      | Some x -> f x

    method subscribe ?(callback=ignore) () : 'a subscription =
      under_lock (fun () ->
        let sub = new subscription (self :> 'a simple_magazine) id ~callback in
        subscribers <- (id,sub)::subscribers;
        id <- id + 1;
        begin
          try
            self#with_last_issue (fun x -> sub#receive x);
          with
          | No_issue -> ()
        end;
        sub)

    method unsubscribe id =
      subscribers <- List.filter (fun (id',_) -> id <> id') subscribers
  end
;;
