4 files changed, 181 insertions, 182 deletions

diff --git a/viz.js/convert.ml b/viz.js/convert.ml
index 68bf244..a615ce4 100755
--- a/viz.js/convert.ml
+++ b/viz.js/convert.ml
@@ -2,153 +2,168 @@ open Js_of_ocaml
 open Js_of_ocaml_lwt
 
 (** Event generated once the library has created the svg image *)
-let (generated_svg_event:(Dom_svg.svgElement Js.t * Js.js_string Js.t) Dom.Event.typ)
-  = Dom_html.Event.make "generated_svg"
-
-(* Save the generated image *)
-let on_result_png image = begin
-  let a = Dom_html.createA Dom_html.document in
-  a##.href := image##.src;
-  Js.Unsafe.set a (Js.string "download") (Js.string "output.png");
-  Dom.appendChild Dom_html.document##.body a;
-  a##click;
-  Dom.removeChild Dom_html.document##.body a
-end
-
-let on_result_svg
-  : Dom_html.element Js.t -> (Dom.node Js.t) -> unit
-  = fun svg_display image -> begin
-      let childNodes = svg_display##.childNodes in
-      for i = 0 to childNodes##.length do
-        Js.Opt.iter (childNodes##item i) (fun elem -> ignore @@ svg_display##removeChild elem)
-      done;
-      Dom.appendChild svg_display image;
-      ()
-    end
+let (generated_svg_event :
+      (Dom_svg.svgElement Js.t * Js.js_string Js.t) Dom.Event.typ) =
+  Dom_html.Event.make "generated_svg"
+
+(** Save the generated image *)
+let on_result_png image =
+  begin
+    let a = Dom_html.createA Dom_html.document in
+    a##.href := image##.src;
+    Js.Unsafe.set a (Js.string "download") (Js.string "output.png");
+    Dom.appendChild Dom_html.document##.body a;
+    a##click;
+    Dom.removeChild Dom_html.document##.body a
+  end
+
+let on_result_svg : Dom_html.element Js.t -> Dom.node Js.t -> unit =
+ fun svg_display image ->
+  begin
+    let childNodes = svg_display##.childNodes in
+    for i = 0 to childNodes##.length do
+      Js.Opt.iter
+        (childNodes##item i)
+        (fun elem -> ignore @@ svg_display##removeChild elem)
+    done;
+    Dom.appendChild svg_display image;
+    ()
+  end
 
-(** Message send by the worker *)
 type message = Process.t
+(** Message send by the worker *)
+
 type worker = (Js.js_string Js.t, message) Worker.worker Js.t
 
-let change_event (worker:worker) input _ev _ = begin
-  let text: Js.js_string Js.t = input##.value in
+let change_event (worker : worker) input _ev _ =
+  begin
+    let text : Js.js_string Js.t = input##.value in
 
-  (* Send the content to the worker *)
-  let () = worker##postMessage text in
-  Lwt.return_unit
-end
+    (* Send the content to the worker *)
+    let () = worker##postMessage text in
+    Lwt.return_unit
+  end
 
 class type _Dom_parser = object
-  method parseFromString: Js.js_string Js.t -> Js.js_string Js.t -> Dom_html.document Js.t Js.meth
+  method parseFromString :
+    Js.js_string Js.t -> Js.js_string Js.t -> Dom_html.document Js.t Js.meth
 end
 
-let dom_parser = (Js.Unsafe.global##._DOMParser)
+let dom_parser = Js.Unsafe.global##._DOMParser
 let dom_parser = new%js dom_parser
 
 let load () =
-
   (* The URL is be relative with the page location. If the worker is called
      from diffenent location, it becomes mandatory to declare the URL as
      absolute. *)
-  let (worker:worker) = Worker.create "/resources/viz.js/worker.js" in
+  let (worker : worker) = Worker.create "/resources/viz.js/worker.js" in
 
-  worker##.onmessage := Dom.handler (fun (event: message Worker.messageEvent Js.t) ->
-      let gv, image = event##.data in
-      let image = dom_parser##parseFromString image "image/svg+xml" in
-      let image = image##.documentElement in
+  let handler : (_, (_, _) Dom_html.messageEvent Js.t) Dom_html.event_listener =
+    Dom.handler (fun (event : (_, message) Dom_html.messageEvent Js.t) ->
+        let gv, image = event##.data in
+        let image = dom_parser##parseFromString image "image/svg+xml" in
+        let image = image##.documentElement in
 
-      let _ = Dispatch.call generated_svg_event (image, gv) in
-      Js._true);
+        let _ = Dispatch.call generated_svg_event (image, gv) in
+        Js._true)
+  in
+  worker##.onmessage := handler;
 
   let svg_display = Dom_html.getElementById_exn "svg"
   and output_button = Dom_html.getElementById_exn "png_output"
   and dot_button = Dom_html.getElementById_exn "dot_output"
   and editor = Dom_html.getElementById_exn "editor" in
 
-  ignore @@ Dispatch.register generated_svg_event (fun (image, input) ->
-
+  ignore
+  @@ Dispatch.register generated_svg_event (fun (image, input) ->
       on_result_svg svg_display (image :> Dom.node Js.t);
 
       (* Download the dot file *)
-      dot_button##.onclick := Dom_html.handler (fun _ev ->
-          let _ = Elements.Transfert.send
-              ~mime_type:(Jstr.v "text/plain")
-              ~filename:(Jstr.v "output.dot")
-              (Obj.magic input) in
-          Js._false
-        );
+      dot_button##.onclick :=
+        Dom_html.handler (fun _ev ->
+            let _ =
+              Elements.Transfert.send ~mime_type:(Jstr.v "text/plain")
+                ~filename:(Jstr.v "output.dot") (Obj.magic input)
+            in
+            Js._false);
 
       (* Convert the svg in png *)
-      output_button##.onclick := Dom_html.handler (fun _->
-          (*download image*)
-          CanvasTool.generate_png image (fun image ->
-              let _ =
-                Elements.Transfert.send_raw
-                  ~filename:(Jstr.v "output.png")
-                  (Obj.magic image) in
-              ()
-            );
-          Js._false
-        );
-    );
+      output_button##.onclick :=
+        Dom_html.handler (fun _ ->
+            (*download image*)
+            CanvasTool.generate_png image (fun image ->
+                let _ =
+                  Elements.Transfert.send_raw ~filename:(Jstr.v "output.png")
+                    (Obj.magic image)
+                in
+                ());
+            Js._false));
 
   Js.Opt.iter (Dom_html.CoerceTo.textarea editor) (fun input ->
-      Lwt_js_events.async (fun () -> (Lwt_js_events.limited_loop Lwt_js_events.change ~elapsed_time:0.1 editor (change_event worker input) ));
-      Lwt_js_events.async (fun () -> (Lwt_js_events.limited_loop  Lwt_js_events.input ~elapsed_time:0.1 editor (change_event worker input) ));
+      Lwt_js_events.async (fun () ->
+          Lwt_js_events.limited_loop Lwt_js_events.change ~elapsed_time:0.1
+            editor
+            (change_event worker input));
+      Lwt_js_events.async (fun () ->
+          Lwt_js_events.limited_loop Lwt_js_events.input ~elapsed_time:0.1
+            editor
+            (change_event worker input));
       (* Run the first generation *)
-      Lwt.ignore_result (change_event worker input () ());
-    );
+      Lwt.ignore_result (change_event worker input () ()));
 
