From 688025946408486abfac9ea8d71dbdb6e8390374 Mon Sep 17 00:00:00 2001 From: andrewray Date: Sun, 7 Sep 2014 01:22:36 +0100 Subject: [PATCH 1/4] add prototype XMLHttpRequest client for javascript --- _oasis | 14 ++++ _tags | 18 +++- cohttp/META | 13 ++- js/cohttp_lwt_xhr.ml | 172 ++++++++++++++++++++++++++++++++++++++ js/cohttp_lwt_xhr.mldylib | 4 + js/cohttp_lwt_xhr.mli | 40 +++++++++ js/cohttp_lwt_xhr.mllib | 4 + myocamlbuild.ml | 6 +- setup.ml | 64 +++++++++++++- 9 files changed, 328 insertions(+), 7 deletions(-) create mode 100644 js/cohttp_lwt_xhr.ml create mode 100644 js/cohttp_lwt_xhr.mldylib create mode 100644 js/cohttp_lwt_xhr.mli create mode 100644 js/cohttp_lwt_xhr.mllib diff --git a/_oasis b/_oasis index 03f66ea9d5..14cbeab75a 100644 --- a/_oasis +++ b/_oasis @@ -28,6 +28,10 @@ Flag async Description: build the Core/Async library Default: false +Flag js + Description: build the Javascript XHR client library + Default: false + Flag nettests Description: run the internet-using tests Default: false @@ -52,6 +56,16 @@ Library cohttp_lwt_unix XMETARequires: cohttp.lwt-core, unix, lwt.unix, lwt.ssl, conduit.lwt Modules: Cohttp_lwt_unix_io, Cohttp_lwt_unix, Cohttp_lwt_unix_net +Library cohttp_lwt_xhr + Build$: flag(lwt) && flag(js) + Install$: flag(lwt) && flag(js) + Path: js + Findlibname: js + FindlibParent: cohttp + BuildDepends: cohttp.lwt-core, js_of_ocaml, js_of_ocaml.syntax + XMETARequires: cohttp.lwt-core, js_of_ocaml + Modules: Cohttp_lwt_xhr + Library cohttp_async Build$: flag(async) Install$: flag(async) diff --git a/_tags b/_tags index 33f9698dc1..0a7a4163b3 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: bf32f3d69d75950b1ffda558b49ccb53) +# DO NOT EDIT (digest: 313e637245f1f50cb65af4a61de329ce) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -60,6 +60,22 @@ : pkg_uri.services : use_cohttp : use_cohttp_lwt +# Library cohttp_lwt_xhr +"js/cohttp_lwt_xhr.cmxs": use_cohttp_lwt_xhr +: pkg_fieldslib +: pkg_fieldslib.syntax +: pkg_js_of_ocaml +: pkg_js_of_ocaml.syntax +: pkg_lwt +: pkg_lwt.syntax +: pkg_re.emacs +: pkg_sexplib +: pkg_sexplib.syntax +: pkg_stringext +: pkg_uri +: pkg_uri.services +: use_cohttp +: use_cohttp_lwt # Library cohttp_async "async/cohttp_async.cmxs": use_cohttp_async : pkg_async diff --git a/cohttp/META b/cohttp/META index 502dffb755..ed932c9fc4 100644 --- a/cohttp/META +++ b/cohttp/META @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: eee80b05ce0be3b4bcecf7d96fff6df8) +# DO NOT EDIT (digest: 7ad1a9f80af587793deb1ae42f35e61d) version = "0.12.0" description = "HTTP library for Lwt, Async and Mirage" requires = "re.emacs stringext uri uri.services fieldslib sexplib" @@ -30,6 +30,17 @@ package "lwt" ( exists_if = "cohttp_lwt_unix.cma" ) +package "js" ( + version = "0.12.0" + description = "HTTP library for Lwt, Async and Mirage" + requires = "cohttp.lwt-core js_of_ocaml" + archive(byte) = "cohttp_lwt_xhr.cma" + archive(byte, plugin) = "cohttp_lwt_xhr.cma" + archive(native) = "cohttp_lwt_xhr.cmxa" + archive(native, plugin) = "cohttp_lwt_xhr.cmxs" + exists_if = "cohttp_lwt_xhr.cma" +) + package "async" ( version = "0.12.0" description = "HTTP library for Lwt, Async and Mirage" diff --git a/js/cohttp_lwt_xhr.ml b/js/cohttp_lwt_xhr.ml new file mode 100644 index 0000000000..e619e1baa7 --- /dev/null +++ b/js/cohttp_lwt_xhr.ml @@ -0,0 +1,172 @@ +type ic' = + { + str : string; + mutable pos : int; + len : int; + } + +module String_io = struct + type 'a t = 'a Lwt.t + let return = Lwt.return + let (>>=) = Lwt.bind + + let rec iter = Lwt_list.iter_s + + type ic = ic' + type oc = Buffer.t + + let read_rest x = + let s = String.sub x.str x.pos (x.len-x.pos) in + x.pos <- x.len; + s + + let read_line' x = + if x.pos < x.len then + let start = x.pos in + try + while x.str.[x.pos] != '\n' do + x.pos <- x.pos + 1 + done; + let s = String.sub x.str start (x.pos-start) in + x.pos <- x.pos + 1; + Some s + with _ -> + Some (read_rest x) + else + None + + let read_line x = return (read_line' x) + + let read_exactly' x n = + if x.len-x.pos < n then None + else begin + let s = String.sub x.str x.pos n in + x.pos <- x.pos + n; + Some s + end + + let read_exactly x n = return (read_exactly' x n) + + let read x n = + match read_exactly' x n with + | None when x.pos >= x.len -> Lwt.fail End_of_file + | None -> return (read_rest x) + | Some(x) -> return x + + let rec write x s = Buffer.add_string x s; return () + + let flush x = return () + +end + +module C = Cohttp +module CLB = Cohttp_lwt_body + +module Response = Cohttp_lwt.Make_response(String_io) +module Request = Cohttp_lwt.Make_request(String_io) + +module Client = struct + + module IO = String_io + module Response = Response + module Request = Request + + module Header_io = Cohttp.Header_io.Make(String_io) + + (* XXX remove me *) + let log_active = ref true + let log fmt = + Printf.ksprintf (fun s -> + match !log_active with + | false -> () + | true -> prerr_endline (">>> GitHub: " ^ s)) fmt + + let call ?headers ?body ?chunked meth uri = + let xml = XmlHttpRequest.create () in + let () = xml##_open(Js.string (C.Code.string_of_method meth), + Js.string (Uri.to_string uri), + Js._false) (* async??? *) + in + (* set request headers *) + let () = + match headers with + | None -> () + | Some(headers) -> + C.Header.iter + (fun k v -> List.iter + (fun v -> + log "[req header] %s: %s" k v; + xml##setRequestHeader(Js.string k, Js.string v)) v) + headers + in + (* perform call *) + lwt () = + match body with + | None -> Lwt.return (xml##send(Js.null)) + | Some(body) -> + lwt body = CLB.to_string body in + Lwt.return (xml##send(Js.Opt.return (Js.string body))) + in + + let () = log "[resp status] %s" (Js.to_string xml##statusText) in + + (* construct body *) + let body_str = Js.to_string xml##responseText in + let body = CLB.of_string body_str in + + (* (re-)construct the response *) + lwt resp_headers = + let resp_headers = Js.to_string (xml##getAllResponseHeaders()) in + lwt resp_headers = Header_io.parse + String_io.({ str=resp_headers; pos=0; len=String.length resp_headers }) in + C.Header.iter + (fun k v -> List.iter (fun v -> log "[resp header] %s: %s" k v) v) + resp_headers; + Lwt.return resp_headers + in + + let response = Response.make + ~version:`HTTP_1_1 + ~status:(Cohttp.Code.status_of_code xml##status) + ~flush:false + ~encoding:(Cohttp.Transfer.Fixed (String.length body_str)) + ~headers:resp_headers + () + in + + (* log the response *) + lwt () = + let b = Buffer.create 100 in + lwt () = Response.write_header response b in + let () = log "response:\n%s" (Buffer.contents b) in + Lwt.return () + in + + Lwt.return (response,body) + + (* The HEAD should not have a response body *) + let head ?headers uri = + let open Lwt in + call ?headers ~chunked:false `HEAD uri + >|= fst + + let get ?headers uri = call ?headers ~chunked:false `GET uri + let delete ?headers uri = call ?headers ~chunked:false `DELETE uri + let post ?body ?chunked ?headers uri = call ?headers ?body ?chunked `POST uri + let put ?body ?chunked ?headers uri = call ?headers ?body ?chunked `PUT uri + let patch ?body ?chunked ?headers uri = call ?headers ?body ?chunked `PATCH uri + + let post_form ?headers ~params uri = + let headers = C.Header.add_opt headers "content-type" "application/x-www-form-urlencoded" in + let q = List.map (fun (k,v) -> k, [v]) (C.Header.to_list params) in + let body = Cohttp_lwt_body.of_string (Uri.encoded_of_query q) in + post ~chunked:false ~headers ~body uri + + exception Cohttp_lwt_xhr_not_implemented + + (* no implementation (can it be done?). + * what should the failure exception be? *) + let callv ?(ssl=false) host port reqs = Lwt.fail Cohttp_lwt_xhr_not_implemented (* ??? *) + +end + diff --git a/js/cohttp_lwt_xhr.mldylib b/js/cohttp_lwt_xhr.mldylib new file mode 100644 index 0000000000..bd0d057f2e --- /dev/null +++ b/js/cohttp_lwt_xhr.mldylib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 8c40f6224969cac084c43da913957e60) +Cohttp_lwt_xhr +# OASIS_STOP diff --git a/js/cohttp_lwt_xhr.mli b/js/cohttp_lwt_xhr.mli new file mode 100644 index 0000000000..0c91c9a817 --- /dev/null +++ b/js/cohttp_lwt_xhr.mli @@ -0,0 +1,40 @@ +(* + * Copyright (c) 2012-2013 Anil Madhavapeddy + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) + +(** HTTP client for javascript using XMLHttpRequest. *) + +type ic' = + { + str : string; + mutable pos : int; + len : int; + } + +module String_io : Cohttp.S.IO + with type 'a t = 'a Lwt.t + and type ic = ic' + and type oc = Buffer.t + +(** The [Request] module holds the information about a HTTP request *) +module Request : Cohttp_lwt.Request with module IO = String_io + +(** The [Response] module holds the information about a HTTP response *) +module Response : Cohttp_lwt.Response with module IO = String_io + +(** The [Client] module implements an HTTP client interface. *) +module Client : Cohttp_lwt.Client with module IO = String_io + diff --git a/js/cohttp_lwt_xhr.mllib b/js/cohttp_lwt_xhr.mllib new file mode 100644 index 0000000000..bd0d057f2e --- /dev/null +++ b/js/cohttp_lwt_xhr.mllib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 8c40f6224969cac084c43da913957e60) +Cohttp_lwt_xhr +# OASIS_STOP diff --git a/myocamlbuild.ml b/myocamlbuild.ml index e7ee315120..71e65f0bc2 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: bcb5bed918c5d1e532d353d9d6b0139d) *) +(* DO NOT EDIT (digest: c7224e6b924b2c3c091ce2d5f6b9c4d0) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -600,6 +600,7 @@ let package_default = ("cohttp", ["cohttp"], []); ("cohttp_lwt", ["lwt"], []); ("cohttp_lwt_unix", ["lwt"], []); + ("cohttp_lwt_xhr", ["js"], []); ("cohttp_async", ["async"], []) ]; lib_c = []; @@ -608,6 +609,7 @@ let package_default = [ ("lwt", ["cohttp"]); ("lib_test", ["async"; "cohttp"; "lwt"]); + ("js", ["lwt"]); ("examples/async", ["async"; "cohttp"]); ("bin", ["async"; "cohttp"; "lwt"]); ("async", ["cohttp"]) @@ -617,6 +619,6 @@ let package_default = let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; -# 621 "myocamlbuild.ml" +# 623 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml index 0f3ec9d761..5cdb6c7e30 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.4 *) (* OASIS_START *) -(* DO NOT EDIT (digest: ee44efe9fba12678b0a94faef395be06) *) +(* DO NOT EDIT (digest: 7ed39d114a07eb594ae4e9eac7c4a640) *) (* Regenerated by OASIS v0.4.4 Visit http://oasis.forge.ocamlcore.org for more information and @@ -7086,6 +7086,17 @@ let setup_t = flag_description = Some "build the Core/Async library"; flag_default = [(OASISExpr.EBool true, false)] }); + Flag + ({ + cs_name = "js"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + flag_description = + Some "build the Javascript XHR client library"; + flag_default = [(OASISExpr.EBool true, false)] + }); Flag ({ cs_name = "nettests"; @@ -7190,6 +7201,53 @@ let setup_t = lib_findlib_name = Some "lwt"; lib_findlib_containers = [] }); + Library + ({ + cs_name = "cohttp_lwt_xhr"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EAnd + (OASISExpr.EFlag "lwt", OASISExpr.EFlag "js"), + true) + ]; + bs_install = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EAnd + (OASISExpr.EFlag "lwt", OASISExpr.EFlag "js"), + true) + ]; + bs_path = "js"; + bs_compiled_object = Best; + bs_build_depends = + [ + InternalLibrary "cohttp_lwt"; + FindlibPackage ("js_of_ocaml", None); + FindlibPackage ("js_of_ocaml.syntax", None) + ]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_c_sources = []; + bs_data_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + { + lib_modules = ["Cohttp_lwt_xhr"]; + lib_pack = false; + lib_internal_modules = []; + lib_findlib_parent = Some "cohttp"; + lib_findlib_name = Some "js"; + lib_findlib_containers = [] + }); Library ({ cs_name = "cohttp_async"; @@ -8050,7 +8108,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.4"; - oasis_digest = Some "TRÛ\154Q_­\157\002\006éÉ~í#8"; + oasis_digest = Some "\185K\249\030\\\148\203\017\169\139b*\173\015\192:"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -8058,6 +8116,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 8062 "setup.ml" +# 8120 "setup.ml" (* OASIS_STOP *) let () = setup ();; From 5e736458d94d85caf280c6d0bce99629c82b40ac Mon Sep 17 00:00:00 2001 From: andrewray Date: Sun, 7 Sep 2014 01:33:49 +0100 Subject: [PATCH 2/4] add a few more docs --- js/cohttp_lwt_xhr.ml | 14 ++++++++++---- js/cohttp_lwt_xhr.mli | 3 ++- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/js/cohttp_lwt_xhr.ml b/js/cohttp_lwt_xhr.ml index e619e1baa7..657973e7dd 100644 --- a/js/cohttp_lwt_xhr.ml +++ b/js/cohttp_lwt_xhr.ml @@ -1,3 +1,4 @@ +(* input channel type - a string with a (file) position and length *) type ic' = { str : string; @@ -13,8 +14,11 @@ module String_io = struct let rec iter = Lwt_list.iter_s type ic = ic' + + (* output channels are just buffers *) type oc = Buffer.t + (* the following read/write logic has only been lightly tested... *) let read_rest x = let s = String.sub x.str x.pos (x.len-x.pos) in x.pos <- x.len; @@ -85,7 +89,9 @@ module Client = struct let xml = XmlHttpRequest.create () in let () = xml##_open(Js.string (C.Code.string_of_method meth), Js.string (Uri.to_string uri), - Js._false) (* async??? *) + Js._false) (* For simplicity, do a sync call. We should + really make this async. See js_of_ocaml apis + for an example *) in (* set request headers *) let () = @@ -94,6 +100,8 @@ module Client = struct | Some(headers) -> C.Header.iter (fun k v -> List.iter + (* some headers lead to errors in the javascript console, should + we filter then out here? *) (fun v -> log "[req header] %s: %s" k v; xml##setRequestHeader(Js.string k, Js.string v)) v) @@ -162,10 +170,8 @@ module Client = struct let body = Cohttp_lwt_body.of_string (Uri.encoded_of_query q) in post ~chunked:false ~headers ~body uri + (* No implementation (can it be done?). What should the failure exception be? *) exception Cohttp_lwt_xhr_not_implemented - - (* no implementation (can it be done?). - * what should the failure exception be? *) let callv ?(ssl=false) host port reqs = Lwt.fail Cohttp_lwt_xhr_not_implemented (* ??? *) end diff --git a/js/cohttp_lwt_xhr.mli b/js/cohttp_lwt_xhr.mli index 0c91c9a817..0202338aec 100644 --- a/js/cohttp_lwt_xhr.mli +++ b/js/cohttp_lwt_xhr.mli @@ -15,7 +15,7 @@ * *) -(** HTTP client for javascript using XMLHttpRequest. *) +(** Prototype HTTP client for javascript using XMLHttpRequest. *) type ic' = { @@ -24,6 +24,7 @@ type ic' = len : int; } +(** IO is implemented with strings *) module String_io : Cohttp.S.IO with type 'a t = 'a Lwt.t and type ic = ic' From 15da410ef14e1510a98fda0efd5a6f175910e61f Mon Sep 17 00:00:00 2001 From: andrewray Date: Sun, 7 Sep 2014 15:01:54 +0100 Subject: [PATCH 3/4] add a test for Cohttp_lwt_xhr --- _oasis | 9 +++++++ _tags | 48 +++++++++++++++++++++++++--------- js/cohttp_lwt_xhr.mli | 2 +- lib_test/index.html | 26 ++++++++++++++++++ lib_test/test_xhr.ml | 61 +++++++++++++++++++++++++++++++++++++++++++ myocamlbuild.ml | 4 +-- setup.ml | 45 ++++++++++++++++++++++++++++--- 7 files changed, 176 insertions(+), 19 deletions(-) create mode 100644 lib_test/index.html create mode 100644 lib_test/test_xhr.ml diff --git a/_oasis b/_oasis index 14cbeab75a..3d09191dbc 100644 --- a/_oasis +++ b/_oasis @@ -245,6 +245,15 @@ Executable "async-hello-world" Install: false BuildDepends: cohttp, cohttp.async +Executable "test_xhr" + Path: lib_test + MainIs: test_xhr.ml + Build$: flag(tests) && flag(lwt) && flag(js) + Custom: true + CompiledObject: byte + Install: false + BuildDepends: cohttp, cohttp.js, yojson, lwt.syntax, js_of_ocaml.syntax + Test test_accept Run$: flag(tests) Command: $test_accept diff --git a/_tags b/_tags index 0a7a4163b3..a8c51f1659 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 313e637245f1f50cb65af4a61de329ce) +# DO NOT EDIT (digest: a3c9129481ad50253d7b74ad3ede3dbd) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -249,12 +249,9 @@ : use_cohttp_lwt : use_cohttp_lwt_unix : pkg_conduit.lwt -: pkg_lwt : pkg_lwt.ssl -: pkg_lwt.syntax : pkg_lwt.unix : pkg_unix -: use_cohttp_lwt : use_cohttp_lwt_unix : custom # Executable test_net_async @@ -322,17 +319,8 @@ : use_cohttp_async : pkg_async : pkg_conduit.async -: pkg_fieldslib -: pkg_fieldslib.syntax : pkg_oUnit -: pkg_re.emacs -: pkg_sexplib -: pkg_sexplib.syntax -: pkg_stringext : pkg_threads -: pkg_uri -: pkg_uri.services -: use_cohttp : use_cohttp_async : custom # Executable cohttp-server-async @@ -418,5 +406,39 @@ : use_cohttp : use_cohttp_async : custom +# Executable test_xhr +"lib_test/test_xhr.byte": pkg_fieldslib +"lib_test/test_xhr.byte": pkg_fieldslib.syntax +"lib_test/test_xhr.byte": pkg_js_of_ocaml +"lib_test/test_xhr.byte": pkg_js_of_ocaml.syntax +"lib_test/test_xhr.byte": pkg_lwt +"lib_test/test_xhr.byte": pkg_lwt.syntax +"lib_test/test_xhr.byte": pkg_re.emacs +"lib_test/test_xhr.byte": pkg_sexplib +"lib_test/test_xhr.byte": pkg_sexplib.syntax +"lib_test/test_xhr.byte": pkg_stringext +"lib_test/test_xhr.byte": pkg_uri +"lib_test/test_xhr.byte": pkg_uri.services +"lib_test/test_xhr.byte": pkg_yojson +"lib_test/test_xhr.byte": use_cohttp +"lib_test/test_xhr.byte": use_cohttp_lwt +"lib_test/test_xhr.byte": use_cohttp_lwt_xhr +: pkg_fieldslib +: pkg_fieldslib.syntax +: pkg_js_of_ocaml +: pkg_js_of_ocaml.syntax +: pkg_lwt +: pkg_lwt.syntax +: pkg_re.emacs +: pkg_sexplib +: pkg_sexplib.syntax +: pkg_stringext +: pkg_uri +: pkg_uri.services +: pkg_yojson +: use_cohttp +: use_cohttp_lwt +: use_cohttp_lwt_xhr +"lib_test/test_xhr.byte": custom # OASIS_STOP true: annot, bin_annot, principal, strict_sequence, debug diff --git a/js/cohttp_lwt_xhr.mli b/js/cohttp_lwt_xhr.mli index 0202338aec..59c4198e97 100644 --- a/js/cohttp_lwt_xhr.mli +++ b/js/cohttp_lwt_xhr.mli @@ -1,5 +1,5 @@ (* - * Copyright (c) 2012-2013 Anil Madhavapeddy + * Copyright (c) 2014 Andy Ray * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above diff --git a/lib_test/index.html b/lib_test/index.html new file mode 100644 index 0000000000..ae491a051e --- /dev/null +++ b/lib_test/index.html @@ -0,0 +1,26 @@ + + + + + Cohttp_lwt_xhr + + + + + +

