(**************************************************************************)
(*  The CDuce compiler                                                    *)
(*  Alain Frisch <Alain.Frisch@inria.fr> and the CDuce team               *)
(*  Copyright CNRS,INRIA, 2003,2004 (see LICENSE for details)             *)
(**************************************************************************)

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 "Netclient. Bad http answer: %s" s in
	       raise (Location.Generic msg)
	   | Http_client.Http_error (n,s) ->
	       let msg = Printf.sprintf "Netclient. Http error %i: %s" n s in
	       raise (Location.Generic msg)
	   | Http_client.No_reply ->
	       raise (Location.Generic "Netclient. No reply")
	   | Http_client.Http_protocol exn ->
	       let msg = Printf.sprintf "Netclient. %s" 
			   (Printexc.to_string exn) in
	       raise (Location.Generic msg)
	)
    | "file" ->
	raise (Location.Generic 
		 "FIXME: write in url.ml the code so that netclient \
                    handle file:// protocol")
    | sc -> 
	let msg = 
	  Printf.sprintf "Error: netclient does not handle the %s protocol" sc
	in
	raise (Location.Generic msg) 

let () = 
  Config.register 
    "netclient" 
    "Load external URLs with netclient"
    (fun () -> Url.url_loader := load_url)
