Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
irmin: rebase onto current toml + json APIs
- toml: drop the [toml.bytesrw] dep and inline encoder names —
[Toml.encode_string] is now [Toml.to_string],
[Toml_bytesrw.decode_string] is now [Toml.of_string], both via
the main [toml] library.
- json: AST constructors moved to top-level [Json.{Object,Array,
mem,name,object',list,...}]; only the codec namespace stays under
[Json.Codec]. Fixes the [Json.Codec.Object] / [Json.Codec.Value.mem]
usages in irmin_oci, irmin_json, test_irmin_tar, test_schema.
- worktree: two stray [(Json.Error.to_string e).path] expressions
were typo'd; [e] is an entry record so it's just [e.path].
- test_worktree: [e] is already a string after the bos error
unwrap; drop the [Json.Error.to_string] wrapper.
- test_sync.stats.unique_hashes was [mutable] but only ever
Hashtbl-mutated, never reassigned; drop the [mutable] keyword.
- test_schema.git_hash was orphaned (no callers); delete.
+52
-107
+1
-21
bin/dune
+1
-21
bin/dune
···
28
28
base64
29
29
unix
30
30
monopam-info)
31
-
(modules
32
-
config
33
-
common
34
-
cmd_init
35
-
cmd_get
36
-
cmd_set
37
-
cmd_del
38
-
cmd_list
39
-
cmd_tree
40
-
cmd_log
41
-
cmd_branches
42
-
cmd_checkout
43
-
cmd_proof
44
-
cmd_import
45
-
cmd_export
46
-
cmd_info
47
-
cmd_merge
48
-
cmd_pull
49
-
cmd_push
50
-
cmd_serve
51
-
main))
31
+
)
-1
fuzz/dune
-1
fuzz/dune
+1
-1
lib/admin/dune
+1
-1
lib/admin/dune
+1
-1
lib/admin/irmin_admin.ml
+1
-1
lib/admin/irmin_admin.ml
+1
-1
lib/atproto/dune
+1
-1
lib/atproto/dune
-1
lib/dune
-1
lib/dune
-1
lib/git/dune
-1
lib/git/dune
+1
-1
lib/json/dune
+1
-1
lib/json/dune
+11
-15
lib/json/irmin_json.ml
+11
-15
lib/json/irmin_json.ml
···
7
7
8
8
module S = Irmin.SHA256
9
9
10
-
let nv (type a) (n : a Jsont.node) : a = fst n
10
+
let nv (type a) (n : a Json.node) : a = fst n
11
11
12
12
let enc c =
13
-
match Jsont_bytesrw.encode_string Jsont.json c with
14
-
| Ok s -> s
15
-
| Error _ -> ""
13
+
match Json.to_string Json.Codec.Value.t c with Ok s -> s | Error _ -> ""
16
14
17
15
let parse : S.dec =
18
16
fun block ->
19
-
match Jsont_bytesrw.decode_string Jsont.json block with
20
-
| Ok (Jsont.Object obj) ->
17
+
match Json.of_string Json.Codec.Value.t block with
18
+
| Ok (Json.Object obj) ->
21
19
S.Named
22
-
(List.map
23
-
(fun ((n, c) : Jsont.mem) -> (nv n, `Inline (enc c)))
24
-
(nv obj))
25
-
| Ok (Jsont.Array arr) ->
20
+
(List.map (fun ((n, c) : Json.mem) -> (nv n, `Inline (enc c))) (nv obj))
21
+
| Ok (Json.Array arr) ->
26
22
S.Indexed
27
23
(Array.of_list
28
24
(List.map (fun c -> (`Inline (enc c) : S.child)) (nv arr)))
29
25
| _ -> S.Named []
30
26
31
27
let dec s =
32
-
match Jsont_bytesrw.decode_string Jsont.json s with
28
+
match Json.of_string Json.Codec.Value.t s with
33
29
| Ok v -> v
34
-
| Error _ -> Jsont.Null ((), Jsont.Meta.none)
30
+
| Error _ -> Json.Null ((), Json.Meta.none)
35
31
36
32
let serialize : S.enc = function
37
33
| S.Named children ->
···
43
39
| `Inline data -> dec data
44
40
| `Link _ -> dec "null"
45
41
in
46
-
Jsont.Json.mem (Jsont.Json.name name) v)
42
+
Json.mem (Json.name name) v)
47
43
children
48
44
in
49
-
enc (Jsont.Json.object' mems)
45
+
enc (Json.object' mems)
50
46
| S.Indexed children ->
51
47
let items =
52
48
Array.to_list
···
57
53
| `Link _ -> dec "null")
58
54
children)
59
55
in
60
-
enc (Jsont.Json.list items)
56
+
enc (Json.list items)
61
57
62
58
let ( => ) = S.( => )
63
59
+1
-1
lib/oci/dune
+1
-1
lib/oci/dune
+11
-15
lib/oci/irmin_oci.ml
+11
-15
lib/oci/irmin_oci.ml
···
8
8
9
9
(* OCI manifests and configs are JSON. Reuse the JSON codec pattern. *)
10
10
11
-
let nv (type a) (n : a Jsont.node) : a = fst n
11
+
let nv (type a) (n : a Json.node) : a = fst n
12
12
13
13
let enc c =
14
-
match Jsont_bytesrw.encode_string Jsont.json c with
15
-
| Ok s -> s
16
-
| Error _ -> ""
14
+
match Json.to_string Json.Codec.Value.t c with Ok s -> s | Error _ -> ""
17
15
18
16
let dec s =
19
-
match Jsont_bytesrw.decode_string Jsont.json s with
17
+
match Json.of_string Json.Codec.Value.t s with
20
18
| Ok v -> v
21
-
| Error _ -> Jsont.Null ((), Jsont.Meta.none)
19
+
| Error _ -> Json.Null ((), Json.Meta.none)
22
20
23
21
let parse : S.dec =
24
22
fun block ->
25
-
match Jsont_bytesrw.decode_string Jsont.json block with
26
-
| Ok (Jsont.Object obj) ->
23
+
match Json.of_string Json.Codec.Value.t block with
24
+
| Ok (Json.Object obj) ->
27
25
S.Named
28
-
(List.map
29
-
(fun ((n, c) : Jsont.mem) -> (nv n, `Inline (enc c)))
30
-
(nv obj))
31
-
| Ok (Jsont.Array arr) ->
26
+
(List.map (fun ((n, c) : Json.mem) -> (nv n, `Inline (enc c))) (nv obj))
27
+
| Ok (Json.Array arr) ->
32
28
S.Indexed
33
29
(Array.of_list
34
30
(List.map (fun c -> (`Inline (enc c) : S.child)) (nv arr)))
···
44
40
| `Inline data -> dec data
45
41
| `Link _ -> dec "null"
46
42
in
47
-
Jsont.Json.mem (Jsont.Json.name name) v)
43
+
Json.mem (Json.name name) v)
48
44
children
49
45
in
50
-
enc (Jsont.Json.object' mems)
46
+
enc (Json.object' mems)
51
47
| S.Indexed children ->
52
48
let items =
53
49
Array.to_list
···
58
54
| `Link _ -> dec "null")
59
55
children)
60
56
in
61
-
enc (Jsont.Json.list items)
57
+
enc (Json.list items)
62
58
63
59
let ( => ) = S.( => )
64
60
+3
-3
lib/toml/irmin_toml.ml
+3
-3
lib/toml/irmin_toml.ml
···
6
6
top so we can re-parse it as a stand-alone document. *)
7
7
let enc (v : Toml.Value.t) : string =
8
8
match v with
9
-
| Toml.Value.Table _ -> Toml.encode_string Toml.value v
9
+
| Toml.Value.Table _ -> Toml.to_string Toml.value v
10
10
| _ ->
11
11
(* Scalars and arrays need to be wrapped; use a dummy key. *)
12
-
Toml.encode_string Toml.value (Toml.Value.Table [ ("_", v) ])
12
+
Toml.to_string Toml.value (Toml.Value.Table [ ("_", v) ])
13
13
14
14
let dec (s : string) : Toml.Value.t =
15
-
match Toml.decode_string Toml.value s with
15
+
match Toml.of_string Toml.value s with
16
16
| Ok (Toml.Value.Table [ ("_", v) ]) -> v
17
17
| Ok v -> v
18
18
| Error _ -> Toml.Value.Table []
+4
-2
lib/worktree.ml
+4
-2
lib/worktree.ml
···
47
47
List.iter
48
48
(fun e ->
49
49
Buffer.add_string buf
50
-
(Fmt.str "%s\t%s\t%.6f\t%d\n" e.path (H.to_hex e.hash) e.mtime e.size))
50
+
(Fmt.str "%s\t%s\t%.6f\t%d\n" e.path (H.to_hex e.hash) e.mtime
51
+
e.size))
51
52
entries;
52
53
Eio.Path.save ~create:(`Or_truncate 0o644) p (Buffer.contents buf)
53
54
···
196
197
let tree_str =
197
198
String.concat "\n"
198
199
(List.map
199
-
(fun e -> Fmt.str "%s\t%s" e.path (H.to_hex e.hash))
200
+
(fun e ->
201
+
Fmt.str "%s\t%s" e.path (H.to_hex e.hash))
200
202
new_entries)
201
203
in
202
204
let tree_hash = H.hash_string tree_str in
+1
-9
test/bench/dune
+1
-9
test/bench/dune
+1
-13
test/dune
+1
-13
test/dune
···
1
1
(test
2
2
(name test)
3
-
(modules
4
-
test
5
-
test_admin
6
-
test_gzip
7
-
test_hash
8
-
test_heap
9
-
test_irmin
10
-
test_schema
11
-
test_irmin_tar
12
-
test_sync
13
-
test_worktree)
14
3
(libraries
15
4
irmin
16
5
irmin_admin
···
23
12
eio_main
24
13
eio
25
14
fpath
26
-
jsont
27
-
jsont.bytesrw
15
+
json
28
16
digestif))
+6
-10
test/test_irmin_tar.ml
+6
-10
test/test_irmin_tar.ml
···
92
92
(* JSON parse function -- defined here, not in the tar backend *)
93
93
let json_parse : S.dec =
94
94
fun data ->
95
-
let nv (type a) (n : a Jsont.node) : a = fst n in
95
+
let nv (type a) (n : a Json.node) : a = fst n in
96
96
let enc c =
97
-
match Jsont_bytesrw.encode_string Jsont.json c with
98
-
| Ok s -> s
99
-
| Error _ -> ""
97
+
match Json.to_string Json.Codec.Value.t c with Ok s -> s | Error _ -> ""
100
98
in
101
-
match Jsont_bytesrw.decode_string Jsont.json data with
102
-
| Ok (Jsont.Object obj) ->
99
+
match Json.of_string Json.Codec.Value.t data with
100
+
| Ok (Json.Object obj) ->
103
101
S.Named
104
-
(List.map
105
-
(fun ((n, c) : Jsont.mem) -> (nv n, `Inline (enc c)))
106
-
(nv obj))
107
-
| Ok (Jsont.Array arr) ->
102
+
(List.map (fun ((n, c) : Json.mem) -> (nv n, `Inline (enc c))) (nv obj))
103
+
| Ok (Json.Array arr) ->
108
104
S.Indexed
109
105
(Array.of_list
110
106
(List.map (fun c -> (`Inline (enc c) : S.child)) (nv arr)))
+6
-9
test/test_schema.ml
+6
-9
test/test_schema.ml
···
15
15
16
16
(* ===== Parse functions ===== *)
17
17
18
-
let git_hash h = Git.Hash.of_raw_string (Irmin.Hash.to_bytes h)
19
18
let irmin_hash h = Irmin.Hash.sha1_of_bytes (Git.Hash.to_raw_string h)
20
19
21
20
let git_tree_parse : S.dec =
···
42
41
| _ -> S.Named [])
43
42
| Error _ -> S.Named []
44
43
45
-
let json_nv (type a) (n : a Jsont.node) : a = fst n
44
+
let json_nv (type a) (n : a Json.node) : a = fst n
46
45
47
46
let json_parse : S.dec =
48
47
fun data ->
49
48
let enc c =
50
-
match Jsont_bytesrw.encode_string Jsont.json c with
51
-
| Ok s -> s
52
-
| Error _ -> ""
49
+
match Json.to_string Json.Codec.Value.t c with Ok s -> s | Error _ -> ""
53
50
in
54
-
match Jsont_bytesrw.decode_string Jsont.json data with
55
-
| Ok (Jsont.Object obj) ->
51
+
match Json.of_string Json.Codec.Value.t data with
52
+
| Ok (Json.Object obj) ->
56
53
S.Named
57
54
(List.map
58
-
(fun ((n, c) : Jsont.mem) -> (json_nv n, `Inline (enc c)))
55
+
(fun ((n, c) : Json.mem) -> (json_nv n, `Inline (enc c)))
59
56
(json_nv obj))
60
-
| Ok (Jsont.Array arr) ->
57
+
| Ok (Json.Array arr) ->
61
58
S.Indexed
62
59
(Array.of_list (List.map (fun c -> `Inline (enc c)) (json_nv arr)))
63
60
| _ -> S.Named []
+1
-1
test/test_sync.ml
+1
-1
test/test_sync.ml
+2
-1
test/test_worktree.ml
+2
-1
test/test_worktree.ml
···
67
67
W.commit ~fs heap ~branch:"main" ~dir ~message:"init" ~author:"test"
68
68
with
69
69
| Ok _hash -> ()
70
-
| Error (`Msg e) -> Alcotest.failf "commit failed: %s" e);
70
+
| Error (`Msg e) ->
71
+
Alcotest.failf "commit failed: %s" e);
71
72
(* Status should be clean after commit *)
72
73
let changes = W.status ~fs ~dir in
73
74
Alcotest.(check int) "clean after commit" 0 (List.length changes);