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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
open Import
module type G = sig
include Git.S
val v : ?dotgit:Fpath.t -> Fpath.t -> (t, error) result Lwt.t
end
module Make
(G : G)
(S : Git.Sync.S with type hash := G.hash and type store := G.t)
(Schema : Schema.S
with type Hash.t = G.hash
and type Node.t = G.Value.Tree.t
and type Commit.t = G.Value.Commit.t) =
struct
module Hash = Irmin.Hash.Make (G.Hash)
module Schema = Schema
module Key = Irmin.Key.Of_hash (Hash)
module Commit_key = Key
module Node_key = Key
module Contents = struct
module S = Contents.Make (G) (Schema.Contents)
include Irmin.Contents.Store (S) (S.Hash) (S.Val)
end
module Node = struct
module S = Node.Store (G) (Schema.Path)
include
Irmin.Node.Store (Contents) (S) (S.Key) (S.Val) (Metadata) (Schema.Path)
end
module Node_portable = Irmin.Node.Portable.Of_node (Node.Val)
module Commit = struct
module S = Commit.Store (G)
include Irmin.Commit.Store (Schema.Info) (Node) (S) (S.Hash) (S.Val)
end
module Commit_portable = Irmin.Commit.Portable.Of_commit (Commit.S.Val)
module Branch = struct
module Key = Schema.Branch
module Val = Commit_key
module S = Atomic_write.Make (Schema.Branch) (G)
include Atomic_write.Check_closed (S)
let v ?lock ~head ~bare t = S.v ?lock ~head ~bare t >|= v
end
module Slice = Irmin.Backend.Slice.Make (Contents) (Node) (Commit)
module Repo = struct
let handle_git_err = function
| Ok x -> Lwt.return x
| Error e -> Fmt.kstr Lwt.fail_with "%a" G.pp_error e
type t = { config : Irmin.config; closed : bool ref; g : G.t; b : Branch.t }
let branch_t t = t.b
let contents_t t : 'a Contents.t = (t.closed, t.g)
let node_t t : 'a Node.t = (contents_t t, (t.closed, t.g))
let commit_t t : 'a Commit.t = (node_t t, (t.closed, t.g))
let batch t f = f (contents_t t) (node_t t) (commit_t t)
type config = {
root : string;
dot_git : string option;
level : int option;
buffers : int option;
head : G.Reference.t option;
bare : bool;
}
let config c =
let module C = Irmin.Backend.Conf in
let root = C.find_root c |> Option.value ~default:"." in
let dot_git = C.get c Conf.Key.dot_git in
let level = C.get c Conf.Key.level in
let head = C.get c Conf.Key.head in
let bare = C.get c Conf.Key.bare in
let buffers = C.get c Conf.Key.buffers in
{ root; dot_git; level; head; buffers; bare }
let fopt f = function None -> None | Some x -> Some (f x)
let v conf =
let { root; dot_git; head; bare; _ } = config conf in
let dotgit = fopt Fpath.v dot_git in
let root = Fpath.v root in
let* g = G.v ?dotgit root >>= handle_git_err in
let+ b = Branch.v ~head ~bare g in
{ g; b; closed = ref false; config = (conf :> Irmin.config) }
let config t = t.config
let close t = Branch.close t.b >|= fun () -> t.closed := true
end
module Remote = struct
include Remote.Make (G) (S) (Schema.Branch)
let v repo = Lwt.return repo.Repo.g
end
let git_of_repo r = r.Repo.g
let repo_of_git ?head ?(bare = true) ?lock g =
let+ b = Branch.v ?lock ~head ~bare g in
{
Repo.config = Irmin.Backend.Conf.empty Conf.spec;
closed = ref false;
g;
b;
}
end