Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

436 lines (394 sloc) 14.308 kb
(*
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;
"/usr/local/lib/node_modules";
])
(* 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
Jump to Line
Something went wrong with that request. Please try again.