Import attributes (#6599)

* initial implementation of import attributes

* change expected layout of import attributes in @module

* quotation around keys

* add test for regular import

* refactor

* revert

* changelog

Author: zth

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 11.1.0-rc.2 (Unreleased)
 
+#### :rocket: New Feature
+
+- Support import attributes (https://github.com/tc39/proposal-import-attributes) in `@module()`. https://github.com/rescript-lang/rescript-compiler/pull/6599
+
 #### :bug: Bug Fix
 
 - Fix issue with async and newtype in uncurried mode. https://github.com/rescript-lang/rescript-compiler/pull/6601

jscomp/core/js_dump_import_export.ml

@@ -120,24 +120,49 @@ let requires require_lit cxt f (modules : (Ident.t * string * bool) list) =
       P.newline f);
   outer_cxt
 
+let dumpImportAttributes f (importAttributes : External_ffi_types.import_attributes option) = 
+  match importAttributes with 
+  | None -> () 
+  | Some importAttributes -> 
+    P.space f;
+    P.string f "with";
+    P.space f;
+    let total = Hashtbl.length importAttributes in
+    let idx = ref 1 in
+    P.brace_group f 0 (
+      fun _ -> 
+        importAttributes |> Hashtbl.iter(fun key value ->
+          Js_dump_string.pp_string f key;
+          P.string f L.colon_space;
+          Js_dump_string.pp_string f value;
+          let shouldAddComma = !idx < total in
+          if shouldAddComma then (
+            P.string f L.comma;
+            P.space f
+          );
+          idx := !idx + 1;
+        )
+    )
+
 (** ES6 module style imports *)
-let imports cxt f (modules : (Ident.t * string * bool) list) =
+let imports cxt f (modules : (Ident.t * string * bool * External_ffi_types.import_attributes option) list) =
   (* the context used to print the following program *)
   let outer_cxt, reversed_list =
-    Ext_list.fold_left modules (cxt, []) (fun (cxt, acc) (id, s, b) ->
+    Ext_list.fold_left modules (cxt, []) (fun (cxt, acc) (id, s, b, i) ->
         let str, cxt = Ext_pp_scope.str_of_ident cxt id in
-        (cxt, (str, s, b) :: acc))
+        (cxt, (str, s, b, i) :: acc))
   in
   P.at_least_two_lines f;
-  Ext_list.rev_iter reversed_list (fun (s, file, default) ->
+  Ext_list.rev_iter reversed_list (fun (s, file, default, import_attributes) ->
       P.string f L.import;
       P.space f;
       if default then (
         P.string f s;
         P.space f;
         P.string f L.from;
         P.space f;
-        Js_dump_string.pp_string f file)
+        Js_dump_string.pp_string f file;
+        dumpImportAttributes f import_attributes)
       else (
         P.string f L.star;
         P.space f;
@@ -148,7 +173,8 @@ let imports cxt f (modules : (Ident.t * string * bool) list) =
         P.space f;
         P.string f L.from;
         P.space f;
-        Js_dump_string.pp_string f file);
+        Js_dump_string.pp_string f file;
+        dumpImportAttributes f import_attributes);
       P.string f L.semi;
       P.newline f);
   outer_cxt

jscomp/core/js_dump_import_export.mli

@@ -36,4 +36,4 @@ val requires :
   Ext_pp_scope.t
 
 val imports :
-  Ext_pp_scope.t -> Ext_pp.t -> (Ident.t * string * bool) list -> Ext_pp_scope.t
+  Ext_pp_scope.t -> Ext_pp.t -> (Ident.t * string * bool * External_ffi_types.import_attributes option) list -> Ext_pp_scope.t

jscomp/core/js_dump_program.ml

@@ -94,7 +94,8 @@ let es6_program ~output_dir fmt f (x : J.deps_program) =
         | false -> 
            Some ( x.id,
              Js_name_of_module_id.string_of_module_id x ~output_dir fmt,
-             is_default x.kind )))
+             is_default x.kind,
+             (match x.kind with | External {import_attributes} -> import_attributes | _ -> None) )))
   in
   let () = P.at_least_two_lines f in
   let cxt = Js_dump.statements true cxt f x.program.block in

jscomp/core/js_exp_make.ml

@@ -92,20 +92,20 @@ let ml_var_dot ?comment ?(dynamic_import = false) (id : Ident.t) e : J.expressio
      var http = require("http")
    ]}
 *)
-let external_var_field ?comment ~external_name:name (id : Ident.t) ~field
+let external_var_field ?import_attributes ?comment ~external_name:name (id : Ident.t) ~field
     ~default : t =
   {
     expression_desc =
-      Var (Qualified ({ id; kind = External { name; default }; dynamic_import = false }, Some field));
+      Var (Qualified ({ id; kind = External { name; default; import_attributes }; dynamic_import = false }, Some field));
     comment;
   }
 
