Added viz.js code

15 files changed, 760 insertions, 0 deletions

diff --git a/viz.js/canvasTool.ml b/viz.js/canvasTool.ml
new file mode 100755
index 0000000..1b21143
--- /dev/null
+++ b/viz.js/canvasTool.ml
@@ -0,0 +1,39 @@
+open Js_of_ocaml
+
+let (pixelRatio: int) = 2 * Js.Unsafe.get Dom_html.window (Js.string "devicePixelRatio")
+
+class type xmlSerializer = object
+  method serializeToString: Dom.element Js.t -> Js.js_string Js.t Js.meth
+end
+
+let (xmlSerializer: xmlSerializer Js.t Js.constr) = Js.Unsafe.global##._XMLSerializer
+
+(* Extract an image from a svg element *)
+let generate_png (svg_image : Dom_svg.svgElement Js.t) callback = begin
+  let image = Dom_html.createImg Dom_html.document in
+
+  image##.onload := Dom_html.handler (fun _ev ->
+
+      let canvas = Dom_html.createCanvas Dom_html.document in
+      let context = canvas##getContext Dom_html._2d_ in
+      let width = svg_image##.width##.baseVal##.value
+      and height = svg_image##.height##.baseVal##.value in
+
+      image##.width := pixelRatio * (int_of_float width);
+      image##.height := pixelRatio * (int_of_float height);
+
+      canvas##.width := pixelRatio * (int_of_float width);
+      canvas##.height := pixelRatio * (int_of_float height);
+
+      context##drawImage_withSize image 0.0 0.0 ((float_of_int pixelRatio) *. width) ((float_of_int pixelRatio) *. height);
+
+      callback @@ canvas##toDataURL_type (Js.string "image/png");
+      Js._false
+    );
+
+  let xml = new%js xmlSerializer in
+  let svg_xml = xml##serializeToString (svg_image :> Dom.element Js.t) in
+  let svg_src = (Js.string "data:image/svg+xml;base64,")##concat (Dom_html.window##btoa (Js.unescape (Js.encodeURIComponent  svg_xml))) in
+  image##.src := svg_src;
+
+end
diff --git a/viz.js/convert.ml b/viz.js/convert.ml
new file mode 100755
index 0000000..75c4fcd
--- /dev/null
+++ b/viz.js/convert.ml
@@ -0,0 +1,155 @@
+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 download data (filename : Js.js_string Js.t) (mime: Js.js_string Js.t)
+  = Js.Unsafe.(
+      fun_call (js_expr "download")
+        [| inject data
+         ; inject filename
+         ; inject mime |])
+
+(** Message send by the worker *)
+type message = Process.t
+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
+
+  (* 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
+end
+
+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
+
+  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 _ = Dispatch.call generated_svg_event (image, gv) in
+      Js._true);
+
+  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) ->
+
+      on_result_svg svg_display (image :> Dom.node Js.t);
+
+      (* Download the dot file *)
+      dot_button##.onclick := Dom_html.handler (fun _ev ->
+          let _ = download input (Js.string "output.dot") (Js.string "text/plain") in
+          Js._false
+        );
+
+      (* Convert the svg in png *)
+      output_button##.onclick := Dom_html.handler (fun _->
+          (*download image*)
+          CanvasTool.generate_png image (fun image ->
+              let _ = download image (Js.string "output.png") (Js.string "text/plain") 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) ));
+      (* Run the first generation *)
+      Lwt.ignore_result (change_event worker input () ());
+    );
+
+  (** 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
+       ()
+    )
+    (Dom_html.getElementById_opt "btn_window");
+  Lwt.return Js._false
+
+let _ = Lwt.bind (Lwt_js_events.onload ()) (fun _ -> load())
+
+let _ =
+  Js.export "generator"
+    (object%js
+      method load = load ()
+    end)
diff --git a/viz.js/dispatch.ml b/viz.js/dispatch.ml
new file mode 100755
index 0000000..42f7dc8
--- /dev/null
+++ b/viz.js/dispatch.ml
@@ -0,0 +1,30 @@
+open Js_of_ocaml
+
+type event_container =
+    E : 'a Dom.Event.typ * ('a -> unit) -> event_container
+
+type event_key = K : 'a Dom.Event.typ -> event_key
+
+type t = event_container
+
+let (catalog:event_container list ref) = ref []
+
+let register: type a. a Dom.Event.typ -> (a -> unit) -> t =
+  begin fun event callback ->
+    let handler = E (event, callback) in
+    catalog := handler::!catalog;
+    handler
+  end
+
+let remove: type a. a Dom.Event.typ -> t -> unit =
+  begin fun _event callback ->
+    catalog := List.filter (fun reg -> reg != callback)  !catalog;
+  end
+
+let call: type a. a Dom.Event.typ -> a -> unit =
+  begin fun event value ->
+    List.iter (fun (E (registered_event, callback)) ->
+        if K event = K registered_event then
+          callback (Obj.magic value)
+      ) !catalog
+  end
diff --git a/viz.js/dispatch.mli b/viz.js/dispatch.mli
new file mode 100755
index 0000000..8d8999b
--- /dev/null
+++ b/viz.js/dispatch.mli
@@ -0,0 +1,12 @@
+open Js_of_ocaml
+
+type t
+
+(** Register a new function with the given event *)
+val register: 'a Dom.Event.typ -> ('a -> unit) -> t
+
+(* Remove the handler for the event *)
+val remove: 'a Dom.Event.typ -> t -> unit
+
+(* Call the event *)
+val call: 'a Dom.Event.typ -> 'a -> unit
diff --git a/viz.js/dune b/viz.js/dune
new file mode 100755
index 0000000..d6eba67
--- /dev/null
+++ b/viz.js/dune
@@ -0,0 +1,37 @@
+(executable
+ (name convert)
+ (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 convert dispatch CanvasTool)
+ )
+
+(rule
+  (targets convert.js)
+  (deps convert.bc.js)
+  (action (copy %{deps} %{targets})))
+
+(executable
+ (name worker)
+ (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)
+ )
+
+(rule
+  (targets worker.js)
+  (deps worker.bc.js)
+  (action (copy %{deps} %{targets})))
diff --git a/viz.js/index.html b/viz.js/index.html
new file mode 100755
index 0000000..abb158c
--- /dev/null
+++ b/viz.js/index.html
@@ -0,0 +1,110 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8">
+    <title>Graph editor</title>
+    <style>
+
+    #app {
+      display: flex;
+      display: -webkit-flex;
+      flex-direction: column;
+      -webkit-flex-direction: column;
+      position: absolute;
+      top: 0;
+      left: 0;
+      width: 100%;
+      height: 100%;
+    }
+
+    #panes {
+      display: flex;
+      display: -webkit-flex;
+      flex: 1 1 auto;
+      -webkit-flex: 1 1 auto;
+    }
+
+    #graph {
+      display: flex;
+      display: -webkit-flex;
+      flex-direction: column;
+      -webkit-flex-direction: column;
+    }
+    
+    #output {
+      flex: 1 1 auto;
+      -webkit-flex: 1 1 auto;
+      position: relative;
+      overflow: auto;
+    }
+    
+    #editor {
+      width : 40%;
+      border-right: 1px solid #ccc;
+    }
+
+    #output svg {
+      top: 0;
+      left: 0;
+      width: 100%;
+      height: 100%;
+    }
+    
+    #output #text {
+      font-size: 12px;
+      white-space: pre;
+      position: absolute;
+      top: 0;
+      left: 0;
+      width: 100%;
+      height: 100%;
+      overflow: auto;
+    }
+    
+    #output.working svg, #output.error svg,
+    #output.working #text, #output.error #text,
+    #output.working img, #output.error img {
+      opacity: 0.4;
+    }
+    
+    #output.error #error {
+      display: inherit;
+    }
+    
+    .split {
+      -webkit-box-sizing: border-box;
+      -moz-box-sizing: border-box;
+      box-sizing: border-box;
+
+      overflow-y: auto;
+      overflow-x: hidden;
+    }
+
+    .split.split-horizontal, .gutter.gutter-horizontal {
+      height: 100%;
+      float: left;
+    }
+    
+    </style>
+  </head>
+  <body>
+    
+    <div id="app">
+      <div id="panes" class="split split-horizontal">
+        <textarea id="editor"></textarea>
+        <div id="graph" class="split">
+          <div id="output">
+            <button id="dot_output">Export DOT</button>
+            <button id="png_output">Export PNG</button>
+            <button id="btn_window">Isoler</button>
+            <div id="svg"></div>
+          </div>
+        </div>
+      </div>
+    </div>
+    
+    <script src="download.js"></script>
+    <script src="convert.js"></script>
+  </body>
+</html>
+
diff --git a/viz.js/process/dune b/viz.js/process/dune
new file mode 100755
index 0000000..fba62e8
--- /dev/null
+++ b/viz.js/process/dune
@@ -0,0 +1,10 @@
+(ocamllex tab_Lexer)
+
+(library
+ (name process)
+ (libraries 
+   js_of_ocaml 
+   promise
+   )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/viz.js/process/formatter.ml b/viz.js/process/formatter.ml
new file mode 100755
index 0000000..e6a8a0e
--- /dev/null
+++ b/viz.js/process/formatter.ml
@@ -0,0 +1,100 @@
+open Js_of_ocaml
+
+module T = Tools
+
+let leftright = false
+
+module Printer = struct
+
+  type t = Js.js_string Js.t
+
+  let inject = Js.string
+
+  let print2 t t1 t2 = t##concat_2 t1 t2
+  let print4 t t1 t2 t3 t4 = t##concat_4 t1 t2 t3 t4
+  let print5 t t1 t2 t3 t4 t5 = (t##concat t1)##concat_4 t2 t3 t4 t5
+  let print10 t t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 =
+    ((t##concat_4 t1 t2 t3 t4)##concat_3 t5 t6 t7)##concat_3 t8 t9 t10
+
+end
+
+let print_arrow = begin function
+  | Tab_Lexer.Backward -> Printer.inject "back"
+  | Tab_Lexer.Both -> Printer.inject "both"
+  | Tab_Lexer.None -> Printer.inject "none"
+  | Tab_Lexer.Forward -> Printer.inject "forward"
+end
+
+let rec print_links (acc:Js.js_string Js.t) = begin function
+  | [] -> acc
+  | (current_name, level, target, comment, arrow)::tl ->
+    let acc' = Printer.print10 acc
+        (current_name)
+        (Printer.inject ":")
+        (Printer.inject @@ string_of_int level)
+        (Printer.inject " -> ")
+        target
+        (Printer.inject "[label=\"")
+        comment
+        (Printer.inject "\" dir=\"")
+        (print_arrow arrow)
+        (Printer.inject "\" ]\n") in
+    print_links acc' tl
+end
+
+let shape = (Printer.inject "[label=<<TABLE BORDER=\"0\" CELLBORDER=\"1\" CELLSPACING=\"0\">")
+
+let rec parse lexbuf acc current_name level links = begin
+  try
+    begin match Tab_Lexer.parse_line lexbuf with
+      | Root content ->
+        let acc' = Printer.print2 acc
+            content
+            shape
+        in
+        parse lexbuf acc' content 0 links
+      | Entry (content, target) ->
+        let level' = level + 1 in
+        let acc' = (acc##concat_4
+                      (Js.string "<TR><TD port=\"")
+                      (Js.string @@ string_of_int level')
+                      (Js.string "\">")
+                      content
+                   )##concat
+            (Js.string "</TD></TR>")
+        in
+        let links' = begin match target with
+          | None -> links
+          | Some (target, comment, arrow) -> (current_name, level', target, comment, arrow)::links
+        end in
+        parse lexbuf acc' current_name level' links'
+      | Redirection (target, comment, arrow) ->
+        let links' = (current_name, level, target, comment, arrow)::links in
+        parse lexbuf acc current_name level links'
+      | NewLine ->
+        let acc' =
+          if (level >= 0) then (
+            print_links (acc##concat (Js.string "</TABLE>>];\n")) links;
+          ) else (
+            acc
+          ) in
+        parse lexbuf acc' (Js.string "") (-1) []
+      | Separator ->
+        let text =  "<TR><TD></TD></TR>" in
+        parse lexbuf (acc##concat (Js.string text)) current_name level links
+    end
+  with Tab_Lexer.Eof ->
+    if (level >= 0) then (
+      let text = Js.string "</TABLE>>];\n" in
+      print_links (acc##concat text) links;
+    ) else
+      acc
+end
+
+let convert source = begin
+
+  let text = (Js.string "digraph G {rankdir=LR;node [shape=plaintext];") in
+  (* Content *)
+  let lexbuf = Lexing.from_string (Js.to_string (source##concat (Js.string "\r\n"))) in
+  (parse lexbuf text (Js.string "") 0 [])##concat (Js.string "}")
+end
diff --git a/viz.js/process/process.ml b/viz.js/process/process.ml
new file mode 100755
index 0000000..ef23b78
--- /dev/null
+++ b/viz.js/process/process.ml
@@ -0,0 +1,29 @@
+open Js_of_ocaml
+
+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 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 ()
diff --git a/viz.js/process/tab_Lexer.mll b/viz.js/process/tab_Lexer.mll
new file mode 100755
index 0000000..67793e4
--- /dev/null
+++ b/viz.js/process/tab_Lexer.mll
@@ -0,0 +1,65 @@
+{
+  open Js_of_ocaml
+  exception SyntaxError of string * Lexing.lexbuf
+  exception Eof
+
+  type arrow =
+  | Forward
+  | Backward
+  | Both
+  | None
+
+  type jstring = Js.js_string Js.t
+
+  type res = 
+  | NewLine
+  | Root of jstring
+  | Entry of jstring * (jstring * jstring * arrow) option
+  | Redirection of jstring * jstring * arrow
+  | Separator
+
+  let get_arrow = begin function
+  | "<-" -> Backward
+  | "<->" -> Both
+  | "--" -> None
+  | _ -> Forward
+  end
+
+}
+
+let space = ['\000' '\t' '\x0C' ' '] 
+let spaces = space*
+let newline = spaces ("\r\n" | '\n' | '\r')+
+
+(* Any character except the delimiters and spaces *)
+let regular = [^ '\n' '\x0C' '\r' ]
+let target_id = ['A'-'Z' 'a'-'z' '0'-'9']+ (':' ['0'-'9']+)?
+
+let arrow = "->" | "--" | "<-" | "<->"
+
+rule parse_line = shortest
+  | eof            { raise Eof }
+
+  | newline  {NewLine}
+
+  | space+ '-'+ newline {Separator}
+
+  | (target_id as _1) newline        { Root (Js.string _1) }
+
+  | (spaces as _1) 
+    (arrow as _arrow) space+ 
+    (target_id as _target) spaces 
+    (regular* as comment) newline 
+        { Redirection ( Js.string _target, Js.string comment, (get_arrow _arrow))}
+
+  | spaces
+    (regular+ as _2) space+ 
+    (arrow as _arrow) space+ 
+    (target_id as _target) spaces 
+    (regular* as comment) newline 
+        { Entry (Js.string _2, Some (Js.string _target, Js.string comment, (get_arrow _arrow)))}
+
+  | (space+ as _1) 
+    (regular+ as _2) newline
+        { Entry (Js.string _2, None) }
+
diff --git a/viz.js/process/tools.ml b/viz.js/process/tools.ml
new file mode 100755
index 0000000..c5e39b1
--- /dev/null
+++ b/viz.js/process/tools.ml
@@ -0,0 +1,26 @@
+let drop_while predicate =
+  let rec _drop = function
+    | [] -> []
+    | (hd::tl) as l ->
+      if predicate hd then
+        _drop tl
+      else
+        l
+  in _drop
+
+(* Split a text and and new line before it goes to long *)
+let split limit =
+  let rec _split elms text =
+    let length = (String.length text) -1 in
+    if (length < limit) then
+      List.rev (text::elms)
+      |> String.concat "\\n"
+    else
+      try
+        let pos = String.rindex_from text limit ' ' in
+        let hd = String.sub text 0 pos
+        and tl = String.sub text (pos +1) (length - pos) in
+        _split (hd::elms) tl
+      with Not_found -> text
+  in _split []
+
diff --git a/viz.js/promise/dune b/viz.js/promise/dune
new file mode 100755
index 0000000..e1ae25f
--- /dev/null
+++ b/viz.js/promise/dune
@@ -0,0 +1,7 @@
+(library
+ (name promise)
+ (libraries 
+   js_of_ocaml 
+   )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/viz.js/promise/promise.ml b/viz.js/promise/promise.ml
new file mode 100755
index 0000000..f9f7e53
--- /dev/null
+++ b/viz.js/promise/promise.ml
@@ -0,0 +1,66 @@
+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 resolve 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|]
+
+let js_of_opt = function
+  | Some value -> Js.Unsafe.inject value
+  | 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|]
+
+let then_map ~on_fulfilled ?on_rejected promise =
+  Js.Unsafe.meth_call promise "then"
+    [|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|]
+
+let catch_map ~on_rejected promise =
+  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|]
+
+let all promises =
+  let intermediate_promise =
+    Js.Unsafe.fun_call promise_global##.all
+      [|Js.Unsafe.inject (Js.array promises)|]
+  in
+  then_map
+    ~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)|]
+
+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, on_rejected) =
+    then_final ~on_fulfilled ~on_rejected promise
+end
+
diff --git a/viz.js/promise/promise.mli b/viz.js/promise/promise.mli
new file mode 100755
index 0000000..26831c4
--- /dev/null
+++ b/viz.js/promise/promise.mli
@@ -0,0 +1,56 @@
+type ('a, 'b) promise
+
+type 'a resolve = 'a -> unit
+
+type 'a reject = 'a -> unit
+
+val is_supported : unit -> bool
+
+val make : ('a resolve -> 'b reject -> unit) -> ('a, 'b) promise
+
+val resolve : 'a -> ('a, 'b) promise
+
+val reject : 'b -> ('a, 'b) promise
+
+val then_bind :
+  on_fulfilled:('a -> ('c ,'b) promise) ->
+  ?on_rejected:('b -> ('c, 'b) promise) ->
+  ('a, 'b) promise ->
+  ('c, 'b) promise
+
+val then_map :
+  on_fulfilled:('a -> 'c) ->
+  ?on_rejected:('b -> 'd) ->
+  ('a, 'b) promise ->
+  ('c, 'd) promise
+
+val catch_bind :
+  on_rejected:('b -> ('a, 'b) promise) ->
+  ('a, 'b) promise ->
+  ('a, 'b) promise
+
+val catch_map :
+  on_rejected:('b -> 'a) ->
+  ('a, 'b) promise ->
+  ('a, 'b) promise
+
+val then_final :
+  on_fulfilled:('a -> unit) ->
+  on_rejected:('b -> unit) ->
+  ('a, 'b) promise ->
+  unit
+
+val all : (('a, 'b) promise) array -> ('a array, 'b) promise
+
+val race : (('a, 'b) promise) array -> ('a, 'b) promise
+
+module Infix : sig
+  val (>>=) : ('a, 'b) promise -> ('a -> ('c ,'b) promise) -> ('c, 'b) promise
+  val (>|=) : ('a, 'b) promise -> ('a -> 'c) -> ('c, 'b) promise
+
+  val (>>~) : ('a, 'b) promise -> ('b -> ('a, 'b) promise) -> ('a, 'b) promise
+  val (>|~) : ('a, 'b) promise -> ('b -> 'a) -> ('a, 'b) promise
+
+  val (>||) : ('a, 'b) promise -> ('a -> unit) * ('b -> unit) -> unit
+end
+
diff --git a/viz.js/worker.ml b/viz.js/worker.ml
new file mode 100755
index 0000000..c6ed6f5
--- /dev/null
+++ b/viz.js/worker.ml
@@ -0,0 +1,18 @@
+open Js_of_ocaml
+
+let () =
+  Worker.import_scripts
+    [ "viz.js"
+    ; "full.render.js"
+    ]
+
+let () = Worker.set_onmessage (fun content ->
+    let (viz: Process.viz Js.t Js.constr)
+      = Js.Unsafe.global##._Viz in
+
+    let _ = Process.do_action (new%js viz) content in
+    ()
+
+
+  )
+