Merge pull request #380 from bloomberg/http_server_using_nodejs

[feature] finally a working http server using nodejs!!

jscomp/js_exp_make.ml

@@ -80,7 +80,16 @@ let ml_var_dot ?comment ( id  : Ident.t) e : J.expression =
   {expression_desc = Var (Qualified(id, Ml, Some e)); comment }
 
 let external_var_dot ?comment (id : Ident.t) name fn : t = 
-  {expression_desc = Var (Qualified(id, External name, Some fn)); comment }
+  {expression_desc = Var (Qualified(id, External name,  fn)); comment }
+
+(** 
+  module as a value 
+   {[
+     var http = require("http")
+   ]}
+*)
+let external_module_as_var ?comment (id : Ident.t) name : t = 
+  {expression_desc = Var (Qualified(id, External name, None)); comment }
 
 let ml_var ?comment (id : Ident.t) : t  = 
   {expression_desc = Var (Qualified (id, Ml, None)); comment}

jscomp/js_exp_make.mli

@@ -75,7 +75,9 @@ val runtime_var_vid : string -> string -> J.vident
 
 val ml_var_dot : ?comment:string -> Ident.t -> string -> t
 
-val external_var_dot : ?comment:string -> Ident.t -> string -> string -> t
+val external_var_dot : ?comment:string -> Ident.t -> string -> string option -> t
+
+
 
 val ml_var : ?comment:string -> Ident.t -> t
 

jscomp/lam_compile_external_call.ml

@@ -80,7 +80,7 @@ type js_send = {
   name : string 
 } (* we know it is a js send, but what will happen if you pass an ocaml objct *)
 
