On a quest for agency in Bellairs
1(* TODO: put the real implementation here -- for now it's just an
2 in-memory database *)
3
4type file = { mutable content : string }
5type dir = { files : (string, file) Hashtbl.t }
6type entry = { name : string; file : file }
7
8let create { files } name =
9 let file = { content = "" } in
10 Hashtbl.add files name file;
11 file
12
13let root () = { files = Hashtbl.create 10 }
14let open_ dir name = Hashtbl.find dir.files name
15let delete dir name = Hashtbl.remove dir.files name
16
17let read ?(off = 0L) ?len file =
18 let content_len = String.length file.content in
19 let off = Int64.to_int off in
20 let len =
21 match len with None -> content_len | Some len -> Int64.to_int len
22 in
23 let max_len = content_len - off in
24 let len = if len >= max_len then max_len else len in
25 String.sub file.content off len
26
27let write ?(off = 0L) ?len file data =
28 let data_len = String.length data in
29 let off = Int64.to_int off in
30 let len = match len with None -> data_len | Some len -> Int64.to_int len in
31 let required_len = off + len in
32 let file_content =
33 if required_len > String.length file.content then (
34 let new_content = Bytes.make required_len '\000' in
35 String.blit file.content 0 new_content 0 (String.length file.content);
36 let new_content = Bytes.unsafe_to_string new_content in
37 file.content <- new_content;
38 new_content)
39 else file.content
40 in
41 String.blit data 0 (Bytes.unsafe_of_string file_content) off len
42
43let size file = Int64.of_int (String.length file.content)
44
45let list dir =
46 Hashtbl.fold (fun name file acc -> { name; file } :: acc) dir.files []
47
48(* this is done in another layer *)
49let share _ = assert false