-  (** Handle the separation window *)
+  (* Handle the separation window *)
   Option.iter
     (fun button ->
-       let _ = Dom_events.listen button Dom_html.Event.click (fun _ _ ->
-
-           let opt_window2 = Dom_html.window##open_
-               (Js.string "")
-               (Js.string "_image")
-               Js.Opt.empty in
-
-           Js.Opt.iter opt_window2 (fun window2 ->
-
-               let callback
-                 : Dom_svg.svgElement Js.t * Js.js_string Js.t -> unit
-                 = fun (image, _gv)  -> begin
-                     let node2 = image##cloneNode Js._true in
-                     let () = on_result_svg window2##.document##.body
-                         (node2 :> Dom.node Js.t) in
-                     ()
-                   end in
-               let handler = Dispatch.register generated_svg_event callback in
-
-               (* Remove the update event when the window is closed *)
-               window2##.onunload := Dom_html.handler (fun _ev ->
-                   Dispatch.remove generated_svg_event handler;
-                   Js._false
-                 );
-
-               (* Copy the current display to the new window *)
-               let childNodes = svg_display##.childNodes in
-               for i = 0 to childNodes##.length do
-                 Js.Opt.iter
-                   (childNodes##item i)
-                   (fun elem ->
-                      Dom.appendChild window2##.document##.body (elem##cloneNode Js._true)
-                   )
-               done;
-             );
-
-           false
-         ) in
-       ()
-    )
+      let _ =
+        Dom_events.listen button Dom_html.Event.click (fun _ _ ->
+            let opt_window2 =
+              Dom_html.window##open_ (Js.string "") (Js.string "_image")
+                Js.Opt.empty
+            in
+
+            Js.Opt.iter opt_window2 (fun window2 ->
+                let callback :
+                    Dom_svg.svgElement Js.t * Js.js_string Js.t -> unit =
+                 fun (image, _gv) ->
+                  begin
+                    let node2 = image##cloneNode Js._true in
+                    let () =
+                      on_result_svg
+                        window2##.document##.body
+                        (node2 :> Dom.node Js.t)
+                    in
+                    ()
+                  end
+                in
+                let handler = Dispatch.register generated_svg_event callback in
+
+                (* Remove the update event when the window is closed *)
+                window2##.onunload :=
+                  Dom_html.handler (fun _ev ->
+                      Dispatch.remove generated_svg_event handler;
+                      Js._false);
+
+                (* Copy the current display to the new window *)
+                let childNodes = svg_display##.childNodes in
+                for i = 0 to childNodes##.length do
+                  Js.Opt.iter
+                    (childNodes##item i)
+                    (fun elem ->
+                      Dom.appendChild
+                        window2##.document##.body
+                        (elem##cloneNode Js._true))
+                done);
+
+            false)
+      in
+      ())
     (Dom_html.getElementById_opt "btn_window");
   Lwt.return Js._false
 
-let _ = Lwt.bind (Lwt_js_events.onload ()) (fun _ -> load())
+let _ = Lwt.bind (Lwt_js_events.onload ()) (fun _ -> load ())
 
 let _ =
   Js.export "generator"
-    (object%js
+    object%js
       method load = load ()
-    end)
+    end
diff --git a/viz.js/dune b/viz.js/dune
index 18ba438..9b421b6 100755
--- a/viz.js/dune
+++ b/viz.js/dune
@@ -1,39 +1,31 @@
 (executable
  (name convert)
- (libraries 
-   js_of_ocaml 
-   js_of_ocaml-lwt
-   promise
-   process
-   elements
-   brr
-   )
+ (libraries js_of_ocaml js_of_ocaml-lwt promise process elements brr)
  (modes js)
- (preprocess (pps js_of_ocaml-ppx))
- (link_flags (:standard -no-check-prims))
- (modules convert dispatch CanvasTool)
- )
+ (preprocess
+  (pps js_of_ocaml-ppx))
+ (link_flags
+  (:standard -no-check-prims))
+ (modules convert dispatch CanvasTool))
 
 (rule
-  (targets convert.js)
-  (deps convert.bc.js)
-  (action (copy %{deps} %{targets})))
+ (targets convert.js)
+ (deps convert.bc.js)
+ (action
+  (copy %{deps} %{targets})))
 
 (executable
  (name worker)
- (libraries 
-   js_of_ocaml 
-   js_of_ocaml-lwt
-   promise
-   process
-   )
+ (libraries js_of_ocaml js_of_ocaml-lwt promise process)
  (modes js)
- (preprocess (pps js_of_ocaml-ppx))
- (link_flags (:standard -no-check-prims))
- (modules worker)
- )
+ (preprocess
+  (pps js_of_ocaml-ppx))
+ (link_flags
+  (:standard -no-check-prims))
+ (modules worker))
 
 (rule
-  (targets worker.js)
-  (deps worker.bc.js)
-  (action (copy %{deps} %{targets})))
+ (targets worker.js)
+ (deps worker.bc.js)
+ (action
+  (copy %{deps} %{targets})))
diff --git a/viz.js/process/process.ml b/viz.js/process/process.ml
index ef23b78..8d37788 100755
--- a/viz.js/process/process.ml
+++ b/viz.js/process/process.ml
@@ -1,29 +1,27 @@
-open Js_of_ocaml
+module Js = Js_of_ocaml.Js
 
 class type viz = object
