Permalink
Browse files

cohttpserver example

  • Loading branch information...
1 parent df404a5 commit 7faa1863aa20d6299c43f60b16068915c0c38bca Jake Donham committed Jul 27, 2010
@@ -0,0 +1,9 @@
+all: myocamlbuild.ml
+ ocamlbuild clicks.js server.byte
+
+clean:
+ ocamlbuild -clean
+ rm -f myocamlbuild.ml
+
+myocamlbuild.ml:
+ ln -s ../../tools/myocamlbuild.ml
@@ -0,0 +1,7 @@
+You need ocamljs and cohttpserver for this example. Run the server with
+
+ ./server.byte
+
+then point your browser at
+
+ http://localhost:9007/
@@ -0,0 +1,9 @@
+<proto.ml> : pkg_lwt
+<proto_js_clnt.ml*> : pkg_lwt,pkg_orpc-js-client
+<clicks.ml> : pkg_lwt,pkg_orpc-js-client,pkg_dom
+<clicks.js> : pkg_lwt,pkg_orpc-js-client,pkg_dom
+
+<proto_js_srv.ml*> : pkg_lwt,pkg_nethttpd,pkg_orpc-js-server
+<proto_js_aux.ml*> : pkg_orpc-js-server
+<server.ml> : syntax_camlp4o,pkg_lwt.syntax,pkg_cohttpserver,pkg_orpc-js-server,pkg_lwt.unix
+<server.byte> : pkg_cohttpserver,pkg_orpc-js-server,pkg_lwt.unix
@@ -0,0 +1,18 @@
+module Server =
+ Proto_js_clnt.Lwt(struct let with_client f = f (Orpc_js_client.create "/clicks") end)
+
+let (>>=) = Lwt.(>>=)
+
+;;
+
+Dom.window#_set_onload (fun () ->
+ let clicks = (Dom.document#getElementById "clicks" : Dom.span) in
+ let click = (Dom.document#getElementById "click" : Dom.button) in
+
+ let set_clicks n = Lwt.return (clicks#_set_innerHTML (string_of_int n)) in
+
+ click#_set_onclick (fun _ ->
+ ignore(Server.click () >>= set_clicks);
+ Ocamljs.false_ ());
+
+ ignore(Server.clicks () >>= set_clicks))
@@ -0,0 +1,10 @@
+<html>
+ <head>
+ <title>Clicks</title>
+ </head>
+ <body>
+ <p>The button has been clicked <span id="clicks">0</span> times.</p>
+ <p><button type="button" id="click">Click</button></p>
+ <script src="_build/clicks.js"></script>
+ </body>
+</html>
@@ -0,0 +1,11 @@
+module type Sync =
+sig
+ val clicks : unit -> int
+ val click : unit -> int
+end
+
+module type Lwt =
+sig
+ val clicks : unit -> int Lwt.t
+ val click : unit -> int Lwt.t
+end
@@ -0,0 +1,41 @@
+open Cohttp
+open Cohttpserver
+
+module Server =
+struct
+ let n = ref 0
+
+ let clicks () = Lwt.return !n
+ let click () = incr n; Lwt.return !n
+end
+
+module M = Proto_js_srv.Lwt(Server)
+
+let clicks req out =
+ let body = Http_request.body req in
+ lwt body_string = Http_message.string_of_body body in
+ lwt res = M.handler body_string in
+ Http_daemon.respond ~body:res out
+
+let callback _ req out =
+ match Http_request.path req with
+ | "/" -> Http_daemon.respond_file ~fname:"index.html" ~mime_type:"text/html" out
+ | "/_build/clicks.js" -> Http_daemon.respond_file ~fname:"_build/clicks.js" ~mime_type:"application/javascript" out
+ | "/clicks" -> clicks req out
+ | url -> Http_daemon.respond_error ~status:`Not_found ~body:("not found: " ^ url) out
+
+let exn_handler exn out = Lwt.return ()
+
+let spec = {
+ Http_daemon.address = "0.0.0.0";
+ auth = `None;
+ callback = callback;
+ conn_closed = ignore;
+ port = 9007;
+ root_dir = None;
+ exn_handler = exn_handler;
+ timeout = Some 15;
+ auto_close = true;
+}
+
+let _ = Lwt_main.run (Http_daemon.main spec)
@@ -1,27 +0,0 @@
-netplex {
-
- service {
- name = "clicks";
- protocol {
- name = "http/clicks";
- address { type = "internet"; bind = "192.168.206.129:9007"; };
- };
- processor {
- type = "nethttpd";
- host {
- names = "*:0";
- uri { path = "/clicks"; service { type = "dynamic"; handler = "clicks" }};
- uri {
- path = "/";
- service {
- type = "file";
- docroot = "/home/jake/github/orpc/examples/clicks";
- index_files = "index.html";
- media_type { suffix = "html"; type = "text/html"; };
- }
- };
- };
- };
- workload_manager { type = "constant"; threads = 1; };
- };
-}

0 comments on commit 7faa186

Please sign in to comment.