aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2025-01-19 22:09:13 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2025-01-19 22:09:13 -0300
commit355690f76f3ca895ade25d281beb1eea27e1f53e (patch)
tree7d89760b95b79c5e45c4be94652dd2b65a1e6d89
parent919b7f1a81982533ff4ab33730c68313690c2b77 (diff)
downloadSakura-355690f76f3ca895ade25d281beb1eea27e1f53e.tar.gz
Sakura-355690f76f3ca895ade25d281beb1eea27e1f53e.zip
add typing and schema
-rw-r--r--lib/disk.ml17
-rw-r--r--lib/protocol.ml15
-rw-r--r--lib/relation.ml58
-rw-r--r--lib/server.ml4
-rw-r--r--test/test_relational_engine.ml2
5 files changed, 34 insertions, 62 deletions
diff --git a/lib/disk.ml b/lib/disk.ml
index d97a60c..b9f8155 100644
--- a/lib/disk.ml
+++ b/lib/disk.ml
@@ -92,12 +92,21 @@ module Executor = struct
type history = t list [@@deriving show]
end
+ type relational_type =
+ | Text
+ | Integer32
+ | Integer64
+ | Boolean
+ | DiscriminatedUnion of (string * relational_type option) list * string (* [("MemberA", None); ("MemberB", Some Integer32)], "NameOfDU" *)
+
+ type schema = (string * relational_type) list StringMap.t
type references = string list IntMap.t StringMap.t
type commit = {
state : string;
files : Hashes.history StringMap.t;
references : references;
+ schema : schema
}
type history = commit list
@@ -127,7 +136,7 @@ module Executor = struct
in
Interop.Merkle.merkle_generate_root all_hashes
- let write ({ files; references; _ } as commit : commit)
+ let write ({ files; references; schema; _ } as commit : commit)
(locations : locations) ~filename ?hash_to_replace (content : Bytes.t) =
let files = init_file files filename in
let computed_hash : string = Interop.Sha256.compute_hash content in
@@ -162,7 +171,7 @@ module Executor = struct
locations
in
let commit =
- { state = compose_new_state files; files; references }
+ { state = compose_new_state files; files; references; schema }
in
Ok ((commit, locations), Some computed_hash)
| Some hash_to_replace ->
@@ -195,7 +204,7 @@ module Executor = struct
locations
in
let commit =
- { state = compose_new_state files; files; references }
+ { state = compose_new_state files; files; references; schema }
in
Ok ((commit, locations), Some computed_hash))
| Some _ -> (
@@ -227,7 +236,7 @@ module Executor = struct
in *)
let files = StringMap.update filename update_fun files in
let commit =
- { state = compose_new_state files; files; references }
+ { state = compose_new_state files; files; references; schema }
in
(* let locations = StringMap.update computed_hash location_update_fun locations in *)
Ok ((commit, locations), Some computed_hash)
diff --git a/lib/protocol.ml b/lib/protocol.ml
new file mode 100644
index 0000000..9dea3ce
--- /dev/null
+++ b/lib/protocol.ml
@@ -0,0 +1,15 @@
+open Protocol_conv_xml
+open Sexplib0.Sexp_conv
+
+type tuple = string list
+[@@deriving sexp, protocol ~driver:(module Xml_light)]
+
+type relation = {
+ attribute_name : string;
+ attribute_type : string;
+ tuples : tuple;
+}
+[@@deriving sexp, protocol ~driver:(module Xml_light)]
+
+type facts = relation list
+[@@deriving sexp, protocol ~driver:(module Xml_light)] \ No newline at end of file
diff --git a/lib/relation.ml b/lib/relation.ml
index d27f2e2..c01c761 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -1,66 +1,12 @@
-module Protocol = struct
- open Protocol_conv_xml
- open Sexplib0.Sexp_conv
-
- type tuple = string list
- [@@deriving sexp, protocol ~driver:(module Xml_light)]
-
- type relation = {
- attribute_name : string;
- attribute_type : string;
- tuples : tuple;
- }
- [@@deriving sexp, protocol ~driver:(module Xml_light)]
-
- type facts = relation list
- [@@deriving sexp, protocol ~driver:(module Xml_light)]
-end
-
-(*
-let test_write_and_retrieve() =
- let open Disk 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 command_write1: Command.t =
- {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Daisy"; filename = "user/first-name"} in
- let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write1 in
- let command_write2: Command.t =
- {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Blossom"; filename = "user/last-name"} in
- let command_write3: Command.t =
- {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Minnie"; filename = "user/first-name"} in
- let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write2 in
- let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write3 in
- let command_write4: Command.t =
- {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Mouse"; filename = "user/last-name"} in
- let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write4 in
- let command_write5: Command.t =
- {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Billie"; filename = "user/first-name"} in
- let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write5 in
- let command_write6: Command.t =
- {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Beans"; filename = "user/last-name"} in
- let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write6 in
- let command_read1: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user/first-name"} in
- let+ (_, Command.Read first_name) = Command.commit_and_perform (List.tl stream) locations command_read1 in
- let command_read2: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user/last-name"} in
- let+ (_, Command.Read last_name) = Command.commit_and_perform (List.tl stream) locations command_read2 in
- (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string first_name); *)
- (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string last_name); *)
- let relation_result: Protocol.relation list =
- [{attribute_name = "user/first-name"; attribute_type = "string"; tuples = List.map Bytes.to_string first_name};
- {attribute_name = "user/last-name"; attribute_type = "string"; tuples = List.map Bytes.to_string last_name}] in
- Ok (Xml.to_string (Protocol.facts_to_xml_light relation_result))
- (* (Sexp.to_string (Protocol.sexp_of_t )) *)
- [@@warning "-8-27"] (* Suppress pattern match incomplete warnings *)
-*)
-
let write_and_retrieve () =
let open Disk in
+ let schema = Executor.StringMap.empty |> Executor.StringMap.add "user" [("first_name", Executor.Text); ("last_name", Executor.Text)] in
let commit : Executor.commit =
{
state = Executor._EMPTY_SHA_HASH_;
files = Executor.StringMap.empty;
references = Executor.StringMap.empty;
+ schema
}
in
let locations : Executor.locations = Executor.StringMap.empty in
diff --git a/lib/server.ml b/lib/server.ml
index 3fab513..46ef85d 100644
--- a/lib/server.ml
+++ b/lib/server.ml
@@ -32,7 +32,7 @@ let client_read sock maxlen =
(* let tuples = Planner.Join.execute first_names last_names locations in *)
let fname, lname = List.split [] in
(* tuples in *)
- let relation_result : Relation.Protocol.facts =
+ let relation_result : Protocol.facts =
[
{
attribute_name = "user/first-name";
@@ -47,7 +47,7 @@ let client_read sock maxlen =
]
in
return
- @@ Xml.to_string (Relation.Protocol.facts_to_xml_light relation_result)
+ @@ Xml.to_string (Protocol.facts_to_xml_light relation_result)
| Error err -> return err
[@@warning "-27"]
diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml
index 3092acc..e9e4525 100644
--- a/test/test_relational_engine.ml
+++ b/test/test_relational_engine.ml
@@ -6,6 +6,7 @@ let%test _ =
state = _EMPTY_SHA_HASH_;
files = StringMap.empty;
references = StringMap.empty;
+ schema = StringMap.empty
};
]
in
@@ -28,6 +29,7 @@ let%test _ =
state = _EMPTY_SHA_HASH_;
files = StringMap.empty;
references = StringMap.empty;
+ schema = StringMap.empty
};
]
in