-  (* PNG output *)
-  method renderImageElement: Js.js_string Js.t -> (Dom_html.imageElement Js.t, unit) Promise.promise Js.meth
   (* SVG output *)
-  method renderSVGElement: Js.js_string Js.t -> (Dom_svg.svgElement Js.t, unit) Promise.promise Js.meth
+  method renderSVGElement :
+       Js.js_string Js.t
+    -> (Js_of_ocaml.Dom_svg.svgElement Js.t, unit) Promise.promise Js.meth
 
-  method renderString: Js.js_string Js.t -> (Js.js_string Js.t, unit) Promise.promise Js.meth
+  method renderString :
+    Js.js_string Js.t -> (Js.js_string Js.t, unit) Promise.promise Js.meth
 end
 
 type t = Js.js_string Js.t * Js.js_string Js.t
 
-let do_action
-  : viz Js.t -> Js.js_string Js.t -> (unit, unit) Promise.promise
-  = fun v text ->
-
-    if text##.length != 0 then (
-      let gv = Formatter.convert text in
-      let promise =
-        (try v##renderString gv
-         with _ -> Promise.reject ()
-        ) in
-      Promise.then_map
-        ~on_fulfilled:(fun svg -> Worker.post_message ((gv, svg):t))
-        ~on_rejected:(fun _ -> ())
-        promise
-    ) else
-      Promise.reject ()
+let do_action : viz Js.t -> Js.js_string Js.t -> (unit, unit) Promise.promise =
+ fun v text ->
+  if text##.length != 0 then
+    let gv = Formatter.convert text in
+    let promise =
+      try v##renderString gv with
+      | _ -> Promise.reject ()
+    in
+    Promise.then_map
+      ~on_fulfilled:(fun svg -> Js_of_ocaml.Worker.post_message ((gv, svg) : t))
+      ~on_rejected:(fun _ -> ())
+      promise
+  else Promise.reject ()
diff --git a/viz.js/promise/promise.ml b/viz.js/promise/promise.ml
index f9f7e53..47acd28 100755
--- a/viz.js/promise/promise.ml
+++ b/viz.js/promise/promise.ml
@@ -1,66 +1,60 @@
 open Js_of_ocaml
 
 type ('a, 'b) promise
