-
Notifications
You must be signed in to change notification settings - Fork 13
/
repository.ml
85 lines (73 loc) · 2.48 KB
/
repository.ml
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
open Core
type library_name = string
exception RegisteredAlready of library_name
module StringSet = Set.Make(String)
type t = {
cache: Store.store;
metadata: Metadata.store;
}
(* Basic operations *)
let list reg = Metadata.list reg.metadata
(* TODO get data from metadata *)
let directory reg name = Store.directory reg.cache name
let mem reg name = Metadata.mem reg.metadata name
(* TODO lock *)
let remove_multiple reg names =
Metadata.remove_multiple reg.metadata names;
Store.remove_multiple reg.cache names
let remove reg name =
remove_multiple reg [name]
let add_dir reg name dir =
let abs_dir = Filename_unix.realpath dir in
let uri = Uri.make ~scheme:"file" ~path:abs_dir () in
(* Store.add_dir reg.cache name dir; *)
Metadata.add reg.metadata name {
url = uri;
}
let update ~outf reg name =
match Metadata.find reg.metadata name with
| None -> failwith (Printf.sprintf "Library %s is not found" name)
| Some metadata -> begin match Uri.scheme metadata.url with
| Some "file" ->
let dir = Uri.path metadata.url in
let library = Library.read_dir ~outf dir in
Library.to_string library |> print_endline;
Store.remove reg.cache name;
Store.add_library ~outf reg.cache name library
| None ->
failwith (Printf.sprintf "BUG: URL scheme of library %s is unknown." name)
| Some s ->
failwith (Printf.sprintf "Unknown scheme %s." s)
end
(* TODO build only obsoleted libraries *)
let update_all ~outf reg =
let updated_libraries = list reg in
List.iter ~f:(update ~outf reg) updated_libraries;
Some updated_libraries
(* Advanced operations *)
(* TODO Implement lock *)
let add ~outf reg name uri =
if Metadata.mem reg.metadata name
then failwith (Printf.sprintf "%s is already registered." name)
else begin match Uri.scheme uri with
| None | Some "file" ->
let path = Uri.path uri in
add_dir reg name path
| Some s ->
failwith (Printf.sprintf "Unknown scheme %s." s)
end;
update_all ~outf reg
let gc reg =
let current_libraries = list reg |> StringSet.of_list in
let valid_libraries = Metadata.list reg.metadata |> StringSet.of_list in
let broken_libraries = Set.diff current_libraries valid_libraries in
Set.to_list broken_libraries
|> remove_multiple reg
let initialize libraries_dir metadata_file =
Store.initialize libraries_dir;
Metadata.initialize metadata_file
let read library_dir metadata_file = {
cache = Store.read library_dir;
metadata = metadata_file;
}
(* Tests *)