js_packages_info.ml

(* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * In addition to the permissions granted to you by the LGPL, you may combine
 * or link a "work that uses the Library" with a publicly distributed version
 * of this file to produce a combined library or application, then distribute
 * that combined work under the terms of your choosing, with no requirement
 * to comply with the obligations normally placed on you by section 4 of the
 * LGPL version 3 (or the corresponding section of a later version of the LGPL
 * should you choose to use a later version).
 *
 * This program 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 Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)

[@@@warning "+9"]

type module_system = Ext_module_system.t
(* ignore node_modules, just calcluating relative path *)

(* ocamlopt could not optimize such simple case..*)
let compatible (dep : module_system) (query : module_system) =
  match query with
  | Commonjs -> dep = Commonjs
  | Esmodule -> dep = Esmodule
  | Es6_global -> dep = Es6_global || dep = Esmodule
(* As a dependency Leaf Node, it is the same either [global] or [not] *)

type package_info = {
  module_system : module_system;
  path : string;
  suffix : string;
}

type package_name = Pkg_empty | Pkg_runtime | Pkg_normal of string

let ( // ) = Filename.concat

(* in runtime lib, [es6] and [es6] are treated the same wway *)
let runtime_dir_of_module_system (ms : module_system) =
  match ms with Commonjs -> "js" | Esmodule | Es6_global -> "es6"

let runtime_package_path (ms : module_system) js_file =
  !Bs_version.package_name // "lib"
  // runtime_dir_of_module_system ms
  // js_file

type t = { name : package_name; module_systems : package_info list }

let runtime_package_specs : t =
  {
    name = Pkg_runtime;
    module_systems =
      [
        { module_system = Esmodule; path = "lib/es6"; suffix = Literals.suffix_js };
        { module_system = Commonjs; path = "lib/js"; suffix = Literals.suffix_js };
      ];
  }

(**
   populated by the command line
*)
let runtime_test_package_specs : t = { name = Pkg_runtime; module_systems = [] }

let same_package_by_name (x : t) (y : t) =
  match x.name with
  | Pkg_empty -> y.name = Pkg_empty
  | Pkg_runtime -> y.name = Pkg_runtime
  | Pkg_normal s -> (
      match y.name with
      | Pkg_normal y -> s = y
      | Pkg_empty | Pkg_runtime -> false)

let is_runtime_package (x : t) = x.name = Pkg_runtime

let iter (x : t) cb = Ext_list.iter x.module_systems cb

let map (x : t) cb = Ext_list.map x.module_systems cb

(* let equal (x : t) ({name; module_systems}) =
    x.name = name &&
    Ext_list.for_all2_no_exn
      x.module_systems module_systems
      (fun (a0,a1) (b0,b1) -> a0 = b0 && a1 = b1) *)

(* we don't want force people to use package *)

(** 
   TODO: not allowing user to provide such specific package name 
   For empty package, [-bs-package-output] does not make sense
   it is only allowed to generate commonjs file in the same directory
*)
let empty : t = { name = Pkg_empty; module_systems = [] }

let from_name (name : string) : t =
  { name = Pkg_normal name; module_systems = [] }

let is_empty (x : t) = x.name = Pkg_empty

let string_of_module_system (ms : module_system) =
  match ms with Commonjs -> "CommonJS" | Esmodule -> "ESModule" | Es6_global -> "Es6_global"

let module_system_of_string package_name : module_system option =
  match package_name with
  | "commonjs" -> Some Commonjs
  | "esmodule" | "es6" -> Some Esmodule
  | "es6-global" -> Some Es6_global
  | _ -> None

let dump_package_info (fmt : Format.formatter)
    ({ module_system = ms; path = name; suffix } : package_info) =
  Format.fprintf fmt "@[%s@ %s@ %s@]"
    (string_of_module_system ms)
    name
    suffix

let dump_package_name fmt (x : package_name) =
  match x with
  | Pkg_empty -> Format.fprintf fmt "@empty_pkg@"
  | Pkg_normal s -> Format.pp_print_string fmt s
  | Pkg_runtime -> Format.pp_print_string fmt "@runtime"

let dump_packages_info (fmt : Format.formatter)
    ({ name; module_systems = ls } : t) =
  Format.fprintf fmt "@[%a;@ @[%a@]@]" dump_package_name name
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ())
       dump_package_info)
    ls

type package_found_info = {
  rel_path : string;
  pkg_rel_path : string;
  suffix : string;
}

type info_query =
  | Package_script
  | Package_not_found
  | Package_found of package_found_info

(* Note that package-name has to be exactly the same as
   npm package name, otherwise the path resolution will be wrong *)
let query_package_infos ({ name; module_systems } : t)
    (module_system : module_system) : info_query =
  match name with
  | Pkg_empty -> Package_script
  | Pkg_normal name -> (
      match
        Ext_list.find_first module_systems (fun k ->
            compatible k.module_system module_system)
      with
      | Some k ->
          let rel_path = k.path in
          let pkg_rel_path = name // rel_path in
          Package_found { rel_path; pkg_rel_path; suffix = k.suffix }
      | None -> Package_not_found)
  | Pkg_runtime -> (
      (*FIXME: [compatible] seems not correct *)
      match
        Ext_list.find_first module_systems (fun k ->
            compatible k.module_system module_system)
      with
      | Some k ->
          let rel_path = k.path in
          let pkg_rel_path = !Bs_version.package_name // rel_path in
          Package_found { rel_path; pkg_rel_path; suffix = k.suffix }
      | None -> Package_not_found)

let get_js_path (x : t) (module_system : module_system) : string =
  match
    Ext_list.find_first x.module_systems (fun k ->
        compatible k.module_system module_system)
  with
  | Some k -> k.path
  | None -> assert false

(* for a single pass compilation, [output_dir]
   can be cached
*)
let get_output_dir (info : t) ~package_dir module_system =
  Filename.concat package_dir (get_js_path info module_system)

let add_npm_package_path (packages_info : t) (s : string) : t =
  if is_empty packages_info then
    Bsc_args.bad_arg "please set package name first using -bs-package-name "
  else
    let handle_module_system module_system =
      match module_system_of_string module_system with
      | Some x -> x
      | None -> Bsc_args.bad_arg ("invalid module system " ^ module_system)
    in
    let m =
      match Ext_string.split ~keep_empty:true s ':' with
      | [ path ] -> { module_system = Esmodule; path; suffix = Literals.suffix_js }
      | [ module_system; path ] ->
          {
            module_system = handle_module_system module_system;
            path;
            suffix = Literals.suffix_js;
          }
      | [ module_system; path; suffix ] ->
          {
            module_system = handle_module_system module_system;
            path;
            suffix;
          }
      | _ -> Bsc_args.bad_arg ("invalid npm package path: " ^ s)
    in
    { packages_info with module_systems = m :: packages_info.module_systems }

(* support es6 modules instead
   TODO: enrich ast to support import export
   http://www.ecma-international.org/ecma-262/6.0/#sec-imports
   For every module, we need [Ident.t] for accessing and [filename] for import,
   they are not necessarily the same.

   Es6 modules is not the same with commonjs, we use commonjs currently
   (play better with node)

   FIXME: the module order matters?
*)