1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
(**************************************************************************)
(* The CDuce compiler *)
(* Alain Frisch <Alain.Frisch@inria.fr> and the CDuce team *)
(* Copyright CNRS,INRIA, 2003,2004,2005,2006,2007 (see LICENSE for details) *)
(**************************************************************************)
let start_with s p =
let l = String.length p in
let n = String.length s in
if (n >= l) && (String.sub s 0 l = p)
then Some (String.sub s l (n - l))
else None
let is_url s =
try
match Sys.os_type with
| "Cygwin" | "Win32" ->
let uscheme = Neturl.extract_url_scheme s in
if String.length uscheme == 1
then false
else true
| _ -> let _ = Neturl.extract_url_scheme s in true
with Neturl.Malformed_URL -> false
let no_load_url s =
let msg =
Printf.sprintf
"Error \"%s\": \nTo fetch external URLs, you need to compile CDuce with curl and/or netclient" s
in
raise (Cduce_loc.Generic msg)
let url_loader = ref no_load_url
type kind = File of string | Uri of string | String of string
let kind s =
match start_with s "string:" with
| None -> if is_url s then Uri s else File s
| Some s -> String s
let local s1 s2 =
match (kind s1, kind s2) with
| File _, File _ ->
let url1 = Neturl.file_url_of_local_path s1 in
let url2 =
Neturl.parse_url
~base_syntax:(Neturl.url_syntax_of_url url1)
s2 in
Neturl.local_path_of_file_url(
Neturl.ensure_absolute_url ~base:url1 url2
)
| _, (String _ | Uri _) | (String _, File _) ->
s2
| Uri _, File _ ->
let url1 = Neturl.parse_url s1 in
let url2 =
Neturl.parse_url
~base_syntax:(Neturl.url_syntax_of_url url1)
s2 in
Neturl.string_of_url (Neturl.ensure_absolute_url ~base:url1 url2)
let load_file fn =
try
let ic = open_in fn in
let len = in_channel_length ic in
let s = String.create len in
really_input ic s 0 len;
close_in ic;
s
with exn ->
Value.failwith' (Printf.sprintf "load_file: %s"
(Printexc.to_string exn))
let load_url s =
match start_with s "string:" with
| None -> if is_url s then !url_loader s else load_file s
| Some s -> s
|