Skip to content

Commit

Permalink
[fix] jslang: Missing JsPackage files
Browse files Browse the repository at this point in the history
  • Loading branch information
BourgerieQuentin committed Oct 17, 2012
1 parent ea28ae2 commit 0d8b7f9
Show file tree
Hide file tree
Showing 2 changed files with 284 additions and 0 deletions.
192 changes: 192 additions & 0 deletions compiler/jslang/jsPackage.ml
@@ -0,0 +1,192 @@
(*
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/>.
*)

module Format = BaseFormat
module List = BaseList

module J = JsonTypes

module JS = JsAst

type elt =
| Verbatim of string
| Code of JsAst.code

type t = {
name : string;
main : string;
build_dir : string;
version : string;
dependencies: string StringMap.t;
more : (string * J.json) list;
files : (string * string) list;
code : elt list;
perm : Unix.file_perm;
}

let native_package = StringSet.from_list [
"assert";
"buffer_ieee754";
"buffer";
"child_process";
"cluster";
"console";
"constants";
"crypto";
"_debugger";
"dgram";
"dns";
"domain";
"events";
"freelist";
"fs";
"http";
"https";
"_linklist";
"module";
"net";
"os";
"path";
"punycode";
"querystring";
"readline";
"repl";
"stream";
"string_decoder";
"sys";
"timers";
"tls";
"tty";
"url";
"util";
"vm";
"zlib";
]

let package_json = "package.json"

let default ~name = {
name;
main = "main.js";
build_dir = ".";
version = BuildInfos.opa_version_name;
dependencies = StringMap.empty;
more = [];
files = [];
perm=0o644;
code=[];
}

let set_main t main = { t with main }

let set_perm t perm = { t with perm }

let set_build_dir t build_dir = { t with build_dir }

let set_version t version = { t with version }

let add_dependencies t d = { t with dependencies =
List.fold_left (fun dependencies (k,v) -> StringMap.add k v dependencies) t.dependencies d }

let add_file t file = { t with files = file::t.files }

let add_verbatim t verbatim = {t with code = Verbatim verbatim :: t.code }

let add_code t code = {t with code = Code code :: t.code }

let foldr f acc t = List.fold_left f acc t.code

let fold f acc t = List.fold_left f acc (List.rev t.code)

let is_empty t = List.is_empty t.code

let get_code t =
foldr
(fun code -> function
| Code c -> c @ code
| Verbatim _ -> code
) [] t

let merge t1 t2 =
{ t2 with
dependencies = StringMap.merge (fun x _ -> x) t1.dependencies t2.dependencies;
code = t1.code @ t2.code
}

let auto_dependencies ?(miss=fun _ -> ()) t =
let dependencies =
List.fold_left
(fun dependencies -> function
| Verbatim _ -> dependencies
| Code code ->
List.fold_left
(fun dependencies stm ->
JsWalk.ExprInStatement.fold
(fun dependencies -> function
| JS.Je_call (_, JS.Je_ident (_, JS.Native (`global _, "require")),
[JS.Je_string (_, pack, _)], _) ->
if StringMap.mem pack dependencies || StringSet.mem pack native_package
then dependencies
else (
miss pack;
StringMap.add pack "*" dependencies
)
| _ -> dependencies
) dependencies stm
) dependencies code
) t.dependencies t.code
in {t with dependencies}

let to_json {name; version; main; dependencies; more} =
J.Record
(more @ [
"name", J.String name;
"version", J.String version;
"main", J.String main;
"dependencies", J.Record
(StringMap.fold (fun k v acc -> (k, J.String v) ::acc) dependencies []);
])

let pp_json fmt t = JsonPrint.pp fmt (to_json t)

let pp_code0 fmt = function
| Verbatim v -> Format.pp_print_string fmt v
| Code c -> JsPrint.pp#code fmt c

let pp_code fmt t =
List.iter_right (pp_code0 fmt) t.code

let write t =
let build_dir = t.build_dir in
let json = Filename.concat build_dir package_json in
let main = Filename.concat build_dir t.main in
if not (File.check_create_path build_dir) then
OManager.error "Cannot create directory @{<bright>%s@}" build_dir;
let output filename pp x =
match File.pp_output filename pp x with
| None -> ()
| Some msg ->
OManager.error "Could not create package @{<bright>%s}: %s" t.name msg
in
List.iter (fun (name, content) -> output
(Filename.concat build_dir name) Format.pp_print_string content)
t.files;
output json pp_json t;
output main pp_code t;
Unix.chmod main t.perm

92 changes: 92 additions & 0 deletions compiler/jslang/jsPackage.mli
@@ -0,0 +1,92 @@
(*
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/>.
*)

(** This module is used to manipulates JavaScript package especially to produce
valid node.js packages.
@author Quentin Bourgerie
*)

(** Describe an element of a package. *)
type elt =
| Verbatim of string
| Code of JsAst.code

(** Describes a (Node) JavaScript package. *)
type t

(** Default package. *)
val default : name:string -> t

(** Set the filename of the main js file. *)
val set_main : t -> string -> t

(** Set the version of a package. *)
val set_version : t -> string -> t

(** Set the Unix permission of the main js file. *)
val set_perm : t -> Unix.file_perm -> t

(** Set the build directory, i.e. where the package will be written by
[write]. *)
val set_build_dir : t -> string -> t

(** Add a list of dependencies. *)
val add_dependencies : t -> (string * string) list -> t

(** Add an additional file to a package. (filename, content) *)
val add_file : t -> (string * string) -> t

(** Add verbatim code to a package. *)
val add_verbatim : t -> string -> t

(** Add structured code to a package. *)
val add_code : t -> JsAst.code -> t

(** Auto add dependencies (i.e look for require("const")). [miss] are called for
each dependencies which not already present. *)
val auto_dependencies : ?miss:(string -> unit) -> t -> t

(** Fold on the package elements. The package elements are through in order of
insertions. *)
val fold : ('acc -> elt -> 'acc) -> 'acc -> t -> 'acc

(** Fold on the package elements. The package elements are through in reverse
order of insertions. *)
val foldr : ('acc -> elt -> 'acc) -> 'acc -> t -> 'acc

(** Get the code contained on this package, it doesn't returns verbatim code. *)
val get_code : t -> JsAst.code

(** [merge p1 p2] Merge content of [p1] to the package [p2] (prepend) *)
val merge : t -> t -> t

(** Returns true if the package does not contains any code *)
val is_empty : t -> bool

(** Pretty printer of [package.json] configuration file *)
val pp_json : t BaseFormat.pprinter

(** Pretty printer of code contained in this package *)
val pp_code : t BaseFormat.pprinter

(** Write the package on the file system. *)
val write : t -> unit



0 comments on commit 0d8b7f9

Please sign in to comment.