Cohttp_lwt_xhr client test

+ +

Enter user name to query github

+ + +
+ username: + + +
+ +

+
+
+
+
diff --git a/lib_test/test_xhr.ml b/lib_test/test_xhr.ml
new file mode 100644
index 0000000000..55aeb9e4b9
--- /dev/null
+++ b/lib_test/test_xhr.ml
@@ -0,0 +1,61 @@
+(*
+
+Description: 
+
+Enter a username and click the button to query github and get a JSON
+description of the users public repositories.
+
+Build instructions:
+
+$ ocamlfind c -syntax camlp4o -package lwt.syntax -package js_of_ocaml.syntax \
+    -package cohttp.js -package yojson -linkpkg -o test_xhr.byte test_xhr.ml
+
+This is done through oasis with --enable-tests
+
+The next step is to convert to javscript.  I'm not sure how to automate this step
+with oasis.
+
+$ js_of_ocaml +weak test_xhr.byte -o lib_test/test_xhr.js
+
+and load it in the browser.
+
+$ chromium-browser lib_test/index.html
+
+*)
+
+(* grab elements from the webpage *)
+let get_element e = 
+    let d = Dom_html.document in
+    Js.Opt.get 
+        (d##getElementById (Js.string e))
+        (fun () -> assert false)
+let get_input n =
+    match Dom_html.tagged (get_element n) with
+    | Dom_html.Input(x) -> x
+    | _ -> failwith ("couldn't find text element" ^ n)
+let value n = Js.to_string (get_input n)##value
+
+let main _ = 
+  let output_list_repos = get_element "output-list-repos" in
+  let list_repos = get_element "list-repos" in
+  
+  (* pretty print output *)
+  let pretty s = Yojson.Basic.(pretty_to_string (from_string s)) in
+  
+  (* run the cohttp query to github *)
+  let run_query _ = 
+    Lwt.ignore_result (
+      lwt resp, body = Cohttp_lwt_xhr.Client.get 
+        Uri.(of_string ("https://api.github.com/users/" ^ value "username" ^ "/repos"))
+      in
+      lwt body = Cohttp_lwt_body.to_string body in
+      output_list_repos##innerHTML <- Js.string (pretty body);
+      Lwt.return ());
+    Js._false
+  in
+  list_repos##onclick <- Dom_html.handler run_query;
+  Js._false
+  
+
+let _ = Dom_html.window##onload <- Dom_html.handler main
+
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 71e65f0bc2..6c562827a7 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: c7224e6b924b2c3c091ce2d5f6b9c4d0) *)
+(* DO NOT EDIT (digest: 1414bd98bb1d170c8461f63140200ee3) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -608,7 +608,7 @@ let package_default =
      includes =
        [
           ("lwt", ["cohttp"]);
-          ("lib_test", ["async"; "cohttp"; "lwt"]);
+          ("lib_test", ["async"; "cohttp"; "js"; "lwt"]);
           ("js", ["lwt"]);
           ("examples/async", ["async"; "cohttp"]);
           ("bin", ["async"; "cohttp"; "lwt"]);
diff --git a/setup.ml b/setup.ml
index 5cdb6c7e30..bf3ed3ca3c 100644
--- a/setup.ml
+++ b/setup.ml
@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 7ed39d114a07eb594ae4e9eac7c4a640) *)
+(* DO NOT EDIT (digest: 25db211c1ea72f9822bceafda37b6243) *)
 (*
    Regenerated by OASIS v0.4.4
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -7959,6 +7959,45 @@ let setup_t =
                       bs_nativeopt = [(OASISExpr.EBool true, [])]
                    },
                    {exec_custom = true; exec_main_is = "hello_world.ml"});
