diff options
| -rw-r--r-- | lib/disk.ml | 70 | ||||
| -rw-r--r-- | lib/relation.ml | 25 |
2 files changed, 61 insertions, 34 deletions
diff --git a/lib/disk.ml b/lib/disk.ml index d5ee00e..7cd3471 100644 --- a/lib/disk.ml +++ b/lib/disk.ml @@ -106,6 +106,8 @@ module Executor = struct type relational_literal = | LText of string | LInteger32 of int32 + | LInteger64 of int64 + | LBoolean of bool | LRelation of int64 [@@deriving show] @@ -279,16 +281,26 @@ module Executor = struct let cast_to_type (type': relational_type) (content: bytes): relational_literal = match type' with | Text -> LText (Bytes.to_string content) - | Integer32 -> LInteger32 (Bytes.get_int32_be content 0) - | Relation _ -> LRelation (Bytes.get_int64_be content 0) + | Integer32 -> LInteger32 (Data_encoding.Binary.of_bytes_exn Data_encoding.int32 content) + | Relation _ -> LRelation (Data_encoding.Binary.of_bytes_exn Data_encoding.int64 content) | _ -> failwith "Not implemented" + let relational_literal_to_bytes (literal: relational_literal): bytes = + match literal with + | LText x -> Bytes.of_string x + | LInteger32 x -> Data_encoding.Binary.to_bytes_exn Data_encoding.int32 x + | LInteger64 x -> Data_encoding.Binary.to_bytes_exn Data_encoding.int64 x + | LRelation x -> Data_encoding.Binary.to_bytes_exn Data_encoding.int64 x + | LBoolean x -> Data_encoding.Binary.to_bytes_exn Data_encoding.bool x + let read_location ~hash (locations: locations) (cast_type: relational_type): relational_literal = match StringMap.find_opt hash locations with | Some ({ offset; size; _ } : Location.t) -> - begin match FS.read FS.Storage offset size with - | Ok x -> cast_to_type cast_type x - | Error err -> failwith err + begin + print_endline ("TRASH: " ^ Int.to_string size); + match FS.read FS.Storage offset size with + | Ok x -> cast_to_type cast_type x + | Error err -> failwith err end | None -> failwith "Location could not be found." end @@ -324,11 +336,11 @@ module Command = struct type transaction = { (* kind : command_kind; *) timestamp : float; - hash : string; - filename : string; + (* hash : string; *) + attribute : string; entity_id : int64 option; (* branch must be added here later *) - content : string; + content : Executor.relational_literal; type': Executor.relational_type; } @@ -362,22 +374,42 @@ module Command = struct (function Executor.Relation reference -> Some reference | _ -> None) (function reference -> Executor.Relation reference); ] + + let relational_literal_encoding = + union + [ + case ~title:"text" (Tag 0) Data_encoding.string + (function Executor.LText x -> Some x | _ -> None) + (function x -> Executor.LText x); + case ~title:"integer32" (Tag 1) Data_encoding.int32 + (function Executor.LInteger32 x -> Some x | _ -> None) + (function x -> Executor.LInteger32 x); + case ~title:"integer64" (Tag 2) Data_encoding.int64 + (function Executor.LInteger64 x -> Some x | _ -> None) + (function x -> Executor.LInteger64 x); + case ~title:"boolean" (Tag 3) Data_encoding.bool + (function Executor.LBoolean x -> Some x | _ -> None) + (function x -> Executor.LBoolean x); + case ~title:"relation" (Tag 4) Data_encoding.int64 + (function Executor.LRelation reference -> Some reference | _ -> None) + (function reference -> Executor.LRelation reference); + ] let command_encoding = conv - (fun { timestamp; hash; filename; entity_id; content; type' } -> - (timestamp, hash, filename, entity_id, content, type')) - (fun (timestamp, hash, filename, entity_id, content, type') -> - { timestamp; hash; filename; entity_id; content; type' }) - Data_encoding.(tup6 float string string (option int64) string relational_type_encoding) + (fun { timestamp; attribute; entity_id; content; type' } -> + (timestamp, attribute, entity_id, content, type')) + (fun (timestamp, attribute, entity_id, content, type') -> + { timestamp; attribute; entity_id; content; type' }) + Data_encoding.(tup5 float string (option int64) relational_literal_encoding relational_type_encoding) let parse_command ~data = let contract_encoding = - Data_encoding.(tup5 string string (option int64) string relational_type_encoding) + Data_encoding.(tup4 string (option int64) relational_literal_encoding relational_type_encoding) in match Binary.of_bytes_opt contract_encoding data with - | Some (hash, filename, entity_id, content, type') -> - Ok { timestamp = Unix.time (); hash; filename; entity_id; content; type' } + | Some (attribute, entity_id, content, type') -> + Ok { timestamp = Unix.time (); attribute; entity_id; content; type' } | None -> Error "Failed to parse command" type return = @@ -400,14 +432,14 @@ module Command = struct let+ _ = FS.append FS.Transaction serialized_command in let open Extensions.Result in let+ (commit, locations), computed_hash_handle = - Executor.write commit locations ~filename:command.filename - @@ Bytes.of_string command.content + Executor.write commit locations ~filename:command.attribute + @@ Executor.relational_literal_to_bytes command.content in match (computed_hash_handle, command.entity_id) with | Some computed_hash_handle, Some entity_id -> let references: Executor.references = let relation_name = - List.hd @@ String.split_on_char '/' command.filename + List.hd @@ String.split_on_char '/' command.attribute in Executor.StringMap.update relation_name (function diff --git a/lib/relation.ml b/lib/relation.ml index 02dcc44..0278131 100644 --- a/lib/relation.ml +++ b/lib/relation.ml @@ -45,10 +45,9 @@ let write_and_retrieve () = let command_write1 : Command.transaction = { timestamp = 10.0; - hash = ""; - content = "Daisy"; + content = Executor.LText "Daisy"; entity_id = Some 0L; - filename = "user/first-name"; + attribute = "user/first-name"; type' = Executor.Text; } in @@ -59,10 +58,9 @@ let write_and_retrieve () = let command_write2 : Command.transaction = { timestamp = 10.0; - hash = ""; - content = "Blossom"; + content = Executor.LText "Blossom"; entity_id = Some 0L; - filename = "user/last-name"; + attribute = "user/last-name"; type' = Executor.Text; } in @@ -73,10 +71,9 @@ let write_and_retrieve () = let command_write1_address : Command.transaction = { timestamp = 10.0; - hash = ""; - content = "Saint James St."; + content = Executor.LText "Saint James St."; entity_id = Some 0L; - filename = "address/street"; + attribute = "address/street"; type' = Executor.Text; } in @@ -87,10 +84,9 @@ let write_and_retrieve () = let command_write2_address : Command.transaction = { timestamp = 10.0; - hash = ""; - content = "41"; + content = Executor.LInteger32 41l; entity_id = Some 0L; - filename = "address/number"; + attribute = "address/number"; type' = Executor.Text; } in @@ -101,10 +97,9 @@ let write_and_retrieve () = let command_write2_5 : Command.transaction = { timestamp = 10.0; - hash = ""; - content = "0"; + content = Executor.LRelation 0L; entity_id = Some 0L; - filename = "user/address"; + attribute = "user/address"; type' = Executor.Relation "address"; } in |