-let external_var ?comment ~external_name (id : Ident.t) : t =
+let external_var ?import_attributes ?comment ~external_name (id : Ident.t) : t =
   {
     expression_desc =
       Var
         (Qualified
-           ( { id; kind = External { name = external_name; default = false }; dynamic_import = false },
+           ( { id; kind = External { name = external_name; default = false; import_attributes }; dynamic_import = false },
              None ));
     comment;
   }

jscomp/core/js_exp_make.mli

@@ -54,6 +54,7 @@ val ml_var_dot : ?comment:string -> ?dynamic_import:bool -> Ident.t -> string ->
 *)
 
 val external_var_field :
+  ?import_attributes:External_ffi_types.import_attributes ->
   ?comment:string ->
   external_name:string ->
   Ident.t ->
@@ -64,7 +65,7 @@ val external_var_field :
     Used in FFI
 *)
 
-val external_var : ?comment:string -> external_name:string -> Ident.t -> t
+val external_var : ?import_attributes:External_ffi_types.import_attributes -> ?comment:string -> external_name:string -> Ident.t -> t
 
 val ml_module_as_var : ?comment:string -> ?dynamic_import:bool -> Ident.t -> t
 

jscomp/core/js_op.ml

@@ -114,7 +114,7 @@ type int_op =
 *)
 type level = Log | Info | Warn | Error
 
-type kind = Ml | Runtime | External of { name : string; default : bool }
+type kind = Ml | Runtime | External of { name : string; default : bool; import_attributes : External_ffi_types.import_attributes option }
 
 type property = Lam_compat.let_kind = Strict | Alias | StrictOpt | Variable
 

jscomp/core/lam_compile_env.ml

@@ -59,7 +59,7 @@ let reset () =
     since when we print it in the end, it will 
     be escaped quite ugly
 *)
-let add_js_module (hint_name : External_ffi_types.module_bind_name)
+let add_js_module ?import_attributes (hint_name : External_ffi_types.module_bind_name)
     (module_name : string) default : Ident.t =
   let id =
     Ident.create
@@ -71,7 +71,7 @@ let add_js_module (hint_name : External_ffi_types.module_bind_name)
       | Phint_nothing -> Ext_modulename.js_id_name_of_hint_name module_name)
   in
   let lam_module_ident : J.module_id =
-    { id; kind = External { name = module_name; default }; dynamic_import = false }
+    { id; kind = External { name = module_name; default; import_attributes }; dynamic_import = false }
   in
   match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with
   | None ->

jscomp/core/lam_compile_env.mli

@@ -27,7 +27,7 @@
 val reset : unit -> unit
 
 val add_js_module :
-  External_ffi_types.module_bind_name -> string -> bool -> Ident.t
+  ?import_attributes:External_ffi_types.import_attributes -> External_ffi_types.module_bind_name -> string -> bool -> Ident.t
 (** 
    [add_js_module hint_name module_name]
    Given a js module name and hint name, assign an id to it

jscomp/core/lam_compile_external_call.ml

@@ -50,9 +50,9 @@ let splice_obj_apply obj name args =
    bundle *)
 
 let external_var
