From c284fcd570342c31bc21169960579a20a763e32e Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Tue, 23 Jun 2026 23:53:26 -0300 Subject: Format --- lib/management/branch.ml | 17 ++++---- lib/management/multigroup.ml | 32 ++++++--------- lib/management/physical.ml | 97 +++++++++++++++++++------------------------- 3 files changed, 61 insertions(+), 85 deletions(-) (limited to 'lib/management') diff --git a/lib/management/branch.ml b/lib/management/branch.ml index 4ba0983..1583b9b 100644 --- a/lib/management/branch.ml +++ b/lib/management/branch.ml @@ -4,7 +4,7 @@ - "branch_names" -> serialized string list (index for enumeration) - "head" -> branch name as raw bytes *) -type t = { name : string; tip : Conventions.Hash.t } +type t = {name: string; tip: Conventions.Hash.t} type head = string type error = string @@ -15,7 +15,9 @@ let names_key = "branch_names" module Make (Storage : Physical.S) = struct module Error = struct open Condition - let branch_not_found name = condition "branch-not-found" "Branch not found" ("name" |=| (of_string name)) + + let branch_not_found name = + condition "branch-not-found" "Branch not found" ("name" |=| of_string name) end let load_names storage = @@ -28,7 +30,7 @@ module Make (Storage : Physical.S) = struct ignore (Storage.store_raw storage names_key bytes) let create storage ~name ~tip = - let record = { name; tip } in + let record = {name; tip} in let bytes = Marshal.to_bytes record [] in match Storage.store_raw storage (branch_key name) bytes with | Error e -> Error e @@ -58,7 +60,7 @@ module Make (Storage : Physical.S) = struct let update_tip storage ~name ~tip = match Storage.load_raw storage (branch_key name) with | Ok (Some _) -> - let record = { name; tip } in + let record = {name; tip} in let bytes = Marshal.to_bytes record [] in Storage.store_raw storage (branch_key name) bytes | Ok None -> Error (Error.branch_not_found name) @@ -68,14 +70,11 @@ module Make (Storage : Physical.S) = struct let names = load_names storage in let branches = List.filter_map - (fun name -> - match get_tip storage name with - | Ok (Some tip) -> Some (name, tip) - | _ -> None) + (fun name -> match get_tip storage name with Ok (Some tip) -> Some (name, tip) | _ -> None) names in Ok branches -(* + (* let branch_relation storage : Relation.t = let schema = Schema.empty |> Schema.add "name" "string" |> Schema.add "hash" "string" diff --git a/lib/management/multigroup.ml b/lib/management/multigroup.ml index b908302..2882afa 100644 --- a/lib/management/multigroup.ml +++ b/lib/management/multigroup.ml @@ -2,13 +2,11 @@ to content-addressed relation values. The multigroup object owns the B+ tree pointer and advances it when relations change. *) - class multigroup ~name:(init_name : Conventions.Name.t) = object (_self) val name : Conventions.Name.t = init_name val relations : Relation.relation BatMap.String.t = BatMap.String.empty val timestamp : float = Unix.gettimeofday () - method name = name method relations = relations method timestamp = timestamp @@ -19,21 +17,19 @@ class multigroup ~name:(init_name : Conventions.Name.t) = method has_relation rel_name = BatMap.String.mem rel_name relations method add_relation (rel : Relation.relation) = - {< relations = BatMap.String.add rel#name rel relations >} + {} - method remove_relation rel_name = - {< relations = BatMap.String.remove rel_name relations >} + method remove_relation rel_name = {} method update_relation (rel : Relation.relation) = - if not (BatMap.String.mem rel#name relations) then {< >} - else {< relations = BatMap.String.add rel#name rel relations >} + if not (BatMap.String.mem rel#name relations) then {<>} + else {} method serialize () : Storable.Multigroup.t = - { - Storable.Multigroup.name = name; - relations = BatMap.String.bindings relations |> List.map snd |> List.map (fun r -> r#serialize ()); - } -end + { Storable.Multigroup.name; + relations= + BatMap.String.bindings relations |> List.map snd |> List.map (fun r -> r#serialize ()) } + end let deserialize (bytes : bytes) : (multigroup, string) result = (* Reconstruct a multigroup from its persisted payload. @@ -48,19 +44,15 @@ let deserialize (bytes : bytes) : (multigroup, string) result = (fun mg rel -> let relation = new Relation.stored - ~name:rel.Storable.Relation.name - ~schema:rel.schema - ~constraints:None - ~cardinality:Conventions.Cardinality.AlephZero - ~lineage:None - ~provenance:None - ~membership_criteria:(fun _ -> true) + ~name:rel.Storable.Relation.name ~schema:rel.schema ~constraints:None + ~cardinality:Conventions.Cardinality.AlephZero ~lineage:None ~provenance:None + ~membership_criteria:(fun _ -> true ) in let relation = if rel.tree_pointer = "" then relation else relation#set_tree_pointer (Some rel.tree_pointer) in - mg#add_relation (relation :> Relation.relation)) + mg#add_relation (relation :> Relation.relation) ) db stored.relations in Ok db diff --git a/lib/management/physical.ml b/lib/management/physical.ml index 7c6f6b2..b896330 100644 --- a/lib/management/physical.ml +++ b/lib/management/physical.ml @@ -13,37 +13,35 @@ module type BACKEND = sig type connection - val connect : configuration -> (connection, Condition.t) result (** Connect to the storage backend *) + val connect : configuration -> (connection, Condition.t) result - val disconnect : connection -> unit (** Disconnect from the backend *) + val disconnect : connection -> unit - val get : connection -> Conventions.Hash.t -> (bytes option, Condition.t) result (** Get a value by its hash. Returns None if not found. *) + val get : connection -> Conventions.Hash.t -> (bytes option, Condition.t) result - val put : connection -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result (** Store a value at its hash *) + val put : connection -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result - val exists : connection -> Conventions.Hash.t -> (bool, Condition.t) result (** Check if a hash exists *) + val exists : connection -> Conventions.Hash.t -> (bool, Condition.t) result - val begin_transaction : connection -> (unit, Condition.t) result (** Begin a transaction *) + val begin_transaction : connection -> (unit, Condition.t) result - val commit : connection -> (unit, Condition.t) result (** Commit a transaction *) + val commit : connection -> (unit, Condition.t) result - val rollback : connection -> (unit, Condition.t) result (** Rollback a transaction *) + val rollback : connection -> (unit, Condition.t) result - val get_many : - connection -> Conventions.Hash.t list -> (bytes option list, Condition.t) result (** Batch get multiple values *) + val get_many : connection -> Conventions.Hash.t list -> (bytes option list, Condition.t) result - val put_many : - connection -> (Conventions.Hash.t * bytes) list -> (unit, Condition.t) result (** Batch put multiple values *) + val put_many : connection -> (Conventions.Hash.t * bytes) list -> (unit, Condition.t) result end (** Storage operations built on top of a backend *) @@ -52,38 +50,34 @@ module type S = sig type t - val create : configuration -> (t, Condition.t) result (** Create a storage instance from a backend connection *) + val create : configuration -> (t, Condition.t) result - val close : t -> unit (** Close the storage *) + val close : t -> unit - val store_attribute : - t -> Conventions.AbstractValue.t -> (Conventions.Hash.t, Condition.t) result (** Store an attribute value, returns its hash *) + val store_attribute : t -> Conventions.AbstractValue.t -> (Conventions.Hash.t, Condition.t) result - val load_attribute : - t -> - Conventions.Hash.t -> - (Conventions.AbstractValue.t option, Condition.t) result (** Load an attribute value by hash *) + val load_attribute : + t -> Conventions.Hash.t -> (Conventions.AbstractValue.t option, Condition.t) result - val store_raw : t -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result (** Store raw bytes at a hash *) + val store_raw : t -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result - val load_raw : t -> Conventions.Hash.t -> (bytes option, Condition.t) result (** Load raw bytes by hash *) + val load_raw : t -> Conventions.Hash.t -> (bytes option, Condition.t) result - val exists : t -> Conventions.Hash.t -> (bool, Condition.t) result (** Check if a hash exists *) + val exists : t -> Conventions.Hash.t -> (bool, Condition.t) result - val with_transaction : t -> (unit -> ('a, Condition.t) result) -> ('a, Condition.t) result (** Execute a function within a transaction *) + val with_transaction : t -> (unit -> ('a, Condition.t) result) -> ('a, Condition.t) result end (** Functor to create storage operations from a backend *) -module Make (B : BACKEND) : - S with type configuration = B.configuration = struct +module Make (B : BACKEND) : S with type configuration = B.configuration = struct type configuration = B.configuration type t = B.connection @@ -110,30 +104,31 @@ module Make (B : BACKEND) : match B.begin_transaction conn with | Error e -> Error e | Ok () -> ( - match f () with - | Ok result -> ( - match B.commit conn with Ok () -> Ok result | Error e -> Error e) - | Error e -> - let _ = B.rollback conn in - Error e) + match f () with + | Ok result -> ( match B.commit conn with Ok () -> Ok result | Error e -> Error e ) + | Error e -> + let _ = B.rollback conn in + Error e ) end (** In-memory backend for testing and development *) -module MemoryBackend : - BACKEND with type configuration = unit = struct +module MemoryBackend : BACKEND with type configuration = unit = struct type configuration = unit - type connection = { - data : (string, bytes) Hashtbl.t; - mutable in_transaction : bool; - mutable transaction_buffer : (string * bytes) list; - } + type connection = + { data: (string, bytes) Hashtbl.t; + mutable in_transaction: bool; + mutable transaction_buffer: (string * bytes) list } module Error = struct open Condition + (* TODO: more structure *) let parse_error msg = condition "parse-error" msg empty - let already_in_transaction = condition "already-in-transaction" "Already inside a transaction" empty + + let already_in_transaction = + condition "already-in-transaction" "Already inside a transaction" empty + let not_in_transaction = condition "not-in-transaction" "Not inside a transaction" empty end @@ -144,16 +139,9 @@ module MemoryBackend : Error (Error.parse_error (Printf.sprintf "memory backend takes no configuration, got: %s" - (Sexplib.Sexp.to_string sexp))) - - let connect () = - Ok - { - data = Hashtbl.create 1024; - in_transaction = false; - transaction_buffer = []; - } + (Sexplib.Sexp.to_string sexp) ) ) + let connect () = Ok {data= Hashtbl.create 1024; in_transaction= false; transaction_buffer= []} let disconnect _ = () let get conn hash = Ok (Hashtbl.find_opt conn.data hash) @@ -180,9 +168,7 @@ module MemoryBackend : let commit conn = if not conn.in_transaction then Error Error.not_in_transaction else begin - List.iter - (fun (hash, value) -> Hashtbl.replace conn.data hash value) - conn.transaction_buffer; + List.iter (fun (hash, value) -> Hashtbl.replace conn.data hash value) conn.transaction_buffer; conn.in_transaction <- false; conn.transaction_buffer <- []; Ok () @@ -196,18 +182,17 @@ module MemoryBackend : Ok () end - let get_many conn hashes = - Ok (List.map (fun h -> Hashtbl.find_opt conn.data h) hashes) + let get_many conn hashes = Ok (List.map (fun h -> Hashtbl.find_opt conn.data h) hashes) let put_many conn pairs = List.iter (fun (hash, value) -> if conn.in_transaction then conn.transaction_buffer <- (hash, value) :: conn.transaction_buffer - else Hashtbl.replace conn.data hash value) + else Hashtbl.replace conn.data hash value ) pairs; Ok () end -module Memory = Make (MemoryBackend) (** Default in-memory storage for development *) +module Memory = Make (MemoryBackend) -- cgit v1.2.3