diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-06-23 23:53:26 -0300 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2026-06-23 23:53:26 -0300 |
| commit | c284fcd570342c31bc21169960579a20a763e32e (patch) | |
| tree | ce7485055116d794c55090ad0978e0b3f5ff4c2a /lib/storable.ml | |
| parent | b81586ee4a0543a5f9866586c78dccdd6328934a (diff) | |
| download | Sakura-c284fcd570342c31bc21169960579a20a763e32e.tar.gz Sakura-c284fcd570342c31bc21169960579a20a763e32e.zip | |
Format
Diffstat (limited to '')
| -rw-r--r-- | lib/storable.ml | 84 |
1 files changed, 36 insertions, 48 deletions
diff --git a/lib/storable.ml b/lib/storable.ml index 5527044..7c02732 100644 --- a/lib/storable.ml +++ b/lib/storable.ml @@ -4,28 +4,27 @@ module Wire = struct | None -> None | Some index -> Some - ( String.sub value 0 index, - String.sub value (index + 1) (String.length value - index - 1) ) + (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' + 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)) + |> 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) + 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 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 @@ -40,56 +39,51 @@ module Wire = struct let encode fields = fields |> List.map (fun (key, value) -> key ^ "=" ^ value) - |> String.concat "\n" |> fun value -> Bytes.of_string (value ^ "\n") + |> String.concat "\n" + |> fun value -> Bytes.of_string (value ^ "\n") end module Tuple = struct - type t = { relation : string; attributes : (string * string) list } + 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) + ( ["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); - } + { 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; - } + 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) + ( [ "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:""; - } + { 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 } + 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. @@ -107,31 +101,25 @@ module Multigroup = struct let parse_relation value = match Wire.split_once '|' value with - | None -> { Relation.name = value; schema = []; tree_pointer = "" } + | 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) + 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 } + {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) + ( ["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); - } + { name= Wire.required "name" fields; + relations= List.map parse_relation (Wire.values "relation" fields) } end |
