journal for the websitejournal

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