Skip to content

Examples #433

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 2 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 12 additions & 0 deletions jscomp/examples/node_buffer.ml
Original file line number Diff line number Diff line change
@@ -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]
Empty file added jscomp/examples/typed_array.ml
Empty file.
12 changes: 12 additions & 0 deletions jscomp/test/.depend
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 \
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 \
Expand Down
278 changes: 278 additions & 0 deletions jscomp/test/dom.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,278 @@
[@@@bs.config{obj_type_auto_uncurry = true } ]

open Js
type 'a opt = 'a Null.t
class type ['node] arrayLikeRead = object
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
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
inherit node
method name : string
method specified : boolean
method value : string
method ownerElement : element t
end

(** Specification of [NamedNodeMap] objects. *)
and ['node] namedNodeMap = object
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
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
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
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
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 *)

11 changes: 11 additions & 0 deletions jscomp/test/dom_test.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@


open Dom
open Js

let () =
match Null.to_opt @@ document##getElementById "x" with
| None -> log "hey"
| Some v ->
Js.log (v##nodeName, v##parentNode(* e, v##xx *))

18 changes: 18 additions & 0 deletions jscomp/test/json.ml
Original file line number Diff line number Diff line change
@@ -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}"
8 changes: 7 additions & 1 deletion jscomp/test/test.mllib
Original file line number Diff line number Diff line change
Expand Up @@ -315,6 +315,7 @@ uncurry_glob_test
nested_obj_test
nested_obj_literal


method_name_test
format_test

Expand All @@ -324,4 +325,9 @@ format_test
# builder

config1_test
config2_test
config2_test

dom
dom_test
json

6 changes: 6 additions & 0 deletions lib/js/test/dom.js
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
// GENERATED CODE BY BUCKLESCRIPT VERSION 0.5.0 , PLEASE EDIT WITH CARE
'use strict';



/* No side effect */
Loading