-type js_global = { 
+type js_val = { 
   name : string ;
   external_module_name : external_module_name option;
 
@@ -92,7 +92,8 @@ type js_get = { name : string }
 
 type ffi = 
   | Obj_create 
-  | Js_global of js_global 
+  | Js_global of js_val 
+  | Js_global_as_var of  external_module_name
   | Js_call of js_call external_module
   | Js_send of js_send
   | Js_new of js_new external_module
@@ -104,17 +105,19 @@ type ffi =
   (* When it's normal, it is handled as normal c functional ffi call *)
 type prim = Types.type_expr option Primitive.description
 
-let handle_attributes ({prim_attributes ; } as _prim  : prim ) : Location.t option * ffi  = 
+let handle_attributes ({prim_attributes ; prim_name} as _prim  : prim ) : Location.t option * ffi  = 
   let qualifiers = ref [] in
   let call_name = ref None in
   let external_module_name  = ref None in
   let is_obj =  ref false in
-  let js_global = ref `None in
+  let js_val = ref `None in
+  let js_val_of_module = ref `None in 
   let js_send = ref `None in
   let js_set = ref `None in
   let js_get = ref `None in
   let js_set_index = ref false in 
   let js_get_index = ref false in
+
   let js_splice = ref false in
   let start_loc : Location.t option ref = ref None in
   let finish_loc = ref None in
@@ -130,7 +133,7 @@ let handle_attributes ({prim_attributes ; } as _prim  : prim ) : Location.t opti
          | "bs.val"
            (* can be generalized into 
               {[
-                [@@bs.value]
+                [@@bs.val]
               ]}
               and combined with 
               {[
@@ -140,11 +143,21 @@ let handle_attributes ({prim_attributes ; } as _prim  : prim ) : Location.t opti
            -> 
            begin  match is_single_string pay_load with
              | Some name -> 
-               js_global := `Value name 
+               js_val := `Value name 
              | None -> 
-               js_global := `Value _prim.prim_name
+               js_val := `Value _prim.prim_name
                 (* we can report error here ... *)
            end
+         | "bs.val_of_module" 
+           (* {[ [@@bs.val_of_module]]}
+           *)
+           -> 
+           begin match is_single_string pay_load with 
+           | Some name ->
+             js_val_of_module := `Value(Bind (name, prim_name))
+           | None -> 
+             js_val_of_module := `Value (Single prim_name)
+           end
          |"bs.splice"
            -> 
            js_splice := true
@@ -182,19 +195,9 @@ let handle_attributes ({prim_attributes ; } as _prim  : prim ) : Location.t opti
              | `Single name -> external_module_name:= Some (Single name)
              | `Some [a;b] -> external_module_name := Some (Bind (a,b))
              | `Some _ -> ()
-             | `None -> () 
+             | `None -> () (* should emit a warning instead *)
            end
-         (* -- no scope -- could have 
-            [@@bs.module "./react.js"]
-            [@@bs.module "react-dom" "React"]
-         *)
-         (* | "bs.scope" *)
-         (*   ->  *)
-         (*   begin match is_string_or_strings pay_load with  *)
-         (*     | `None -> () *)
-         (*     | `Single name -> qualifiers := [name] *)
-         (*     | `Some vs -> qualifiers := List.rev vs  *)
-         (*   end *)
+
          | "bs.new" -> 
            begin match is_single_string pay_load with 
              | Some x -> js_new := Some x 
@@ -221,7 +224,10 @@ let handle_attributes ({prim_attributes ; } as _prim  : prim ) : Location.t opti
     else if !js_set_index then 
       Js_set_index
     else 
-      begin match !call_name, !js_global, !js_send, !js_new, !js_set, !js_get  with 
+    begin match !js_val_of_module with 
+    | `Value v -> Js_global_as_var v 
+    | `None -> 
+      begin match !call_name, !js_val, !js_send, !js_new, !js_set, !js_get  with 
       | Some (_,fn),
         `None, `None, _, `None, `None -> 
           Js_call { txt = { splice = !js_splice; qualifiers = !qualifiers; name = fn};
@@ -241,7 +247,7 @@ let handle_attributes ({prim_attributes ; } as _prim  : prim ) : Location.t opti
       | _ -> 
           Location.raise_errorf ?loc "Ill defined attribute"
       end
-
+    end
     (* Given label, type and the argument --> encode it into 
        javascript meaningful value 
        -- check whether splice or not for the last element
@@ -397,6 +403,12 @@ let translate
             E.call ~info:{arity=Full; call_info = Call_na} fn args
         | None -> assert false 
       end
+    | Js_global_as_var module_name -> 
+      begin match handle_external (Some module_name) with 
+        | Some (id, name) -> 
+          E.external_var_dot id name None
+        | None -> assert false 
+      end
     | Js_new { external_module_name = module_name; 
                txt = { name = fn};
              } -> 
@@ -409,7 +421,7 @@ let translate
           let fn =  
             match handle_external module_name with 
             | Some (id,name) ->  
-              E.external_var_dot id name fn
+              E.external_var_dot id name (Some fn)
 
             | None -> 
               (** TODO: check, no [@@bs.module], 
@@ -449,7 +461,7 @@ let translate
         | "null", None -> E.nil 
         | "undefined", None -> E.undefined
         | _, Some(id,mod_name)
-          -> E.external_var_dot id mod_name name
+          -> E.external_var_dot id mod_name (Some name)
         | _, None -> 
 
           E.var (Ext_ident.create_js name)

jscomp/test/.depend

@@ -16,7 +16,7 @@ mt_global.cmi : mt.cmi
 ocaml_proto_test.cmi :
 scanf_reference_error_regression_test.cmi :
 test_for_map2.cmi :
-test_http_server.cmi : ../runtime/js.cmj
+test_http_server.cmi :
 test_is_js.cmi :
 test_unsafe_obj_ffi.cmi : ../runtime/js.cmj ../runtime/fn.cmj
 test_unsafe_obj_ffi_ppx.cmi : ../runtime/js.cmj
@@ -224,6 +224,8 @@ hashtbl_test.cmj : mt.cmi ../stdlib/moreLabels.cmi ../stdlib/list.cmi \
     ../stdlib/hashtbl.cmi ../stdlib/array.cmi
 hashtbl_test.cmx : mt.cmx ../stdlib/moreLabels.cmx ../stdlib/list.cmx \
     ../stdlib/hashtbl.cmx ../stdlib/array.cmx
+http_types.cmj : ../runtime/js.cmj
+http_types.cmx : ../runtime/js.cmx
 inline_edge_cases.cmj : inline_edge_cases.cmi
 inline_edge_cases.cmx : inline_edge_cases.cmi
 inline_map2_test.cmj : mt.cmi ../stdlib/list.cmi
@@ -498,8 +500,8 @@ test_global_print.cmj : ../stdlib/list.cmi ../stdlib/hashtbl.cmi
 test_global_print.cmx : ../stdlib/list.cmx ../stdlib/hashtbl.cmx
 test_google_closure.cmj : ../runtime/js.cmj ../stdlib/array.cmi
 test_google_closure.cmx : ../runtime/js.cmx ../stdlib/array.cmx
-test_http_server.cmj : ../runtime/js.cmj test_http_server.cmi
-test_http_server.cmx : ../runtime/js.cmx test_http_server.cmi
+test_http_server.cmj : http_types.cmj test_http_server.cmi
+test_http_server.cmx : http_types.cmx test_http_server.cmi
 test_include.cmj : test_order.cmj ../stdlib/string.cmi ../stdlib/set.cmi \
     ../stdlib/list.cmi
 test_include.cmx : test_order.cmx ../stdlib/string.cmx ../stdlib/set.cmx \
@@ -864,6 +866,8 @@ hashtbl_test.cmo : mt.cmi ../stdlib/moreLabels.cmi ../stdlib/list.cmi \
     ../stdlib/hashtbl.cmi ../stdlib/array.cmi
 hashtbl_test.cmj : mt.cmj ../stdlib/moreLabels.cmj ../stdlib/list.cmj \
     ../stdlib/hashtbl.cmj ../stdlib/array.cmj
+http_types.cmo : ../runtime/js.cmo
+http_types.cmj : ../runtime/js.cmj
 inline_edge_cases.cmo : inline_edge_cases.cmi
 inline_edge_cases.cmj : inline_edge_cases.cmi
 inline_map2_test.cmo : mt.cmi ../stdlib/list.cmi
@@ -1138,8 +1142,8 @@ test_global_print.cmo : ../stdlib/list.cmi ../stdlib/hashtbl.cmi
 test_global_print.cmj : ../stdlib/list.cmj ../stdlib/hashtbl.cmj
 test_google_closure.cmo : ../runtime/js.cmo ../stdlib/array.cmi
 test_google_closure.cmj : ../runtime/js.cmj ../stdlib/array.cmj
-test_http_server.cmo : ../runtime/js.cmo test_http_server.cmi
-test_http_server.cmj : ../runtime/js.cmj test_http_server.cmi
+test_http_server.cmo : http_types.cmo test_http_server.cmi
+test_http_server.cmj : http_types.cmj test_http_server.cmi
 test_include.cmo : test_order.cmo ../stdlib/string.cmi ../stdlib/set.cmi \
     ../stdlib/list.cmi
 test_include.cmj : test_order.cmj ../stdlib/string.cmj ../stdlib/set.cmj \

jscomp/test/http_types.ml

@@ -0,0 +1,33 @@
+  (** 
+     [%bs (req Js.t * resp Js.t => unit ) => server Js.t 
+     ]
+
+     A syntax extension
+
+     (req Js.t ->  resp Js.t -> unit  [@uncurry] )-> server Js.t [@uncurry]
+     type a = [%bs (req Js.t * resp Js.t => unit ) => server Js.t ]
+  *)
+
+
+
+
+
+type req 
+type resp = <
+   statusCode__set : int Js.set ;
+   setHeader : string * string -> unit [@uncurry];
+   end__ : string ->  unit [@uncurry]
+>
+
+type server = <
+   listen : int * string *  (unit -> unit  [@uncurry]) -> unit [@uncurry]
+>
+
+
+
+type http = <
+   createServer : (req Js.t * resp Js.t -> unit [@uncurry]) ->  server Js.t [@uncurry]
+>
+
+
+external http : http Js.t = "http"  [@@bs.val_of_module ]

jscomp/test/test.mllib

@@ -295,4 +295,5 @@ ocaml_proto_test
 test_unsafe_obj_ffi_ppx
 
 ppx_apply_test
-test_http_server
+test_http_server
+http_types

jscomp/test/test_http_server.ml

@@ -13,41 +13,7 @@ let create_server  http =
   server##listen(port, hostname,  fun %uncurry () -> 
       Js.log ("Server running at http://"^ hostname ^ ":" ^ string_of_int port ^ "/")
     ) 
-type req 
-type resp = <
-   statusCode__set : int Js.set ;
-   setHeader : string * string -> unit [@uncurry];
-   end__ : string ->  unit [@uncurry]
->
-
-type server = <
-   listen : int * string *  (unit -> unit  [@uncurry]) -> unit [@uncurry]
->
-
-
-
-type http = <
-   createServer : (req Js.t * resp Js.t -> unit [@uncurry]) ->  server Js.t [@uncurry]
->
-
-(*
-external http : http Js.t = "http" [@@bs.val] [@@bs.module "http"]
-
 let () = 
-  create_server http
-*)
-
-
-  (** 
-     [%bs (req Js.t * resp Js.t => unit ) => server Js.t 
-     ]
-
-     A syntax extension
-
-     (req Js.t ->  resp Js.t -> unit  [@uncurry] )-> server Js.t [@uncurry]
-     type a = [%bs (req Js.t * resp Js.t => unit ) => server Js.t ]
-  *)
-
-
+  create_server Http_types.http
 
 

jscomp/test/test_http_server.mli

@@ -1,19 +1,2 @@
 
-type req 
-type resp = <
-   statusCode__set : int Js.set ;
-   setHeader : string * string -> unit [@uncurry];
-   end__ : string ->  unit [@uncurry]
->
-
-type server = <
-   listen : int * string *  (unit -> unit  [@uncurry]) -> unit [@uncurry]
->
-
-
-
-type http = <
-   createServer : (req Js.t * resp Js.t -> unit [@uncurry]) ->  server Js.t [@uncurry]
->
-
-val create_server : http Js.t -> unit
+(* val create_server : Http_types.http Js.t -> unit *)

lib/js/test/http_types.js

@@ -0,0 +1,6 @@
+// GENERATED CODE BY BUCKLESCRIPT VERSION 0.3 , PLEASE EDIT WITH CARE
+'use strict';
+
+
+
+/* No side effect */

lib/js/test/test_http_server.js

@@ -1,6 +1,7 @@
 // GENERATED CODE BY BUCKLESCRIPT VERSION 0.3 , PLEASE EDIT WITH CARE
 'use strict';
 
+var Http = require("http");
 
 var hostname = "127.0.0.1";
 
@@ -16,5 +17,6 @@ function create_server(http) {
             });
 }
 
-exports.create_server = create_server;
-/* No side effect */
+create_server(Http);
+
+/*  Not a pure module */