goji_jslink.ml

(****************************************************************************)
(* GOJI (JavaScript Interface Generator for OCaml)                          *)
(* This file is published under the CeCILL licence                          *)
(* (C) 2013 Benjamin Canou                                                  *)
(****************************************************************************)

(** Implementation of the [jslink] command. *)

let () = Findlib.init ()

let append_contents fp_js fn =
  let fp = open_in fn in
  try
    while true do
      Printf.fprintf fp_js "%s\n" (input_line fp)
    done
  with End_of_file -> close_in fp

let merge_dirs dfrom dto =
  let module SS = Set.Make (String) in
  let lfrom = Array.fold_left (fun r f -> SS.add f r) SS.empty (Sys.readdir dfrom) in
  let lto = Array.fold_left (fun r f -> SS.add f r) SS.empty (Sys.readdir dto) in
  SS.iter
    (fun l ->
      if SS.mem l lto then
	Goji_messages.error "collision on file %S, cannot continue" l
      else
	Sys.rename (dfrom ^ "/" ^ l) (dto ^ "/" ^ l)
    ) lfrom

(** Main entry point of the [jslink] command *)
let main base_dir out_file packages  =
  if packages = [] then
    Goji_messages.warning
      "no package specified, generating empty JavaScript file." ;
  let open Findlib in
  let resolved =
    List.filter (fun (n, p) -> Sys.file_exists p)
      (List.map
	 (fun n ->
	   try n, package_directory n ^ "/goji_jslib_" ^ n ^ ".zip"
	   with No_such_package _ ->
	     Goji_messages.error "package %S not found" n)
	 packages)
  in
  if resolved = [] then
    Goji_messages.warning
      "no package contains JavaScript, generating empty JavaScript file." ;
  let js_name = base_dir ^ "/" ^ out_file in
  let fp_js = open_out js_name in
  Printf.fprintf fp_js "/*** THIS FILE HAS BEEN AUTOMATICALLY GENERATED BY GOJI ***/\n" ; 
  List.iter
    (fun (n, p) ->
      Printf.fprintf fp_js "/*** sources for library %s ***/\n" n ; 
      let tmp = Filename.get_temp_dir_name () in
      ignore (Sys.command ("unzip -q -d " ^ tmp ^ " " ^ p)) ;
      let entry = tmp ^  "/goji_jslib_" ^ n ^ "/" ^ "goji_entry.js" in
      append_contents fp_js entry ;
      ignore (Sys.remove entry) ;
      merge_dirs (tmp ^ "/goji_jslib_" ^ n) base_dir ;
      ignore (Sys.command ("rm -rf " ^ tmp ^ "/goji_jslib_" ^ n)))
    resolved ;
  close_out fp_js