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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
module Dune = Functoria.Dune
open Functoria.DSL
type ro = RO
let ro = typ RO
let crunch dirname =
let is_valid = function
| '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' -> true
| _ -> false
in
let name =
let modname = String.map (fun c -> if is_valid c then c else '_') dirname in
"Static_" ^ String.lowercase_ascii modname
in
let packages =
[
package ~min:"4.0.0" ~max:"5.0.0" "mirage-kv-mem";
package ~min:"4.0.0" ~max:"5.0.0" ~build:true "crunch";
]
in
let connect _ modname _ = code ~pos:__POS__ "%s.connect ()" modname in
let dune _i =
let dir = Fpath.(v dirname) in
let file ext = Fpath.(v name + ext) in
let ml = file "ml" in
let mli = file "mli" in
let dune =
Dune.stanzaf
{|
(rule
(targets %a %a)
(deps (source_tree %a))
(action
(run ocaml-crunch -o %a %a)))
|}
Fpath.pp ml Fpath.pp mli Fpath.pp dir Fpath.pp ml Fpath.pp dir
in
[ dune ]
in
impl ~packages ~connect ~dune name ro
let direct_kv_ro dirname =
let packages = [ package ~min:"2.1.0" ~max:"3.0.0" "mirage-kv-unix" ] in
let connect _ modname _names =
code ~pos:__POS__ "%s.connect \"%s\"" modname dirname
in
impl ~packages ~connect "Mirage_kv_unix" ro
let direct_kv_ro dirname =
match_impl
Key.(value target)
[
(`Xen, crunch dirname);
(`Qubes, crunch dirname);
(`Virtio, crunch dirname);
(`Hvt, crunch dirname);
(`Spt, crunch dirname);
(`Muen, crunch dirname);
(`Genode, crunch dirname);
]
~default:(direct_kv_ro dirname)
type rw = RW
let rw = typ RW
let direct_kv_rw dirname =
let packages = [ package ~min:"2.1.0" ~max:"3.0.0" "mirage-kv-unix" ] in
let connect _ modname _names =
code ~pos:__POS__ "%s.connect \"%s\"" modname dirname
in
impl ~packages ~connect "Mirage_kv_unix" rw
let mem_kv_rw () =
let packages = [ package ~min:"3.0.0" ~max:"4.0.0" "mirage-kv-mem" ] in
let connect _ modname _names = code ~pos:__POS__ "%s.connect ()" modname in
impl ~packages ~connect "Mirage_kv_mem" rw
(** generic kv_ro. *)
let generic_kv_ro ?group ?(key = Key.value @@ Key.kv_ro ?group ()) dir =
match_impl key
[ (`Crunch, crunch dir); (`Direct, direct_kv_ro dir) ]
~default:(direct_kv_ro dir)