Port to jbuilder + mustache

bridge.ml

@@ -1,4 +1,4 @@
-(* 
+(*
  * iocamlserver - IOCaml notebook server
  *
  *   (c) 2014 MicroJamJar Ltd
@@ -7,19 +7,19 @@
  * Description: bridge websockets and zmq sockets
  *
  *)
-open Lwt
+open Lwt.Infix
 open Iocaml_zmq
 
 type ws_stream = Websocket_lwt.Frame.t Lwt_stream.t
 type ws_push = Websocket_lwt.Frame.t -> unit Lwt.t
-type ws_comm = ws_stream * ws_push 
+type ws_comm = ws_stream * ws_push
 
-let zmq_of_ws_message data = 
+let zmq_of_ws_message data =
     let open Yojson.Basic in
     let data = from_string data in
     match data with
     | `Assoc l ->
-        [   
+        [
             "<IDS|MSG>";
             "";
             to_string (List.assoc "header" l);
@@ -29,7 +29,7 @@ let zmq_of_ws_message data =
         ]
     | _ -> raise (Failure "deserialize_ws")
 
-let ws_of_zmq_message data = 
+let ws_of_zmq_message data =
     let open Yojson.Basic in
     let rec find = function
         | [] -> raise (Failure "bad zmq message")
@@ -38,7 +38,7 @@ let ws_of_zmq_message data =
         | h::t -> find t
     in
     let header,parent,meta,content = find data in
-    let extract data = 
+    let extract data =
         match header with `Assoc l -> (List.assoc data l) | _ -> `String "error"
     in
     to_string
@@ -51,62 +51,63 @@ let ws_of_zmq_message data =
             "metadata", meta;
         ])
 
-let ws_to_zmq verbose name stream socket = 
-    lwt frame = Lwt_stream.next stream in
-    let data = frame.Websocket_lwt.Frame.content in
-    lwt () = 
-        if verbose > 1 then Lwt_io.eprintf "[ws->zmq]%s: %s\n" name data 
-        else return ()
-    in
-    try_lwt Lwt_zmq.Socket.send_all socket (zmq_of_ws_message data)
-    with _ -> return ()
+let ws_to_zmq verbose name stream socket =
+  Lwt_stream.next stream >>= fun frame ->
+  let data = frame.Websocket_lwt.Frame.content in
+  (if verbose > 1 then Lwt_io.eprintf "[ws->zmq]%s: %s\n" name data
+   else Lwt.return_unit) >>= fun () ->
+  Lwt.catch
+    (fun () -> Lwt_zmq.Socket.send_all socket (zmq_of_ws_message data))
+    (fun _ -> Lwt.return_unit)
 
-let zmq_to_ws verbose name socket push = 
-    lwt frames = Lwt_zmq.Socket.recv_all socket in
-    lwt () = 
-        if verbose > 1 then Lwt_list.iter_s (Lwt_io.eprintf "[zmq->ws]%s: %s\n" name) frames 
-        else return ()
-    in
-    try_lwt
-        let frame = ws_of_zmq_message frames in
-        push (Websocket_lwt.Frame.create ~content:frame ())
-    with _ -> return ()
+let zmq_to_ws verbose name socket (push : ws_push) =
+  Lwt_zmq.Socket.recv_all socket >>= fun frames ->
+  (if verbose > 1 then
+     Lwt_list.iter_s (Lwt_io.eprintf "[zmq->ws]%s: %s\n" name) frames
+   else
+     Lwt.return ()) >>= fun () ->
+  Lwt.catch (fun () ->
+      let frame = ws_of_zmq_message frames in
+      push (Websocket_lwt.Frame.create ~content:frame ())
+    ) (fun _exn -> Lwt.return_unit)
 
-let rec ws_zmq_comms verbose name socket uri (stream,push) = 
-    lwt _ = zmq_to_ws verbose name socket push <?> ws_to_zmq verbose name stream socket in
-    ws_zmq_comms verbose name socket uri (stream,push)
+let rec ws_zmq_comms verbose name socket uri (stream, push) =
+  zmq_to_ws verbose name socket push <?> ws_to_zmq verbose name stream socket >>= fun _ ->
+  ws_zmq_comms verbose name socket uri (stream,push)
 
-let ws_init verbose id req recv send = 
+let ws_init verbose (client : Websocket_lwt.Connected_client.t) =
   let open Websocket_lwt in
   let open Kernel in
-  try_lwt
-    recv () >>= fun cookie ->
+  Lwt.catch (fun () ->
+      Connected_client.recv client >>= fun cookie ->
       (* we get one special message per channel, after which it's comms time *)
       let cookie = cookie.Frame.content in
-      lwt () = if verbose > 1 then Lwt_io.eprintf "cookie:[%i] %s\n" (String.length cookie) cookie else return () in
+      (if verbose > 1 then
+         Lwt_io.eprintf "cookie:[%i] %s\n" (String.length cookie) cookie
+       else
+         Lwt.return_unit) >>= fun () ->
       (* parse the uri to find out which socket we want *)
-      let get guid = 
-          match M.kernel_of_kernel_guid guid with
-          | None -> fail (Failure ("cant find kernel: " ^ guid))
-          | Some(x) -> return x
+      let get guid =
+        match M.kernel_of_kernel_guid guid with
+        | None -> Lwt.fail_with ("cant find kernel: " ^ guid)
+        | Some x -> Lwt.return x
       in
-      let uri = Cohttp.Request.uri req in
-      let stream = Websocket_lwt.mk_frame_stream recv in
-      match_lwt Uri_paths.decode_ws (Uri.path uri) with
-      | `Ws_shell(guid) -> 
-          get guid >>= fun k -> ws_zmq_comms verbose "shell" (k.shell()) uri (stream,send)
-      | `Ws_stdin(guid) ->                                      
-          get guid >>= fun k -> ws_zmq_comms verbose "stdin" (k.stdin()) uri (stream,send)
-      | `Ws_iopub(guid) ->                                      
-          get guid >>= fun k -> ws_zmq_comms verbose "iopub" (k.iopub()) uri (stream,send)
-      | `Error_not_found -> 
-          Lwt.fail (Failure "invalid websocket url")
-
-  with 
-  | x ->
-    lwt () = 
-      if verbose > 0 then Lwt_io.eprintf "ws_init failed with %s\n" (Printexc.to_string x)
-      else return ()
-    in
-    return ()
-
+      let uri = Cohttp.Request.uri (Connected_client.http_request client) in
+      let stream =
+        Websocket_lwt.mk_frame_stream
+          (fun () -> Connected_client.recv client) in
+      let send = Connected_client.send client in
+      Uri_paths.decode_ws (Uri.path uri) >>= function
+      | `Ws_shell(guid) ->
+        get guid >>= fun k -> ws_zmq_comms verbose "shell" (k.shell()) uri (stream, send)
+      | `Ws_stdin(guid) ->
+        get guid >>= fun k -> ws_zmq_comms verbose "stdin" (k.stdin()) uri (stream, send)
+      | `Ws_iopub(guid) ->
+        get guid >>= fun k -> ws_zmq_comms verbose "iopub" (k.iopub()) uri (stream, send)
+      | `Error_not_found ->
+        Lwt.fail (Failure "invalid websocket url")
+    ) (fun x ->
+        if verbose > 0 then
+          Lwt_io.eprintf "ws_init failed with %s\n" (Printexc.to_string x)
+        else
+          Lwt.return_unit)

bridge.mli

@@ -1,4 +1,4 @@
-(* 
+(*
  * iocamlserver - IOCaml notebook server
  *
  *   (c) 2014 MicroJamJar Ltd
@@ -12,7 +12,7 @@ open Iocaml_zmq
 
 type ws_stream = Websocket_lwt.Frame.t Lwt_stream.t
 type ws_push = Websocket_lwt.Frame.t -> unit Lwt.t
-type ws_comm = ws_stream * ws_push 
+type ws_comm = ws_stream * ws_push
 
 val zmq_of_ws_message : string -> string list
 
@@ -24,8 +24,4 @@ val zmq_to_ws : int -> string -> 'a Lwt_zmq.Socket.t -> ws_push -> unit Lwt.t
 
 val ws_zmq_comms : int -> string -> 'a Lwt_zmq.Socket.t -> Uri.t -> ws_comm -> unit Lwt.t
 
-val ws_init : int -> 
-  (int ->
-    Cohttp.Request.t ->
-    (unit -> Websocket_lwt.Frame.t Lwt.t) -> (Websocket_lwt.Frame.t -> unit Lwt.t) -> unit Lwt.t) 
-
+val ws_init : int -> (Websocket_lwt.Connected_client.t -> unit Lwt.t)

config.ml

@@ -1 +1,30 @@
+let with_process_in cmd args f =
+  let path = ["/bin";"/usr/bin"] in
+  let cmd =
+    List.find Sys.file_exists (List.map (fun d -> Filename.concat d cmd) path)
+  in
+  let ic = Unix.open_process_in (cmd^" "^args) in
+  try
+    let r = f ic in
+    ignore (Unix.close_process_in ic) ; r
+  with exn ->
+    ignore (Unix.close_process_in ic) ; raise exn
+
+let uname_s () =
+  try
+    with_process_in "uname" "-s"
+      (fun ic -> Some (String.trim (input_line ic)))
+  with Unix.Unix_error _ | Sys_error _ | Not_found ->
+    None
+
 let default_browser_command = "xdg-open"
+
+let default_browser_command =
+  match Sys.os_type with
+  | "Unix" ->
+    begin match uname_s () with
+    | Some "Darwin" -> "open"
+    | _ -> "xdg-open"
+    end
+  | _ -> "xdg-open"
+