Merge pull request #111 from andrewray/server

Toplevel: add a simple cohttp based server

toplevel/Makefile

@@ -92,6 +92,9 @@ $(NAME).byte: $(OBJS) ../compiler/compiler.cma
 errors.cmi: errors.mli
 	$(OCAMLC) -c $<
 
+server: server.ml
+	ocamlfind ocamlc -linkpkg -package cohttp.lwt server.ml -o server
+
 clean::
 	rm -f *.cm[io] $(NAME).byte $(NAME).js
 

toplevel/server.ml

@@ -0,0 +1,44 @@
+open Lwt
+open Cohttp
+open Cohttp_lwt_unix
+open Re
+
+let address = ref "127.0.0.1"
+let port = ref 8888
+let filesys = ref (Filename.concat (Sys.getenv "HOME") ".opam")
+
+let server () = 
+
+    let re_filesys = compile (seq [ str "/filesys/"; group (rep any); eos ]) in
+
+    let header typ = 
+        let h = Header.init () in
+        let h = Header.add h "Content-Type" typ in
+        let h = Header.add h "Server" "iocaml" in
+        h
+    in
+    let header_html = header "text/html; charset=UTF-8" in
+    let header_plain_user_charset = header "text/plain; charset=x-user-defined" in
+
+    let callback conn_id req body = 
+        let uri = Request.uri req in
+        let path = Uri.path uri in
+
+        try 
+            (* send binary file *)
+            let fname = get (exec re_filesys path) 1 in
+            Lwt_io.eprintf "filesys: %s\n" fname >>= fun () ->
+            Server.respond_file ~headers:header_plain_user_charset ~fname:fname ()
+        with _ ->
+            (* send static file *)
+            let fname = Server.resolve_file ~docroot:"." ~uri:uri in
+            Lwt_io.eprintf "static: %s\n" fname >>= fun () -> 
+            Server.respond_file ~headers:header_html ~fname:fname ()
+
+    in
+    let conn_closed conn_id () = () in
+    let config = { Server.callback; conn_closed } in
+    Server.create ~address:!address ~port:!port config
+
+let () = Lwt_unix.run (server())
+

toplevel/toplevel.ml

@@ -118,6 +118,7 @@ end = struct
 
   class type global_data = object
     method compile : (string -> string) Js.writeonly_prop
+    method auto_register_file_ : (string -> int) Js.writeonly_prop
   end
 
   external global_data : unit -> global_data Js.t = "caml_get_global_data"
@@ -205,7 +206,31 @@ end = struct
       flush_all ()
 
 
+  (* load (binary) file from server using a synchronous XMLHttpRequest *)
+  let load_from_server path = 
+    let xml = XmlHttpRequest.create () in
+    let () = xml##_open(Js.string "GET", Js.string ("filesys/" ^ path), Js._false) in
+    let () = xml##send(Js.null) in
+    if xml##status = 200 then
+      let resp = xml##responseText in
+      let len = resp##length in
+      let str = String.create len in
+      for i=0 to len-1 do 
+          str.[i] <- Char.chr (int_of_float resp##charCodeAt(i) land 0xff)
+      done;
+      Some(str)
+    else
+      None
+
+  let auto_register_file name = 
+    match load_from_server name with
+    | None -> 0
+    | Some(content) ->
+      let () = Sys_js.register_file ~name ~content in
+      1
+
   let initialize () =
+    g##auto_register_file_ <- auto_register_file;
     Toploop.initialize_toplevel_env ();
     Toploop.input_name := "//toplevel//";
     let header = "        Objective Caml version %s@.@." in