-
 type 'a resolve = 'a -> unit
-
 type 'a reject = 'a -> unit
 
 let promise_global = Js.Unsafe.global##._Promise
-
 let is_supported () = Js.Optdef.test promise_global
-
-let make f =
-  Js.Unsafe.new_obj promise_global [|Js.Unsafe.inject f|]
+let make f = Js.Unsafe.new_obj promise_global [| Js.Unsafe.inject f |]
 
 let resolve value =
-  Js.Unsafe.fun_call promise_global##.resolve [|Js.Unsafe.inject value|]
+  Js.Unsafe.fun_call promise_global##.resolve [| Js.Unsafe.inject value |]
 
 let reject value =
-  Js.Unsafe.fun_call promise_global##.reject [|Js.Unsafe.inject value|]
+  Js.Unsafe.fun_call promise_global##.reject [| Js.Unsafe.inject value |]
 
 let js_of_opt = function
   | Some value -> Js.Unsafe.inject value
-  | None       -> Js.Unsafe.inject Js.undefined
+  | None -> Js.Unsafe.inject Js.undefined
 
 let then_bind ~on_fulfilled ?on_rejected promise =
   Js.Unsafe.meth_call promise "then"
-    [|Js.Unsafe.inject on_fulfilled; js_of_opt on_rejected|]
+    [| Js.Unsafe.inject on_fulfilled; js_of_opt on_rejected |]
 
 let then_map ~on_fulfilled ?on_rejected promise =
   Js.Unsafe.meth_call promise "then"
-    [|Js.Unsafe.inject on_fulfilled; js_of_opt on_rejected|]
+    [| Js.Unsafe.inject on_fulfilled; js_of_opt on_rejected |]
 
 let catch_bind ~on_rejected promise =
-  Js.Unsafe.meth_call promise "catch" [|Js.Unsafe.inject on_rejected|]
+  Js.Unsafe.meth_call promise "catch" [| Js.Unsafe.inject on_rejected |]
 
 let catch_map ~on_rejected promise =
-  Js.Unsafe.meth_call promise "catch" [|Js.Unsafe.inject on_rejected|]
+  Js.Unsafe.meth_call promise "catch" [| Js.Unsafe.inject on_rejected |]
 
 let then_final ~on_fulfilled ~on_rejected promise =
   Js.Unsafe.meth_call promise "then"
-    [|Js.Unsafe.inject on_fulfilled; Js.Unsafe.inject on_rejected|]
+    [| Js.Unsafe.inject on_fulfilled; Js.Unsafe.inject on_rejected |]
 
 let all promises =
   let intermediate_promise =
     Js.Unsafe.fun_call promise_global##.all
-      [|Js.Unsafe.inject (Js.array promises)|]
+      [| Js.Unsafe.inject (Js.array promises) |]
   in
   then_map
-    ~on_fulfilled:(fun js_array -> Js.to_array js_array) intermediate_promise
+    ~on_fulfilled:(fun js_array -> Js.to_array js_array)
+    intermediate_promise
 
 let race promises =
   Js.Unsafe.fun_call promise_global##.race
-    [|Js.Unsafe.inject (Js.array promises)|]
+    [| Js.Unsafe.inject (Js.array promises) |]
 
 module Infix = struct
-  let (>>=) promise on_fulfilled = then_bind ~on_fulfilled promise
-  let (>|=) promise on_fulfilled = then_map  ~on_fulfilled promise
-
-  let (>>~) promise on_rejected = catch_bind ~on_rejected promise
-  let (>|~) promise on_rejected = catch_map  ~on_rejected promise
+  let ( >>= ) promise on_fulfilled = then_bind ~on_fulfilled promise
+  let ( >|= ) promise on_fulfilled = then_map ~on_fulfilled promise
+  let ( >>~ ) promise on_rejected = catch_bind ~on_rejected promise
+  let ( >|~ ) promise on_rejected = catch_map ~on_rejected promise
 
-  let (>||) promise (on_fulfilled, on_rejected) =
+  let ( >|| ) promise (on_fulfilled, on_rejected) =
     then_final ~on_fulfilled ~on_rejected promise
 end
-