+               Executable
+                 ({
+                     cs_name = "test_xhr";
+                     cs_data = PropList.Data.create ();
+                     cs_plugin_data = []
+                  },
+                   {
+                      bs_build =
+                        [
+                           (OASISExpr.EBool true, false);
+                           (OASISExpr.EAnd
+                              (OASISExpr.EFlag "tests",
+                                OASISExpr.EAnd
+                                  (OASISExpr.EFlag "lwt",
+                                    OASISExpr.EFlag "js")),
+                             true)
+                        ];
+                      bs_install = [(OASISExpr.EBool true, false)];
+                      bs_path = "lib_test";
+                      bs_compiled_object = Byte;
+                      bs_build_depends =
+                        [
+                           InternalLibrary "cohttp";
+                           InternalLibrary "cohttp_lwt_xhr";
+                           FindlibPackage ("yojson", None);
+                           FindlibPackage ("lwt.syntax", None);
+                           FindlibPackage ("js_of_ocaml.syntax", None)
+                        ];
+                      bs_build_tools = [ExternalTool "ocamlbuild"];
+                      bs_c_sources = [];
+                      bs_data_files = [];
+                      bs_ccopt = [(OASISExpr.EBool true, [])];
+                      bs_cclib = [(OASISExpr.EBool true, [])];
+                      bs_dlllib = [(OASISExpr.EBool true, [])];
+                      bs_dllpath = [(OASISExpr.EBool true, [])];
+                      bs_byteopt = [(OASISExpr.EBool true, [])];
+                      bs_nativeopt = [(OASISExpr.EBool true, [])]
+                   },
+                   {exec_custom = true; exec_main_is = "test_xhr.ml"});
                Test
                  ({
                      cs_name = "test_accept";
@@ -8108,7 +8147,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.4";
-     oasis_digest = Some "\185K\249\030\\\148\203\017\169\139b*\173\015\192:";
+     oasis_digest = Some "m\228\168=)\144T\216\186\1292\128\015K\186\137";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -8116,6 +8155,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 8120 "setup.ml"
+# 8159 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

From e73ff3f4eba9cda5f183347ce4756c5e88924ad1 Mon Sep 17 00:00:00 2001
From: andrewray 
Date: Sun, 7 Sep 2014 18:01:23 +0100
Subject: [PATCH 4/4] Remove Yojson.  Display response.

---
 _oasis               |  2 +-
 _tags                |  4 +---
 lib_test/index.html  |  1 +
 lib_test/test_xhr.ml | 25 +++++++++++++++++++++----
 setup.ml             |  6 +++---
 5 files changed, 27 insertions(+), 11 deletions(-)

diff --git a/_oasis b/_oasis
index 3d09191dbc..7d66d5a0cf 100644
--- a/_oasis
+++ b/_oasis
@@ -252,7 +252,7 @@ Executable "test_xhr"
   Custom:             true
   CompiledObject:     byte
   Install:            false
-  BuildDepends:       cohttp, cohttp.js, yojson, lwt.syntax, js_of_ocaml.syntax
+  BuildDepends:       cohttp, cohttp.js, lwt.syntax, js_of_ocaml.syntax
 
 Test test_accept
   Run$:               flag(tests)
diff --git a/_tags b/_tags
index a8c51f1659..418654a13e 100644
--- a/_tags
+++ b/_tags
@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: a3c9129481ad50253d7b74ad3ede3dbd)
+# DO NOT EDIT (digest: 7fcc86205df6bf1109d091bd98c630d4)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -419,7 +419,6 @@
 "lib_test/test_xhr.byte": pkg_stringext
 "lib_test/test_xhr.byte": pkg_uri
 "lib_test/test_xhr.byte": pkg_uri.services
-"lib_test/test_xhr.byte": pkg_yojson
 "lib_test/test_xhr.byte": use_cohttp
 "lib_test/test_xhr.byte": use_cohttp_lwt
 "lib_test/test_xhr.byte": use_cohttp_lwt_xhr
@@ -435,7 +434,6 @@
 : pkg_stringext
 : pkg_uri
 : pkg_uri.services
-: pkg_yojson
 : use_cohttp
 : use_cohttp_lwt
 : use_cohttp_lwt_xhr
diff --git a/lib_test/index.html b/lib_test/index.html
index ae491a051e..b8968ca377 100644
--- a/lib_test/index.html
+++ b/lib_test/index.html
@@ -19,6 +19,7 @@ 
Cohttp_lwt_xhr client test

   
 
 
+

 

 
 
diff --git a/lib_test/test_xhr.ml b/lib_test/test_xhr.ml
index 55aeb9e4b9..dbe5628175 100644
--- a/lib_test/test_xhr.ml
+++ b/lib_test/test_xhr.ml
@@ -35,21 +35,38 @@ let get_input n =
     | _ -> failwith ("couldn't find text element" ^ n)
 let value n = Js.to_string (get_input n)##value
 
+(* JSON object used for pretty printing result *)
+type json_object
+class type json = object
+    method parse : Js.js_string Js.t -> json_object Js.t Js.meth
+    method stringify : json_object Js.t -> unit Js.opt -> int -> Js.js_string Js.t Js.meth
+end
+let json : json Js.t = Js.Unsafe.variable "JSON"
+let pretty str = json##stringify(json##parse(Js.string str), Js.null, 2)
+
 let main _ = 
+  let output_response = get_element "output-response" in
   let output_list_repos = get_element "output-list-repos" in
   let list_repos = get_element "list-repos" in
   
-  (* pretty print output *)
-  let pretty s = Yojson.Basic.(pretty_to_string (from_string s)) in
-  
   (* run the cohttp query to github *)
   let run_query _ = 
     Lwt.ignore_result (
       lwt resp, body = Cohttp_lwt_xhr.Client.get 
         Uri.(of_string ("https://api.github.com/users/" ^ value "username" ^ "/repos"))
       in
+      (* show the response data *)
+      let b = Buffer.create 1024 in
+      let add s = Buffer.add_string b s; Buffer.add_string b "\n" in
+      add Cohttp.(Code.(string_of_version resp.Response.version)); 
+      add Cohttp.(Code.(string_of_status resp.Response.status));
+      Cohttp.Header.iter (fun k v -> List.iter (fun v -> add (k ^ ": " ^ v)) v) 
+        resp.Cohttp.Response.headers;
+      output_response##innerHTML <- Js.string (Buffer.contents b);
+
+      (* show the body as pretty printed json *)
       lwt body = Cohttp_lwt_body.to_string body in
-      output_list_repos##innerHTML <- Js.string (pretty body);
+      output_list_repos##innerHTML <- pretty body;
       Lwt.return ());
     Js._false
   in
diff --git a/setup.ml b/setup.ml
index bf3ed3ca3c..fc8779ba30 100644
--- a/setup.ml
+++ b/setup.ml
@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 25db211c1ea72f9822bceafda37b6243) *)
+(* DO NOT EDIT (digest: a69d4bacae5bcd5d239a5b97c80baef7) *)
 (*
    Regenerated by OASIS v0.4.4
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -7983,7 +7983,6 @@ let setup_t =
                         [
                            InternalLibrary "cohttp";
                            InternalLibrary "cohttp_lwt_xhr";
-                           FindlibPackage ("yojson", None);
                            FindlibPackage ("lwt.syntax", None);
                            FindlibPackage ("js_of_ocaml.syntax", None)
                         ];
@@ -8147,7 +8146,8 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.4";
-     oasis_digest = Some "m\228\168=)\144T\216\186\1292\128\015K\186\137";
+     oasis_digest =
+       Some "i\205\197?\226\200\151\172\209\199\228l\135\239\192\222";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false