Skip to content

Commit 61b4748

Browse files
committed
Create jsoo_common.ml module for common logic for playground entrypoints
1 parent f3a4a25 commit 61b4748

File tree

4 files changed

+80
-95
lines changed

4 files changed

+80
-95
lines changed

jscomp/main/jsoo_common.ml

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
module Js = struct
2+
module Unsafe = struct
3+
type any
4+
external inject : 'a -> any = "%identity"
5+
external get : 'a -> 'b -> 'c = "caml_js_get"
6+
external set : 'a -> 'b -> 'c -> unit = "caml_js_set"
7+
external pure_js_expr : string -> 'a = "caml_pure_js_expr"
8+
let global = pure_js_expr "joo_global_object"
9+
type obj
10+
external obj : (string * any) array -> obj = "caml_js_object"
11+
end
12+
type (-'a, +'b) meth_callback
13+
type 'a callback = (unit, 'a) meth_callback
14+
external wrap_callback : ('a -> 'b) -> ('c, 'a -> 'b) meth_callback = "caml_js_wrap_callback"
15+
external wrap_meth_callback : ('a -> 'b) -> ('a, 'b) meth_callback = "caml_js_wrap_meth_callback"
16+
type + 'a t
17+
type js_string
18+
external string : string -> js_string t = "caml_js_from_string"
19+
external to_string : js_string t -> string = "caml_js_to_string"
20+
external create_file : js_string t -> js_string t -> unit = "caml_create_file"
21+
external to_bytestring : js_string t -> string = "caml_js_to_byte_string"
22+
end
23+
24+
let mk_js_error (loc: Location.t) (msg: string) =
25+
let (file,line,startchar) = Location.get_pos_info loc.Location.loc_start in
26+
let (file,endline,endchar) = Location.get_pos_info loc.Location.loc_end in
27+
Js.Unsafe.(obj
28+
[|
29+
"js_error_msg",
30+
inject @@ Js.string (Printf.sprintf "Line %d, %d:\n %s" line startchar msg);
31+
"row" , inject (line - 1);
32+
"column" , inject startchar;
33+
"endRow" , inject (endline - 1);
34+
"endColumn" , inject endchar;
35+
"text" , inject @@ Js.string msg;
36+
"type" , inject @@ Js.string "error"
37+
|]
38+
)
39+

jscomp/main/jsoo_common.mli

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
(**
2+
This module is shared between different JSOO / Playground based modules
3+
*)
4+
module Js :
5+
sig
6+
module Unsafe :
7+
sig
8+
type any
9+
external inject : 'a -> any = "%identity"
10+
external get : 'a -> 'b -> 'c = "caml_js_get"
11+
external set : 'a -> 'b -> 'c -> unit = "caml_js_set"
12+
external pure_js_expr : string -> 'a = "caml_pure_js_expr"
13+
val global : 'a
14+
type obj
15+
external obj : (string * any) array -> obj = "caml_js_object"
16+
end
17+
type (-'a, +'b) meth_callback
18+
type 'a callback = (unit, 'a) meth_callback
19+
external wrap_callback : ('a -> 'b) -> ('c, 'a -> 'b) meth_callback
20+
= "caml_js_wrap_callback"
21+
external wrap_meth_callback : ('a -> 'b) -> ('a, 'b) meth_callback
22+
= "caml_js_wrap_meth_callback"
23+
type +'a t
24+
type js_string
25+
external string : string -> js_string t = "caml_js_from_string"
26+
external to_string : js_string t -> string = "caml_js_to_string"
27+
external create_file : js_string t -> js_string t -> unit
28+
= "caml_create_file"
29+
external to_bytestring : js_string t -> string = "caml_js_to_byte_string"
30+
end
31+
32+
(*
33+
Creates a Js Error object for given location with and a certain error message
34+
*)
35+
val mk_js_error : Location.t -> string -> Js.Unsafe.obj

jscomp/main/jsoo_main.ml

Lines changed: 2 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -23,29 +23,7 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

2525
(** *)
26-
module Js = struct
27-
module Unsafe = struct
28-
type any
29-
external inject : 'a -> any = "%identity"
30-
external get : 'a -> 'b -> 'c = "caml_js_get"
31-
external set : 'a -> 'b -> 'c -> unit = "caml_js_set"
32-
external pure_js_expr : string -> 'a = "caml_pure_js_expr"
33-
let global = pure_js_expr "joo_global_object"
34-
type obj
35-
external obj : (string * any) array -> obj = "caml_js_object"
36-
end
37-
type (-'a, +'b) meth_callback
38-
type 'a callback = (unit, 'a) meth_callback
39-
external wrap_callback : ('a -> 'b) -> ('c, 'a -> 'b) meth_callback = "caml_js_wrap_callback"
40-
external wrap_meth_callback : ('a -> 'b) -> ('a, 'b) meth_callback = "caml_js_wrap_meth_callback"
41-
type + 'a t
42-
type js_string
43-
external string : string -> js_string t = "caml_js_from_string"
44-
external to_string : js_string t -> string = "caml_js_to_string"
45-
external create_file : js_string t -> js_string t -> unit = "caml_create_file"
46-
external to_bytestring : js_string t -> string = "caml_js_to_byte_string"
47-
end
48-
26+
module Js = Jsoo_common.Js
4927

5028
(*
5129
Error:
@@ -127,21 +105,7 @@ let implementation ~use_super_errors ?(react_ppx_version=V3) prefix impl str :
127105
begin match error_of_exn e with
128106
| Some error ->
129107
Location.report_error Format.err_formatter error;
130-
let (file,line,startchar) = Location.get_pos_info error.loc.loc_start in
131-
let (file,endline,endchar) = Location.get_pos_info error.loc.loc_end in
132-
Js.Unsafe.(obj
133-
[|
134-
"js_error_msg",
135-
inject @@ Js.string (Printf.sprintf "Line %d, %d:\n %s" line startchar error.msg);
136-
"row" , inject (line - 1);
137-
"column" , inject startchar;
138-
"endRow" , inject (endline - 1);
139-
"endColumn" , inject endchar;
140-
"text" , inject @@ Js.string error.msg;
141-
"type" , inject @@ Js.string "error"
142-
|]
143-
);
144-
108+
Jsoo_common.mk_js_error error.loc error.msg
145109
| None ->
146110
Js.Unsafe.(obj [|
147111
"js_error_msg" , inject @@ Js.string (Printexc.to_string e)

jscomp/main/jsoo_refmt_main.ml

Lines changed: 4 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -26,54 +26,8 @@
2626
`jsoo_refmt_main` is the JSOO compilation entry point for building BuckleScript + Refmt as one bundle.
2727
This is usually the file you want to build for the full playground experience.
2828
*)
29-
module Js = struct
30-
module Unsafe = struct
31-
type any
32-
external inject : 'a -> any = "%identity"
33-
external get : 'a -> 'b -> 'c = "caml_js_get"
34-
external set : 'a -> 'b -> 'c -> unit = "caml_js_set"
35-
external pure_js_expr : string -> 'a = "caml_pure_js_expr"
36-
let global = pure_js_expr "joo_global_object"
37-
type obj
38-
external obj : (string * any) array -> obj = "caml_js_object"
39-
end
40-
type (-'a, +'b) meth_callback
41-
type 'a callback = (unit, 'a) meth_callback
42-
external wrap_callback : ('a -> 'b) -> ('c, 'a -> 'b) meth_callback = "caml_js_wrap_callback"
43-
external wrap_meth_callback : ('a -> 'b) -> ('a, 'b) meth_callback = "caml_js_wrap_meth_callback"
44-
type + 'a t
45-
type js_string
46-
external string : string -> js_string t = "caml_js_from_string"
47-
external to_string : js_string t -> string = "caml_js_to_string"
48-
external create_file : js_string t -> js_string t -> unit = "caml_create_file"
49-
external to_bytestring : js_string t -> string = "caml_js_to_byte_string"
50-
end
51-
52-
53-
(*
54-
Error:
55-
* {
56-
* row: 12,
57-
* column: 2, //can be undefined
58-
* text: "Missing argument",
59-
* type: "error" // or "warning" or "info"
60-
* }
61-
*)
62-
let mk_js_error loc msg =
63-
let (file,line,startchar) = Location.get_pos_info loc.Location.loc_start in
64-
let (file,endline,endchar) = Location.get_pos_info loc.Location.loc_end in
65-
Js.Unsafe.(obj
66-
[|
67-
"js_error_msg",
68-
inject @@ Js.string (Printf.sprintf "Line %d, %d:\n %s" line startchar msg);
69-
"row" , inject (line - 1);
70-
"column" , inject startchar;
71-
"endRow" , inject (endline - 1);
72-
"endColumn" , inject endchar;
73-
"text" , inject @@ Js.string msg;
74-
"type" , inject @@ Js.string "error"
75-
|]
76-
)
29+
30+
module Js = Jsoo_common.Js
7731

7832
let () =
7933
Bs_conditional_initial.setup_env ();
@@ -147,13 +101,13 @@ let implementation ~use_super_errors ?(react_ppx_version=V3) ?prefix impl str :
147101
begin match error_of_exn e with
148102
| Some error ->
149103
Location.report_error Format.err_formatter error;
150-
mk_js_error error.loc error.msg
104+
Jsoo_common.mk_js_error error.loc error.msg
151105
| None ->
152106
let msg = Printexc.to_string e in
153107
match e with
154108
| Refmt_api.Migrate_parsetree.Def.Migration_error (_,loc)
155109
| Refmt_api.Reason_errors.Reason_error (_,loc) ->
156-
mk_js_error loc msg
110+
Jsoo_common.mk_js_error loc msg
157111
| _ ->
158112
Js.Unsafe.(obj [|
159113
"js_error_msg" , inject @@ Js.string msg;
@@ -168,15 +122,11 @@ let compile impl ~use_super_errors ?react_ppx_version =
168122
let shake_compile impl ~use_super_errors ?react_ppx_version prefix =
169123
implementation ~use_super_errors ?react_ppx_version ~prefix impl
170124

171-
172-
173125
let load_module cmi_path cmi_content cmj_name cmj_content =
174126
Js.create_file cmi_path cmi_content;
175127
Js_cmj_datasets.data_sets :=
176128
String_map.add !Js_cmj_datasets.data_sets
177129
cmj_name (lazy (Js_cmj_format.from_string cmj_content))
178-
179-
180130

181131
let export (field : string) v =
182132
Js.Unsafe.set (Js.Unsafe.global) field v
@@ -187,7 +137,6 @@ let export (field : string) v =
187137
let dir_directory d =
188138
Config.load_path := d :: !Config.load_path
189139

190-
191140
let () =
192141
dir_directory "/static/cmis"
193142

@@ -243,8 +192,6 @@ let make_compiler name impl prefix =
243192
let () = make_compiler "ocaml" Parse.implementation "[@@@bs.config{no_export}]\n#1 \"repl.ml\"\n"
244193
let () = make_compiler "reason" reason_parse "[@bs.config {no_export: no_export}];\n#1 \"repl.re\";\n"
245194

246-
let _ = 1
247-
248195
(* local variables: *)
249196
(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene driver.cmo" *)
250197
(* end: *)

0 commit comments

Comments
 (0)