cduce_netclient.ml 1020 Bytes
Newer Older
1 2 3
ifdef HAS_NETCLIENT4 then module Http_client = Nethttp_client


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

7 8 9 10 11 12
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 ->
13 14
	       let msg = Printf.sprintf "Bad HTTP answer: %s" s in
	       error msg
15
	   | Http_client.Http_error (n,s) ->
16 17
	       let msg = Printf.sprintf "HTTP error %i: %s" n s in
	       error msg
18
	   | Http_client.No_reply ->
19
	       error "No reply"
20
	   | Http_client.Http_protocol exn ->
21 22
	       let msg = Printexc.to_string exn in
	       error msg
23 24
	)
    | "file" ->
25 26 27
	error
	  "FIXME: write in url.ml the code so that netclient \
                    handle file:// protocol"
28 29
    | sc -> 
	let msg = 
30
	  Printf.sprintf "Netclient does not handle the %s protocol" sc
31
	in
32
	error msg
33 34

let () = 
35
  Cduce_config.register 
36 37
    "netclient" 
    "Load external URLs with netclient"
38
    (fun () -> Url.url_loader := load_url)