purge schema in favor of simple namespace

2 files changed, 0 insertions, 219 deletions

diff --git a/lib/kernel/Schema.ml b/lib/kernel/Schema.ml
deleted file mode 100644
index e121e7a..0000000
--- a/lib/kernel/Schema.ml
+++ /dev/null
@@ -1,196 +0,0 @@
-module Make (S : Abstract.Storage.STORAGE) = struct
-  module SI = Storage.Make (S)
-  module R = SubstantialRelation.Make (S)
-  module E = EphemeralRelation.Make (S)
-
-  (* A relation as a schema holds it. *)
-  module Entry = struct
-    module Stored = EphemeralRelation.Persisted.Representation
-
-    type t = Substantial of R.t | Ephemeral of EphemeralRelation.Persisted.t
-
-    let encode = function
-      | Substantial relation -> R.encode relation
-      | Ephemeral relation -> Stored.to_blob relation
-
-    let decode blob =
-      let open Utilities.Result in
-      let open Concepts.Encoding in
-      let* data = Bencode.of_blob blob in
-      match data with
-      | Bencode.Tagged (tag, _) when Char.equal tag Stored.tag ->
-          Stored.of_bencode data |> Result.map (fun relation -> Ephemeral relation)
-      | _ -> R.Representation.of_bencode data |> Result.map (fun relation -> Substantial relation)
-
-    let load ?bind storage = function
-      | Substantial relation -> R.load storage relation
-      | Ephemeral relation -> E.load ?bind storage relation
-
-    (* A program is stored as itself, to run whenever it is read; any
-       other relation is stored as the tuples it holds now. *)
-    let admit name h =
-      let open Utilities.Result in
-      let address entry = Concepts.Hash.hash_of_blob (encode entry) in
-      match EphemeralRelation.stored h with
-      | Some (evaluator, code, _) ->
-          let* description = Protocols.Relation.heading h in
-          Ok
-            (fun tx ->
-              let* record = E.store tx ~name ~evaluator ~code description in
-              Ok (address (Ephemeral record)) )
-      | None ->
-          let* description, tuples = Protocols.Relation.read h in
-          Ok
-            (fun tx ->
-              let* relation = R.store tx description tuples in
-              Ok (address (Substantial relation)) )
-  end
-
-  module RelationM = Merkle.Interface (S) (Merkle.StringKey) (Entry)
-  module RMAddressable = Prototype.Addressable.OfTree (S) (Merkle.StringKey)
-  module RMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (Entry)
-  module RMAssociative = Prototype.Associative.OfTree (S) (Merkle.StringKey)
-
-  type t = {relations: RelationM.address}
-
-  module Error = struct
-    open Concepts.Condition
-
-    let malformed_schema () =
-      condition "malformed-schema"
-        "The on-disk representation of a schema did not conform to what was expected. Is your \
-         database corrupted?"
-        empty
-
-    let incomplete_schema addr =
-      condition "incomplete-schema"
-        "A stored schema is missing part of its expected structure. Is your storage corrupted?"
-        ("address" |=| Concepts.Value.String (Concepts.Hash.to_hum_string addr))
-  end
-
-  module rec Representation : (Concepts.Encoding.Record.S with type t = t) =
-    Concepts.Encoding.Record.Make (Body)
-
-  and Body : Concepts.Encoding.Record.BODY = struct
-    type nonrec t = t
-
-    let tag = 'S'
-    let malformed = Error.malformed_schema
-
-    let fields {relations} =
-      let open Concepts.Encoding in
-      ["relations", Value.bencode_of_hash relations]
-
-    let of_fields fields =
-      let open Utilities.Result in
-      let open Concepts.Encoding in
-      let* relations = Bencode.field "relations" fields |> fmap Value.hash_of_bencode in
-      Ok {relations}
-  end
-
-  let encode = Representation.to_blob
-  let decode = Representation.of_blob
-
-  let node_of tx schema =
-    let open Utilities.Result in
-    RelationM.find tx schema.relations
-    |> fmap (Option.to_result ~none:(Error.incomplete_schema schema.relations))
-
-  class schema ?bind conn value node =
-    object (self)
-      inherit Lifecycle.null
-      method to_string = "schema"
-      val schema = value
-      val storage = conn
-      val node = node (* FIXME: see the comment on Branch.ml *)
-
-      (* TODO: Add later to the lifecycle management, accounting for
-         derived instances. Callers must release the previous handle
-         when done with it so its instance can be cleaned up after the
-         last reference is released. *)
-      method deriving schema' =
-        let open Utilities.Result in
-        let* node' =
-          SI.with_transaction storage (fun tx ->
-              let* _ = SI.store_blob tx (Representation.to_blob schema') in
-              node_of tx schema' )
-        in
-        new schema ?bind storage schema' node' |> Protocols.Handle.make |> Result.ok
-
-      method protocols : Protocols.Handle.protocol list =
-        let open Utilities.Result in
-        Protocols.
-          [ Addressable.make self;
-            Prototype.Associative.(
-              of_properties
-                [ ( "relation",
-                    update_only (fun node' ->
-                        Handle.require Addressable.from node'
-                        |> Result.map Addressable.address
-                        |> fmap (fun addr -> self#deriving {relations= addr}) ) ) ] );
-            Prototype.Directory.of_properties
-              [ ( "relation",
-                  Prototype.mixture_of node (fun make node ->
-                      [ RMAddressable.make ~node:(RelationM.into node);
-                        RMDirectory.make ~storage ~node ~constructor:(Entry.load ?bind storage);
-                        RMAssociative.make ~admit:Entry.admit ~storage ~node:(RelationM.into node)
-                          ~constructor:(fun node' -> RelationM.from node' |> make |> Result.ok)
-                          () ] ) ) ] ]
-
-      method hash = Representation.to_blob schema |> Concepts.Hash.hash_of_blob
-      method address = self#hash
-    end
-
-  let load ?bind conn value =
-    let open Utilities.Result in
-    let* node = SI.with_read conn (fun tx -> node_of tx value) in
-    new schema ?bind conn value node |> Protocols.Handle.make |> Result.ok
-
-  let make conn =
-    let open Utilities.Result in
-    SI.with_transaction conn (fun tx ->
-        let* empty = RelationM.empty_under tx in
-        let schema = {relations= empty} in
-        let* _ = SI.store_blob tx (Representation.to_blob schema) in
-        new schema conn schema RelationM.empty |> Protocols.Handle.make |> Result.ok )
-
-  (* Handed over as the tree shows one, a directory holding its relations
-     under \relation, a schema not stored yet is stored with them. *)
-  let admit _ h =
-    let open Utilities.Result in
-    let* listing = Protocols.Handle.require Protocols.Directory.from h in
-    let* relations = Protocols.Directory.find listing "relation" in
-    let* relations =
-      match relations with
-      | None -> Ok []
-      | Some relations ->
-          let* listing = Protocols.Handle.require Protocols.Directory.from relations in
-          let* names = Protocols.Directory.list listing in
-          BatFingerTree.to_list names
-          |> List.filter_map (fun name ->
-              match Protocols.Directory.find listing name with
-              | Ok None -> None
-              | Error c -> Some (Error c)
-              | Ok (Some relation) -> (
-                match Protocols.Addressable.from relation with
-                | Some a ->
-                    let addr = Protocols.Addressable.address a in
-                    Some (Ok (name, fun _ -> Ok addr))
-                | None -> Some (Entry.admit name relation |> Result.map (fun p -> name, p)) ) )
-          |> Utilities.List.sequence
-    in
-    Ok
-      (fun tx ->
-        let* _ = RelationM.empty_under tx in
-        let* node =
-          RelationM.with_batch tx (fun () ->
-              List.fold_left
-                (fun node (name, store) ->
-                  let* node = node in
-                  let* addr = store tx in
-                  RelationM.Tree.insert tx name addr (RelationM.into node)
-                  |> Result.map RelationM.from )
-                (Ok RelationM.empty) relations )
-        in
-        SI.store_blob tx (Representation.to_blob {relations= RelationM.hash_of node}) )
-end
diff --git a/lib/kernel/Schema.mli b/lib/kernel/Schema.mli
deleted file mode 100644
index 7970ee2..0000000
--- a/lib/kernel/Schema.mli
+++ /dev/null
@@ -1,23 +0,0 @@
-(** A schema: its relations, \schema\[s]\relation\[r]. For now only a
-    namespace for them. *)
-module Make (S : Abstract.Storage.STORAGE) : sig
-  include Merkle.VALUE
-
-  val load :
-    ?bind:EphemeralRelation.binding ->
-    S.connection ->
-    t ->
-    (Protocols.Handle.t, Concepts.Condition.condition) result
-
-  (** a schema handed over with no address, as a directory holding its
-      relations under \relation, to store once the write has begun. A
-      relation with no address is stored as a program if it is one, and
-      as the tuples it holds if not. *)
-  val admit :
-    string ->
-    Protocols.Handle.t ->
-    (S.transaction Prototype.Associative.admission, Concepts.Condition.condition) result
-
-  (** an empty one, stored. *)
-  val make : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result
-end