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
|
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 }
let to_bytes relation =
Wire.encode
([ ("type", "relation"); ("name", relation.name); ("kind", "stored") ]
@ 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);
}
end
module Multigroup = struct
type t = { name : string; relations : Relation.t list }
let relation_value relation =
let attrs =
relation.Relation.schema
|> List.map (fun (name, domain) -> name ^ ":" ^ domain)
|> String.concat ","
in
relation.name ^ "|" ^ attrs
let parse_relation value =
match Wire.split_once '|' value with
| None -> { Relation.name = value; schema = [] }
| Some (name, attrs) ->
let schema =
if attrs = "" then []
else attrs |> String.split_on_char ',' |> List.map Wire.attribute
in
{ Relation.name; schema }
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
|
