eliom_channel.eliom

(* Example website login: localhost:8080/?user_num=1 *)

{shared{
  open Eliom_lib
  open Eliom_content
  open Html5.D
  open Eliom_parameter
}}

module Channel_example_app =
  Eliom_registration.App (
    struct
      let application_name = "channel_example"
    end)

let main_service =
  Eliom_service.App.service ~path:[] ~get_params:(int "user_num") ()

(* ref to hold all of the functions to push messages to channels *)
let all_channels : (string * (string option -> unit)) list ref =
  ref ([] : (string * (string option -> unit)) list)

let all_channels_mutex = Lwt_mutex.create ()

(* Send a hello message from the server through the channel *)
let send_hello (user_num, msg) =
  lwt () = Lwt_mutex.lock all_channels_mutex in
  (* Get the channel corresponding to the user_num *)
  let rec push_msg ~chans =
    match chans with
    | [] -> Lwt.async (fun () -> Lwt_io.print "\nNo channel found\n")
    | (chan_num, push_fun) :: tl ->
        if chan_num = user_num
        then
          (
            Lwt.async (fun () -> Lwt_io.print "\nChannel Found\n");
            push_fun (Some msg)
          )
        else push_msg ~chans:tl
  in
  push_msg ~chans:!all_channels;
  Lwt_io.print "\nsend_hello called\n"
  >>= fun () -> Lwt.return @@ Lwt_mutex.unlock all_channels_mutex

(* Server function version of send_hello *)
let send_hello' =
  server_function Json.t<string * string> (fun (user_num, msg) -> send_hello (user_num, msg))

let () =
  Channel_example_app.register
    ~service:main_service
    (fun user_num () ->
      (* Create a channel for the current user and add it to all_channels *)
      let my_stream, my_server_push_fun = Lwt_stream.create () in
      (* How is ~name used? *)
      let my_chan = Eliom_comet.Channel.create ~name:(string_of_int user_num) my_stream in
      Lwt_mutex.lock all_channels_mutex
      >>= fun () ->
        Lwt.return @@
        begin
          match List.mem_assoc (string_of_int user_num) !all_channels with
          | true -> ()
          | false ->
              all_channels := ((string_of_int user_num, my_server_push_fun) :: !all_channels)
        end
      >>= fun () -> Lwt.return @@ Lwt_mutex.unlock all_channels_mutex
      >>= fun () ->
      Lwt.return
        (Eliom_tools.F.html
           ~title:"channel_example"
           ~css:[["css";"channel_example.css"]]
           Html5.F.(body [
             h2 [pcdata ("Your are logged in as user #" ^ (string_of_int user_num))];
             Html5.C.node
             {{
               let () =
                 Lwt.ignore_result @@
                   %send_hello' ((string_of_int %user_num), "Hello from the SERVER")
               in
               let next_msg () =
                 match Lwt_stream.get_available %my_chan with
                 | [] -> "No new messages..."
                 | hd :: tl -> hd
               in
               h1 [pcdata (next_msg ())]
             }}
           ])))