blob: be84972d5b311912c983706410b7e41f5d626a87 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
(* @composes Storage -- functor parameter *)
(* @composes Cursor -- applies Cursor.Make (Store) *)
(* @uses Object -- find, registry/kind inspection *)
(* @uses Condition -- builds not-a-relation / no-such-object errors *)
(* @needs Path *)
(* @needs Tuple *)
(* @needs Value *)
module type HANDLER = sig
type t
type handle
type cursor
val open_ : t -> path:Concepts.Path.t -> (handle, Concepts.Condition.condition) result
val open_cursor :
handle ->
args:Concepts.Value.value BatFingerTree.t ->
(cursor, Concepts.Condition.condition) result
val next : cursor -> (Concepts.Tuple.t option, Concepts.Condition.condition) result
val close : cursor -> unit
end
let not_a_relation () : Concepts.Condition.condition =
Concepts.Condition.condition "not-a-relation"
"handle does not refer to a stored or ephemeral relation" Concepts.Condition.empty
let no_such_object () : Concepts.Condition.condition =
Concepts.Condition.condition "no-such-object" "no object registered at the given path"
Concepts.Condition.empty
module Make (Store : Abstract.Storage.STORAGE) = struct
module Cur = Cursor.Make (Store)
type t = {objects: Object.rnt_object_tree; txn: Store.transaction}
type handle = {object_: Object.registry; txn: Store.transaction}
type cursor = Cur.cursor
let create objects txn = {objects; txn}
let open_ t ~path =
match Object.find path t.objects with
| Some object_ -> Ok {object_; txn= t.txn}
| None -> Error (no_such_object ())
let relation_descriptor (object_ : Object.registry) :
(Cursor.descriptor, Concepts.Condition.condition) result =
let {Object.entry; _} = object_ in
match entry.Object.kind with
| Object.Relation {merkle_root} -> Ok (Cursor.Stored {merkle_root})
| Object.EphemeralRelation {merkle_root; dependencies} ->
Ok (Cursor.Ephemeral {merkle_root; dependencies})
| _ -> Error (not_a_relation ())
let open_cursor handle ~args =
let open Utilities.Result in
let* descriptor = relation_descriptor handle.object_ in
Cur.open_ handle.txn descriptor ~args
let next = Cur.next
let close = Cur.close
let object_ (handle : handle) = handle.object_
end
|
