trunk/parser/cduce_netclient.ml

let error msg =
  Value.failwith' (Printf.sprintf "Netclient error. %s" msg)

let load_url s =
  match  Neturl.extract_url_scheme s with
    | "http" -> 
        (try Http_client.Convenience.http_get s
         with 
           | Http_client.Bad_message s ->
               let msg = Printf.sprintf "Bad HTTP answer: %s" s in
               error msg
           | Http_client.Http_error (n,s) ->
               let msg = Printf.sprintf "HTTP error %i: %s" n s in
               error msg
           | Http_client.No_reply ->
               error "No reply"
           | Http_client.Http_protocol exn ->
               let msg = Printexc.to_string exn in
               error msg
        )
    | "file" ->
        error
          "FIXME: write in url.ml the code so that netclient \
                    handle file:// protocol"
    | sc -> 
        let msg = 
          Printf.sprintf "Netclient does not handle the %s protocol" sc
        in
        error msg

let () = 
  Cduce_config.register 
    "netclient" 
    "Load external URLs with netclient"
    (fun () -> Url.url_loader := load_url)
1	let error msg =
2	Value.failwith' (Printf.sprintf "Netclient error. %s" msg)
3
4	let load_url s =
5	match Neturl.extract_url_scheme s with
6	\| "http" ->
7	(try Http_client.Convenience.http_get s
8	with
9	\| Http_client.Bad_message s ->
10	let msg = Printf.sprintf "Bad HTTP answer: %s" s in
11	error msg
12	\| Http_client.Http_error (n,s) ->
13	let msg = Printf.sprintf "HTTP error %i: %s" n s in
14	error msg
15	\| Http_client.No_reply ->
16	error "No reply"
17	\| Http_client.Http_protocol exn ->
18	let msg = Printexc.to_string exn in
19	error msg
20	)
21	\| "file" ->
22	error
23	"FIXME: write in url.ml the code so that netclient \
24	handle file:// protocol"
25	\| sc ->
26	let msg =
27	Printf.sprintf "Netclient does not handle the %s protocol" sc
28	in
29	error msg
30
31	let () =
32	Cduce_config.register
33	"netclient"
34	"Load external URLs with netclient"
35	(fun () -> Url.url_loader := load_url)