Source file `content_store.ml`

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
(* Copyright (C) 2020, Thomas Leonard.
   See the README file for details. *)

open Lwt.Infix

module Make (K : Irmin.Hash.S) (V : Irmin.Type.S) = struct
  type 'a t = Raw.store
  type key = K.t
  type value = V.t

  let string_of_hash = Irmin.Type.to_string K.t

  let value_of_string s =
    match Irmin.Type.of_bin_string V.t s with
    | Ok x -> x
    | Error (`Msg m) -> failwith m

  let string_of_value = Irmin.Type.to_bin_string V.t

  let find t k =
    Raw.get t (string_of_hash k) >|= function
    | None -> None
    | Some s -> Some (value_of_string s)

  let mem t k =
    Raw.get t (string_of_hash k) >|= function
    | None -> false
    | Some _ -> true

  let unsafe_add t key value =
    let value = string_of_value value in
    Raw.set t (string_of_hash key) value

  let add t value =
    let value = string_of_value value in
    let k = K.hash (fun add -> add value) in
    Raw.set t (string_of_hash k) value >|= fun () -> k

  let batch t fn = fn t

  let close _ = Lwt.return_unit

  let v config =
    let db_name = Irmin.Private.Conf.get config Config.db_name_key in
    Config.connect db_name >|= fun idb ->
    Raw.store idb Config.ao
end