blob: ba4d96d9162d10e1e19da1d1ddabb15c8f91e536 (
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
|
type t = {identifier: string; branch: string; snapshot: string; commit: unit}
let namespace identifier = "\\session\\" ^ identifier
let branch_path name = "\\branch\\" ^ name
let snapshot_of kernel branch =
let open Utilities.Result in
let* handle = RNT.lookup kernel (branch_path branch) in
let snapshot = RNT.identity handle in
RNT.release handle; Ok snapshot
class session ~kernel ~identifier ~branch ~snapshot ~commit =
object
val mutable session : t = {identifier; branch; snapshot; commit}
method identifier = session.identifier
method branch = session.branch
method snapshot = session.snapshot
method namespace = namespace session.identifier
(** Switch to a different branch within the same session. *)
method set_branch_to branch =
let open Utilities.Result in
let* snapshot = snapshot_of kernel branch in
session <- {session with branch; snapshot};
Ok ()
method close = RNT.remove kernel (namespace session.identifier)
end
(* Open a session on a live (mutable) branch.
Creates the branch if it does not exist yet. *)
let open_session kernel ~branch_name =
let open Utilities.Result in
let* branches = RNT.list kernel "\\branch" in
let* () =
if List.mem branch_name branches then Ok ()
else RNT.create kernel (branch_path branch_name) RNT.Branch
in
let* snapshot = snapshot_of kernel branch_name in
let identifier = Printf.sprintf "%016Lx" (Random.State.bits64 (Random.State.make_self_init ())) in
let* () = RNT.create kernel (namespace identifier) RNT.Namespace in
Ok (new session ~kernel ~identifier ~branch:branch_name ~snapshot ~commit:())
(* Open a session pinned to a specific snapshot hash (detached / read-only).
Mutations through the returned branch are refused. *)
(* let open_snapshot_session claims ~branch_name ~snapshot_hash = *)
(* Error *)
|