-    ({ bundle; module_bind_name } : External_ffi_types.external_module_name) =
-  let id = Lam_compile_env.add_js_module module_bind_name bundle false in
-  E.external_var id ~external_name:bundle
+   ({ bundle; module_bind_name; import_attributes } : External_ffi_types.external_module_name) =
+  let id = Lam_compile_env.add_js_module ?import_attributes module_bind_name bundle false in
+  E.external_var ?import_attributes ~external_name:bundle id
 
 (* let handle_external_opt
     (module_name : External_ffi_types.external_module_name option)
@@ -218,22 +218,22 @@ let translate_scoped_module_val
     (module_name : External_ffi_types.external_module_name option) (fn : string)
     (scopes : string list) =
   match module_name with
-  | Some { bundle; module_bind_name } -> (
+  | Some { bundle; module_bind_name; import_attributes } -> (
       match scopes with
       | [] ->
           let default = fn = "default" in
           let id =
-            Lam_compile_env.add_js_module module_bind_name bundle default
+            Lam_compile_env.add_js_module ?import_attributes module_bind_name bundle default
           in
-          E.external_var_field ~external_name:bundle ~field:fn ~default id
+          E.external_var_field ?import_attributes ~external_name:bundle ~field:fn ~default id
       | x :: rest ->
           (* TODO: what happens when scope contains "default" ?*)
           let default = false in
           let id =
-            Lam_compile_env.add_js_module module_bind_name bundle default
+            Lam_compile_env.add_js_module ?import_attributes module_bind_name bundle default
           in
           let start =
-            E.external_var_field ~external_name:bundle ~field:x ~default id
+            E.external_var_field ?import_attributes ~external_name:bundle ~field:x ~default id
           in
           Ext_list.fold_left (Ext_list.append rest [ fn ]) start E.dot)
   | None -> (

jscomp/core/lam_module_ident.ml

@@ -52,9 +52,9 @@ module Cmp = struct
   type nonrec t = t
   let equal (x : t) y = 
     match x.kind with 
-    | External {name = x_kind; default = x_default}-> 
+    | External {name = x_kind; default = x_default; _} -> 
       begin match y.kind with 
-        | External {name = y_kind; default = y_default} -> 
+        | External {name = y_kind; default = y_default; _} -> 
           x_kind = (y_kind : string) && x_default = y_default
         | _ -> false 
       end

jscomp/frontend/ast_external_process.ml

@@ -248,7 +248,12 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
           {
             st with
             external_module_name =
-              Some {bundle; module_bind_name = Phint_nothing};
+              Some
+                {
+                  bundle;
+                  module_bind_name = Phint_nothing;
+                  import_attributes = None;
+                };
           } )
       else
         let action () =
@@ -262,30 +267,115 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
                 call_name = Some (name_from_payload_or_prim ~loc payload);
               }
           | "bs.module" | "module" -> (
-            match Ast_payload.assert_strings loc payload with
-            | [bundle] ->
-              {
-                st with
-                external_module_name =
-                  Some {bundle; module_bind_name = Phint_nothing};
-              }
-            | [bundle; bind_name] ->
-              {
-                st with
-                external_module_name =
-                  Some {bundle; module_bind_name = Phint_name bind_name};
-              }
-            | [] ->
-              {
-                st with
-                module_as_val =
-                  Some
-                    {
-                      bundle = prim_name_or_pval_prim.name;
-                      module_bind_name = Phint_nothing;
-                    };
-              }
-            | _ -> Bs_syntaxerr.err loc Illegal_attribute)
+            match payload with
+            | PStr
+                [
+                  {
+                    pstr_desc =
+                      Pstr_eval
+                        ({pexp_loc; pexp_desc = Pexp_record (fields, _); _}, _);
+                    _;
+                  };
+                ] -> (
+              let fromName = ref None in
+              let with_ = ref None in
+              fields
+              |> List.iter
+                   (fun
+                     ((l, exp) :
+                       Longident.t Location.loc * Parsetree.expression)
+                   ->
+                     match (l, exp.pexp_desc) with
+                     | ( {txt = Lident "from"; _},
+                         Pexp_constant (Pconst_string (s, _)) ) ->
+                       fromName := Some s
+                     | {txt = Lident "with"; _}, Pexp_record (fields, _) ->
+                       with_ := Some fields
+                     | _ -> ());
+              match (!fromName, !with_) with
+              | None, _ ->
+                Location.raise_errorf ~loc:pexp_loc
+                  "@module annotations with import attributes must have a \
+                   \"from\" field. This \"from\" field should point to the JS \
+                   module to import, just like the string payload to @module \
+                   normally does."
+              | Some _, None ->
+                Location.raise_errorf ~loc:pexp_loc
+                  "@module annotations with import attributes must have a \
+                   \"with\" field. This \"with\" field should hold a record of \
+                   the import attributes you want applied to the import."
+              | Some fromName, Some withFields ->
+                let importAttributesFromRecord =
+                  withFields
+                  |> List.filter_map
+                       (fun
+                         ((l, exp) :
+                           Longident.t Location.loc * Parsetree.expression)
+                       ->
+                         match exp.pexp_desc with
+                         | Pexp_constant (Pconst_string (s, _)) -> (
+                           match l.txt with
+                           | Longident.Lident "type_" -> Some ("type", s)
+                           | Longident.Lident txt -> Some (txt, s)
+                           | _ ->
+                             Location.raise_errorf ~loc:exp.pexp_loc
+                               "Field must be a regular key.")
+                         | _ ->
+                           Location.raise_errorf ~loc:exp.pexp_loc
+                             "Only string values are allowed here.")
+                in
+                let import_attributes =
+                  Hashtbl.create (List.length importAttributesFromRecord)
+                in
+                importAttributesFromRecord
+                |> List.iter (fun (key, value) ->
+                       Hashtbl.replace import_attributes key value);
+                {
+                  st with
+                  external_module_name =
+                    Some
+                      {
+                        bundle = fromName;
+                        module_bind_name = Phint_nothing;
+                        import_attributes = Some import_attributes;
+                      };
+                })
+            | _ -> (
+              match Ast_payload.assert_strings loc payload with
+              | [bundle] ->
+                {
+                  st with
+                  external_module_name =
+                    Some
+                      {
+                        bundle;
+                        module_bind_name = Phint_nothing;
+                        import_attributes = None;
+                      };
+                }
+              | [bundle; bind_name] ->
+                {
+                  st with
+                  external_module_name =
+                    Some
+                      {
+                        bundle;
+                        module_bind_name = Phint_name bind_name;
+                        import_attributes = None;
+                      };
+                }
+              | [] ->
+                {
+                  st with
+                  module_as_val =
+                    Some
+                      {
+                        bundle = prim_name_or_pval_prim.name;
+                        module_bind_name = Phint_nothing;
+                        import_attributes = None;
+                      };
+                }
+              | _ -> Bs_syntaxerr.err loc Illegal_attribute))
           | "bs.scope" | "scope" -> (
             match Ast_payload.assert_strings loc payload with
             | [] -> Bs_syntaxerr.err loc Illegal_attribute