dune fmt

21 files changed, 839 insertions, 791 deletions

diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index 53f6fa1..d398707 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -7,7 +7,6 @@ module Make (S : Abstract.Storage.STORAGE) = struct
    *)
 
   module SI = Storage.Make (S)
-
   module M = Multigroup.Make (S)
   module MultigroupM = Merkle.Interface (S) (Merkle.StringKey) (M)
   module MMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (M)
@@ -18,112 +17,117 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     open Concepts.Condition
 
     let incomplete_branch addr =
-      condition "incomplete-branch" "A stored branch is missing part of its expected structure. Is your storage corrupted?"
+      condition "incomplete-branch"
+        "A stored branch is missing part of its expected structure. Is your storage corrupted?"
         ("address" |=| Concepts.Value.String (Concepts.Hash.to_hum_string addr))
   end
 
-  type t = {
-    multigroups : MultigroupM.address;
-    previous : t SI.Pointer.t option
-  }
+  type t = {multigroups: MultigroupM.address; previous: t SI.Pointer.t option}
+
+  module rec Representation : (Concepts.Encoding.Record.S with type t = t) =
+    Concepts.Encoding.Record.Make (Body)
 
-  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 = 'Y'
+
     let malformed () =
-      Concepts.Condition.
-      (condition "malformed-branch" "The on-disk representation of a branch did not conform to what was expected. Is your database corrupted?"
-         empty)
+      Concepts.Condition.(
+        condition "malformed-branch"
+          "The on-disk representation of a branch did not conform to what was expected. Is your \
+           database corrupted?"
+          empty )
 
-    let fields { multigroups; previous } =
+    let fields {multigroups; previous} =
       let open Concepts.Encoding in
-      ["multigroups", Value.bencode_of_hash multigroups;
-       "previous", Value.bencode_of_option
-                     (fun v -> SI.Pointer.address_of v
-                               |> SI.as_hash
-                               |> Value.bencode_of_hash)
-                     previous]
+      [ "multigroups", Value.bencode_of_hash multigroups;
+        ( "previous",
+          Value.bencode_of_option
+            (fun v -> SI.Pointer.address_of v |> SI.as_hash |> Value.bencode_of_hash)
+            previous ) ]
 
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
       let* multigroups = Bencode.field "multigroups" fields |> fmap Value.hash_of_bencode in
-      let* previous = Bencode.field "previous" fields
-                      |> fmap (Value.option_of_bencode
-                                 (fun v -> Value.hash_of_bencode v
-                                           |> Result.map (fun hash -> S.Hash hash)
-                                           |> Result.map (SI.Pointer.make Loader.load))) in
-      Ok { multigroups; previous }
+      let* previous =
+        Bencode.field "previous" fields
+        |> fmap
+             (Value.option_of_bencode (fun v ->
+                  Value.hash_of_bencode v
+                  |> Result.map (fun hash -> S.Hash hash)
+                  |> Result.map (SI.Pointer.make Loader.load) ) )
+      in
+      Ok {multigroups; previous}
   end
-  and Loader : sig val load : (S.transaction -> S.address -> (t, Concepts.Condition.condition) result) end = struct
-    let load tx addr =
-      SI.get_req tx addr
-      |> Utilities.Result.fmap Representation.of_blob
+
+  and Loader : sig
+    val load : S.transaction -> S.address -> (t, Concepts.Condition.condition) result
+  end = struct
+    let load tx addr = SI.get_req tx addr |> Utilities.Result.fmap Representation.of_blob
   end
 
   let pointer_of hash = SI.Pointer.make Loader.load (S.Hash hash)
 
