journal for the websitejournal

2 files changed, 65 insertions, 0 deletions

diff --git a/lib/kernel/View.ml b/lib/kernel/View.ml
new file mode 100644
index 0000000..b90afef
--- /dev/null
+++ b/lib/kernel/View.ml
@@ -0,0 +1,44 @@
+type heading = Protocols.Schematics.attribute_description BatMap.String.t
+type rows = (Concepts.Tuple.t list, Concepts.Condition.condition) result
+
+let ephemeral heading enumerate =
+  EphemeralRelation.instantiate heading
+    {EphemeralRelation.name= None; schematics= `Temporary heading; program= None}
+    (fun () ->
+      Result.map
+        (fun tuples -> Generator.cursor_of (fun ~yield -> List.iter yield tuples; Ok ()))
+        (enumerate ()) )
+
+let fixed heading tuples = ephemeral heading (fun () -> Ok tuples)
+
+let computed heading ~current compute =
+  let open Utilities.Result in
+  let now = ephemeral heading (fun () -> current () |> fmap compute) in
+  Prototype.mixture
+    ( Protocols.Derived.make
+        object
+          method within directory = Ok (ephemeral heading (fun () -> compute directory))
+        end
+    :: Protocols.Handle.protocols now )
+
+let read relation =
+  let open Utilities.Result in
+  let* schematics = Protocols.Handle.require Protocols.Schematics.from relation in
+  let* description = Protocols.Schematics.describe schematics in
+  let* heading =
+    match description with
+    | Protocols.Schematics.Relation heading -> Ok heading
+    | _ ->
+        Error
+          Concepts.Condition.(
+            condition "not-a-relation" "The object does not describe itself as a relation"
+              ("object" |=| Concepts.Value.String (Protocols.Handle.to_string relation)) )
+  in
+  let* enumerable = Protocols.Enumerable.require relation in
+  let* cursor = Protocols.Enumerable.enumerate enumerable in
+  Fun.protect
+    ~finally:(fun () -> Protocols.Handle.release cursor)
+    (fun () ->
+      let* scan = Protocols.Cursor.require cursor in
+      let* tuples = Protocols.Cursor.drain scan () in
+      Ok (heading, BatFingerTree.to_list tuples) )
diff --git a/lib/kernel/View.mli b/lib/kernel/View.mli
new file mode 100644
index 0000000..04e75ff
--- /dev/null
+++ b/lib/kernel/View.mli
@@ -0,0 +1,21 @@
+(** relations as values a subsystem hands to the tree. *)
+
+type heading = Protocols.Schematics.attribute_description BatMap.String.t
+type rows = (Concepts.Tuple.t list, Concepts.Condition.condition) result
+
+(** a relation holding [tuples], which never changes. *)
+val fixed : heading -> Concepts.Tuple.t list -> Protocols.Handle.t
+
+(** a relation computed from a directory of relations. Read as it is, it
+    is computed against [current ()] each time; read through a snapshot,
+    it is computed against the snapshot instead (see [Protocols.Derived]),
+    so it is what it was, or would be, at that moment. *)
+val computed :
+  heading ->
+  current:(unit -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
+  (Protocols.Handle.t -> rows) ->
+  Protocols.Handle.t
+
+(** the heading and tuples of a relation, read whole. *)
+val read :
+  Protocols.Handle.t -> (heading * Concepts.Tuple.t list, Concepts.Condition.condition) result