relax [@@bs.as {json| .. ] to allow object literals

Author: bobzhang

jscomp/core/lam_compile_const.ml

@@ -130,9 +130,5 @@ let translate_arg_cst (cst : External_arg_spec.cst) =
      E.int (Int32.of_int i)
    | Arg_string_lit i -> 
      E.str i
-   | Arg_js_null  -> E.nil
    | Arg_js_literal s 
      -> E.raw_js_code (Exp (Js_literal {comment = None})) s
-
-   | Arg_js_true  -> E.bool true
-   | Arg_js_false -> E.bool false 

jscomp/syntax/ast_attributes.ml

@@ -285,13 +285,20 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
                        {pexp_desc = 
                           Pexp_constant 
                             (Pconst_string(s, (None | Some "json" as dec)))
-                       ;
+                       ; pexp_loc ;
                          _},_);
                    _}] -> 
                  if dec = None then
                    st := Some (Str (s))
                  else
+                 begin 
+                   (match Classify_function.classify ~check:(pexp_loc, Bs_flow_ast_utils.flow_deli_offset dec)
+                            s with 
+                   | Js_literal _ -> ()
+                   | _ -> 
+                    Location.raise_errorf ~loc:pexp_loc "an object literal expected");
                    st := Some (Js_literal_str s )
+                 end
                | _ -> 
                  Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal
              end

jscomp/syntax/ast_external_process.ml

@@ -114,8 +114,7 @@ let refine_arg_type ~(nolabel:bool) (ptyp : Ast_core_type.t)
      | Some (Str i)->
        Arg_cst (External_arg_spec.cst_string i)     
      | Some (Js_literal_str s) ->
-       (* FIXME: This seems to be wrong in bs.obj, we should disable such payload in bs.obj *)
-       Arg_cst (External_arg_spec.cst_json ptyp.ptyp_loc s)
+       Arg_cst (External_arg_spec.cst_obj_literal  s)
    else (* ([`a|`b] [@bs.string]) *)
      spec_of_ptyp nolabel ptyp   
   )

jscomp/syntax/ast_payload.ml

@@ -68,14 +68,7 @@ let is_single_int (x : t ) : int option =
 
 
 
-let flow_deli_off_set deli = 
-  (match deli with 
-  | None -> 1  (* length of '"'*)
-  | Some deli ->
-     String.length deli + 2 (* length of "{|"*)
-  )
-
-;;      
+
 let raw_as_string_exp_exn 
   ~(kind: Js_raw_info.raw_kind)
   (x : t ) : _ option = 
@@ -89,7 +82,7 @@ let raw_as_string_exp_exn
                ;
            pexp_loc = loc} as e ,_);
       _}] -> 
-    Bs_flow_ast_utils.check_flow_errors ~loc ~offset:(flow_deli_off_set deli) (match kind with 
+    Bs_flow_ast_utils.check_flow_errors ~loc ~offset:(Bs_flow_ast_utils.flow_deli_offset deli) (match kind with 
         | Raw_re 
         | Raw_exp ->  
           let (_loc,e),errors =  (Parser_flow.parse_expression (Parser_env.init_env None str) false) in 

jscomp/syntax/bs_flow_ast_utils.ml

@@ -35,6 +35,17 @@
    pos_cnum =  pos_bol + column
  } 
 
+
+let flow_deli_offset deli = 
+  (match deli with 
+   | None -> 1  (* length of '"'*)
+   | Some deli ->
+     String.length deli + 2 (* length of "{|"*)
+  )
+
+;;      
+
+
 (* Here the loc is  the payload loc *)
 let check_flow_errors ~(loc : Location.t)
     ~offset

jscomp/syntax/bs_flow_ast_utils.mli

@@ -22,9 +22,12 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+val flow_deli_offset:
+  string option -> 
+  int
 
- val check_flow_errors:
-   loc:Location.t -> 
-   offset:int -> 
-   (Loc.t * Parse_error.t) list ->    
-    unit
+val check_flow_errors:
+  loc:Location.t -> 
+  offset:int -> 
+  (Loc.t * Parse_error.t) list ->    
+  unit

jscomp/syntax/external_arg_spec.ml

@@ -27,10 +27,6 @@
 type cst = 
   | Arg_int_lit of int 
   | Arg_string_lit of string 
-
-  | Arg_js_null
-  | Arg_js_true
-  | Arg_js_false
   | Arg_js_literal of string
 
 type label_noname = 
@@ -87,36 +83,6 @@ type obj_param =
 type obj_params = obj_param list 
 type params = param list 
 
-exception Error of Location.t * Ext_json_parse.error
-
-let pp_invaild_json fmt err = 
-  Format.fprintf fmt "@[Invalid json literal:  %a@]@." 
-    Ext_json_parse.report_error err
-
-let () = 
-  Location.register_error_of_exn (function 
-    | Error (loc,err) ->       
-      Some (Location.error_of_printer loc pp_invaild_json err)
-    | _ -> None
-    )
-
-
-let cst_json (loc : Location.t) s : cst  =
-  match Ext_json_parse.parse_json_from_string s with 
-  | True _ -> Arg_js_true
-  | False _ -> Arg_js_false 
-  | Null _ -> Arg_js_null 
-  | _ -> Arg_js_literal s 
-  | exception Ext_json_parse.Error (start,finish,error_info)
-    ->
-    let loc1 = {
-      loc with
-       loc_start = 
-        Ext_position.offset loc.loc_start start; 
-       loc_end =   
-       Ext_position.offset loc.loc_start finish;
-    } in 
-     raise (Error (loc1 , error_info))
 let cst_obj_literal s = Arg_js_literal s
 let cst_int i = Arg_int_lit i 
 let cst_string s = Arg_string_lit s 

jscomp/syntax/external_arg_spec.mli

@@ -25,9 +25,6 @@
 type cst = private
   | Arg_int_lit of int 
   | Arg_string_lit of string 
-  | Arg_js_null
-  | Arg_js_true
-  | Arg_js_false
   | Arg_js_literal of string
 
 
@@ -79,7 +76,7 @@ type obj_params = obj_param list
 type params = param list 
 
 val cst_obj_literal : string -> cst 
-val cst_json : Location.t -> string -> cst 
+
 val cst_int : int -> cst 
 val cst_string : string -> cst