diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/protocols/Derived.ml | 10 | ||||
| -rw-r--r-- | lib/protocols/Derived.mli | 13 | ||||
| -rw-r--r-- | lib/protocols/Journal.ml | 25 | ||||
| -rw-r--r-- | lib/protocols/Journal.mli | 48 |
4 files changed, 96 insertions, 0 deletions
diff --git a/lib/protocols/Derived.ml b/lib/protocols/Derived.ml new file mode 100644 index 0000000..1968ffc --- /dev/null +++ b/lib/protocols/Derived.ml @@ -0,0 +1,10 @@ +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 new file mode 100644 index 0000000..b3dce96 --- /dev/null +++ b/lib/protocols/Derived.mli @@ -0,0 +1,13 @@ +(** 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/Journal.ml b/lib/protocols/Journal.ml new file mode 100644 index 0000000..392eb5a --- /dev/null +++ b/lib/protocols/Journal.ml @@ -0,0 +1,25 @@ +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 new file mode 100644 index 0000000..5f2e760 --- /dev/null +++ b/lib/protocols/Journal.mli @@ -0,0 +1,48 @@ +(** 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 |
