aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2024-12-08 13:30:48 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2024-12-08 13:30:48 -0300
commit75f1ff70f92b9b7e7c72580ce210b5c7622918bf (patch)
tree731c2538bcff35a47501a3a4350e622e3ed401dc /lib
parentf43943346e3c6d347b829bbbaeccae5f49327749 (diff)
downloadSakura-75f1ff70f92b9b7e7c72580ce210b5c7622918bf.tar.gz
Sakura-75f1ff70f92b9b7e7c72580ce210b5c7622918bf.zip
schema as a meta relation
Diffstat (limited to 'lib')
-rw-r--r--lib/disk.ml5
-rw-r--r--lib/relation.ml2
-rw-r--r--lib/schema.ml55
3 files changed, 60 insertions, 2 deletions
diff --git a/lib/disk.ml b/lib/disk.ml
index 0629a9e..ea863a5 100644
--- a/lib/disk.ml
+++ b/lib/disk.ml
@@ -200,6 +200,7 @@ module Command = struct
| OPEN
| WRITE
| READ
+ (* | CREATE_RELATION *)
let command_kind_encoding =
union [
case ~title:"open" (Tag 0)
@@ -214,6 +215,10 @@ module Command = struct
Data_encoding.empty
(function READ -> Some () | _ -> None)
(function () -> READ);
+ (* case ~title:"create_relation" (Tag 3) *)
+ (* Data_encoding.empty *)
+ (* (function CREATE_RELATION -> Some () | _ -> None) *)
+ (* (function () -> CREATE_RELATION); *)
]
type t =
diff --git a/lib/relation.ml b/lib/relation.ml
index 5c8d1e0..ed644dd 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -1,5 +1,3 @@
-
-
module Protocol = struct
open Protocol_conv_xml
open Sexplib0.Sexp_conv
diff --git a/lib/schema.ml b/lib/schema.ml
new file mode 100644
index 0000000..74ce720
--- /dev/null
+++ b/lib/schema.ml
@@ -0,0 +1,55 @@
+module Protocol = struct
+ open Data_encoding
+ type attribute =
+ { name: string;
+ attr_type: string }
+ type relation =
+ { name: string;
+ attributes: attribute list }
+ let attribute_encoding =
+ conv
+ (fun {name; attr_type} -> (name, attr_type))
+ (fun (name, attr_type) -> {name; attr_type})
+ Data_encoding.(tup2 string string)
+
+ let parse_attribute ~data =
+ let contract_encoding = Data_encoding.(tup2 string string) in
+ match Binary.of_bytes_opt contract_encoding data with
+ | Some (name, attr_type) -> Ok {name; attr_type}
+ | None -> Error "Failed to parse attribute"
+
+ let relation_encoding =
+ conv
+ (fun {name; attributes} -> (name, attributes))
+ (fun (name, attributes) -> {name; attributes})
+ Data_encoding.(tup2 string (list attribute_encoding))
+
+ let parse_relation ~data =
+ let contract_encoding = Data_encoding.(tup2 string (list attribute_encoding)) in
+ match Binary.of_bytes_opt contract_encoding data with
+ | Some (name, attributes) -> Ok {name; attributes}
+ | None -> Error "Failed to parse relation"
+end
+
+let test_schema_write_and_retrieve() =
+ let open Disk in
+ let open Data_encoding in
+ let stream: Executor.history = [{state = Executor._EMPTY_SHA_HASH_; files = Executor.StringMap.empty}] in
+ let locations: Executor.locations = Executor.StringMap.empty in
+ let open Extensions.Result in
+ let+ user_relation =
+ let relation: Protocol.relation = { name = "user"; attributes = [{name = "first-name"; attr_type = "string"}; {name = "last-name"; attr_type = "string"}] } in
+ Result.map_error (fun _ -> "Failed to serialize relation to binary format.")
+ @@ Binary.to_bytes Protocol.relation_encoding relation
+ in
+ let command_write: Command.t =
+ {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = Bytes.to_string user_relation; filename = "user"; references = []} in
+ let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write in
+ let command_read: Command.t =
+ {kind = Command.READ; timestamp = 10.0; hash = handle; content = ""; filename = "user"; references = []} in
+ let+ ((stream, locations), Command.Read content) = Command.commit_and_perform stream locations command_read in
+ let+ user_relation =
+ Result.map_error (fun _ -> "Failed to deserialize relation from binary format.")
+ @@ Binary.of_bytes Protocol.relation_encoding (Bytes.concat Bytes.empty content) in
+ Ok (stream, locations, user_relation)
+ [@@warning "-8"] (* Suppress pattern match incomplete warnings *)