examples/test_lwt.ml

   1 (** curl lwt example *)
   2
   3 open Printf
   4
   5 let (@@) f x = f x
   6 let (|>) x f = f x
   7
   8 let curl_setup_simple h =
   9   let open Curl in
  10   set_useragent h "Curl_lwt";
  11   set_nosignal h true;
  12   set_connecttimeout h 5;
  13   set_timeout h 10;
  14   set_followlocation h false;
  15   set_maxredirs h 1;
  16   set_encoding h CURL_ENCODING_ANY
  17
  18 let log_curl h code =
  19   let open Curl in
  20   let url = get_effectiveurl h in
  21   print_endline @@ sprintf "%3d %.2f %g URL: %s (%s)%s"
  22     (get_httpcode h)
  23     (get_totaltime h)
  24     (get_sizedownload h)
  25     (if get_httpcode h / 100 = 3 then sprintf "%s -> %s" url (get_redirecturl h) else url)
  26     (get_contenttype h)
  27     (match code with CURLE_OK -> "" | _ -> sprintf " %s (%d)" (strerror code) (errno code))
  28
  29 let download h =
  30   let b = Buffer.create 16 in
  31   Curl.set_writefunction h (fun s -> Buffer.add_string b s; String.length s);
  32   Lwt.bind (Curl_lwt.perform h) (fun code -> Lwt.return (code, Buffer.contents b))
  33
  34 let get url =
  35   let h = Curl.init () in
  36   Curl.set_url h url;
  37   curl_setup_simple h;
  38 (*   lwt (code,body) = download h in *)
  39   Lwt.bind (download h) @@ fun (code,_body) ->
  40   log_curl h code;
  41   (* do something with body *)
  42   Curl.cleanup h;
  43   Lwt.return ()
  44
  45 let run () =
  46   [
  47     "www.google.com";
  48     "ya.ru";
  49     "www.forth.org.ru";
  50     "caml.inria.fr";
  51     "www.mozart-oz.org";
  52     "forge.ocamlcore.org";
  53   ]
  54   |> List.map get
  55   |> Lwt.join
  56
  57 let () =
  58   Lwt_main.run @@ run ()