From 40679f97ce28cd5dbc27cda5e240a1275ee23542 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Fri, 27 May 2016 08:40:01 -0400 Subject: [PATCH 1/2] WIP --- jscomp/examples/node_buffer.ml | 12 ++ jscomp/examples/typed_array.ml | 0 jscomp/test/.depend | 12 ++ jscomp/test/dom.ml | 278 +++++++++++++++++++++++++++++++++ jscomp/test/dom_test.ml | 9 ++ jscomp/test/json.ml | 18 +++ jscomp/test/test.mllib | 8 +- lib/js/test/dom.js | 6 + lib/js/test/dom_test.js | 14 ++ lib/js/test/json.js | 8 + 10 files changed, 364 insertions(+), 1 deletion(-) create mode 100644 jscomp/examples/node_buffer.ml create mode 100644 jscomp/examples/typed_array.ml create mode 100644 jscomp/test/dom.ml create mode 100644 jscomp/test/dom_test.ml create mode 100644 jscomp/test/json.ml create mode 100644 lib/js/test/dom.js create mode 100644 lib/js/test/dom_test.js create mode 100644 lib/js/test/json.js diff --git a/jscomp/examples/node_buffer.ml b/jscomp/examples/node_buffer.ml new file mode 100644 index 0000000000..07106b873f --- /dev/null +++ b/jscomp/examples/node_buffer.ml @@ -0,0 +1,12 @@ + +type encoding = string (* [hex], [base64],[utf8]*) + +class type buffer = object[@uncurry] + method toString : encoding -> string +end + +external make : int -> buffer = "Buffer" [@@bs.new] + + + +external make_with_encoding : int -> encoding -> buffer = "Buffer" [@@bs.new] diff --git a/jscomp/examples/typed_array.ml b/jscomp/examples/typed_array.ml new file mode 100644 index 0000000000..e69de29bb2 diff --git a/jscomp/test/.depend b/jscomp/test/.depend index 41f764c8b9..4922526580 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -140,6 +140,10 @@ digest_test.cmj : ../stdlib/string.cmi ../stdlib/printf.cmi mt.cmi \ ext_array.cmj ../stdlib/digest.cmi ../stdlib/array.cmi digest_test.cmx : ../stdlib/string.cmx ../stdlib/printf.cmx mt.cmx \ ext_array.cmx ../stdlib/digest.cmx ../stdlib/array.cmx +dom.cmj : ../runtime/js.cmj +dom.cmx : ../runtime/js.cmx +dom_test.cmj : ../runtime/js.cmj dom.cmj +dom_test.cmx : ../runtime/js.cmx dom.cmx empty_obj.cmj : empty_obj.cmx : epsilon_test.cmj : mt.cmi @@ -286,6 +290,8 @@ js_obj_test.cmj : mt.cmi ../runtime/js.cmj js_obj_test.cmx : mt.cmx ../runtime/js.cmx js_val.cmj : js_val.cmx : +json.cmj : ../runtime/js.cmj +json.cmx : ../runtime/js.cmx lazy_test.cmj : mt.cmi ../stdlib/lazy.cmi lazy_test.cmx : mt.cmx ../stdlib/lazy.cmx lexer_test.cmj : number_lexer.cmj mt.cmi ../stdlib/list.cmi \ @@ -798,6 +804,10 @@ digest_test.cmo : ../stdlib/string.cmi ../stdlib/printf.cmi mt.cmi \ ext_array.cmo ../stdlib/digest.cmi ../stdlib/array.cmi digest_test.cmj : ../stdlib/string.cmj ../stdlib/printf.cmj mt.cmj \ ext_array.cmj ../stdlib/digest.cmj ../stdlib/array.cmj +dom.cmo : ../runtime/js.cmo +dom.cmj : ../runtime/js.cmj +dom_test.cmo : ../runtime/js.cmo dom.cmo +dom_test.cmj : ../runtime/js.cmj dom.cmj empty_obj.cmo : empty_obj.cmj : epsilon_test.cmo : mt.cmi @@ -944,6 +954,8 @@ js_obj_test.cmo : mt.cmi ../runtime/js.cmo js_obj_test.cmj : mt.cmj ../runtime/js.cmj js_val.cmo : js_val.cmj : +json.cmo : ../runtime/js.cmo +json.cmj : ../runtime/js.cmj lazy_test.cmo : mt.cmi ../stdlib/lazy.cmi lazy_test.cmj : mt.cmj ../stdlib/lazy.cmj lexer_test.cmo : number_lexer.cmo mt.cmi ../stdlib/list.cmi \ diff --git a/jscomp/test/dom.ml b/jscomp/test/dom.ml new file mode 100644 index 0000000000..7f2b386ec5 --- /dev/null +++ b/jscomp/test/dom.ml @@ -0,0 +1,278 @@ +[@@@bs.uncurry.object ] + +open Js +type 'a opt = 'a Null.t +class type ['node] arrayLikeRead = object [@uncurry] + method case : int -> 'node t Null.t + method length : int +end + +type nodeType = + OTHER (* Will not happen *) + | ELEMENT + | ATTRIBUTE + | TEXT + | CDATA_SECTION + | ENTITY_REFERENCE + | ENTITY + | PROCESSING_INSTRUCTION + | COMMENT + | DOCUMENT + | DOCUMENT_TYPE + | DOCUMENT_FRAGMENT + | NOTATION +(* https://developer.mozilla.org/en-US/docs/Web/API/Node/compareDocumentPosition *) +type document_position = int + +class type node = object [@uncurry] + method nodeName : string + method nodeValue : string opt + method nodeType : nodeType + method parentNode : node t opt + method childNodes : node arrayLikeRead t + method firstChild : node t opt + method lastChild : node t opt + method previousSibling : node t opt + method nextSibling : node t opt + method namespaceURI : string opt + + method insertBefore : node t * node t opt -> node t + method replaceChild : node t * node t -> node t + method removeChild : node t -> node t + method appendChild : node t -> node t + method hasChildNodes : unit -> bool t + method cloneNode : boolean -> node t + method compareDocumentPosition : node t -> document_position + method lookupNamespaceURI : string -> string opt + method lookupPrefix : string -> string opt +end + +(** Specification of [Attr] objects. *) +class type attr = object [@uncurry] + inherit node + method name : string + method specified : boolean + method value : string + method ownerElement : element t +end + +(** Specification of [NamedNodeMap] objects. *) +and ['node] namedNodeMap = object [@uncurry] + method getNamedItem : string -> 'node t opt + method setNamedItem : 'node t -> 'node t opt + method removeNamedItem : string -> 'node t opt + method item : int -> 'node t opt + method length : int +end + +(** Specification of [Element] objects. *) +and element = object [@uncurry] + inherit node + method tagName : string + method getAttribute : string -> string opt + method setAttribute : string -> string -> unit + method removeAttribute : string -> unit + method hasAttribute : string -> bool t + + method getAttributeNS : string * string -> string opt + method setAttributeNS : string * string -> string -> unit + method removeAttributeNS : string * string -> unit + method hasAttributeNS : string * string -> bool t + + method getAttributeNode : string -> attr t opt + method setAttributeNode : attr t -> attr t opt + method removeAttributeNode : attr t -> attr t + + method getAttributeNodeNS : string -> string -> attr t opt + method setAttributeNodeNS : attr t -> attr t opt + + method getElementsByTagName : string -> element arrayLikeRead t + method attributes : attr namedNodeMap t +end + +class type characterData = object [@uncurry] + inherit node + method data : string + method length : int + method substringData : int * int -> string + method appendData : string -> unit + method insertData : int * string -> unit + method deleteData : int * int -> unit + method replaceData : int * int * string -> unit +end + +class type comment = characterData + +class type text = characterData + +class type documentFragment = node + +class type ['element] document = object[@uncurry] + inherit node + method documentElement : 'element t + method createDocumentFragment : documentFragment t + method createElement : string -> 'element t + method createElementNS : string -> string -> 'element t + method createTextNode : string -> text t + method createAttribute : string -> attr t + method createComment : string -> comment t + method getElementById : string -> 'element t opt + method getElementsByTagName : string -> 'element arrayLikeRead t + method importNode : element t * bool t -> 'element t + method adoptNode : element t -> 'element t +end + + + +class type ['a] event = object [@uncurry] + method _type : string + method target : 'a t opt + method currentTarget : 'a t opt + method srcElement : 'a t opt +end + +external document : node document t = "document" [@@bs.val] + + +(* type node_type = *) +(* | Element of element t *) +(* | Attr of attr t *) +(* | Text of text t *) +(* | Other of node t *) + + +(* type event_listener_id = unit -> unit *) +(* type ('a, 'b) event_listener = ('a, 'b -> bool t) meth_callback opt *) + (** The type of event listener functions. The first type parameter + ['a] is the type of the target object; the second parameter + ['b] is the type of the event object. *) + +(* module Event = struct *) +(* type 'a typ = string Js.t *) +(* let make s = Js.string s *) +(* end *) + +(* let nodeType e = *) +(* match e##nodeType with *) +(* | ELEMENT -> Element (Js.Unsafe.coerce e) *) +(* | ATTRIBUTE -> Attr (Js.Unsafe.coerce e) *) +(* | CDATA_SECTION *) +(* | TEXT -> Text (Js.Unsafe.coerce e) *) +(* | _ -> Other (e:>node t) *) + +(* module CoerceTo = struct *) + +(* let cast (e:#node Js.t) t = *) +(* if e##nodeType = t *) +(* then Js.some (Js.Unsafe.coerce e) *) +(* else Js.null *) + +(* let element e : element Js.t Js.opt = cast e ELEMENT *) + +(* let text e : text Js.t Js.opt = *) +(* if e##nodeType == TEXT || e##nodeType == CDATA_SECTION *) +(* then Js.some (Js.Unsafe.coerce e) *) +(* else Js.null *) + +(* let attr e : attr Js.t Js.opt = cast e ATTRIBUTE *) + +(* end *) + +(* let no_handler : ('a, 'b) event_listener = Js.null *) +(* let window_event () : 'a #event t = Js.Unsafe.pure_js_expr "event" *) +(* (\* The function preventDefault must be called explicitely when *) +(* using addEventListener... *\) *) +(* let handler f = *) +(* Js.some (Js.Unsafe.callback *) +(* (fun e -> *) +(* (\* depending on the internet explorer version, e can be null or undefined. *\) *) +(* if not (Js.Opt.test (some e)) *) +(* then *) +(* let e = window_event () in *) +(* let res = f e in *) +(* if not (Js.to_bool res) *) +(* then e##returnValue <- res; *) +(* res *) +(* else *) +(* let res = f e in *) +(* if not (Js.to_bool res) then *) +(* (Js.Unsafe.coerce e)##preventDefault (); *) +(* res)) *) +(* let full_handler f = *) +(* Js.some (Js.Unsafe.meth_callback *) +(* (fun this e -> *) +(* (\* depending on the internet explorer version, e can be null or undefined *\) *) +(* if not (Js.Opt.test (some e)) *) +(* then *) +(* let e = window_event () in *) +(* let res = f this e in *) +(* if not (Js.to_bool res) *) +(* then e##returnValue <- res; *) +(* res *) +(* else *) +(* let res = f this e in *) +(* if not (Js.to_bool res) then *) +(* (Js.Unsafe.coerce e)##preventDefault (); *) +(* res)) *) +(* let invoke_handler *) +(* (f : ('a, 'b) event_listener) (this : 'a) (event : 'b) : bool t = *) +(* Js.Unsafe.call f this [|Js.Unsafe.inject event|] *) + +(* let eventTarget (e: (< .. > as 'a) #event t) : 'a t = *) +(* let target = *) +(* Opt.get (e##target) (fun () -> *) +(* Opt.get (e##srcElement) (fun () -> raise Not_found)) *) +(* in *) +(* if Js.instanceof target (Js.Unsafe.global ## _Node) *) +(* then *) +(* (\* Workaround for Safari bug *\) *) +(* let target' : node Js.t = Js.Unsafe.coerce target in *) +(* if target'##nodeType == TEXT then *) +(* Js.Unsafe.coerce (Opt.get (target'##parentNode) (fun () -> assert false)) *) +(* else *) +(* target *) +(* else target *) + + +(* let addEventListener (e : (< .. > as 'a) t) typ h capt = *) +(* if (Js.Unsafe.coerce e)##addEventListener == Js.undefined then begin *) +(* let ev = (Js.string "on")##concat(typ) in *) +(* let callback = fun e -> Js.Unsafe.call (h, e, [||]) in *) +(* let () = (Js.Unsafe.coerce e)##attachEvent(ev, callback) in *) +(* fun () -> (Js.Unsafe.coerce e)##detachEvent(ev, callback) *) +(* end else begin *) +(* let () = (Js.Unsafe.coerce e)##addEventListener(typ, h, capt) in *) +(* fun () -> (Js.Unsafe.coerce e)##removeEventListener (typ, h, capt) *) +(* end *) + +(* let removeEventListener id = id () *) + +(* let preventDefault ev = *) +(* if Js.Optdef.test ((Js.Unsafe.coerce ev)##preventDefault) (\* IE hack *\) *) +(* then (Js.Unsafe.coerce ev)##preventDefault() *) +(* else (Js.Unsafe.coerce ev)##returnValue <- Js.bool false (\* IE < 9 *\) *) + +(* let appendChild (p : #node t) (n : #node t) = *) +(* ignore (p##appendChild ((n :> node t))) *) + +(* let removeChild (p : #node t) (n : #node t) = *) +(* ignore (p##removeChild ((n :> node t))) *) + +(* let replaceChild (p : #node t) (n : #node t) (o : #node t) = *) +(* ignore (p##replaceChild ((n :> node t), (o :> node t))) *) + +(* let insertBefore (p : #node t) (n : #node t) (o : #node t opt) = *) +(* ignore (p##insertBefore ((n :> node t), (o :> node t opt))) *) + +(* let list_of_arrayLikeRead (arrayLikeRead:'a arrayLikeRead t) = *) +(* let length = arrayLikeRead##length in *) +(* let rec add_item acc i = *) +(* if i < length *) +(* then *) +(* match Null.to_opt (arrayLikeRead##case i) with *) +(* | None -> add_item acc (i+1) *) +(* | Some e -> add_item (e::acc) (i+1) *) +(* else List.rev acc *) +(* in *) +(* add_item [] 0 *) + diff --git a/jscomp/test/dom_test.ml b/jscomp/test/dom_test.ml new file mode 100644 index 0000000000..b04bbdcb0b --- /dev/null +++ b/jscomp/test/dom_test.ml @@ -0,0 +1,9 @@ + + +open Dom +open Js + +let () = + match Null.to_opt @@ document##getElementById "x" with + | None -> log "hey" + | Some v -> log "hi" diff --git a/jscomp/test/json.ml b/jscomp/test/json.ml new file mode 100644 index 0000000000..8ce4fbc24a --- /dev/null +++ b/jscomp/test/json.ml @@ -0,0 +1,18 @@ +class type json = object [@uncurry] + method parse : 'a . string -> 'a +end + +type json2 = + < + parse : 'a . string -> 'a + > [@uncurry] (* can not be inherited *) + +class type json3 = object [@uncurry] + (* inherit json2 *) + inherit json +end + + +external v : json Js.t = "json" [@@bs.val] + +let h = v##parse "{ x : 3 , y : 4}" diff --git a/jscomp/test/test.mllib b/jscomp/test/test.mllib index a75e4d73cc..a8044229e8 100644 --- a/jscomp/test/test.mllib +++ b/jscomp/test/test.mllib @@ -315,6 +315,7 @@ uncurry_glob_test nested_obj_test nested_obj_literal + method_name_test format_test @@ -324,4 +325,9 @@ format_test # builder config1_test -config2_test \ No newline at end of file +config2_test + +dom +dom_test +json + diff --git a/lib/js/test/dom.js b/lib/js/test/dom.js new file mode 100644 index 0000000000..1bc545d8f7 --- /dev/null +++ b/lib/js/test/dom.js @@ -0,0 +1,6 @@ +// GENERATED CODE BY BUCKLESCRIPT VERSION 0.5.0 , PLEASE EDIT WITH CARE +'use strict'; + + + +/* No side effect */ diff --git a/lib/js/test/dom_test.js b/lib/js/test/dom_test.js new file mode 100644 index 0000000000..1c7e1551b4 --- /dev/null +++ b/lib/js/test/dom_test.js @@ -0,0 +1,14 @@ +// GENERATED CODE BY BUCKLESCRIPT VERSION 0.5.0 , PLEASE EDIT WITH CARE +'use strict'; + + +var match = document.getElementById("x"); + +if (match !== null) { + console.log("hi"); +} +else { + console.log("hey"); +} + +/* match Not a pure module */ diff --git a/lib/js/test/json.js b/lib/js/test/json.js new file mode 100644 index 0000000000..955975e4b7 --- /dev/null +++ b/lib/js/test/json.js @@ -0,0 +1,8 @@ +// GENERATED CODE BY BUCKLESCRIPT VERSION 0.5.0 , PLEASE EDIT WITH CARE +'use strict'; + + +var h = json.parse("{ x : 3 , y : 4}"); + +exports.h = h; +/* h Not a pure module */ From bb602869119626033558170d92673d6e2373ec23 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Wed, 1 Jun 2016 16:24:42 -0400 Subject: [PATCH 2/2] rebase --- jscomp/test/dom.ml | 26 +++++++++++++------------- jscomp/test/dom_test.ml | 4 +++- lib/js/test/dom_test.js | 5 ++++- 3 files changed, 20 insertions(+), 15 deletions(-) diff --git a/jscomp/test/dom.ml b/jscomp/test/dom.ml index 7f2b386ec5..aae0b7bb47 100644 --- a/jscomp/test/dom.ml +++ b/jscomp/test/dom.ml @@ -1,8 +1,8 @@ -[@@@bs.uncurry.object ] +[@@@bs.config{obj_type_auto_uncurry = true } ] open Js type 'a opt = 'a Null.t -class type ['node] arrayLikeRead = object [@uncurry] +class type ['node] arrayLikeRead = object method case : int -> 'node t Null.t method length : int end @@ -24,7 +24,7 @@ type nodeType = (* https://developer.mozilla.org/en-US/docs/Web/API/Node/compareDocumentPosition *) type document_position = int -class type node = object [@uncurry] +class type node = object method nodeName : string method nodeValue : string opt method nodeType : nodeType @@ -48,7 +48,7 @@ class type node = object [@uncurry] end (** Specification of [Attr] objects. *) -class type attr = object [@uncurry] +class type attr = object inherit node method name : string method specified : boolean @@ -57,7 +57,7 @@ class type attr = object [@uncurry] end (** Specification of [NamedNodeMap] objects. *) -and ['node] namedNodeMap = object [@uncurry] +and ['node] namedNodeMap = object method getNamedItem : string -> 'node t opt method setNamedItem : 'node t -> 'node t opt method removeNamedItem : string -> 'node t opt @@ -66,11 +66,11 @@ and ['node] namedNodeMap = object [@uncurry] end (** Specification of [Element] objects. *) -and element = object [@uncurry] +and element = object inherit node method tagName : string method getAttribute : string -> string opt - method setAttribute : string -> string -> unit + method setAttribute : string * string -> unit method removeAttribute : string -> unit method hasAttribute : string -> bool t @@ -83,14 +83,14 @@ and element = object [@uncurry] method setAttributeNode : attr t -> attr t opt method removeAttributeNode : attr t -> attr t - method getAttributeNodeNS : string -> string -> attr t opt - method setAttributeNodeNS : attr t -> attr t opt + method getAttributeNodeNS : string * string -> attr t opt + method setAttributeNodeNS : attr t * attr t opt method getElementsByTagName : string -> element arrayLikeRead t method attributes : attr namedNodeMap t end -class type characterData = object [@uncurry] +class type characterData = object inherit node method data : string method length : int @@ -107,7 +107,7 @@ class type text = characterData class type documentFragment = node -class type ['element] document = object[@uncurry] +class type ['element] document = object inherit node method documentElement : 'element t method createDocumentFragment : documentFragment t @@ -124,8 +124,8 @@ end -class type ['a] event = object [@uncurry] - method _type : string +class type ['a] event = object + method type_ : string method target : 'a t opt method currentTarget : 'a t opt method srcElement : 'a t opt diff --git a/jscomp/test/dom_test.ml b/jscomp/test/dom_test.ml index b04bbdcb0b..d3d07e9256 100644 --- a/jscomp/test/dom_test.ml +++ b/jscomp/test/dom_test.ml @@ -6,4 +6,6 @@ open Js let () = match Null.to_opt @@ document##getElementById "x" with | None -> log "hey" - | Some v -> log "hi" + | Some v -> + Js.log (v##nodeName, v##parentNode(* e, v##xx *)) + diff --git a/lib/js/test/dom_test.js b/lib/js/test/dom_test.js index 1c7e1551b4..c46f69dcf8 100644 --- a/lib/js/test/dom_test.js +++ b/lib/js/test/dom_test.js @@ -5,7 +5,10 @@ var match = document.getElementById("x"); if (match !== null) { - console.log("hi"); + console.log(/* tuple */[ + match.nodeName, + match.parentNode + ]); } else { console.log("hey");