-
Notifications
You must be signed in to change notification settings - Fork 125
/
qml2js.ml
435 lines (394 loc) · 14 KB
/
qml2js.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
(*
Copyright © 2011, 2012 MLstate
This file is part of Opa.
Opa is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
Opa is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with Opa. If not, see <http://www.gnu.org/licenses/>.
*)
(**
@author Mathieu Barbin
@author Maxime Audouin
@author Quentin Bourgerie
*)
(* depends *)
module List = Base.List
module Format = BaseFormat
(* alias *)
module J = Qml2jsOptions
module BPI = BslPluginInterface
module JA = JsAst
(** some type are shared with qml2ocaml, some not *)
type env_js_output =
{
(** path/name without build directory * contents *)
generated_files : (string * string) list ;
}
let wclass =
let doc = "Javascript compiler warnings" in
WarningClass.create ~name:"jscompiler" ~doc ~err:false ~enable:true ()
type nodejs_module = string
type linked_file =
| ExtraLib of nodejs_module
| Plugin of nodejs_module
type loaded_file = linked_file * string
let nodejs_module_of_linked_file = function
| ExtraLib m -> m
| Plugin m -> Filename.basename m
let system_path =
try Sys.getenv InstallDir.name
with Not_found -> "."
let static_path =
Filename.concat system_path InstallDir.lib_opa
let plugin_object name =
(* pluginNodeJsPackage.js *)
name ^ BslConvention.Suffix.nodejspackage ^ ".js"
let plugin_main_file plugin =
(* Some plugin_path/plugin.opp/pluginNodeJsPackage.js or None*)
match plugin.BPI.basename, plugin.BPI.path with
| Some name, Some path ->
Some (Filename.concat path (plugin_object name))
| _, _ -> None
(**
PASSES :
-------
// Command line passes
returns a : env_bsl, env_blender
val js_generation : argv_options -> env_js_input -> env_js_output
val js_treat : argv_options -> env_js_output -> int
NEEDED from any instance of a js-compiler :
val qml_to_js : qml_to_js
*)
type loaded_bsl = {
regular : loaded_file list;
bundled : JsPackage.t option;
generated_ast: JA.code
}
module JsTreat :
sig
val js_bslfilesloading : Qml2jsOptions.t -> BslLib.env_bsl ->
loaded_bsl
val js_generation : ?depends:string list -> Qml2jsOptions.t -> BslLib.env_bsl ->
loaded_bsl -> J.env_js_input -> env_js_output
val js_treat : Qml2jsOptions.t -> env_js_output -> int
end =
struct
open Qml2jsOptions
let default_node_path = lazy (
let static_path =
Filename.concat (
try Sys.getenv InstallDir.name
with Not_found -> ".")
InstallDir.lib_opa
in
StringSet.from_list [
"$NODE_PATH";
"node_modules";
static_path;
"`which npm > /dev/null 2>&1 && npm root -g`";
])
(* Write shell script incantation to check dependencies,
set load path, etc *)
let launcher_header env_bsl =
let node_path =
ObjectFiles.fold_dir ~packages:true ~deep:true
(fun node_path filename ->
StringSet.add (Filename.dirname filename) node_path)
(Lazy.force default_node_path)
in
let node_path =
List.fold_left
(fun node_path {BPI. has_server_code; path; _} ->
if not has_server_code then node_path
else match path with
| None -> node_path
| Some path -> StringSet.add (Filename.dirname path) node_path
) node_path env_bsl.BslLib.all_plugins
in
Format.sprintf
"#!/usr/bin/env sh
/*usr/bin/env true
export NODE_PATH=\"%a\"
%s
*/
var dependencies = ['mongodb', 'formidable', 'nodemailer', 'simplesmtp', 'imap'];
var opa_dependencies = ['opa-js-runtime-cps'];
%s
"
(StringSet.pp ":" Format.pp_print_string) node_path
LaunchHelper.script
LaunchHelper.js
let extrafiles () =
match ObjectFiles.get_current_package_name () with
| "" -> []
| package -> [
"README.md",
(Format.sprintf "\
# %s.opx
This is a module generated by Opa compiler (%s)
" package BuildInfos.opa_version_name)
]
(* JS statement to require library [lib] *)
let require_stm name lib =
let call = JsCons.Expr.call ~pure:false
(JsCons.Expr.native "require")
[(JsCons.Expr.string lib)] in
match name with
| Some name ->
JsCons.Statement.var
(JsCons.Ident.native name)
~expr:call
| None ->
JsCons.Statement.expr call
let js_bslfilesloading env_opt env_bsl =
(* 1) extra libraries *)
let extra_lib = List.filter_map (function
| `server (lib, conf) -> Some (lib, conf)
| _ -> None
) env_opt.extra_lib
in
let loaded_files =
let fold acc (extra_lib, conf) =
let () =
(*
TODO: refactor so that conf is not ignored,
and optimization pass applied
*)
ignore conf
in
let get t =
let contents = File.content (Filename.concat t "main.js") in
(ExtraLib (Filename.basename t), contents)::acc
in
match File.get_locations ~dir:true env_opt.extra_path extra_lib with
| [] ->
OManager.error (
"Cannot find extra-lib @{<bright>%s@} in search path@\n"^^
"@[<2>@{<bright>Hint@}:@\nPerhaps a missing @{<bright>-I@} ?@]" ) extra_lib
| [t] -> get t
| (t::_) as all ->
OManager.warning ~wclass:WarningClass.bsl_loading (
"extra-lib @{<bright>%s@} is found in several places@\n%s\n"^^
"I will use this one : @{<bright>%s@}" ) extra_lib (String.concat " " all) t ;
get t
in
List.fold_left fold [] extra_lib
in
(* 2) loaded bsl containing js files order : since the generated
code contains call to bypass of bsl, it is too dangerous to put
the extra-libs between bsl and the generated code *)
let loaded_files =
let plugins = env_bsl.BslLib.all_external_plugins in
let fold acc loader =
if not (JsPackage.is_empty loader.BslPluginInterface.nodejs_pack) then
match plugin_main_file loader with
| Some filename ->
let content = File.content filename in
(Plugin filename, content) :: acc
| None -> acc
else
acc
in
List.fold_left fold loaded_files plugins
in
let ast = List.flatten (List.rev_map (fun (file, content) ->
(*
TODO: we must take care about conf,
and not parse file tagged as Verbatim
*)
try
JsParse.String.code ~throw_exn:true content
with JsParse.Exception error -> (
let _ = File.output "jserror.js" content in
OManager.error "JavaScript parser error on file '%s'\n%a\n"
(nodejs_module_of_linked_file file) JsParse.pp error;
)
) loaded_files)
in
(* Correct reverse order produced by fold *)
let loaded_files = List.rev loaded_files in
let bundled, ast = match env_bsl.BslLib.bundled_plugin with
| Some plugin ->
let pack = plugin.BPI.nodejs_pack in
let code = JsPackage.get_code pack in
Some pack, code @ ast
| None -> None, ast in
{ regular = loaded_files; bundled; generated_ast = ast; }
let get_js_init env_js_input = List.flatten (
List.map
(fun (_, x) -> match x with
| `ast ast -> ast
| `string str ->
OManager.i_error "JS INIT CONTAINS UNEXPECTED PROJECTION : %s\n" str
)
env_js_input.Qml2jsOptions.js_init_contents)
let compilation_generation ?(depends=[]) ?package env_opt
bundled_plugin env_js_input =
let js_init = get_js_init env_js_input in
let js_code = List.map snd js_init @ env_js_input.js_code in
let package =
match package with
| None ->
let package =
JsPackage.default
~name:(Printf.sprintf "%s.opx" (ObjectFiles.get_current_package_name ())) in
JsPackage.set_build_dir package env_opt.compilation_directory
| Some package -> package
in
let package = match bundled_plugin with
| None -> package
| Some p -> JsPackage.merge p package
in
let package = List.fold_left JsPackage.add_file package (extrafiles ()) in
let package =
let depends = List.map (fun d -> d, BuildInfos.opa_version_name) depends in
JsPackage.add_dependencies package depends
in
let package = JsPackage.add_code package js_code in
JsPackage.write package
let linking_generation ?depends env_opt env_bsl loaded_bsl env_js_input =
let package = JsPackage.default ~name:"link" in
let package = JsPackage.set_build_dir package (Filename.dirname env_opt.target) in
let package = JsPackage.set_main package (Filename.basename env_opt.target) in
let package = JsPackage.add_verbatim package (launcher_header env_bsl) in
let package = JsPackage.set_perm package 0o755 in
compilation_generation ?depends ~package env_opt loaded_bsl.bundled env_js_input
let bundle_generation env_opt env_bsl =
match Qml2jsBackendOptions.bundle () with
| None -> ()
| Some bundle ->
OManager.verbose "Create bundle %s" bundle;
let dir =
Filename.concat env_opt.compilation_directory
(Printf.sprintf "%s.bundle"
(Filename.basename
(Filename.chop_extension env_opt.target)))
in
File.remove_rec dir;
let concat = Filename.concat (Filename.concat dir "node_modules") in
let copy src dst =
match File.copy src dst with
| 0 -> ()
| _ ->
OManager.i_error "Could not copy @{<bright>%s@} to @{<bright>%s@}"
src dst
in
(* JavaScript file *)
copy env_opt.target (Filename.concat dir (Filename.basename env_opt.target));
(* Opa packages *)
ObjectFiles.iter_dir ~packages:true ~deep:true
(fun filename ->
let copy file =
let src = Filename.concat filename file in
let dst = concat (Filename.concat (Filename.basename filename) file) in
copy src dst
in
(* FIXME: Remove "static filenames" *)
copy "main.js";
copy "package.json"
);
(* Opa plugins *)
List.iter
(fun {BPI. has_server_code; path; basename; _} ->
if not has_server_code then ()
else match path, basename with
| Some path, Some name ->
let copy file =
copy
(Filename.concat path file)
(concat (Filename.concat (Filename.basename path) file))
in
(* FIXME: Remove "static filenames" *)
copy (plugin_object name);
copy "package.json"
| _ -> ())
env_bsl.BslLib.all_plugins;
(* Opa static lib *)
let () =
let runtime_path = Filename.concat static_path "opa-js-runtime-cps" in
let bundle_path = concat "opa-js-runtime-cps" in
let copy file =
let src = Filename.concat runtime_path file in
let dst = Filename.concat bundle_path file in
copy src dst
in
copy "main.js";
copy "package.json"
in
(* Make the tarball *)
let cwd = Unix.getcwd () in
Unix.chdir dir;
let code =
let bundle =
if Filename.is_relative bundle then Filename.concat cwd bundle
else bundle
in
Sys.command (Printf.sprintf "tar czf \"%s\" *" bundle)
in
Unix.chdir cwd;
File.remove_rec dir;
match code with
| 0 -> ()
| _ -> OManager.error "Could not create bundle @{<bright>%s@}" bundle
let js_generation ?depends env_opt env_bsl loaded_bsl env_js_input =
begin match ObjectFiles.compilation_mode () with
| `compilation ->
compilation_generation ?depends env_opt loaded_bsl.bundled env_js_input
| `init -> ()
| `linking ->
linking_generation ?depends env_opt env_bsl loaded_bsl env_js_input;
bundle_generation env_opt env_bsl
| `prelude -> assert false
end;
{ generated_files = [env_opt.target, ""] }
let js_treat env_opt env_js_output =
if not env_opt.exe_run
then 0
else
let args = env_opt.exe_argv in
let args = args @ ( List.map fst env_js_output.generated_files ) in
let prog = fst (List.hd env_js_output.generated_files) in
let prog = Filename.concat (Sys.getcwd ()) prog in
OManager.verbose "building finished, will run @{<bright>%s@}" prog ;
let command = String.concat " " (prog::args) in
OManager.verbose "exec$ %s" command ;
let args = Array.of_list (prog::args) in
let run () = Unix.execvp prog args in
Unix.handle_unix_error run ()
end
module Sugar :
sig
val for_opa : val_:(string -> QmlAst.ident) ->
?bsl:JsAst.code ->
closure_map:Ident.t IdentMap.t ->
is_distant:(Ident.t -> bool) ->
renaming:QmlRenamingMap.t ->
bsl_lang:BslLanguage.t ->
exported:IdentSet.t ->
(module Qml2jsOptions.JsBackend) ->
Qml2jsOptions.t ->
BslLib.env_bsl ->
QmlTyper.env ->
QmlAst.code ->
J.env_js_input
val dummy_for_opa : (module Qml2jsOptions.JsBackend) -> unit
end
=
struct
let for_opa ~val_ ?bsl:bsl_code ~closure_map ~is_distant ~renaming ~bsl_lang ~exported
back_end argv env_bsl env_typer code =
let module M = (val back_end : Qml2jsOptions.JsBackend) in
let env_js_input =
M.compile ~val_ ?bsl:bsl_code ~closure_map ~is_distant ~renaming ~bsl_lang ~exported
argv env_bsl env_typer code
in
env_js_input
let dummy_for_opa backend =
let module M = (val backend : Qml2jsOptions.JsBackend) in
M.dummy_compile ()
end