Remove pa_lwt

_oasis

@@ -65,7 +65,7 @@ Library cohttp_lwt
   Path:          lwt
   Findlibname:   lwt-core
   FindlibParent: cohttp
-  BuildDepends:  lwt, uri, cohttp, lwt.syntax
+  BuildDepends:  lwt, uri, cohttp
   XMETARequires: lwt, uri, cohttp
   Modules:       Cohttp_lwt_body, Cohttp_lwt, String_io_lwt
 
@@ -85,7 +85,7 @@ Library cohttp_lwt_xhr
   Path:          js
   Findlibname:   js
   FindlibParent: cohttp
-  BuildDepends:  cohttp.lwt-core, js_of_ocaml, js_of_ocaml.syntax
+  BuildDepends:  cohttp.lwt-core, js_of_ocaml, js_of_ocaml.syntax, lwt.syntax
   XMETARequires: cohttp.lwt-core, js_of_ocaml
   Modules:       Cohttp_lwt_xhr
 

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 0ad4df17498f27d1dda960ea7d20a378)
+# DO NOT EDIT (digest: 5fa3841c8dc3c29fb17f88da786b068b)
 # 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
@@ -92,7 +92,6 @@ true: annot, bin_annot
 <lwt/*.ml{,i,y}>: pkg_fieldslib
 <lwt/*.ml{,i,y}>: pkg_fieldslib.syntax
 <lwt/*.ml{,i,y}>: pkg_lwt
-<lwt/*.ml{,i,y}>: pkg_lwt.syntax
 <lwt/*.ml{,i,y}>: pkg_lwt.unix
 <lwt/*.ml{,i,y}>: pkg_magic-mime
 <lwt/*.ml{,i,y}>: pkg_oUnit
@@ -113,7 +112,6 @@ true: annot, bin_annot
 <lib_test/test_parser.{native,byte}>: pkg_fieldslib
 <lib_test/test_parser.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_parser.{native,byte}>: pkg_lwt
-<lib_test/test_parser.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_parser.{native,byte}>: pkg_lwt.unix
 <lib_test/test_parser.{native,byte}>: pkg_magic-mime
 <lib_test/test_parser.{native,byte}>: pkg_oUnit
@@ -198,7 +196,6 @@ true: annot, bin_annot
 <lib_test/test_net_lwt.{native,byte}>: pkg_fieldslib
 <lib_test/test_net_lwt.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_net_lwt.{native,byte}>: pkg_lwt
-<lib_test/test_net_lwt.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_net_lwt.{native,byte}>: pkg_lwt.unix
 <lib_test/test_net_lwt.{native,byte}>: pkg_magic-mime
 <lib_test/test_net_lwt.{native,byte}>: pkg_oUnit
@@ -221,7 +218,6 @@ true: annot, bin_annot
 <lib_test/test_net_lwt_google.{native,byte}>: pkg_fieldslib
 <lib_test/test_net_lwt_google.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_net_lwt_google.{native,byte}>: pkg_lwt
-<lib_test/test_net_lwt_google.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_net_lwt_google.{native,byte}>: pkg_lwt.unix
 <lib_test/test_net_lwt_google.{native,byte}>: pkg_magic-mime
 <lib_test/test_net_lwt_google.{native,byte}>: pkg_re.emacs
@@ -242,7 +238,6 @@ true: annot, bin_annot
 <lib_test/test_net_lwt_google_custom_ctx.{native,byte}>: pkg_fieldslib
 <lib_test/test_net_lwt_google_custom_ctx.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_net_lwt_google_custom_ctx.{native,byte}>: pkg_lwt
-<lib_test/test_net_lwt_google_custom_ctx.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_net_lwt_google_custom_ctx.{native,byte}>: pkg_lwt.unix
 <lib_test/test_net_lwt_google_custom_ctx.{native,byte}>: pkg_magic-mime
 <lib_test/test_net_lwt_google_custom_ctx.{native,byte}>: pkg_re.emacs
@@ -263,7 +258,6 @@ true: annot, bin_annot
 <lib_test/test_net_lwt_lastminute.{native,byte}>: pkg_fieldslib
 <lib_test/test_net_lwt_lastminute.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_net_lwt_lastminute.{native,byte}>: pkg_lwt
-<lib_test/test_net_lwt_lastminute.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_net_lwt_lastminute.{native,byte}>: pkg_lwt.unix
 <lib_test/test_net_lwt_lastminute.{native,byte}>: pkg_magic-mime
 <lib_test/test_net_lwt_lastminute.{native,byte}>: pkg_re.emacs
@@ -284,7 +278,6 @@ true: annot, bin_annot
 <lib_test/test_net_lwt_server.{native,byte}>: pkg_fieldslib
 <lib_test/test_net_lwt_server.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_net_lwt_server.{native,byte}>: pkg_lwt
-<lib_test/test_net_lwt_server.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_net_lwt_server.{native,byte}>: pkg_lwt.unix
 <lib_test/test_net_lwt_server.{native,byte}>: pkg_magic-mime
 <lib_test/test_net_lwt_server.{native,byte}>: pkg_re.emacs
@@ -305,7 +298,6 @@ true: annot, bin_annot
 <lib_test/test_net_lwt_multi_get.{native,byte}>: pkg_fieldslib
 <lib_test/test_net_lwt_multi_get.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_net_lwt_multi_get.{native,byte}>: pkg_lwt
-<lib_test/test_net_lwt_multi_get.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_net_lwt_multi_get.{native,byte}>: pkg_lwt.unix
 <lib_test/test_net_lwt_multi_get.{native,byte}>: pkg_magic-mime
 <lib_test/test_net_lwt_multi_get.{native,byte}>: pkg_re.emacs
@@ -326,7 +318,6 @@ true: annot, bin_annot
 <lib_test/test_net_lwt_client_and_server.{native,byte}>: pkg_fieldslib
 <lib_test/test_net_lwt_client_and_server.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_net_lwt_client_and_server.{native,byte}>: pkg_lwt
-<lib_test/test_net_lwt_client_and_server.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_net_lwt_client_and_server.{native,byte}>: pkg_lwt.unix
 <lib_test/test_net_lwt_client_and_server.{native,byte}>: pkg_magic-mime
 <lib_test/test_net_lwt_client_and_server.{native,byte}>: pkg_re.emacs
@@ -468,7 +459,6 @@ true: annot, bin_annot
 <bin/cohttp_server_lwt.{native,byte}>: pkg_fieldslib
 <bin/cohttp_server_lwt.{native,byte}>: pkg_fieldslib.syntax
 <bin/cohttp_server_lwt.{native,byte}>: pkg_lwt
-<bin/cohttp_server_lwt.{native,byte}>: pkg_lwt.syntax
 <bin/cohttp_server_lwt.{native,byte}>: pkg_lwt.unix
 <bin/cohttp_server_lwt.{native,byte}>: pkg_magic-mime
 <bin/cohttp_server_lwt.{native,byte}>: pkg_re.emacs
@@ -490,7 +480,6 @@ true: annot, bin_annot
 <bin/cohttp_proxy_lwt.{native,byte}>: pkg_fieldslib
 <bin/cohttp_proxy_lwt.{native,byte}>: pkg_fieldslib.syntax
 <bin/cohttp_proxy_lwt.{native,byte}>: pkg_lwt
-<bin/cohttp_proxy_lwt.{native,byte}>: pkg_lwt.syntax
 <bin/cohttp_proxy_lwt.{native,byte}>: pkg_lwt.unix
 <bin/cohttp_proxy_lwt.{native,byte}>: pkg_magic-mime
 <bin/cohttp_proxy_lwt.{native,byte}>: pkg_re.emacs
@@ -512,7 +501,6 @@ true: annot, bin_annot
 <bin/cohttp_curl_lwt.{native,byte}>: pkg_fieldslib
 <bin/cohttp_curl_lwt.{native,byte}>: pkg_fieldslib.syntax
 <bin/cohttp_curl_lwt.{native,byte}>: pkg_lwt
-<bin/cohttp_curl_lwt.{native,byte}>: pkg_lwt.syntax
 <bin/cohttp_curl_lwt.{native,byte}>: pkg_lwt.unix
 <bin/cohttp_curl_lwt.{native,byte}>: pkg_magic-mime
 <bin/cohttp_curl_lwt.{native,byte}>: pkg_re.emacs
@@ -532,7 +520,6 @@ true: annot, bin_annot
 <bin/*.ml{,i,y}>: pkg_fieldslib
 <bin/*.ml{,i,y}>: pkg_fieldslib.syntax
 <bin/*.ml{,i,y}>: pkg_lwt
-<bin/*.ml{,i,y}>: pkg_lwt.syntax
 <bin/*.ml{,i,y}>: pkg_lwt.unix
 <bin/*.ml{,i,y}>: pkg_magic-mime
 <bin/*.ml{,i,y}>: pkg_re.emacs
@@ -606,6 +593,7 @@ true: annot, bin_annot
 "lib_test/test_xhr.byte": use_cohttp_lwt_xhr
 <lib_test/*.ml{,i,y}>: pkg_js_of_ocaml
 <lib_test/*.ml{,i,y}>: pkg_js_of_ocaml.syntax
+<lib_test/*.ml{,i,y}>: pkg_lwt.syntax
 <lib_test/*.ml{,i,y}>: use_cohttp_lwt_xhr
 "lib_test/test_xhr.byte": custom
 # Executable async-receive-post
@@ -649,7 +637,6 @@ true: annot, bin_annot
 <lib_test/test_sanity.{native,byte}>: pkg_fieldslib
 <lib_test/test_sanity.{native,byte}>: pkg_fieldslib.syntax
 <lib_test/test_sanity.{native,byte}>: pkg_lwt
-<lib_test/test_sanity.{native,byte}>: pkg_lwt.syntax
 <lib_test/test_sanity.{native,byte}>: pkg_lwt.unix
 <lib_test/test_sanity.{native,byte}>: pkg_magic-mime
 <lib_test/test_sanity.{native,byte}>: pkg_oUnit
@@ -670,7 +657,6 @@ true: annot, bin_annot
 <lib_test/*.ml{,i,y}>: pkg_fieldslib
 <lib_test/*.ml{,i,y}>: pkg_fieldslib.syntax
 <lib_test/*.ml{,i,y}>: pkg_lwt
-<lib_test/*.ml{,i,y}>: pkg_lwt.syntax
 <lib_test/*.ml{,i,y}>: pkg_lwt.unix
 <lib_test/*.ml{,i,y}>: pkg_magic-mime
 <lib_test/*.ml{,i,y}>: pkg_oUnit

lwt/cohttp_lwt.ml

@@ -167,7 +167,7 @@ module Make_client
 
   let call ?(ctx=default_ctx) ?headers ?(body=`Empty) ?chunked meth uri =
     let headers = match headers with None -> Header.init () | Some h -> h in
-    lwt (conn,ic,oc) = Net.connect_uri ~ctx uri in
+    Net.connect_uri ~ctx uri >>= fun (conn, ic, oc) ->
     let closefn () = Net.close ic oc in
     let chunked = match chunked with None -> is_meth_chunked meth | Some v -> v in
     let sent = match chunked with
@@ -178,7 +178,7 @@ module Make_client
       | false ->
         (* If chunked is not allowed, then obtain the body length and
            insert header *)
-        lwt (body_length, buf) = Cohttp_lwt_body.length body in
+        Cohttp_lwt_body.length body >>= fun (body_length, buf) ->
         let req =
           Request.make_for_client ~headers ~chunked ~body_length meth uri
         in
@@ -208,14 +208,14 @@ module Make_client
     post ?ctx ~chunked:false ~headers ~body uri
 
   let callv ?(ctx=default_ctx) uri reqs =
-    lwt (conn, ic, oc) = Net.connect_uri ~ctx uri in
+    Net.connect_uri ~ctx uri >>= fun (conn, ic, oc) ->
     (* Serialise the requests out to the wire *)
-    lwt meths = Lwt_stream.fold_s (fun (req,body) meths ->
+    Lwt_stream.fold_s (fun (req,body) meths ->
       Request.write (fun writer ->
         Cohttp_lwt_body.write_body (Request.write_body writer) body
       ) req oc >>= fun () ->
       return ((Request.meth req)::meths)
-    ) reqs [] in
+    ) reqs [] >>= fun meths ->
     (* Read the responses. For each response, ensure that the previous
        response has consumed the body before continuing to the next
        response because HTTP/1.1-pipelining cannot be interleaved. *)
@@ -224,7 +224,7 @@ module Make_client
     let last_body = ref None in
     let resps = Lwt_stream.from (fun () ->
       let closefn () = Lwt_mutex.unlock read_m in
-      match_lwt Lwt_stream.get meth_stream with
+      Lwt_stream.get meth_stream >>= function
       | None -> return_none
       | Some meth ->
         begin match !last_body with None -> return_unit | Some body ->
@@ -400,21 +400,22 @@ module Make_server(IO:IO)
       (* Map the requests onto a response stream to serialise out *)
       let res_stream =
         Lwt_stream.map_s (fun (req, body) ->
-          try_lwt
-            spec.callback (io_id,conn_id) req body
-          with exn ->
-            respond_error ~body:(Printexc.to_string exn) ()
-          finally Cohttp_lwt_body.drain_body body
+          Lwt.finalize
+            (fun () ->
+               Lwt.catch
+                 (fun () -> spec.callback (io_id, conn_id) req body)
+                 (fun exn -> respond_error ~body:(Printexc.to_string exn) ()))
+            (fun () -> Cohttp_lwt_body.drain_body body)
         ) req_stream in
       (* Clean up resources when the response stream terminates and call
        * the user callback *)
       Lwt_stream.on_terminate res_stream conn_closed;
       (* Transmit the responses *)
-      for_lwt (res,body) in res_stream do
+      res_stream |> Lwt_stream.iter_s (fun (res,body) ->
         let flush = Response.flush res in
         Response.write ~flush (fun writer ->
           Cohttp_lwt_body.write_body (Response.write_body writer) body
         ) res oc
-      done
+      )
     in daemon_callback
 end

lwt/cohttp_lwt_body.ml

@@ -31,16 +31,14 @@ let create_stream fn arg =
   let fin = ref false in
   Lwt_stream.from (fun () ->
     match !fin with
-    |true -> return_none
-    |false -> begin
-        match_lwt fn arg with
-        |Transfer.Done ->
-          return_none
-        |Transfer.Final_chunk c ->
+    | true -> return_none
+    | false -> begin
+        fn arg >>= function
+        | Transfer.Done -> return_none
+        | Transfer.Final_chunk c ->
           fin := true;
           return (Some c);
-        |Transfer.Chunk c ->
-          return (Some c)
+        | Transfer.Chunk c -> return (Some c)
       end
   )
 
@@ -92,7 +90,7 @@ let length (body:t) : (int64 * t) Lwt.t =
   match body with
   |#Body.t as body -> return (Body.length body, body)
   |`Stream s ->
-    lwt buf = to_string body in
+    to_string body >>= fun buf ->
     let len = Int64.of_int (String.length buf) in
     return (len, `String buf)
 

lwt/cohttp_lwt_unix.ml

@@ -53,24 +53,24 @@ module Server = struct
 
   exception Isnt_a_file
   let respond_file ?headers ~fname () =
-    try_lwt
+    Lwt.catch (fun () ->
       (* Check this isnt a directory first *)
       (fname |> Lwt_unix.stat >>= fun s ->
        if Unix.(s.st_kind <> S_REG)
        then fail Isnt_a_file
        else return_unit) >>= fun () ->
       let buffer_size = 16384 in
-      lwt ic = Lwt_io.open_file ~buffer_size ~mode:Lwt_io.input fname in
-      lwt len = Lwt_io.length ic in
+      Lwt_io.open_file ~buffer_size ~mode:Lwt_io.input fname >>= fun ic ->
+      Lwt_io.length ic >>= fun len ->
       let encoding = Cohttp.Transfer.Fixed len in
       let stream = Lwt_stream.from (fun () ->
-        try_lwt
+        Lwt.catch (fun () ->
           Lwt_io.read ~count:buffer_size ic >|= function
           | "" -> None
-          | buf -> Some buf
-        with exn ->
-          Lwt_log.ign_debug ~exn ("Error resolving file " ^ fname);
-          return_none
+          | buf -> Some buf)
+          (fun exn ->
+             Lwt_log.ign_debug ~exn ("Error resolving file " ^ fname);
+             return_none)
       ) in
       Lwt_stream.on_terminate stream (fun () ->
         ignore_result (Lwt_io.close ic));
@@ -79,12 +79,12 @@ module Server = struct
       let headers = Cohttp.Header.add_opt_unless_exists headers "content-type" mime_type in
       let res = Cohttp.Response.make ~status:`OK ~encoding ~headers () in
       return (res, body)
-    with
-    | Unix.Unix_error(Unix.ENOENT,_,_) | Isnt_a_file ->
-      respond_not_found ()
-    | exn ->
-      let body = Printexc.to_string exn in
-      respond_error ~status:`Internal_server_error ~body ()
+    ) (function
+      | Unix.Unix_error(Unix.ENOENT,_,_) | Isnt_a_file ->
+        respond_not_found ()
+      | exn ->
+        let body = Printexc.to_string exn in
+        respond_error ~status:`Internal_server_error ~body ())
 
   let create ?timeout ?stop ?(ctx=Cohttp_lwt_unix_net.default_ctx) ?(mode=`TCP (`Port 8080)) spec =
     Conduit_lwt_unix.serve ?timeout ?stop ~ctx:ctx.Cohttp_lwt_unix_net.ctx ~mode

lwt/cohttp_lwt_unix_io.ml

@@ -30,36 +30,42 @@ let iter fn x = Lwt_list.iter_s fn x
 
 let read_line ic =
   if !CD.debug_active then
-    (match_lwt Lwt_io.read_line_opt ic with
-     | None -> CD.debug_print "<<< EOF\n"; Lwt.return_none
-     | Some l as x -> CD.debug_print "<<< %s\n" l; Lwt.return x)
+    Lwt_io.read_line_opt ic >>= function
+    | None -> CD.debug_print "<<< EOF\n"; Lwt.return_none
+    | Some l as x -> CD.debug_print "<<< %s\n" l; Lwt.return x
   else
     Lwt_io.read_line_opt ic
 
 let read ic count =
- let count = min count Sys.max_string_length in
- if !CD.debug_active then
-   (lwt buf =
-       try_lwt Lwt_io.read ~count ic
-       with End_of_file -> return "" in
-     CD.debug_print "<<<[%d] %s" count buf;
-     return buf)
- else
-   (try_lwt Lwt_io.read ~count ic
-     with End_of_file -> return "")
+  let try_read () =
+    Lwt.catch (fun () -> Lwt_io.read ~count ic)
+      (function
+        | End_of_file -> return ""
+        | x -> Lwt.fail x) in
+  let count = min count Sys.max_string_length in
+  if !CD.debug_active then
+    try_read ()
+    >>= fun buf ->
+    CD.debug_print "<<<[%d] %s" count buf;
+    return buf
+  else
+    try_read ()
 
 let read_exactly ic buf off len =
+  let try_read () =
+    Lwt.try_bind (fun () -> Lwt_io.read_into_exactly ic buf off len)
+      (fun () -> Lwt.return_true)
+      (function
+        | End_of_file -> Lwt.return_false
+        | x -> Lwt.fail x) in
   if !CD.debug_active then
-   (lwt rd =
-        try_lwt Lwt_io.read_into_exactly ic buf off len >>= fun () ->  return true
-        with End_of_file -> return false in
-      (match rd with
-      |true -> CD.debug_print "<<< %S" (String.sub buf off len)
-      |false -> CD.debug_print "<<< <EOF>\n");
-      return rd)
+    try_read () >>= fun rd ->
+    (match rd with
+    | true -> CD.debug_print "<<< %S" (String.sub buf off len)
+    | false -> CD.debug_print "<<< <EOF>\n");
+    return rd
   else
-    (try_lwt Lwt_io.read_into_exactly ic buf off len >>= fun () ->  return true
-      with End_of_file -> return false)
+    try_read ()
 
 let read_exactly ic len =
   let buf = Bytes.create len in

lwt/cohttp_lwt_unix_net.ml

@@ -43,15 +43,10 @@ let connect_uri ~ctx uri =
   >>= fun client ->
   Conduit_lwt_unix.connect ~ctx:ctx.ctx client
 
-let close_in ic =
-  ignore_result (try_lwt Lwt_io.close ic with _ -> return_unit)
+let close c = Lwt.catch (fun () -> Lwt_io.close c) (fun _ -> return_unit)
 
-let close_out oc =
-  ignore_result (try_lwt Lwt_io.close oc with _ -> return_unit)
+let close_in ic = ignore_result (close ic)
 
-let close' ic oc =
-  try_lwt Lwt_io.close oc with _ -> return_unit >>= fun () ->
-  try_lwt Lwt_io.close ic with _ -> return_unit
+let close_out oc = ignore_result (close oc)
 
-let close ic oc =
-  ignore_result (close' ic oc)
+let close ic oc = ignore_result (close ic >>= fun () -> close oc)