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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
(** *)
open Cohttp
type meta =
{ iri : Iri.t ;
acl : Iri.t option ;
meta: Iri.t option ;
user: string option ;
websocket: Iri.t option ;
editable : Code.meth list ;
exists: bool ;
info: Response.t * Cohttp_lwt.Body.t ;
}
let meta ?acl ?meta ?user ?websocket ?(editable=[]) ?(exists=true) resp body iri =
{ iri ; acl ; meta ; user ; websocket ; editable ; exists ; info = (resp, body) }
let string_of_meta m =
let b = Buffer.create 256 in
let p = Printf.bprintf b in
p "meta.iri=%s\n" (Iri.to_string m.iri) ;
Option.iter (p "meta.acl=%s\n") (Option.map Iri.to_string m.acl);
Option.iter (p "meta.meta=%s\n") (Option.map Iri.to_string m.meta);
Option.iter (p "meta.user=%s\n") m.user;
Option.iter (p "meta.websocket=%s\n") (Option.map Iri.to_string m.websocket);
Buffer.contents b
type rdf_resource =
{ meta : meta ;
graph: Rdf.Graph.graph ;
ct: Ct.t ;
contents: string ;
}
type non_rdf_resource =
{ meta : meta ;
ct: Ct.t ;
contents: string ;
}
type resource =
| Container of rdf_resource
| Rdf of rdf_resource
| Non_rdf of non_rdf_resource
let container_children g =
let sub = Rdf.Term.Iri (g.Rdf.Graph.name()) in
let pred = Rdf.Ldp.contains in
Rdf.Graph.iri_objects_of ~sub ~pred g
type error = ..
exception Error of error
let error e = raise (Error e)
let fail e = Lwt.fail (Error e)
let ref_string_of_error = ref (function _ -> "Unknown error")
let string_of_error e = !ref_string_of_error e
let register_string_of_error f =
let g = !ref_string_of_error in
ref_string_of_error := f g
let () = Printexc.register_printer
(function Error e -> Some (string_of_error e) | _ -> None)
let content_type_of_string ?(fail=true) s =
match Ct.of_string s with
| Ok ct -> ct
| Error e ->
if fail then
let msg = Ct.string_of_error e in
failwith msg
else
Ct.default
type error +=
| Invalid_method of string
| Missing_pred of Iri.t * Iri.t
| Missing_pred_iri of Iri.t * Iri.t
| Request_error of Iri.t * string
| Parse_error of Iri.t * exn
| Unsupported_format of Iri.t * Ct.mime
| Other of exn
let () = register_string_of_error
(fun fallback -> function
| Invalid_method str -> Printf.sprintf "Invalid method %S" str
| Missing_pred (sub, pred) ->
Printf.sprintf "%s has no relation with predicate %s"
(Iri.to_string sub) (Iri.to_string pred)
| Missing_pred_iri (sub, pred) ->
Printf.sprintf "%s has no relation to an IRI with predicate %s"
(Iri.to_string sub) (Iri.to_string pred)
| Request_error (iri, msg) ->
Printf.sprintf "%s: %s"
(Iri.to_string iri) msg
| Parse_error (iri, exn) ->
Printf.sprintf "%s: %s"
(Iri.to_string iri) (Printexc.to_string exn)
| Unsupported_format (iri, mime) ->
Printf.sprintf "%s: unsupported format %s"
(Iri.to_string iri) (Ct.mime_to_string mime)
| Other e -> Printexc.to_string e
| e -> fallback e
)
let split_string ?(keep_empty=false) s chars =
let len = String.length s in
let rec iter acc pos =
if pos >= len then
match acc with
"" -> if keep_empty then [""] else []
| _ -> [acc]
else
if List.mem s.[pos] chars then
match acc with
"" ->
if keep_empty then
"" :: iter "" (pos + 1)
else
iter "" (pos + 1)
| _ -> acc :: (iter "" (pos + 1))
else
iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1)
in
iter "" 0
let no_blanks s =
let len = String.length s in
let buf = Buffer.create len in
for i = 0 to len - 1 do
match s.[i] with
' ' | '\n' | '\t' | '\r' -> ()
| c -> Buffer.add_char buf c
done;
Buffer.contents buf
let methods_of_string =
let f acc m =
try (Code.method_of_string m) :: acc
with _ -> acc
in
fun str ->
List.fold_left f [] (split_string str [',';' ';'\t'])