From b2ff91614a7f1c7dd54a43bbfe88bbb6694b0a71 Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Sat, 24 Oct 2026 01:50:35 +0000 Subject: Formatting --- lib/concepts/Encoding.ml | 2 +- lib/kernel/Branch.ml | 10 ++++------ lib/kernel/EphemeralRelation.ml | 6 +++--- lib/kernel/Multigroup.ml | 6 +++--- lib/kernel/Namespace.ml | 5 +---- lib/kernel/Path.ml | 6 +----- lib/kernel/Program.ml | 3 +-- lib/kernel/Tuple.ml | 3 +-- test/integration/Registration.ml | 3 +-- test/unit/evaluators/FOL.ml | 15 +++++++++------ test/unit/kernel/Branch.ml | 18 +++++++++++------- test/unit/kernel/EphemeralRelation.ml | 8 ++++++-- test/unit/kernel/Merkle.ml | 15 +++------------ test/unit/kernel/Session.ml | 4 +++- 14 files changed, 48 insertions(+), 56 deletions(-) diff --git a/lib/concepts/Encoding.ml b/lib/concepts/Encoding.ml index 6420817..50eb6e6 100644 --- a/lib/concepts/Encoding.ml +++ b/lib/concepts/Encoding.ml @@ -216,7 +216,7 @@ module Value = struct Bencode.with_tag '?' value |>> Bencode.as_list |> Result.map Utilities.List.hd_opt - |>> (function None -> Ok None | Some v -> f v |> Result.map Option.some) + |>> function None -> Ok None | Some v -> f v |> Result.map Option.some end module Field = struct diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml index 89a16ff..598e102 100644 --- a/lib/kernel/Branch.ml +++ b/lib/kernel/Branch.ml @@ -54,9 +54,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct let* previous = Bencode.field "previous" fields |>> Value.option_of_bencode (fun v -> - Value.hash_of_bencode v - |> Result.map (fun hash -> S.Hash hash) - |> Result.map (SI.Pointer.make Loader.load) ) + Value.hash_of_bencode v + |> Result.map (fun hash -> S.Hash hash) + |> Result.map (SI.Pointer.make Loader.load) ) in Ok {multigroups; previous} end @@ -107,9 +107,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct method protocols : Protocols.Handle.protocol list = let bind = - Option.map - (fun root -> {EphemeralRelation.root; within= Protocols.Handle.make {<>}}) - root + Option.map (fun root -> {EphemeralRelation.root; within= Protocols.Handle.make {<>}}) root in let multigroups = Prototype.mixture_of node (fun make node -> diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml index 8843d11..8672424 100644 --- a/lib/kernel/EphemeralRelation.ml +++ b/lib/kernel/EphemeralRelation.ml @@ -138,7 +138,8 @@ let enumerate_owned relation = end ) let asking f relation = - Protocols.Handle.releasing relation (fun () -> Result.bind (Protocols.Relation.require relation) f) + Protocols.Handle.releasing relation (fun () -> + Result.bind (Protocols.Relation.require relation) f ) let generated ?program ?within name description value = let invoking f () = @@ -163,8 +164,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct module SI = Storage.Make (S) module R = SubstantialRelation.Make (S) - let restore ?program ?within ({Persisted.name; schematics; pointer} : Persisted.t) - description = + let restore ?program ?within ({Persisted.name; schematics; pointer} : Persisted.t) description = generated ?program ?within name description {name= Some name; schematics= `Persisted schematics; pointer= Some pointer} diff --git a/lib/kernel/Multigroup.ml b/lib/kernel/Multigroup.ml index 399ab30..79479d7 100644 --- a/lib/kernel/Multigroup.ml +++ b/lib/kernel/Multigroup.ml @@ -72,8 +72,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct let unjudgeable denial = condition "unjudgeable-denial" - "A denial does not declare that reading it with nothing bound ends, so the state cannot \ - be judged" + "A denial does not declare that reading it with nothing bound ends, so the state cannot be \ + judged" ("denial" |=| Concepts.Value.String denial) end @@ -230,7 +230,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct let derive f node' = Protocols.Handle.require Protocols.Addressable.from node' |> Result.map Protocols.Addressable.address - |>> (fun addr -> self#deriving (f addr)) + |>> fun addr -> self#deriving (f addr) in Protocols. [ Addressable.make self; diff --git a/lib/kernel/Namespace.ml b/lib/kernel/Namespace.ml index efaf667..314a28e 100644 --- a/lib/kernel/Namespace.ml +++ b/lib/kernel/Namespace.ml @@ -26,10 +26,7 @@ class namespace = method find key = let open Utilities.Option in - Atomic.get entries - |> BatMap.find_opt key - |>> Protocols.Handle.copy - |> Result.ok + Atomic.get entries |> BatMap.find_opt key |>> Protocols.Handle.copy |> Result.ok end let make () = Protocols.Handle.make (new namespace) diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml index 24d3d10..4dfba36 100644 --- a/lib/kernel/Path.ml +++ b/lib/kernel/Path.ml @@ -49,11 +49,7 @@ let walking ?missing f g handle path = let lookup handle path = walking (fun _ _ f -> f ()) Result.ok handle path let find handle path = - walking - ~missing:(fun () -> Ok None) - (fun _ _ f -> f ()) - (fun h -> Ok (Some h)) - handle path + walking ~missing:(fun () -> Ok None) (fun _ _ f -> f ()) (fun h -> Ok (Some h)) handle path let update handle path key reference value = let open Utilities.Result in diff --git a/lib/kernel/Program.ml b/lib/kernel/Program.ml index 64a9fcf..22ef7c3 100644 --- a/lib/kernel/Program.ml +++ b/lib/kernel/Program.ml @@ -70,5 +70,4 @@ let make ?root ~evaluator ~source kind = let load root ~evaluator ~source = with_evaluator root evaluator (fun found -> - Protocols.Evaluator.parse found source - |> Result.map (make ~root ~evaluator ~source) ) + Protocols.Evaluator.parse found source |> Result.map (make ~root ~evaluator ~source) ) diff --git a/lib/kernel/Tuple.ml b/lib/kernel/Tuple.ml index 7cd952e..7fe483e 100644 --- a/lib/kernel/Tuple.ml +++ b/lib/kernel/Tuple.ml @@ -79,8 +79,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct let node tx {attributes; _} = let open Utilities.Result in - AttributeM.find tx attributes - |>> Option.to_result ~none:(Error.incomplete_tuple attributes) + AttributeM.find tx attributes |>> Option.to_result ~none:(Error.incomplete_tuple attributes) let empty tx ~type_ () = let open Utilities.Result in diff --git a/test/integration/Registration.ml b/test/integration/Registration.ml index 6f308cd..7c7cfba 100644 --- a/test/integration/Registration.ml +++ b/test/integration/Registration.ml @@ -59,8 +59,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = end |> Helpers.condition_as_failure in - check (list string) "the stored program reads the book it was defined over" ["title"] - attributes; + check (list string) "the stored program reads the book it was defined over" ["title"] attributes; check (list Helpers.value) "read through the branch, the stored program runs" [Concepts.Value.String "SQL and Relational Theory"] shelved diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml index 0deb71d..4a6cadd 100644 --- a/test/unit/evaluators/FOL.ml +++ b/test/unit/evaluators/FOL.ml @@ -21,7 +21,10 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let employees = Rnt.Evaluators.FOL.Base Kernel.Path.("employee" @/ this) let names = Rnt.Evaluators.FOL.Project (employees, BatFingerTree.singleton "name") - let heading = BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []} + + let heading = + BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []} + let directory entries = Kernel.Prototype.(mixture [Directory.of_properties entries]) let eval within term = @@ -116,9 +119,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let* relation = H.relation conn ["name"; "age"] [employee "Alaric" 42] in let* stored = store conn names in let* root = namespace ["employee", relation; "stored", stored] in - let* plan = - Rnt.Evaluators.FOL.(instantiate root (Base Kernel.Path.("stored" @/ this))) - in + let* plan = Rnt.Evaluators.FOL.(instantiate root (Base Kernel.Path.("stored" @/ this))) in let* result = Rnt.Evaluators.FOL.execute plan in drain result end @@ -217,7 +218,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = (Kernel.EphemeralRelation.temporary description) (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0))) - let values source = Rnt.Evaluators.FOL.(execute (Project (Base source, BatFingerTree.singleton "value"))) + let values source = + Rnt.Evaluators.FOL.(execute (Project (Base source, BatFingerTree.singleton "value"))) let pull_one_tuple_at_a_time () = let produced = ref 0 and closed = ref false in @@ -248,7 +250,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = check bool "it fails as undecidable instead of reading without end" true ( match asked with | Error condition -> - BatString.starts_with (Concepts.Condition.to_string_hum condition) + BatString.starts_with + (Concepts.Condition.to_string_hum condition) "undecidable-membership" | Ok _ -> false ) diff --git a/test/unit/kernel/Branch.ml b/test/unit/kernel/Branch.ml index d92a6d7..a0f201d 100644 --- a/test/unit/kernel/Branch.ml +++ b/test/unit/kernel/Branch.ml @@ -10,10 +10,8 @@ let under a b = K.Path.(of_list (to_list a @ to_list b)) let shelf = K.Scope.path library "shelf" let s v = C.Value.String v let title = BatMap.String.singleton "title" {P.Schematics.domain= "string"; provenance= []} - let book t = {C.Tuple.type_= "book"; attributes= BatMap.String.singleton "title" (s t)} let books titles = K.EphemeralRelation.literal title (List.map book titles) - let titles relation = ok (Helpers.titles relation) let read root path = titles (ok (K.Path.lookup root path)) @@ -118,7 +116,10 @@ let endless () = (fun () -> Ok (K.Generator.cursor_of (fun ~yield -> - let rec from n = yield (book (string_of_int n)); from (n + 1) in + let rec from n = + yield (book (string_of_int n)); + from (n + 1) + in from 0 ) ) ) (* A toy language: "endless" answers titles without end, "shout r" the @@ -162,7 +163,9 @@ let with_toys ?evaluations root = ignore (ok (K.Initialization.mount root "toys")); ignore (ok - (K.Path.update root K.Path.("toys" @/ "evaluator" @/ this) "toy" None + (K.Path.update root + K.Path.("toys" @/ "evaluator" @/ this) + "toy" None (Some (toy ?evaluations ())) ) ) let toy_program ?root evaluator source = K.Program.make ?root ~evaluator ~source (parse source) @@ -174,8 +177,7 @@ let run root program = let a_program_runs_through_the_evaluator_it_names () = let root = fresh ["Codd"] in with_toys root; - publish root - ["named", Some (K.EphemeralRelation.of_program title (toy_program "toys:toy" "this"))]; + publish root ["named", Some (K.EphemeralRelation.of_program title (toy_program "toys:toy" "this"))]; check (list Helpers.value) "stored in a branch and read back, it runs" [s "this"] (read root (under master (K.Scope.path library "named"))); @@ -236,7 +238,9 @@ let a_denial_without_end_cannot_be_installed () = let root = fresh [] in with_toys root; let endless = K.EphemeralRelation.of_program title (toy_program "toys:toy" "endless") in - match K.Scope.publish root ~branch:"master" ~home:library ~denials:["endless", Some endless] [] with + match + K.Scope.publish root ~branch:"master" ~home:library ~denials:["endless", Some endless] [] + with | Ok () -> fail "a denial without end was installed" | Error condition -> check bool "the state holding it cannot be judged" true diff --git a/test/unit/kernel/EphemeralRelation.ml b/test/unit/kernel/EphemeralRelation.ml index 151f8fc..9426b9a 100644 --- a/test/unit/kernel/EphemeralRelation.ml +++ b/test/unit/kernel/EphemeralRelation.ml @@ -25,7 +25,10 @@ let endless () = (fun () -> Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> - let rec from n = yield (member n); from (n + 1) in + let rec from n = + yield (member n); + from (n + 1) + in from 0 ) ) ) let values tuples = @@ -72,7 +75,8 @@ let refuses_to_scan_without_end () = match Protocols.Relation.contains relation (member 9) with | Error condition -> check bool "it fails as undecidable instead of scanning" true - (BatString.starts_with (Concepts.Condition.to_string_hum condition) + (BatString.starts_with + (Concepts.Condition.to_string_hum condition) "undecidable-membership" ) | Ok _ -> fail "an endless relation with no test decided membership" ) diff --git a/test/unit/kernel/Merkle.ml b/test/unit/kernel/Merkle.ml index b0d4e03..6ac0f63 100644 --- a/test/unit/kernel/Merkle.ml +++ b/test/unit/kernel/Merkle.ml @@ -14,10 +14,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let open Utilities.Result in let* tx = S.start conn in let* node = - T.empty - |> T.insert tx "k1" "v1" - |>> T.insert tx "k2" "v2" - |>> T.insert tx "k3" "v3" + T.empty |> T.insert tx "k1" "v1" |>> T.insert tx "k2" "v2" |>> T.insert tx "k3" "v3" in let* node' = T.insert tx "k3" "toodles" node in let* v1 = T.lookup tx "k1" node in @@ -73,10 +70,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let open Utilities.Result in let* tx = S.start conn in let* node = - T.empty - |> T.insert tx "k1" "v1" - |>> (T.insert tx "k2" "v2") - |>> (T.insert tx "k3" "v3") + T.empty |> T.insert tx "k1" "v1" |>> T.insert tx "k2" "v2" |>> T.insert tx "k3" "v3" in let* () = S.commit tx in Ok (T.hash_of node) @@ -105,10 +99,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let open Utilities.Result in let* tx = S.start conn in let* node = - T.empty - |> T.insert tx "k1" "v1" - |>> (T.insert tx "k2" "v2") - |>> (T.insert tx "k3" "v3") + T.empty |> T.insert tx "k1" "v1" |>> T.insert tx "k2" "v2" |>> T.insert tx "k3" "v3" in let* keys = T.fold_left tx (fun acc k _ -> k :: acc) [] node |> Result.map List.rev in let* values = T.fold_left tx (fun acc _ v -> v :: acc) [] node |> Result.map List.rev in diff --git a/test/unit/kernel/Session.ml b/test/unit/kernel/Session.ml index 0665985..4ce5b23 100644 --- a/test/unit/kernel/Session.ml +++ b/test/unit/kernel/Session.ml @@ -25,7 +25,9 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let* _ = update root ("system" @/ "branch" @/ this) "client" None (Some branch) in let* tip = address branch in let session = Session.make conn {Protocols.Session.snapshot= tip} in - let* _ = update root ("system" @/ "session" @/ this) "client" None (Protocols.Handle.copy session) in + let* _ = + update root ("system" @/ "session" @/ this) "client" None (Protocols.Handle.copy session) + in let library = "system" @/ "session" @/ "client" @/ "branch" @/ "multigroup" @/ "library" @/ this in -- cgit v1.2.3