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
|
module Wire = struct
let split_once ch value =
match String.index_opt value ch with
| None -> None
| Some index ->
Some
( String.sub value 0 index,
String.sub value (index + 1) (String.length value - index - 1) )
let lines bytes =
bytes |> Bytes.to_string |> String.split_on_char '\n'
|> List.filter (fun line -> String.trim line <> "")
let fields bytes =
lines bytes
|> List.filter_map (fun line -> split_once '=' line)
|> List.map (fun (key, value) -> (String.trim key, String.trim value))
let require_type expected fields =
match List.assoc_opt "type" fields with
| Some actual when actual = expected -> ()
| Some actual ->
invalid_arg
(Printf.sprintf "expected storable type %S, got %S" expected actual)
| None -> invalid_arg "missing storable type"
let values key fields =
List.filter_map (fun (k, v) -> if k = key then Some v else None) fields
let required key fields =
match List.assoc_opt key fields with
| Some value -> value
| None -> invalid_arg ("missing storable field: " ^ key)
let attribute value =
match split_once ':' value with
| Some pair -> pair
| None -> invalid_arg ("invalid attribute field: " ^ value)
let encode fields =
fields
|> List.map (fun (key, value) -> key ^ "=" ^ value)
|> String.concat "\n" |> fun value -> Bytes.of_string (value ^ "\n")
end
module Tuple = struct
type t = { relation : string; attributes : (string * string) list }
let to_bytes tuple =
Wire.encode
([ ("type", "tuple"); ("relation", tuple.relation) ]
@ List.map
(fun (name, value) -> ("attribute", name ^ ":" ^ value))
tuple.attributes)
let of_bytes bytes =
let fields = Wire.fields bytes in
Wire.require_type "tuple" fields;
{
relation = Wire.required "relation" fields;
attributes = List.map Wire.attribute (Wire.values "attribute" fields);
}
end
module Relation = struct
type t = {
name : string;
schema : (string * string) list;
(** Hex Merkle root of the relation's tuple set. Empty string = empty relation. *)
tree_pointer : string;
}
let to_bytes relation =
Wire.encode
([ ("type", "relation"); ("name", relation.name); ("kind", "stored");
("tree_pointer", relation.tree_pointer) ]
@ List.map
(fun (name, domain) -> ("attribute", name ^ ":" ^ domain))
relation.schema)
let of_bytes bytes =
let fields = Wire.fields bytes in
Wire.require_type "relation" fields;
{
name = Wire.required "name" fields;
schema = List.map Wire.attribute (Wire.values "attribute" fields);
tree_pointer = Option.value (List.assoc_opt "tree_pointer" fields) ~default:"";
}
end
module Multigroup = struct
type t = { name : string; relations : Relation.t list }
(* Wire format: "name|attr1:dom1,attr2:dom2|<merkle_root>"
The third segment is the Merkle root hex; empty string = empty relation.
A fourth segment for constraints is reserved but not yet implemented.
TODO: add constraints serialisation once a canonical sexp representation
is agreed upon (two syntactically distinct bodies may be semantically
equivalent — the round-trip must account for that). *)
let relation_value relation =
let attrs =
relation.Relation.schema
|> List.map (fun (name, domain) -> name ^ ":" ^ domain)
|> String.concat ","
in
relation.name ^ "|" ^ attrs ^ "|" ^ relation.tree_pointer
let parse_relation value =
match Wire.split_once '|' value with
| None -> { Relation.name = value; schema = []; tree_pointer = "" }
| Some (name, rest) ->
let attrs_str, tree_pointer =
match Wire.split_once '|' rest with
| None -> (rest, "")
| Some (a, tp) -> (a, tp)
in
let schema =
if attrs_str = "" then []
else attrs_str |> String.split_on_char ',' |> List.map Wire.attribute
in
{ Relation.name; schema; tree_pointer }
let to_bytes multigroup =
Wire.encode
([ ("type", "multigroup"); ("name", multigroup.name) ]
@ List.map
(fun relation -> ("relation", relation_value relation))
multigroup.relations)
let of_bytes bytes =
let fields = Wire.fields bytes in
Wire.require_type "multigroup" fields;
{
name = Wire.required "name" fields;
relations = List.map parse_relation (Wire.values "relation" fields);
}
end
|
