From 932e657e38665afa1da1aab549977841abbd9dcf Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Wed, 7 Oct 2026 18:25:43 -0300 Subject: drop journal in favor of local branch history --- lib/protocols/Derived.ml | 10 ---------- lib/protocols/Derived.mli | 13 ------------ lib/protocols/Evaluator.ml | 4 ++-- lib/protocols/Evaluator.mli | 12 ++++++++++-- lib/protocols/Journal.ml | 25 ----------------------- lib/protocols/Journal.mli | 48 --------------------------------------------- lib/protocols/Relation.ml | 18 +++++++++++++++++ lib/protocols/Relation.mli | 5 +++++ 8 files changed, 35 insertions(+), 100 deletions(-) delete mode 100644 lib/protocols/Derived.ml delete mode 100644 lib/protocols/Derived.mli delete mode 100644 lib/protocols/Journal.ml delete mode 100644 lib/protocols/Journal.mli (limited to 'lib/protocols') diff --git a/lib/protocols/Derived.ml b/lib/protocols/Derived.ml deleted file mode 100644 index 1968ffc..0000000 --- a/lib/protocols/Derived.ml +++ /dev/null @@ -1,10 +0,0 @@ -class type implementation = object - method within : Handle.t -> (Handle.t, Concepts.Condition.condition) result -end - -type Handle.protocol += Derived of implementation -type t = implementation - -let make impl = Derived (impl :> implementation) -let from handle = Handle.into handle (function Derived impl -> Some impl | _ -> None) -let within i directory = Handle.invoke i (fun o -> o#within directory) diff --git a/lib/protocols/Derived.mli b/lib/protocols/Derived.mli deleted file mode 100644 index b3dce96..0000000 --- a/lib/protocols/Derived.mli +++ /dev/null @@ -1,13 +0,0 @@ -(** a relation computed from other relations. [within] gives the same - relation read against another directory of relations, so a snapshot - of the tree can hand out its derived relations as they were, or as - they would be, at that moment. *) -type t - -class type implementation = object - method within : Handle.t -> (Handle.t, Concepts.Condition.condition) result -end - -val make : #implementation -> Handle.protocol -val from : Handle.t -> t Handle.interface option -val within : t Handle.interface -> Handle.t -> (Handle.t, Concepts.Condition.condition) result diff --git a/lib/protocols/Evaluator.ml b/lib/protocols/Evaluator.ml index 789fb9d..9f4f5c6 100644 --- a/lib/protocols/Evaluator.ml +++ b/lib/protocols/Evaluator.ml @@ -1,5 +1,5 @@ class type implementation = object - method invoke : Handle.t -> (Handle.t, Concepts.Condition.condition) result + method invoke : Handle.t -> within:Handle.t -> (Handle.t, Concepts.Condition.condition) result end type Handle.protocol += Evaluator of implementation @@ -8,4 +8,4 @@ type t = implementation let make impl = Evaluator (impl :> implementation) let from handle = Handle.into handle (function Evaluator impl -> Some impl | _ -> None) let require = Handle.require from -let invoke i program = Handle.invoke i (fun o -> o#invoke program) +let invoke i program ~within = Handle.invoke i (fun o -> o#invoke program ~within) diff --git a/lib/protocols/Evaluator.mli b/lib/protocols/Evaluator.mli index 3d42b5c..04b3612 100644 --- a/lib/protocols/Evaluator.mli +++ b/lib/protocols/Evaluator.mli @@ -1,10 +1,18 @@ type t +(** [within] is the directory the program's paths resolve against: the + branch state a stored program was read through, or whatever part of + the tree a caller hands over. *) class type implementation = object - method invoke : Handle.t -> (Handle.t, Concepts.Condition.condition) result + method invoke : Handle.t -> within:Handle.t -> (Handle.t, Concepts.Condition.condition) result end val make : #implementation -> Handle.protocol val from : Handle.t -> t Handle.interface option val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result -val invoke : t Handle.interface -> Handle.t -> (Handle.t, Concepts.Condition.condition) result + +val invoke : + t Handle.interface -> + Handle.t -> + within:Handle.t -> + (Handle.t, Concepts.Condition.condition) result diff --git a/lib/protocols/Journal.ml b/lib/protocols/Journal.ml deleted file mode 100644 index 392eb5a..0000000 --- a/lib/protocols/Journal.ml +++ /dev/null @@ -1,25 +0,0 @@ -type change = {name: string; expected: Handle.t option; replacement: Handle.t option} -type commit = {number: int; snapshot: Handle.t; changed: string list} -type proposal = {previous: commit; proposed: commit} -type guard = proposal -> (unit, Concepts.Condition.condition) result -type observer = commit -> unit - -class type implementation = object - method commit : change list -> (commit option, Concepts.Condition.condition) result - method head : commit - method history : commit list - method guard : string -> guard option -> unit - method observe : string -> observer option -> unit -end - -type Handle.protocol += Journal of implementation -type t = implementation - -let make impl = Journal (impl :> implementation) -let from handle = Handle.into handle (function Journal impl -> Some impl | _ -> None) -let require = Handle.require from -let commit i changes = Handle.invoke i (fun o -> o#commit changes) -let head i = Handle.invoke i (fun o -> o#head) -let history i = Handle.invoke i (fun o -> o#history) -let guard i name g = Handle.invoke i (fun o -> o#guard name g) -let observe i name f = Handle.invoke i (fun o -> o#observe name f) diff --git a/lib/protocols/Journal.mli b/lib/protocols/Journal.mli deleted file mode 100644 index 5f2e760..0000000 --- a/lib/protocols/Journal.mli +++ /dev/null @@ -1,48 +0,0 @@ -(** a directory that keeps its history. Every change to its bindings is - a commit: one or more names bound again together, numbered, with a - snapshot of every binding as it stood afterwards. Guards are shown a - commit before it lands and may refuse it; observers are told of it - after. *) -type t - -(** bind [name] to [replacement], or unbind it when [None], provided it - is still bound to [expected]. *) -type change = {name: string; expected: Handle.t option; replacement: Handle.t option} - -(** [snapshot] is a directory of the bindings as of the commit. *) -type commit = {number: int; snapshot: Handle.t; changed: string list} - -(** what a guard is shown: the commit the proposal would follow and the - commit it would be. *) -type proposal = {previous: commit; proposed: commit} - -type guard = proposal -> (unit, Concepts.Condition.condition) result -type observer = commit -> unit - -class type implementation = object - (** [Ok None] when a name was no longer bound to what was expected; - [Error] when a guard refused. Either way nothing changes. *) - method commit : change list -> (commit option, Concepts.Condition.condition) result - - method head : commit - - (** every commit, the oldest first. *) - method history : commit list - - (** install, replace or remove the guard or observer of that name. *) - method guard : string -> guard option -> unit - - method observe : string -> observer option -> unit -end - -val make : #implementation -> Handle.protocol -val from : Handle.t -> t Handle.interface option -val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result - -val commit : - t Handle.interface -> change list -> (commit option, Concepts.Condition.condition) result - -val head : t Handle.interface -> commit -val history : t Handle.interface -> commit list -val guard : t Handle.interface -> string -> guard option -> unit -val observe : t Handle.interface -> string -> observer option -> unit diff --git a/lib/protocols/Relation.ml b/lib/protocols/Relation.ml index 3962c9c..b4cc4ec 100644 --- a/lib/protocols/Relation.ml +++ b/lib/protocols/Relation.ml @@ -17,3 +17,21 @@ let make impl = Relation (impl :> implementation) let from handle = Handle.into handle (function Relation impl -> Some impl | _ -> None) let require handle = from handle |> Option.to_result ~none:(Error.not_a_relation ()) let contains i tuple = Handle.invoke i (fun o -> o#contains tuple) + +let read relation = + let open Utilities.Result in + let* schematics = Handle.require Schematics.from relation in + let* description = Schematics.describe schematics in + let* heading = + match description with + | Schematics.Relation heading -> Ok heading + | _ -> Error (Error.not_a_relation ()) + in + let* enumerable = Enumerable.require relation in + let* cursor = Enumerable.enumerate enumerable in + Fun.protect + ~finally:(fun () -> Handle.release cursor) + (fun () -> + let* scan = Cursor.require cursor in + let* tuples = Cursor.drain scan () in + Ok (heading, BatFingerTree.to_list tuples) ) diff --git a/lib/protocols/Relation.mli b/lib/protocols/Relation.mli index be11cc1..87e6ab2 100644 --- a/lib/protocols/Relation.mli +++ b/lib/protocols/Relation.mli @@ -8,3 +8,8 @@ val make : #implementation -> Handle.protocol val from : Handle.t -> t Handle.interface option val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result val contains : t Handle.interface -> Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result + +(** the heading and tuples of a relation, read whole. *) +val read : + Handle.t -> + (Schematics.relation_description * Concepts.Tuple.t list, Concepts.Condition.condition) result -- cgit v1.2.3