test/Helpers.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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

open Rnt

let rec recursively_remove path =
  if Sys.is_directory path then begin
    Sys.readdir path |> Array.iter (fun name -> recursively_remove (Filename.concat path name));
    Unix.rmdir path
  end
  else Sys.remove path

let with_temporary_directory prefix ?(suffix = "") f =
  let path = Filename.temp_dir ~temp_dir:(Filename.get_temp_dir_name ()) prefix suffix in
  Fun.protect (fun () -> f path) ~finally:(fun () -> recursively_remove path)

let condition_as_failure = function
  | Ok r -> r
  | Error c -> Alcotest.fail (Concepts.Condition.to_string_hum c)

let pp_value ppf v = Format.pp_print_string ppf (Concepts.Value.to_string v)
let value = Alcotest.testable pp_value Concepts.Value.equal

(* the titles a relation of books holds, in order *)
let titles relation =
  let open Utilities.Result in
  let* _, tuples = Protocols.Relation.read relation in
  Ok
    ( tuples
    |> List.map (fun tuple -> BatMap.String.find "title" tuple.Concepts.Tuple.attributes)
    |> List.sort compare )

module Storage = struct
  module type CONFIGURATOR = sig
    val configure : string -> Rnt.Concepts.Configuration.term
  end

  module LMDB_Configurator : CONFIGURATOR = struct
    let configure base =
      let open Sexplib.Sexp in
      List [Atom "lmdb"; List [Atom "path"; Atom base]; List [Atom "mode"; Atom "420"]]
      |> Rnt.Concepts.Configuration.term_of_sexp
  end

  module Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct
    module SI = Kernel.Storage.Make (S)
    module SR = Kernel.SubstantialRelation.Make (S)

    let store_schema tx attributes =
      Concepts.Encoding.Bencode.(Dict (List.map (fun a -> a, String "string") attributes) |> to_blob)
      |> SI.store_blob tx

    let relation conn attributes tuples =
      let open Utilities.Result in
      let description =
        BatMap.String.of_list
          (List.map
             (fun a -> a, {Protocols.Schematics.domain= "string"; provenance= []})
             attributes )
      in
      let* value = SI.with_transaction conn (fun tx -> SR.store tx description tuples) in
      SR.load conn value

    let with_connection f dir () =
      with_temporary_directory dir begin fun dir ->
          begin
            let open Utilities.Result in
            let* conn = S.connect (C.configure dir) in
            Ok (Fun.protect ~finally:(fun () -> S.disconnect conn) (fun () -> f conn))
          end
          |> condition_as_failure
        end
  end
end