-  class branch storage value node = object (self)
-    inherit Lifecycle.null
-
-    method to_string = "branch"
-
-    val storage : S.connection = storage
-    val branch : t = value
-    val node = node (* FIXME: can we not place this inside `t`? *)
-
-    method deriving branch' =
-      let open Utilities.Result in
-      let branch'' = { branch' with previous = self#address
-                                               |> pointer_of
-                                               |> Option.some } in
-      let* node' = SI.with_transaction storage (fun tx ->
-                       let* _ = SI.store_blob tx (Representation.to_blob branch'') in
-                       MultigroupM.find tx branch'.multigroups
-                       |> fmap (Option.to_result ~none:(Error.incomplete_branch branch'.multigroups))) in
-      new branch storage branch'' 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
-                    [ "multigroup", update_only (fun node' ->
-                                        Handle.require Addressable.from node'
-                                        |> Result.map Addressable.address
-                                        |> fmap (fun addr -> self#deriving { branch with multigroups = addr })) ]);
-                  Prototype.Directory.of_properties
-                    [ "multigroup", Prototype.mixture_of node
-                                      (fun make node ->
-                                        [ MMAddressable.make
-                                            ~node:(MultigroupM.into node);
-                                          MMDirectory.make
-                                            ~storage ~node
-                                            ~constructor:(M.wrap storage);
-	                                      MMAssociative.make
-                                            ~storage ~node:(MultigroupM.into node)
-                                            ~constructor:(fun node' -> MultigroupM.from node' |> make |> Result.ok) ]) ] ]
-
-    method hash =
-      Representation.to_blob branch
-      |> Concepts.Hash.hash_of_blob
-
-    method address = self#hash
-  end
+  class branch storage value node =
+    object (self)
+      inherit Lifecycle.null
+      method to_string = "branch"
+      val storage : S.connection = storage
+      val branch : t = value
+      val node = node (* FIXME: can we not place this inside `t`? *)
+
+      method deriving branch' =
+        let open Utilities.Result in
+        let branch'' = {branch' with previous= self#address |> pointer_of |> Option.some} in
+        let* node' =
+          SI.with_transaction storage (fun tx ->
+              let* _ = SI.store_blob tx (Representation.to_blob branch'') in
+              MultigroupM.find tx branch'.multigroups
+              |> fmap (Option.to_result ~none:(Error.incomplete_branch branch'.multigroups)) )
+        in
+        new branch storage branch'' 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
+                [ ( "multigroup",
+                    update_only (fun node' ->
+                        Handle.require Addressable.from node'
+                        |> Result.map Addressable.address
+                        |> fmap (fun addr -> self#deriving {branch with multigroups= addr}) ) ) ] );
+            Prototype.Directory.of_properties
+              [ ( "multigroup",
+                  Prototype.mixture_of node (fun make node ->
+                      [ MMAddressable.make ~node:(MultigroupM.into node);
+                        MMDirectory.make ~storage ~node ~constructor:(M.wrap storage);
+                        MMAssociative.make ~storage ~node:(MultigroupM.into node)
+                          ~constructor:(fun node' -> MultigroupM.from node' |> make |> Result.ok )
+                      ] ) ) ] ]
+
+      method hash = Representation.to_blob branch |> Concepts.Hash.hash_of_blob
+      method address = self#hash
+    end
 
   let load tx conn addr =
     let open Utilities.Result in
     let* data = SI.get_req tx (S.Hash addr) in
     let* branch = Representation.of_blob data in
-    let* node = MultigroupM.find tx branch.multigroups |> fmap (Option.to_result ~none:(Error.incomplete_branch branch.multigroups)) in
+    let* node =
+      MultigroupM.find tx branch.multigroups
+      |> fmap (Option.to_result ~none:(Error.incomplete_branch branch.multigroups))
+    in
     Ok (new branch conn branch node |> Protocols.Handle.make)
 
   let make conn =
     let open Utilities.Result in
     SI.with_transaction conn (fun tx ->
         let* empty = MultigroupM.empty_under tx in
-        let branch = { multigroups = empty; previous = None } in
+        let branch = {multigroups= empty; previous= None} in
         let* _ = SI.store_blob tx (Representation.to_blob branch) in
-        Ok (new branch conn branch MultigroupM.empty |> Protocols.Handle.make))
+        Ok (new branch conn branch MultigroupM.empty |> Protocols.Handle.make) )
 end
diff --git a/lib/kernel/Branch.mli b/lib/kernel/Branch.mli
index 82bdbb7..c08e781 100644
--- a/lib/kernel/Branch.mli
+++ b/lib/kernel/Branch.mli
@@ -2,5 +2,10 @@ module Make (S : Abstract.Storage.STORAGE) : sig
   type t
 
   val make : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result
-  val load : S.transaction -> S.connection -> Concepts.Hash.hash -> (Protocols.Handle.t, Concepts.Condition.condition) result
+
+  val load :
+    S.transaction ->
+    S.connection ->
+    Concepts.Hash.hash ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/BranchManager.ml b/lib/kernel/BranchManager.ml
index bda4233..3531748 100644
--- a/lib/kernel/BranchManager.ml
+++ b/lib/kernel/BranchManager.ml
@@ -2,8 +2,10 @@ module Error = struct
   open Concepts.Condition
 
   let invalid_root head =
-    condition "invalid-root" "The root hash for the database state is missing from the backend. Either your storage is corrupted, or this is a bug in RNT!"
-      ("hash" |=| (Concepts.Value.String (Concepts.Hash.to_hum_string head)))
+    condition "invalid-root"
+      "The root hash for the database state is missing from the backend. Either your storage is \
+       corrupted, or this is a bug in RNT!"
+      ("hash" |=| Concepts.Value.String (Concepts.Hash.to_hum_string head))
 end
 
 module Make (S : Abstract.Storage.STORAGE) = struct
@@ -14,89 +16,90 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   let root_for tx label =
     let open Utilities.Result in
     let* label = S.get tx (S.Label label) in
-    let data = Option.map (fun blob -> Concepts.Blob.bytes_of_blob blob
-                                       |> Bytes.to_string
-                                       |> Concepts.Hash.of_raw_string)
-                 label in
+    let data =
+      Option.map
+        (fun blob ->
+          Concepts.Blob.bytes_of_blob blob |> Bytes.to_string |> Concepts.Hash.of_raw_string )
+        label
+    in
     Ok data
 
   let persist_root tx label addr =
     let data = Concepts.Hash.blob_of_hash addr in
     S.put tx (S.Label label) data
 
-  class manager storage label head = object (self)
-    inherit Lifecycle.null
-    inherit Identity.of_id
+  class manager storage label head =
+    object (self)
+      inherit Lifecycle.null
+      inherit Identity.of_id
+      method to_string = "branch-manager"
+      val storage : S.connection = storage
+      val label : string = label
+      val head : M.node Atomic.t = Atomic.make head
 
-    method to_string = "branch-manager"
+      method fetch branch_name =
+        SI.with_transaction storage (fun tx ->
+            let head = Atomic.get head in
+            M.lookup tx branch_name head )
 
-    val storage : S.connection = storage
-    val label : string = label
-    val head : M.node Atomic.t = Atomic.make head
+      method protocols = Protocols.[Directory.make self; Registry.make self]
+      method list = SI.with_transaction storage (fun tx -> Atomic.get head |> M.keys tx)
 
-    method fetch branch_name =
-      SI.with_transaction storage (fun tx ->
-          let head = Atomic.get head in
-          M.lookup tx branch_name head)
+      method find key =
+        let open Utilities.Result in
+        SI.with_transaction storage (fun tx ->
+            let* head = Atomic.get head |> M.lookup tx key in
+            match head with
+            | None -> Ok None
+            | Some head -> B.load tx storage head |> Result.map Option.some )
 
-    method protocols = Protocols.[Directory.make self; Registry.make self]
-
-    method list = SI.with_transaction storage (fun tx -> Atomic.get head |> M.keys tx)
-
-    method find key =
-      let open Utilities.Result in
-      SI.with_transaction storage (fun tx ->
-          let* head = Atomic.get head |> M.lookup tx key in
-          match head with
-          | None -> Ok None
-          | Some head -> B.load tx storage head |> Result.map Option.some)
-
-    method update key reference value =
-      let open Utilities.Result in
-      let open Protocols in
-      SI.with_transaction storage (fun tx ->
-          match
-            Utilities.Atomic.mswap head (fun head ->
-                let address_of h =
-                  let* i = Handle.require Addressable.from h in
-                  Ok (Addressable.address i)
-                in
-                let* branch = M.lookup tx key head |> Result.map_error (fun e -> Some e) in
-                let* reference = Option.map address_of reference
-                                 |> Utilities.Option.sequence
-                                 |> Result.map_error (fun e -> Some e) in
-                let* value = Option.map address_of value
-                             |> Utilities.Option.sequence
-                             |> Result.map_error (fun e -> Some e) in
-                if branch = reference then
-                  begin
-                    let* new_head = match value with
-                      | Some value -> M.insert tx key value head
-                      | None -> M.remove tx key head
-                    in
-                    let* _ = persist_root tx label (M.hash_of new_head) in
-                    Ok new_head
-                  end
-                  |> Result.map_error (fun e -> Some e)
-                else
-                  Error None)
-          with
-          | Ok _ -> Ok true
-          | Error None -> Ok false
-          | Error (Some e) -> Error e)
-
-  end
+      method update key reference value =
+        let open Utilities.Result in
+        let open Protocols in
+        SI.with_transaction storage (fun tx ->
+            match
+              Utilities.Atomic.mswap head (fun head ->
+                  let address_of h =
+                    let* i = Handle.require Addressable.from h in
+                    Ok (Addressable.address i)
+                  in
+                  let* branch = M.lookup tx key head |> Result.map_error (fun e -> Some e) in
+                  let* reference =
+                    Option.map address_of reference
+                    |> Utilities.Option.sequence
+                    |> Result.map_error (fun e -> Some e)
+                  in
+                  let* value =
+                    Option.map address_of value
+                    |> Utilities.Option.sequence
+                    |> Result.map_error (fun e -> Some e)
+                  in
+                  if branch = reference then
+                    begin
+                      let* new_head =
+                        match value with
+                        | Some value -> M.insert tx key value head
+                        | None -> M.remove tx key head
+                      in
+                      let* _ = persist_root tx label (M.hash_of new_head) in
+                      Ok new_head
+                    end
+                    |> Result.map_error (fun e -> Some e)
+                  else Error None )
+            with
+            | Ok _ -> Ok true
+            | Error None -> Ok false
+            | Error (Some e) -> Error e )
+    end
 
   let make storage label =
     let open Utilities.Result in
     SI.with_transaction storage (fun tx ->
         let* addr = root_for tx label in
         match addr with
-        | None ->
-           Ok (new manager storage label M.empty |> Protocols.Handle.make)
+        | None -> Ok (new manager storage label M.empty |> Protocols.Handle.make)
         | Some addr ->
-           let* head = M.find tx addr in
-           let* head = Option.to_result ~none:(Error.invalid_root addr) head in
-           Ok (new manager storage label head |> Protocols.Handle.make))
-
+            let* head = M.find tx addr in
+            let* head = Option.to_result ~none:(Error.invalid_root addr) head in
+            Ok (new manager storage label head |> Protocols.Handle.make) )
 end
diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
index b403e13..8aa0463 100644
--- a/lib/kernel/EphemeralRelation.ml
+++ b/lib/kernel/EphemeralRelation.ml
@@ -41,7 +41,7 @@ module Make (D : DERIVATION) = struct
       method generate binding =
         D.generate plan binding
         |> Result.map (fun cursor ->
-               new Lifecycle.retaining cursor (self :> Lifecycle.lifecycle) |> Protocols.Handle.make )
+            new Lifecycle.retaining cursor (self :> Lifecycle.lifecycle) |> Protocols.Handle.make )
 
       method enumerate = self#generate Protocols.Generative.nothing
       method describe () = Ok (Protocols.Schematics.Relation description)
diff --git a/lib/kernel/Generator.ml b/lib/kernel/Generator.ml
index 204699f..272bb86 100644
--- a/lib/kernel/Generator.ml
+++ b/lib/kernel/Generator.ml
@@ -5,8 +5,8 @@ type step =
   | Finished of (unit, Concepts.Condition.condition) result
 
 let start produce =
-  try Finished (produce ~yield:(fun tuple -> Effect.perform (Yield tuple))) with
-  | effect (Yield tuple), k -> Element (tuple, k)
+  try Finished (produce ~yield:(fun tuple -> Effect.perform (Yield tuple)))
+  with effect Yield tuple, k -> Element (tuple, k)
 
 let resume k = Effect.Deep.continue k ()
 
@@ -14,9 +14,7 @@ class producer_cursor produce finally =
   object (self)
     inherit Lifecycle.null
     inherit Identity.of_id
-
     method to_string = "producer-cursor"
-
     val mutable state : [`Fresh | `Live of (unit, step) Effect.Deep.continuation | `Done] = `Fresh
     method protocols : Protocols.Handle.protocol list = Protocols.[Cursor.make self]
 
@@ -48,12 +46,10 @@ class producer_cursor produce finally =
           | None -> Ok Protocols.Cursor.{tuples; exhausted= true}
           | Some tuple -> fill (taken + 1) (BatFingerTree.snoc tuples tuple)
       in
-      if limit <= 0 then
-        Ok Protocols.Cursor.{tuples= BatFingerTree.empty; exhausted= (state = `Done)}
+      if limit <= 0 then Ok Protocols.Cursor.{tuples= BatFingerTree.empty; exhausted= state = `Done}
       else fill 0 BatFingerTree.empty
 
     method! release = match state with `Fresh | `Live _ -> self#finish | `Done -> ()
   end
 
-let cursor_of ?finally produce =
-  new producer_cursor produce finally |> Protocols.Handle.make
+let cursor_of ?finally produce = new producer_cursor produce finally |> Protocols.Handle.make
diff --git a/lib/kernel/Identity.ml b/lib/kernel/Identity.ml
index ce3d30c..2205958 100644
--- a/lib/kernel/Identity.ml
+++ b/lib/kernel/Identity.ml
@@ -2,6 +2,7 @@ class type identity = object
   method hash : Concepts.Hash.hash
 end
 
-class of_id = object (self)
-  method hash = Oo.id self |> Concepts.Hash.hash_of_int
-end
+class of_id =
+  object (self)
+    method hash = Oo.id self |> Concepts.Hash.hash_of_int
+  end
diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index ae041fc..25c2b3d 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -14,7 +14,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       List.fold_left
         (fun acc (name, handle) ->
           let* _ = acc in
-          Registry.update evaluator_registry name None (Some handle))
+          Registry.update evaluator_registry name None (Some handle) )
         (Ok true) evaluators
     in
     let* _ = Registry.update registry "evaluator" None (Some evaluator_namespace) in
diff --git a/lib/kernel/Lifecycle.ml b/lib/kernel/Lifecycle.ml
index 772cb6e..bf0b544 100644
--- a/lib/kernel/Lifecycle.ml
+++ b/lib/kernel/Lifecycle.ml
@@ -8,33 +8,25 @@ class type virtual controlled_lifecycle = object
   method virtual destroy : unit
 end
 
-class null = object
-  method reference = true
-  method release = ()
-end
-
-class virtual counted = object (self)
-  val references = Atomic.make 1
-
-  method virtual destroy : unit
-
-  method reference =
-    Atomic.incr references;
-    true
-
-  method release =
-    if Atomic.fetch_and_add references (-1) = 1 then
-      self#destroy
-end
-
-class retaining inner (owner : lifecycle) = object
-  inherit counted
-  initializer ignore owner#reference
-
-  method destroy =
-    Protocols.Handle.release inner;
-    owner#release
-
-  method hash = Protocols.Handle.hash inner
-  method protocols = Protocols.Handle.protocols inner
-end
+class null =
+  object
+    method reference = true
+    method release = ()
+  end
+
+class virtual counted =
+  object (self)
+    val references = Atomic.make 1
+    method virtual destroy : unit
+    method reference = Atomic.incr references; true
+    method release = if Atomic.fetch_and_add references (-1) = 1 then self#destroy
+  end
+
+class retaining inner (owner : lifecycle) =
+  object
+    inherit counted
+    initializer ignore owner#reference
+    method destroy = Protocols.Handle.release inner; owner#release
+    method hash = Protocols.Handle.hash inner
+    method protocols = Protocols.Handle.protocols inner
+  end
diff --git a/lib/kernel/Merkle.ml b/lib/kernel/Merkle.ml
index fc076ac..af5b19f 100644
--- a/lib/kernel/Merkle.ml
+++ b/lib/kernel/Merkle.ml
@@ -13,234 +13,238 @@ end
 
 module type TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> sig
   type address = Concepts.Hash.hash
-
   type node
 
-  val with_batch: S.transaction -> (unit -> (node, Concepts.Condition.condition) result) -> (node, Concepts.Condition.condition) result
+  val with_batch :
+    S.transaction ->
+    (unit -> (node, Concepts.Condition.condition) result) ->
+    (node, Concepts.Condition.condition) result
 
   val find : S.transaction -> address -> (node option, Concepts.Condition.condition) result
   val persist : S.transaction -> node -> (address, Concepts.Condition.condition) result
-
   val empty : node
   val empty_under : S.transaction -> (address, Concepts.Condition.condition) result
-
   val hash_of : node -> address
 
-  val insert : S.transaction -> K.t -> address -> node -> (node, Concepts.Condition.condition) result
+  val insert :
+    S.transaction -> K.t -> address -> node -> (node, Concepts.Condition.condition) result
+
   val remove : S.transaction -> K.t -> node -> (node, Concepts.Condition.condition) result
   val lookup : S.transaction -> K.t -> node -> (address option, Concepts.Condition.condition) result
 
-  val fold_left : S.transaction -> ('c -> K.t -> address -> 'c) -> 'c -> node -> ('c, Concepts.Condition.condition) result
+  val fold_left :
+    S.transaction ->
+    ('c -> K.t -> address -> 'c) ->
+    'c ->
+    node ->
+    ('c, Concepts.Condition.condition) result
+
   val keys : S.transaction -> node -> (K.t BatFingerTree.t, Concepts.Condition.condition) result
 end
 
-module Make : TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> struct
-  type address = Concepts.Hash.hash
+module Make : TREE =
+functor
+  (S : Abstract.Storage.STORAGE)
+  (K : KEY)
+  ->
+  struct
+    type address = Concepts.Hash.hash
 
-  module Error = struct
-    open Concepts.Condition
+    module Error = struct
+      open Concepts.Condition
 
-    let malformed_node () = condition "malformed-node" "A node representation did not conform to what was expected" empty
-  end
+      let malformed_node () =
+        condition "malformed-node" "A node representation did not conform to what was expected"
+          empty
+    end
 
-  type node =
-    Leaf of
-      { keys : K.t BatFingerTree.t;
-        values : address BatFingerTree.t }
-  | Trunk of
-      { keys : K.t BatFingerTree.t;
-        children : address BatFingerTree.t }
-
-  let empty = Leaf { keys = BatFingerTree.empty; values = BatFingerTree.empty }
-
-  let rec lookup1' keys key bottom top =
-    let open Utilities.Ordering in
-    if bottom >= top then (bottom, false)
-    else
-      let mid = bottom + (top - bottom) / 2 in
-      let node = BatFingerTree.get keys mid in
-      match K.compare node key with
-      | Equal -> (mid, true)
-      | Greater -> lookup1' keys key bottom mid
-      | Smaller -> lookup1' keys key (mid + 1) top
-
-  let lookup1 keys key = lookup1' keys key 0 (BatFingerTree.size keys)
-
-  let keys_of = function
-    | Leaf { keys; _ } -> keys
-    | Trunk { keys; _ } -> keys
-
-  let of_bencode =
-    let open Concepts.Encoding.Bencode in
-    let open Utilities.Result in
-    (* This is terrible *)
-    let decode_key t = as_string t
-                       |> Result.map String.to_bytes
-                       |> Result.map Concepts.Blob.blob_of_bytes
-                       |> fmap K.decode in
-    let decode_value t = as_string t |> Result.map Concepts.Hash.of_raw_string in
-    let decode_list f data = data
-                             |> fmap as_list
-                             |> Result.map (List.map f)
-                             |> fmap Utilities.List.sequence
-                             |> Result.map BatFingerTree.of_list in
-    function
-    | Tagged ('!', (Dict _ as data)) ->
-       let* keys = field "keys" data |> decode_list decode_key in
-       let* values = field "values" data |> decode_list decode_value in
-       Ok (Leaf { keys; values })
-    | Tagged ('#', (Dict _ as data)) ->
-       let* keys = field "keys" data |> decode_list decode_key in
-       let* children = field "children" data |> decode_list decode_value in
-       Ok (Trunk { keys; children })
-    | _ -> Error (Error.malformed_node ())
-
-  let from_blob blob = Concepts.Encoding.Bencode.of_blob blob
-                       |> Utilities.Result.fmap of_bencode
-
-  let to_bencode =
-    let open Concepts.Encoding.Bencode in
-    (* Ditto. *)
-    let bencode_key k = K.encode k
-                        |> Concepts.Blob.bytes_of_blob
-                        |> String.of_bytes
-                        |> (fun s -> String s) in
-    let bencode_hash h = String (Concepts.Hash.to_raw_string h) in
-    function
-    | Leaf { keys; values } ->
-       Tagged ('!', Dict [("keys", List (BatFingerTree.to_list keys |> List.map bencode_key));
-                          ("values", List (BatFingerTree.to_list values |> List.map bencode_hash))])
-    | Trunk { keys; children } ->
-       Tagged ('#', Dict [("keys", List (BatFingerTree.to_list keys |> List.map bencode_key));
-                          ("children", List (BatFingerTree.to_list children |> List.map bencode_hash))])
-
-  let to_blob node = to_bencode node |> Concepts.Encoding.Bencode.to_blob
-
-  (* TODO: we should probably cache this inside the node itself rather
+    type node =
+      | Leaf of {keys: K.t BatFingerTree.t; values: address BatFingerTree.t}
+      | Trunk of {keys: K.t BatFingerTree.t; children: address BatFingerTree.t}
+
+    let empty = Leaf {keys= BatFingerTree.empty; values= BatFingerTree.empty}
+
+    let rec lookup1' keys key bottom top =
+      let open Utilities.Ordering in
+      if bottom >= top then bottom, false
+      else
+        let mid = bottom + ((top - bottom) / 2) in
+        let node = BatFingerTree.get keys mid in
+        match K.compare node key with
+        | Equal -> mid, true
+        | Greater -> lookup1' keys key bottom mid
+        | Smaller -> lookup1' keys key (mid + 1) top
+
+    let lookup1 keys key = lookup1' keys key 0 (BatFingerTree.size keys)
+    let keys_of = function Leaf {keys; _} -> keys | Trunk {keys; _} -> keys
+
+    let of_bencode =
+      let open Concepts.Encoding.Bencode in
+      let open Utilities.Result in
+      (* This is terrible *)
+      let decode_key t =
+        as_string t
+        |> Result.map String.to_bytes
+        |> Result.map Concepts.Blob.blob_of_bytes
+        |> fmap K.decode
+      in
+      let decode_value t = as_string t |> Result.map Concepts.Hash.of_raw_string in
+      let decode_list f data =
+        data
+        |> fmap as_list
+        |> Result.map (List.map f)
+        |> fmap Utilities.List.sequence
+        |> Result.map BatFingerTree.of_list
+      in
+      function
+      | Tagged ('!', (Dict _ as data)) ->
+          let* keys = field "keys" data |> decode_list decode_key in
+          let* values = field "values" data |> decode_list decode_value in
+          Ok (Leaf {keys; values})
+      | Tagged ('#', (Dict _ as data)) ->
+          let* keys = field "keys" data |> decode_list decode_key in
+          let* children = field "children" data |> decode_list decode_value in
+          Ok (Trunk {keys; children})
+      | _ -> Error (Error.malformed_node ())
+
+    let from_blob blob = Concepts.Encoding.Bencode.of_blob blob |> Utilities.Result.fmap of_bencode
+
+    let to_bencode =
+      let open Concepts.Encoding.Bencode in
+      (* Ditto. *)
+      let bencode_key k =
+        K.encode k |> Concepts.Blob.bytes_of_blob |> String.of_bytes |> fun s -> String s
+      in
+      let bencode_hash h = String (Concepts.Hash.to_raw_string h) in
+      function
+      | Leaf {keys; values} ->
+          Tagged
+            ( '!',
+              Dict
+                [ "keys", List (BatFingerTree.to_list keys |> List.map bencode_key);
+                  "values", List (BatFingerTree.to_list values |> List.map bencode_hash) ] )
+      | Trunk {keys; children} ->
+          Tagged
+            ( '#',
+              Dict
+                [ "keys", List (BatFingerTree.to_list keys |> List.map bencode_key);
+                  "children", List (BatFingerTree.to_list children |> List.map bencode_hash) ] )
+
+    let to_blob node = to_bencode node |> Concepts.Encoding.Bencode.to_blob
+
+    (* TODO: we should probably cache this inside the node itself rather
      than recalculating it every time. We could also allow the user to
      create "uninterned" nodes that are not storage-backed, that could
      be used for intermediates and the like. *)
-  let hash_of node = to_blob node |> Concepts.Hash.hash_of_blob
-
-  type _ Effect.t += Intern: (address * node * Concepts.Blob.t) -> unit Effect.t | Retrieve: address -> (node * Concepts.Blob.t) option Effect.t
-
-  let rec flush tx buffer addr =
-    let open Utilities.Result in
-    match BatMap.find_opt addr buffer with
-    | None -> Ok ()
-    | Some (node, data) ->
-       let* _ = S.put tx (S.Hash addr) data in
-       match node with
-       | Leaf _ -> Ok ()
-       | Trunk { children; _ } ->
-          BatFingerTree.map (fun addr -> flush tx buffer addr) children
-          |> Utilities.FingerTree.sequence
-          |> Result.map ignore
-
-  let with_batch tx f =
-    let open Utilities.Result in
-    let buffer = ref BatMap.empty in
-    try
-      let* node = f () in
-      let* _ = flush tx !buffer (hash_of node) in
-      Ok node
-    with
-    | effect (Intern (addr, node, data)), k ->
-       buffer := BatMap.add addr (node, data) !buffer;
-       Effect.Deep.continue k ()
-    | effect (Retrieve addr), k ->
-       Effect.Deep.continue k (BatMap.find_opt addr !buffer)
-
-  let find tx addr =
-    let open Utilities.Result in
-    try Effect.perform (Retrieve addr) |> Option.map fst |> Result.ok
-    with
-    | Effect.Unhandled _ ->
-       let* data = S.get tx (S.Hash addr) in
-       match data with
-       | None -> Ok None
-       | Some data ->
-          let* node = from_blob data in
-          Ok (Some node)
-
-  let persist tx node =
-    let data = to_blob node in
-    let addr = Concepts.Hash.hash_of_blob data in
-    begin
-      try Ok (Effect.perform (Intern (addr, node, data)))
+    let hash_of node = to_blob node |> Concepts.Hash.hash_of_blob
+
+    type _ Effect.t +=
+      | Intern : (address * node * Concepts.Blob.t) -> unit Effect.t
+      | Retrieve : address -> (node * Concepts.Blob.t) option Effect.t
+
+    let rec flush tx buffer addr =
+      let open Utilities.Result in
+      match BatMap.find_opt addr buffer with
+      | None -> Ok ()
+      | Some (node, data) -> (
+          let* _ = S.put tx (S.Hash addr) data in
+          match node with
+          | Leaf _ -> Ok ()
+          | Trunk {children; _} ->
+              BatFingerTree.map (fun addr -> flush tx buffer addr) children
+              |> Utilities.FingerTree.sequence
+              |> Result.map ignore )
+
+    let with_batch tx f =
+      let open Utilities.Result in
+      let buffer = ref BatMap.empty in
+      try
+        let* node = f () in
+        let* _ = flush tx !buffer (hash_of node) in
+        Ok node
       with
-      | Effect.Unhandled _ ->
-         S.put tx (S.Hash addr) data
-    end
-    |> Result.map (fun () -> addr)
-
-  let find' tx addr =
-    let open Utilities.Result in
-    let* child = find tx addr in
-    match child with
-    | Some child -> Ok child
-    | None -> failwith "A child node was not found on the underlying storage. Either your database is corrupted, or this is a bug on RNT!"
-
-  let rec lookup tx key node =
-    let open Utilities.Result in
-    let i, found = lookup1 (keys_of node) key in
-    match node with
-    | Leaf { values; _ } ->
-       if found then Ok (Some (BatFingerTree.get values i)) else Ok None
-    | Trunk { children; _ } ->
-       let* child = BatFingerTree.get children (if found then i+1 else i) |> find' tx in
-       lookup tx key child
-
-  let empty_under tx = persist tx empty
-
-  type op = Update of address * node | Split of address * K.t * address
-
-  let emplace i v ft =
-    let size = BatFingerTree.size ft in
-    if i < 0 || i > size then
-      invalid_arg "Merkle.emplace: index out of bounds"
-    else if size = 0 then
-      BatFingerTree.singleton v
-    else if i = size then
-      BatFingerTree.snoc ft v
-    else
-      let fl, fr = BatFingerTree.split_at ft i in
-      BatFingerTree.singleton v
-      |> BatFingerTree.append fl
-      |> (Fun.flip BatFingerTree.append) fr
-
-  let insert1 key value node =
-    let i, present = lookup1 (keys_of node) key in
-    match node with
-    | Leaf ({ keys; values } as leaf) ->
-       if present then
-         Leaf { leaf with values = BatFingerTree.set values i value }
-       else
-         Leaf { keys = emplace i key keys; values = emplace i value values }
-    (* When in danger or in doubt: run in circles, scream and shout. *)
-    | Trunk _ -> failwith "Cannot insert a value on a trunk node. This is a bug in RNT!"
-
-  let pivot_at ft i =
-    let l, r' = BatFingerTree.split_at ft i in
-    let r, p = BatFingerTree.front_exn r' in
-    l, p, r
-
-  let split_at pivot = function
-    | Leaf { keys; values } ->
-       let kl, kr = BatFingerTree.split_at keys pivot in
-       let vl, vr = BatFingerTree.split_at values pivot in
-       let p = BatFingerTree.get kr 0 in
-       Leaf { keys = kl; values = vl },
-       p,
-       Leaf { keys = kr; values = vr }
-    | Trunk { keys; children } ->
-       let kl, kp, kr = pivot_at keys pivot in
-       let cl, cr = BatFingerTree.split_at children (pivot + 1) in
-       Trunk { keys = kl; children = cl },
-       kp,
-       Trunk { keys = kr; children = cr }
-
-  (* FIXME: this works out to a geometric distribution with roughly 64
+      | effect Intern (addr, node, data), k ->
+          buffer := BatMap.add addr (node, data) !buffer;
+          Effect.Deep.continue k ()
+      | effect Retrieve addr, k -> Effect.Deep.continue k (BatMap.find_opt addr !buffer)
+
+    let find tx addr =
+      let open Utilities.Result in
+      try Effect.perform (Retrieve addr) |> Option.map fst |> Result.ok
+      with Effect.Unhandled _ -> (
+        let* data = S.get tx (S.Hash addr) in
+        match data with
+        | None -> Ok None
+        | Some data ->
+            let* node = from_blob data in
+            Ok (Some node) )
+
+    let persist tx node =
+      let data = to_blob node in
+      let addr = Concepts.Hash.hash_of_blob data in
+      begin try Ok (Effect.perform (Intern (addr, node, data)))
+      with Effect.Unhandled _ -> S.put tx (S.Hash addr) data
+      end
+      |> Result.map (fun () -> addr)
+
+    let find' tx addr =
+      let open Utilities.Result in
+      let* child = find tx addr in
+      match child with
+      | Some child -> Ok child
+      | None ->
+          failwith
+            "A child node was not found on the underlying storage. Either your database is \
+             corrupted, or this is a bug on RNT!"
+
+    let rec lookup tx key node =
+      let open Utilities.Result in
+      let i, found = lookup1 (keys_of node) key in
+      match node with
+      | Leaf {values; _} -> if found then Ok (Some (BatFingerTree.get values i)) else Ok None
+      | Trunk {children; _} ->
+          let* child = BatFingerTree.get children (if found then i + 1 else i) |> find' tx in
+          lookup tx key child
+
+    let empty_under tx = persist tx empty
+
+    type op = Update of address * node | Split of address * K.t * address
+
+    let emplace i v ft =
+      let size = BatFingerTree.size ft in
+      if i < 0 || i > size then invalid_arg "Merkle.emplace: index out of bounds"
+      else if size = 0 then BatFingerTree.singleton v
+      else if i = size then BatFingerTree.snoc ft v
+      else
+        let fl, fr = BatFingerTree.split_at ft i in
+        BatFingerTree.singleton v |> BatFingerTree.append fl |> (Fun.flip BatFingerTree.append) fr
+
+    let insert1 key value node =
+      let i, present = lookup1 (keys_of node) key in
+      match node with
+      | Leaf ({keys; values} as leaf) ->
+          if present then Leaf {leaf with values= BatFingerTree.set values i value}
+          else Leaf {keys= emplace i key keys; values= emplace i value values}
+      (* When in danger or in doubt: run in circles, scream and shout. *)
+      | Trunk _ -> failwith "Cannot insert a value on a trunk node. This is a bug in RNT!"
+
+    let pivot_at ft i =
+      let l, r' = BatFingerTree.split_at ft i in
+      let r, p = BatFingerTree.front_exn r' in
+      l, p, r
+
+    let split_at pivot = function
+      | Leaf {keys; values} ->
+          let kl, kr = BatFingerTree.split_at keys pivot in
+          let vl, vr = BatFingerTree.split_at values pivot in
+          let p = BatFingerTree.get kr 0 in
+          Leaf {keys= kl; values= vl}, p, Leaf {keys= kr; values= vr}
+      | Trunk {keys; children} ->
+          let kl, kp, kr = pivot_at keys pivot in
+          let cl, cr = BatFingerTree.split_at children (pivot + 1) in
+          Trunk {keys= kl; children= cl}, kp, Trunk {keys= kr; children= cr}
+
+    (* FIXME: this works out to a geometric distribution with roughly 64
      keys per node. Some of the consequences of this are that:
      - most of our nodes will end up with one or a few elements, which
        would make our trees taller than they would normally need to be
@@ -251,98 +255,94 @@ module Make : TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> struct
      node size. See
      https://www.dolthub.com/docs/architecture/storage-engine/prolly-tree/#controlling-chunk-size
    *)
-  let should_split = Concepts.Hash.pick 6
-
-  let hash_of_keys ks =
-    let buffer = Buffer.create 1024 in
-    BatFingerTree.iter
-      (fun k ->
-        K.encode k
-        |> Concepts.Blob.bytes_of_blob
-        |> Buffer.add_bytes buffer)
-      ks;
-    Concepts.Hash.hash_of_bytes (Buffer.to_bytes buffer)
-
-  let split_position keys =
-    let rec loop left right =
-      match BatFingerTree.front right with
-      | None -> None
-      | Some (tail, head) ->
-         (* TODO: rolling hash *)
-         let left' = BatFingerTree.snoc left head in
-         let hash = hash_of_keys left' in
-         if should_split hash then
-           Some (BatFingerTree.size left)
-         else
-           loop left' tail
-    in
-    loop BatFingerTree.empty keys
-
-  let commit_node tx node =
-    let open Utilities.Result in
-    match split_position (keys_of node) with
-    | Some i ->
-       let l, p, r = split_at i node in
-       let* l_addr = persist tx l in
-       let* r_addr = persist tx r in
-       Ok (Split (l_addr, p, r_addr))
-    | None ->
-       let* addr = persist tx node in
-       Ok (Update (addr, node))
-
-  let rec insert' tx key value node =
-    let open Utilities.Result in
-    match node with
-    | Leaf _ ->
-       insert1 key value node
-       |> commit_node tx
-    | Trunk { keys; children } ->
-       let i, found = lookup1 keys key in
-       let i = if found then i+1 else i in
-       let* child = BatFingerTree.get children i |> find' tx in
-       let* r = insert' tx key value child in
-       match r with
-       | Update (addr, _) ->
-          Trunk { keys; children = BatFingerTree.set children i addr }
-          |> commit_node tx
-       | Split (l, p, r) ->
-          Trunk { keys = emplace i p keys;
-                  children = BatFingerTree.set children i l |> emplace (i + 1) r }
-          |> commit_node tx
-
-  let insert tx key value node =
-    let open Utilities.Result in
-    let* op = insert' tx key value node in
-    match op with
-    | Update (_, node) -> Ok node
-    | Split (l, p, r) ->
-       let new_root =
-         Trunk { keys = BatFingerTree.singleton p;
-                 children = BatFingerTree.empty
-                            |> (Fun.flip BatFingerTree.snoc) l
-                            |> (Fun.flip BatFingerTree.snoc) r } in
-       let* _ = persist tx new_root in
-       Ok new_root
-
-  let remove tx key node = failwith "TODO" [@@warning "-27"]
-
-  let rec fold_left tx f acc =
-    let open Utilities.Result in
-    function
-    | Leaf { keys; values } ->
-       Utilities.FingerTree.zip keys values
-       |> BatFingerTree.fold_left (fun acc (k, v) -> f acc k v) acc
-       |> Result.ok
-    | Trunk { children; _ } ->
-       BatFingerTree.fold_left
-         (fun acc addr ->
-           let* acc = acc in
-           let* node = find' tx addr in
-           fold_left tx f acc node)
-         (Ok acc) children
-
-  let keys tx node = fold_left tx (fun acc k _ -> BatFingerTree.snoc acc k) BatFingerTree.empty node
-end
+    let should_split = Concepts.Hash.pick 6
+
+    let hash_of_keys ks =
+      let buffer = Buffer.create 1024 in
+      BatFingerTree.iter
+        (fun k -> K.encode k |> Concepts.Blob.bytes_of_blob |> Buffer.add_bytes buffer)
+        ks;
+      Concepts.Hash.hash_of_bytes (Buffer.to_bytes buffer)
+
+    let split_position keys =
+      let rec loop left right =
+        match BatFingerTree.front right with
+        | None -> None
+        | Some (tail, head) ->
+            (* TODO: rolling hash *)
+            let left' = BatFingerTree.snoc left head in
+            let hash = hash_of_keys left' in
+            if should_split hash then Some (BatFingerTree.size left) else loop left' tail
+      in
+      loop BatFingerTree.empty keys
+
+    let commit_node tx node =
+      let open Utilities.Result in
+      match split_position (keys_of node) with
+      | Some i ->
+          let l, p, r = split_at i node in
+          let* l_addr = persist tx l in
+          let* r_addr = persist tx r in
+          Ok (Split (l_addr, p, r_addr))
+      | None ->
+          let* addr = persist tx node in
+          Ok (Update (addr, node))
+
+    let rec insert' tx key value node =
+      let open Utilities.Result in
+      match node with
+      | Leaf _ -> insert1 key value node |> commit_node tx
+      | Trunk {keys; children} -> (
+          let i, found = lookup1 keys key in
+          let i = if found then i + 1 else i in
+          let* child = BatFingerTree.get children i |> find' tx in
+          let* r = insert' tx key value child in
+          match r with
+          | Update (addr, _) ->
+              Trunk {keys; children= BatFingerTree.set children i addr} |> commit_node tx
+          | Split (l, p, r) ->
+              Trunk
+                { keys= emplace i p keys;
+                  children= BatFingerTree.set children i l |> emplace (i + 1) r }
+              |> commit_node tx )
+
+    let insert tx key value node =
+      let open Utilities.Result in
+      let* op = insert' tx key value node in
+      match op with
+      | Update (_, node) -> Ok node
+      | Split (l, p, r) ->
+          let new_root =
+            Trunk
+              { keys= BatFingerTree.singleton p;
+                children=
+                  BatFingerTree.empty
+                  |> (Fun.flip BatFingerTree.snoc) l
+                  |> (Fun.flip BatFingerTree.snoc) r }
+          in
+          let* _ = persist tx new_root in
+          Ok new_root
+
+    let remove tx key node = failwith "TODO" [@@warning "-27"]
+
+    let rec fold_left tx f acc =
+      let open Utilities.Result in
+      function
+      | Leaf {keys; values} ->
+          Utilities.FingerTree.zip keys values
+          |> BatFingerTree.fold_left (fun acc (k, v) -> f acc k v) acc
+          |> Result.ok
+      | Trunk {children; _} ->
+          BatFingerTree.fold_left
+            (fun acc addr ->
+              let* acc = acc in
+              let* node = find' tx addr in
+              fold_left tx f acc node )
+            (Ok acc) children
+
+    let keys tx node =
+      fold_left tx (fun acc k _ -> BatFingerTree.snoc acc k) BatFingerTree.empty node
+  end
 
 module type INTERFACE = functor (S : Abstract.Storage.STORAGE) (K : KEY) (V : VALUE) -> sig
   module Tree : module type of Make (S) (K)
@@ -350,83 +350,90 @@ module type INTERFACE = functor (S : Abstract.Storage.STORAGE) (K : KEY) (V : VA
   type address = Concepts.Hash.hash
   type node
 
-  val with_batch: S.transaction -> (unit -> (node, Concepts.Condition.condition) result) -> (node, Concepts.Condition.condition) result
+  val with_batch :
+    S.transaction ->
+    (unit -> (node, Concepts.Condition.condition) result) ->
+    (node, Concepts.Condition.condition) result
 
   val find : S.transaction -> address -> (node option, Concepts.Condition.condition) result
   val from : Tree.node -> node
   val into : node -> Tree.node
-
   val empty : node
   val empty_under : S.transaction -> (address, Concepts.Condition.condition) result
-
   val hash_of : node -> address
-
   val insert : S.transaction -> K.t -> V.t -> node -> (node, Concepts.Condition.condition) result
   val remove : S.transaction -> K.t -> node -> (node, Concepts.Condition.condition) result
   val lookup : S.transaction -> K.t -> node -> (V.t option, Concepts.Condition.condition) result
   val mem : S.transaction -> K.t -> node -> (bool, Concepts.Condition.condition) result
 
-  val fold_left : S.transaction -> ('c -> K.t -> V.t -> 'c) -> 'c -> node -> ('c, Concepts.Condition.condition) result
-  val iter : S.transaction -> (K.t -> V.t -> 'a) -> node -> (unit, Concepts.Condition.condition) result
-  val keys : S.transaction -> node -> (K.t BatFingerTree.t, Concepts.Condition.condition) result
-end
-
-module Interface : INTERFACE = functor (S : Abstract.Storage.STORAGE) (K : KEY) (V : VALUE) -> struct
-  module Tree = Make (S) (K)
-  module SI = Storage.Make (S)
-
-  type address = Tree.address
-  type node = Tree.node
-
-  open Utilities.Result
-
-  let intern tx v =
-    let data = V.encode v in
-    let addr = Concepts.Hash.hash_of_blob data in
-    let* () = S.put tx (S.Hash addr) data in
-    Ok addr
-
-  let retrieve tx addr = SI.get_req tx (S.Hash addr) |> fmap V.decode
-
-  let find = Tree.find
-  let from x = x
-  let into x = x
-  let empty = Tree.empty
-  let empty_under = Tree.empty_under
-  let hash_of = Tree.hash_of
-  let with_batch = Tree.with_batch
-
-  let insert tx k v node =
-    let* addr = intern tx v in
-    Tree.insert tx k addr node
+  val fold_left :
+    S.transaction ->
+    ('c -> K.t -> V.t -> 'c) ->
+    'c ->
+    node ->
+    ('c, Concepts.Condition.condition) result
 
-  let remove = Tree.remove
+  val iter :
+    S.transaction -> (K.t -> V.t -> 'a) -> node -> (unit, Concepts.Condition.condition) result
 
-  let lookup tx k node =
-    let* addr = Tree.lookup tx k node in
-    match addr with
-    | None -> Ok None
-    | Some addr -> retrieve tx addr |> Result.map Option.some
-
-  let mem tx k node = Tree.lookup tx k node |> Result.map Option.is_some
-
-  let fold_left tx f acc node =
-    Tree.fold_left tx
-      (fun acc k addr ->
-        let* acc = acc in
-        let* v = retrieve tx addr in
-        Ok (f acc k v))
-      (Ok acc) node
-    |> Result.join
-
-  let iter tx f node =
-    fold_left tx
-      (fun _ k v -> f k v |> ignore)
-      () node
-
-  let keys = Tree.keys
+  val keys : S.transaction -> node -> (K.t BatFingerTree.t, Concepts.Condition.condition) result
 end
 
+module Interface : INTERFACE =
+functor
+  (S : Abstract.Storage.STORAGE)
+  (K : KEY)
+  (V : VALUE)
+  ->
+  struct
+    module Tree = Make (S) (K)
+    module SI = Storage.Make (S)
+
+    type address = Tree.address
+    type node = Tree.node
+
+    open Utilities.Result
+
+    let intern tx v =
+      let data = V.encode v in
+      let addr = Concepts.Hash.hash_of_blob data in
+      let* () = S.put tx (S.Hash addr) data in
+      Ok addr
+
+    let retrieve tx addr = SI.get_req tx (S.Hash addr) |> fmap V.decode
+    let find = Tree.find
+    let from x = x
+    let into x = x
+    let empty = Tree.empty
+    let empty_under = Tree.empty_under
+    let hash_of = Tree.hash_of
+    let with_batch = Tree.with_batch
+
+    let insert tx k v node =
+      let* addr = intern tx v in
+      Tree.insert tx k addr node
+
+    let remove = Tree.remove
+
+    let lookup tx k node =
+      let* addr = Tree.lookup tx k node in
+      match addr with None -> Ok None | Some addr -> retrieve tx addr |> Result.map Option.some
+
+    let mem tx k node = Tree.lookup tx k node |> Result.map Option.is_some
+
+    let fold_left tx f acc node =
+      Tree.fold_left tx
+        (fun acc k addr ->
+          let* acc = acc in
+          let* v = retrieve tx addr in
+          Ok (f acc k v) )
+        (Ok acc) node
+      |> Result.join
+
+    let iter tx f node = fold_left tx (fun _ k v -> f k v |> ignore) () node
+    let keys = Tree.keys
+  end
+
 module StringKey : KEY with type t = string = struct
   type t = string
 
diff --git a/lib/kernel/Multigroup.ml b/lib/kernel/Multigroup.ml
index c8ffa62..602f3a9 100644
--- a/lib/kernel/Multigroup.ml
+++ b/lib/kernel/Multigroup.ml
@@ -1,30 +1,36 @@
 module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
-
   module R = SubstantialRelation.Make (S)
   module RelationM = Merkle.Interface (S) (Merkle.StringKey) (R)
   module RMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (R)
 
-  type t = { relations : RelationM.address }
+  type t = {relations: RelationM.address}
 
   module Error = struct
     open Concepts.Condition
 
-    let malformed_multigroup () = condition "malformed-multigroup" "The on-disk representation of a multigroup did not conform to what was expected. Is your database corrupted?"
-                                    empty
+    let malformed_multigroup () =
+      condition "malformed-multigroup"
+        "The on-disk representation of a multigroup did not conform to what was expected. Is your \
+         database corrupted?"
+        empty
 
-    let incomplete_multigroup addr = condition "incomplete-multigroup" "A stored multigroup is missing part of its expected structure. Is your storage corrupted?"
-                                       ("address" |=| Concepts.Value.String (Concepts.Hash.to_hum_string addr))
+    let incomplete_multigroup addr =
+      condition "incomplete-multigroup"
+        "A stored multigroup 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)
+  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 = '*'
     let malformed = Error.malformed_multigroup
 
-    let fields { relations } =
+    let fields {relations} =
       let open Concepts.Encoding in
       ["relations", Value.bencode_of_hash relations]
 
@@ -32,47 +38,45 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       let open Utilities.Result in
       let open Concepts.Encoding in
       let* relations = Bencode.field "relations" fields |> fmap Value.hash_of_bencode in
-      Ok { relations }
+      Ok {relations}
   end
 
   let encode = Representation.to_blob
   let decode = Representation.of_blob
 
-  class multigroup conn value node = object (self)
-    inherit Lifecycle.null
-
-    method to_string = "multigroup"
-
-    val multigroup = value
-    val storage = conn
-    val node = node (* FIXME: see the comment on Branch.ml *)
-
-    method protocols : Protocols.Handle.protocol list =
-      Protocols.[ Addressable.make self;
-                  Prototype.Directory.of_properties
-                    [ "relation", Prototype.mixture
-                                    [ RMDirectory.make
-                                        ~storage ~node
-                                        ~constructor:(R.wrap storage) ] ] ]
-
-    method hash =
-      Representation.to_blob multigroup
-      |> Concepts.Hash.hash_of_blob
-
-    method address = self#hash
-  end
+  class multigroup conn value node =
+    object (self)
+      inherit Lifecycle.null
+      method to_string = "multigroup"
+      val multigroup = value
+      val storage = conn
+      val node = node (* FIXME: see the comment on Branch.ml *)
+
+      method protocols : Protocols.Handle.protocol list =
+        Protocols.
+          [ Addressable.make self;
+            Prototype.Directory.of_properties
+              [ ( "relation",
+                  Prototype.mixture [RMDirectory.make ~storage ~node ~constructor:(R.wrap storage)]
+                ) ] ]
+
+      method hash = Representation.to_blob multigroup |> Concepts.Hash.hash_of_blob
+      method address = self#hash
+    end
 
   let wrap conn value =
     let open Utilities.Result in
-    let* node = SI.with_transaction conn (fun tx -> RelationM.find tx value.relations)
-                |> fmap (Option.to_result ~none:(Error.incomplete_multigroup value.relations)) in
+    let* node =
+      SI.with_transaction conn (fun tx -> RelationM.find tx value.relations)
+      |> fmap (Option.to_result ~none:(Error.incomplete_multigroup value.relations))
+    in
     new multigroup 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 multigroup = { relations = empty } in
+        let multigroup = {relations= empty} in
         let* _ = SI.store_blob tx (Representation.to_blob multigroup) in
-        new multigroup conn multigroup RelationM.empty |> Protocols.Handle.make |> Result.ok)
+        new multigroup conn multigroup RelationM.empty |> Protocols.Handle.make |> Result.ok )
 end
diff --git a/lib/kernel/Multigroup.mli b/lib/kernel/Multigroup.mli
index fc58dad..2df41e6 100644
--- a/lib/kernel/Multigroup.mli
+++ b/lib/kernel/Multigroup.mli
@@ -3,7 +3,6 @@ module Make (S : Abstract.Storage.STORAGE) : sig
 
   val encode : t -> Concepts.Blob.t
   val decode : Concepts.Blob.t -> (t, Concepts.Condition.condition) result
-
   val wrap : S.connection -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result
   val make : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/Namespace.ml b/lib/kernel/Namespace.ml
index 728c307..340e813 100644
--- a/lib/kernel/Namespace.ml
+++ b/lib/kernel/Namespace.ml
@@ -1,39 +1,30 @@
-class namespace = object (self)
-  inherit Lifecycle.null
-  inherit Identity.of_id
+class namespace =
+  object (self)
+    inherit Lifecycle.null
+    inherit Identity.of_id
+    method to_string = "namespace"
+    val entries : (string, Protocols.Handle.t) BatMap.t Atomic.t = Atomic.make BatMap.empty
+    method protocols = Protocols.[Directory.make self; Registry.make self]
 
-  method to_string = "namespace"
+    method update key reference value =
+      match
+        Utilities.Atomic.mswap entries (fun e ->
+            if BatMap.find_opt key e = reference then
+              match value with
+              | Some v -> Ok (BatMap.add key v e)
+              | None -> Ok (BatMap.remove key e)
+            else Error () )
+      with
+      | Ok _ -> Ok true
+      | Error _ -> Ok false
 
-  val entries : (string, Protocols.Handle.t) BatMap.t Atomic.t =
-    Atomic.make BatMap.empty
+    method list = Atomic.get entries |> BatMap.keys |> BatFingerTree.of_enum |> Result.ok
 
-  method protocols = Protocols.[Directory.make self; Registry.make self]
-
-  method update key reference value =
-    match
-      Utilities.Atomic.mswap entries
-        (fun e ->
-          if BatMap.find_opt key e = reference then
-            match value with
-            | Some v -> Ok (BatMap.add key v e)
-            | None -> Ok (BatMap.remove key e)
-          else
-            Error ())
-    with
-    | Ok _ -> Ok true
-    | Error _ -> Ok false
-
-  method list =
-    Atomic.get entries
-    |> BatMap.keys
-    |> BatFingerTree.of_enum
-    |> Result.ok
-
-  method find key =
-    Atomic.get entries
-    |> BatMap.find_opt key
-    |> Utilities.Option.fmap Protocols.Handle.copy
-    |> Result.ok
-end
+    method find key =
+      Atomic.get entries
+      |> BatMap.find_opt key
+      |> Utilities.Option.fmap Protocols.Handle.copy
+      |> Result.ok
+  end
 
 let make () = Protocols.Handle.make (new namespace)
diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index b83c9b2..f34abe2 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -1,38 +1,42 @@
 type t = string list
 
 let this = []
-let (@/) x y = x::y
+let ( @/ ) x y = x :: y
 
 let to_string path =
   path
   |> List.map (fun x ->
-         let str = BatString.replace ~str:x ~sub:"^" ~by:"^^" |> snd in
-         BatString.replace ~str ~sub:"/" ~by:"^/" |> snd)
+      let str = BatString.replace ~str:x ~sub:"^" ~by:"^^" |> snd in
+      BatString.replace ~str ~sub:"/" ~by:"^/" |> snd )
   |> BatIO.to_string (BatList.print ~first:"/" ~last:"" ~sep:"/" BatString.print)
 
 module Error = struct
   open Concepts.Condition
 
-  let path_not_found path = condition "path-not-found" "A given path was not found under the specified object"
-                              ("path" |=| Concepts.Value.String (to_string path))
+  let path_not_found path =
+    condition "path-not-found" "A given path was not found under the specified object"
+      ("path" |=| Concepts.Value.String (to_string path))
 end
 
 let walking f g handle path =
   let rec walk handle = function
     | [] -> g handle
-    | x::xs ->
-       let open Utilities.Result in
-       let open Protocols in
-       let* dir =
-         Handle.require Directory.from handle
-         |> Result.map_error Concepts.Condition.(complement ("before-segment" |=| Concepts.Value.String x)) in
-       let* elem = Directory.find dir x in
-       match elem with
-       | None -> Error (Error.path_not_found path)
-       | Some elem -> f x handle (fun () -> walk elem xs)
+    | x :: xs -> (
+        let open Utilities.Result in
+        let open Protocols in
+        let* dir =
+          Handle.require Directory.from handle
+          |> Result.map_error
+               Concepts.Condition.(complement ("before-segment" |=| Concepts.Value.String x))
+        in
+        let* elem = Directory.find dir x in
+        match elem with
+        | None -> Error (Error.path_not_found path)
+        | Some elem -> f x handle (fun () -> walk elem xs) )
   in
   walk handle path
-  |> Result.map_error Concepts.Condition.(complement ("path" |=| Concepts.Value.String (to_string path)))
+  |> Result.map_error
+       Concepts.Condition.(complement ("path" |=| Concepts.Value.String (to_string path)))
 
 let lookup = walking (fun _ _ f -> f ()) Result.ok
 
diff --git a/lib/kernel/Path.mli b/lib/kernel/Path.mli
index ece0615..198ef83 100644
--- a/lib/kernel/Path.mli
+++ b/lib/kernel/Path.mli
@@ -1,9 +1,20 @@
 type t
 
 val this : t
-val (@/) : string -> t -> t
-
+val ( @/ ) : string -> t -> t
 val lookup : Protocols.Handle.t -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result
 
-val update : Protocols.Handle.t -> t -> string -> Protocols.Handle.t option -> Protocols.Handle.t option -> (bool, Concepts.Condition.condition) result
-val assoc : Protocols.Handle.t -> t -> string -> Protocols.Handle.t option -> (Protocols.Handle.t, Concepts.Condition.condition) result
+val update :
+  Protocols.Handle.t ->
+  t ->
+  string ->
+  Protocols.Handle.t option ->
+  Protocols.Handle.t option ->
+  (bool, Concepts.Condition.condition) result
+
+val assoc :
+  Protocols.Handle.t ->
+  t ->
+  string ->
+  Protocols.Handle.t option ->
+  (Protocols.Handle.t, Concepts.Condition.condition) result
diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml
index b159e00..4c96bc3 100644
--- a/lib/kernel/Prototype.ml
+++ b/lib/kernel/Prototype.ml
@@ -1,24 +1,24 @@
-let mixture ps = Protocols.Handle.make @@
-                   object
-                     inherit Lifecycle.null
-                     inherit Identity.of_id (* Should we allow the user to override this? *)
+let mixture ps =
+  Protocols.Handle.make
+  @@ object
+       inherit Lifecycle.null
+       inherit Identity.of_id (* Should we allow the user to override this? *)
+       method protocols = ps
+       method to_string = "mixture"
+     end
 
-                     method protocols = ps
-
-                     method to_string = "mixture"
-                   end
-
-let rec mixture_of value f =
-  mixture (f (fun value' -> mixture_of value' f) value)
+let rec mixture_of value f = mixture (f (fun value' -> mixture_of value' f) value)
 
 module Error = struct
   open Concepts.Condition
 
-  let invalid_property key = condition "invalid-property" "The specified key does not correspond to any property of the object"
-                               ("key" |=| Concepts.Value.String key)
+  let invalid_property key =
+    condition "invalid-property"
+      "The specified key does not correspond to any property of the object"
+      ("key" |=| Concepts.Value.String key)
 
-  let deletion_not_supported () = condition "deletion-not-supported" "Attempting to delete an object property"
-                                    empty
+  let deletion_not_supported () =
+    condition "deletion-not-supported" "Attempting to delete an object property" empty
 end
 
 module Addressable = struct
@@ -26,75 +26,79 @@ module Addressable = struct
     module Tree = Merkle.Make (S) (K)
 
     let make ~node =
-      Protocols.Addressable.make @@
-        object
-          method address = Tree.hash_of node
-        end
+      Protocols.Addressable.make
+      @@ object
+           method address = Tree.hash_of node
+         end
   end
 end
 
 module Associative = struct
   let of_properties props =
-    Protocols.Associative.make @@
-      object
-        val props = BatList.to_seq props |> BatMap.of_seq
+    Protocols.Associative.make
+    @@ object
+         val props = BatList.to_seq props |> BatMap.of_seq
 
-        method update key value =
-          match BatMap.find_opt key props with
-          | None -> Error (Error.invalid_property key)
-          | Some f -> f value
-      end
+         method update key value =
+           match BatMap.find_opt key props with
+           | None -> Error (Error.invalid_property key)
+           | Some f -> f value
+       end
 
-  let update_only f = function
-    | None -> Error (Error.deletion_not_supported ())
-    | Some x -> f x
+  let update_only f = function None -> Error (Error.deletion_not_supported ()) | Some x -> f x
 
   module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) = struct
     module Tree = Merkle.Make (S) (K)
     module SI = Storage.Make (S)
 
     let make ~storage ~constructor ~node =
-      Protocols.Associative.make @@
-        object
-          method update key value =
-            (* TODO: read-only transactions *)
-            SI.with_transaction storage (fun tx ->
-                let open Utilities.Result in
-                let open Protocols in
-                let* node' = match value with
-                  | None -> Tree.remove tx key node
-                  | Some h ->
-                     let* addressable = Handle.require Addressable.from h in
-                     let addr = Addressable.address addressable in
-                     Tree.insert tx key addr node
-                in
-                constructor node')
-        end
+      Protocols.Associative.make
+      @@ object
+           method update key value =
+             (* TODO: read-only transactions *)
+             SI.with_transaction storage (fun tx ->
+                 let open Utilities.Result in
+                 let open Protocols in
+                 let* node' =
+                   match value with
+                   | None -> Tree.remove tx key node
+                   | Some h ->
+                       let* addressable = Handle.require Addressable.from h in
+                       let addr = Addressable.address addressable in
+                       Tree.insert tx key addr node
+                 in
+                 constructor node' )
+         end
   end
 end
 
 module Directory = struct
   let of_properties props =
-    Protocols.Directory.make @@
-      object
-        val props = BatList.to_seq props |> BatMap.of_seq
-
-        method list = Ok (BatMap.keys props |> BatFingerTree.of_enum)
-        method find k = Ok (BatMap.find_opt k props)
-      end
-
-  module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) (V : Merkle.VALUE) = struct
+    Protocols.Directory.make
+    @@ object
+         val props = BatList.to_seq props |> BatMap.of_seq
+         method list = Ok (BatMap.keys props |> BatFingerTree.of_enum)
+         method find k = Ok (BatMap.find_opt k props)
+       end
+
+  module OfTree
+      (S : Abstract.Storage.STORAGE)
+      (K : Merkle.KEY with type t = string)
+      (V : Merkle.VALUE) =
+  struct
     module Tree = Merkle.Interface (S) (K) (V)
     module SI = Storage.Make (S)
 
     let make ~storage ~constructor ~node =
-      Protocols.Directory.make @@
-        object
-          method list = SI.with_transaction storage (Fun.flip Tree.keys node)
-          method find k = SI.with_transaction storage (fun tx -> Tree.lookup tx k node)
-                          |> Utilities.Result.fmap (function
-                                 | None -> Ok None
-                                 | Some x -> constructor x |> Result.map (Option.some))
-        end
+      Protocols.Directory.make
+      @@ object
+           method list = SI.with_transaction storage (Fun.flip Tree.keys node)
+
+           method find k =
+             SI.with_transaction storage (fun tx -> Tree.lookup tx k node)
+             |> Utilities.Result.fmap (function
+               | None -> Ok None
+               | Some x -> constructor x |> Result.map Option.some )
+         end
   end
 end
diff --git a/lib/kernel/Prototype.mli b/lib/kernel/Prototype.mli
index 919f5d3..db22b63 100644
--- a/lib/kernel/Prototype.mli
+++ b/lib/kernel/Prototype.mli
@@ -1,29 +1,52 @@
-val mixture_of : 'a -> (('a -> Protocols.Handle.t) -> 'a -> Protocols.Handle.protocol list) -> Protocols.Handle.t
+val mixture_of :
+  'a -> (('a -> Protocols.Handle.t) -> 'a -> Protocols.Handle.protocol list) -> Protocols.Handle.t
+
 val mixture : Protocols.Handle.protocol list -> Protocols.Handle.t
 
 module Directory : sig
   val of_properties : (string * Protocols.Handle.t) list -> Protocols.Handle.protocol
 
-  module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) (V : Merkle.VALUE) : sig
+  module OfTree
+      (S : Abstract.Storage.STORAGE)
+      (K : Merkle.KEY with type t = string)
+      (V : Merkle.VALUE) : sig
     module Tree : module type of Merkle.Interface (S) (K) (V)
-    val make : storage:S.connection -> constructor:(V.t -> (Protocols.Handle.t, Concepts.Condition.condition) result) -> node:Tree.node -> Protocols.Handle.protocol
+
+    val make :
+      storage:S.connection ->
+      constructor:(V.t -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
+      node:Tree.node ->
+      Protocols.Handle.protocol
   end
 end
 
 module Associative : sig
-  val of_properties : (string * (Protocols.Handle.t option -> (Protocols.Handle.t, Concepts.Condition.condition) result)) list -> Protocols.Handle.protocol
+  val of_properties :
+    ( string
+    * (Protocols.Handle.t option -> (Protocols.Handle.t, Concepts.Condition.condition) result) )
+    list ->
+    Protocols.Handle.protocol
 
-  val update_only : (Protocols.Handle.t -> (Protocols.Handle.t, Concepts.Condition.condition) result) -> (Protocols.Handle.t option -> (Protocols.Handle.t, Concepts.Condition.condition) result)
+  val update_only :
+    (Protocols.Handle.t -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
+    Protocols.Handle.t option ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
 
   module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) : sig
     module Tree : module type of Merkle.Make (S) (K)
-    val make : storage:S.connection -> constructor:(Tree.node -> (Protocols.Handle.t, Concepts.Condition.condition) result) -> node:Tree.node -> Protocols.Handle.protocol
+
+    val make :
+      storage:S.connection ->
+      constructor:(Tree.node -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
+      node:Tree.node ->
+      Protocols.Handle.protocol
   end
 end
 
 module Addressable : sig
   module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY) : sig
     module Tree : module type of Merkle.Make (S) (K)
+
     val make : node:Tree.node -> Protocols.Handle.protocol
   end
 end
diff --git a/lib/kernel/Storage.ml b/lib/kernel/Storage.ml
index d50735c..da438d2 100644
--- a/lib/kernel/Storage.ml
+++ b/lib/kernel/Storage.ml
@@ -1,14 +1,13 @@
 module Make (S : Abstract.Storage.STORAGE) = struct
   module Pointer = struct
-    type 'a t = {
-      addr : S.address;
-      loader : S.transaction -> S.address -> ('a, Concepts.Condition.condition) result
-    }
-
-    let make loader addr = { addr; loader }
-    let address_of { addr; _ } = addr
-    let swap { loader; _ } addr = make loader addr
-    let deref tx { addr; loader } = loader tx addr
+    type 'a t =
+      { addr: S.address;
+        loader: S.transaction -> S.address -> ('a, Concepts.Condition.condition) result }
+
+    let make loader addr = {addr; loader}
+    let address_of {addr; _} = addr
+    let swap {loader; _} addr = make loader addr
+    let deref tx {addr; loader} = loader tx addr
   end
 
   let as_hash = function
@@ -16,25 +15,26 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     | _ -> failwith "A label was provided where a hash was expected."
 
   let to_hum_string = function
-    | S.Hash h -> "Hash " ^ (Concepts.Hash.to_hum_string h)
+    | S.Hash h -> "Hash " ^ Concepts.Hash.to_hum_string h
     | S.Label l -> "Label " ^ l
 
   module Error = struct
     open Concepts.Condition
 
     let missing_data addr =
-      condition "missing-data" "An expected value was not found on the underlying storage. Is your database corrupted?"
+      condition "missing-data"
+        "An expected value was not found on the underlying storage. Is your database corrupted?"
         ("address" |=| Concepts.Value.String (to_hum_string addr))
   end
 
   let finish tx = function
     | Ok value ->
-       let open Utilities.Result in
-       let* () = S.commit tx in
-       Ok value
+        let open Utilities.Result in
+        let* () = S.commit tx in
+        Ok value
     | Error condition ->
-       let _ = S.abort tx in
-       Error condition
+        let _ = S.abort tx in
+        Error condition
 
   let within start connection body =
     let open Utilities.Result in
@@ -51,7 +51,5 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     Ok address
 
   let get_req tx addr =
-    S.get tx addr
-    |> Utilities.Result.fmap (Option.to_result ~none:(Error.missing_data addr))
-
+    S.get tx addr |> Utilities.Result.fmap (Option.to_result ~none:(Error.missing_data addr))
 end
diff --git a/lib/kernel/Storage.mli b/lib/kernel/Storage.mli
index 53bb666..92f602d 100644
--- a/lib/kernel/Storage.mli
+++ b/lib/kernel/Storage.mli
@@ -2,7 +2,9 @@ module Make : functor (S : Abstract.Storage.STORAGE) -> sig
   module Pointer : sig
     type 'a t
 
-    val make : (S.transaction -> S.address -> ('a, Concepts.Condition.condition) result) -> S.address -> 'a t
+    val make :
+      (S.transaction -> S.address -> ('a, Concepts.Condition.condition) result) -> S.address -> 'a t
+
     val address_of : 'a t -> S.address
     val swap : 'a t -> S.address -> 'a t
     val deref : S.transaction -> 'a t -> ('a, Concepts.Condition.condition) result
@@ -10,9 +12,23 @@ module Make : functor (S : Abstract.Storage.STORAGE) -> sig
 
   val as_hash : S.address -> Concepts.Hash.hash
 
-  val finish : S.transaction -> ('a, Concepts.Condition.condition) result -> ('a, Concepts.Condition.condition) result
-  val with_transaction : S.connection -> (S.transaction -> ('a, Concepts.Condition.condition) result) -> ('a, Concepts.Condition.condition) result
-  val with_read : S.connection -> (S.transaction -> ('a, Concepts.Condition.condition) result) -> ('a, Concepts.Condition.condition) result
-  val store_blob : S.transaction -> Concepts.Blob.t -> (Concepts.Hash.hash, Concepts.Condition.condition) result
-  val get_req: S.transaction -> S.address -> (Concepts.Blob.t, Concepts.Condition.condition) result
+  val finish :
+    S.transaction ->
+    ('a, Concepts.Condition.condition) result ->
+    ('a, Concepts.Condition.condition) result
+
+  val with_transaction :
+    S.connection ->
+    (S.transaction -> ('a, Concepts.Condition.condition) result) ->
+    ('a, Concepts.Condition.condition) result
+
+  val with_read :
+    S.connection ->
+    (S.transaction -> ('a, Concepts.Condition.condition) result) ->
+    ('a, Concepts.Condition.condition) result
+
+  val store_blob :
+    S.transaction -> Concepts.Blob.t -> (Concepts.Hash.hash, Concepts.Condition.condition) result
+
+  val get_req : S.transaction -> S.address -> (Concepts.Blob.t, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index 52ce83c..f90ddff 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -87,7 +87,6 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
   let encode = Representation.to_blob
   let decode = Representation.of_blob
-
   let schematics {schematics; _} = schematics
   let predicate {predicate; _} = predicate
   let local_constraints {local_constraints; _} = local_constraints
@@ -119,9 +118,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let* kvs = Concepts.Encoding.Bencode.as_dict fields in
     kvs
     |> List.map (fun (name, domain) ->
-           Concepts.Encoding.Bencode.as_string domain
-           |> Result.map (fun domain ->
-                  (name, {Protocols.Schematics.domain; provenance= []}) ) )
+        Concepts.Encoding.Bencode.as_string domain
+        |> Result.map (fun domain -> name, {Protocols.Schematics.domain; provenance= []}) )
     |> Utilities.List.sequence
     |> Result.map BatMap.String.of_list
 
@@ -150,9 +148,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   class relation storage value description =
     object (self)
       inherit Lifecycle.null
-
       method to_string = "relation"
-
       val storage : S.connection = storage
       val relation : t = value
       val declaration = modes_of description
@@ -172,15 +168,15 @@ module Make (S : Abstract.Storage.STORAGE) = struct
          unused here: this enumeration reads through its own cursor-lifetime transaction and needs
          no name resolution, but cancellation should eventually be checked between tuples. *)
       method enumerate = enumerate storage relation
-
       method modes : (Concepts.Mode.t, Concepts.Condition.condition) result = Ok declaration
       method generate binding = generate storage relation binding
 
       method protocols : Protocols.Handle.protocol list =
-        [ Protocols.Relation.make self
-        ; Protocols.Enumerable.make self
-        ; Protocols.Generative.make self
-        ; Protocols.Schematics.make self ]
+        [ Protocols.Relation.make self;
+          Protocols.Enumerable.make self;
+          Protocols.Generative.make self;
+          Protocols.Schematics.make self ]
+
       method hash = hash relation
     end
 
@@ -188,7 +184,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
      the description and modes are served from it on every request. *)
   let instantiate tx conn relation =
     schema_of tx relation
-    |> Result.map (fun description -> new relation conn relation description |> Protocols.Handle.make)
+    |> Result.map (fun description ->
+        new relation conn relation description |> Protocols.Handle.make )
 
   let make conn ~schematics ?predicate ?local_constraints ?indexes () =
     let open Utilities.Result in
@@ -203,9 +200,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     Representation.of_blob data
 
   let wrap conn relation = SI.with_read conn (fun tx -> instantiate tx conn relation)
-
-  let load tx conn addr =
-    load_value tx addr |> Utilities.Result.fmap (instantiate tx conn)
+  let load tx conn addr = load_value tx addr |> Utilities.Result.fmap (instantiate tx conn)
 
   let assert_tuple tx relation tuple =
     let open Utilities.Result in
diff --git a/lib/kernel/SubstantialRelation.mli b/lib/kernel/SubstantialRelation.mli
index a36c802..98f1e8f 100644
--- a/lib/kernel/SubstantialRelation.mli
+++ b/lib/kernel/SubstantialRelation.mli
@@ -25,7 +25,6 @@ module Make (S : Abstract.Storage.STORAGE) : sig
     (Protocols.Handle.t, Concepts.Condition.condition) result
 
   val load_value : S.transaction -> Concepts.Hash.hash -> (t, Concepts.Condition.condition) result
-
   val wrap : S.connection -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result
 
   val load :
diff --git a/lib/kernel/Tuple.ml b/lib/kernel/Tuple.ml
index bbc20ab..9dbbc17 100644
--- a/lib/kernel/Tuple.ml
+++ b/lib/kernel/Tuple.ml
@@ -7,9 +7,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let unknown_attribute name =
       condition "unknown-attribute" "No such attribute on this tuple"
         ("attribute" |=| Concepts.Value.String name)
+
     let malformed_value () =
-      condition "malformed-tuple-value"
-        "A tuple field did not conform to what was expected" empty
+      condition "malformed-tuple-value" "A tuple field did not conform to what was expected" empty
+
     let incomplete_tuple addr =
       condition "incomplete-tuple"
         "A stored tuple is missing part of its expected structure. Is your storage corrupted?"
@@ -24,9 +25,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let encode value =
       let open Concepts.Encoding in
       Bencode.to_blob
-        (match value with
-         | Concepts.Value.String s -> Bencode.Tagged ('s', Bencode.String s)
-         | Concepts.Value.Integer n -> Bencode.Tagged ('i', Bencode.Int n))
+        ( match value with
+        | Concepts.Value.String s -> Bencode.Tagged ('s', Bencode.String s)
+        | Concepts.Value.Integer n -> Bencode.Tagged ('i', Bencode.Int n) )
 
     let decode blob =
       let open Utilities.Result in
@@ -48,7 +49,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
      over an in-memory storage. Consider later splitting [t] into
      resident (an address) and ephemeral (an in-memory attribute map)
      forms instead. *)
-  type t = { type_ : string; attributes : AttributeM.address }
+  type t = {type_: string; attributes: AttributeM.address}
 
   module rec Representation : (Concepts.Encoding.Record.S with type t = t) =
     Concepts.Encoding.Record.Make (Body)
@@ -59,26 +60,24 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let tag = 'T'
     let malformed = Error.malformed_value
 
-    let fields { type_; attributes } =
+    let fields {type_; attributes} =
       let open Concepts.Encoding in
-      [ "type", Bencode.String type_;
-        "attributes", Value.bencode_of_hash attributes ]
+      ["type", Bencode.String type_; "attributes", Value.bencode_of_hash attributes]
 
     let of_fields data =
       let open Utilities.Result in
       let open Concepts.Encoding in
       let* type_ = Bencode.field "type" data |> fmap Bencode.as_string in
       let* attributes = Bencode.field "attributes" data |> fmap Value.hash_of_bencode in
-      Ok { type_; attributes }
+      Ok {type_; attributes}
   end
 
   let encode = Representation.to_blob
   let decode = Representation.of_blob
   let hash tuple = Representation.to_blob tuple |> Concepts.Hash.hash_of_blob
+  let type_of {type_; _} = type_
 
-  let type_of { type_; _ } = type_
-
-  let node tx { attributes; _ } =
+  let node tx {attributes; _} =
     let open Utilities.Result in
     AttributeM.find tx attributes
     |> fmap (Option.to_result ~none:(Error.incomplete_tuple attributes))
@@ -86,7 +85,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   let empty tx ~type_ () =
     let open Utilities.Result in
     let* attributes = AttributeM.empty_under tx in
-    Ok { type_; attributes }
+    Ok {type_; attributes}
 
   let make tx ~type_ attributes =
     let open Utilities.Result in
@@ -96,10 +95,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct
           |> BatEnum.fold
                (fun node (name, value) ->
                  let* node = node in
-                 AttributeM.insert tx name value node)
-               (Ok AttributeM.empty))
+                 AttributeM.insert tx name value node )
+               (Ok AttributeM.empty) )
     in
-    Ok { type_; attributes = AttributeM.hash_of node }
+    Ok {type_; attributes= AttributeM.hash_of node}
 
   let attribute tx tuple name =
     let open Utilities.Result in
@@ -114,30 +113,27 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       (fun acc name value -> BatMap.String.add name value acc)
       BatMap.String.empty node
 
-  class tuple ~relation conn value node = object (self)
-    inherit Lifecycle.null
-
-    method to_string = "tuple"
-
-    val tuple = value
-    val storage = conn
-    val node = node
-
-    method describe () =
-      let open Utilities.Result in
-      let* attributes =
-        SI.with_transaction storage (fun tx ->
-            AttributeM.fold_left tx
-              (fun acc name value -> BatMap.String.add name (Attribute.domain value) acc)
-              BatMap.String.empty node)
-      in
-      Ok (Protocols.Schematics.Tuple { Protocols.Schematics.relation; attributes })
-
-    method protocols : Protocols.Handle.protocol list =
-      [Protocols.Schematics.make self]
-
-    method hash = hash tuple
-  end
+  class tuple ~relation conn value node =
+    object (self)
+      inherit Lifecycle.null
+      method to_string = "tuple"
+      val tuple = value
+      val storage = conn
+      val node = node
+
+      method describe () =
+        let open Utilities.Result in
+        let* attributes =
+          SI.with_transaction storage (fun tx ->
+              AttributeM.fold_left tx
+                (fun acc name value -> BatMap.String.add name (Attribute.domain value) acc)
+                BatMap.String.empty node )
+        in
+        Ok (Protocols.Schematics.Tuple {Protocols.Schematics.relation; attributes})
+
+      method protocols : Protocols.Handle.protocol list = [Protocols.Schematics.make self]
+      method hash = hash tuple
+    end
 
   let wrap ~relation conn value =
     let open Utilities.Result in