blob: cfde4c1385f4b6fd5e49d05d8ba80543eeee0412 (
plain) (
blame)
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
|
(** Multigroup root: a lightweight versioned descriptor that maps relation names
to content-addressed relation values. The multigroup object owns the B+ tree
pointer and advances it when relations change. *)
class multigroup ~name:(init_name : Conventions.Name.t) =
let init_hash = Conventions.Hash.hash_text init_name in
object (self)
val name : Conventions.Name.t = init_name
val hash : Conventions.Hash.t = init_hash
val previous_version : Conventions.Hash.t option = None
val tree_pointer : Conventions.Hash.t option = None
val relations : Relation.relation BatMap.String.t = BatMap.String.empty
val timestamp : float = Unix.gettimeofday ()
method name = name
method hash = hash
method previous_version = previous_version
method tree_pointer = tree_pointer
method relations = relations
method timestamp = timestamp
method get_relation rel_name = BatMap.String.find_opt rel_name relations
method get_relation_names = BatMap.String.fold (fun n _ acc -> n :: acc) relations []
method has_relation rel_name = BatMap.String.mem rel_name relations
(* Derive the B+ tree root hash from sorted relation hashes. *)
method private compute_tree_pointer rels =
BatMap.String.fold
(fun _n (r : Relation.relation) acc -> acc ^ r#hash)
rels ""
|> Conventions.Hash.hash_text
method private compute_hash tp =
Conventions.Hash.hash_text (name ^ tp)
method private advance rels =
let tp = self#compute_tree_pointer rels in
{< hash = self#compute_hash tp;
previous_version = (if hash = "" then None else Some hash);
tree_pointer = Some tp;
relations = rels;
timestamp = Unix.gettimeofday () >}
method add_relation (rel : Relation.relation) =
let rels = BatMap.String.add rel#name rel relations in
self#advance rels
method remove_relation rel_name =
if not (BatMap.String.mem rel_name relations) then self
else self#advance (BatMap.String.remove rel_name relations)
method update_relation (rel : Relation.relation) =
if not (BatMap.String.mem rel#name relations) then self
else self#advance (BatMap.String.add rel#name rel relations)
method serialize () : Storable.Multigroup.t =
{
Storable.Multigroup.name = name;
relations = BatMap.String.bindings relations |> List.map snd |> List.map (fun r -> r#serialize ());
}
end
let deserialize (_bytes : bytes) : (multigroup, string) result =
try
let stored = Storable.Multigroup.of_bytes _bytes in
let db = new multigroup ~name:stored.name in
let db =
List.fold_left
(fun db rel ->
let membership_criteria =
Constraint.build_membership_criteria ~_name:rel.Storable.Relation.name
~schema:rel.schema
in
let relation =
new Relation.stored ~name:rel.name ~schema:rel.schema ~constraints:None
~cardinality:Conventions.Cardinality.ConstrainedFinite
~membership_criteria ~lineage:None ~provenance:None
in
db#add_relation relation)
db stored.relations
in
Ok db
with Invalid_argument message -> Error message
|
