package irmin-git

  1. Overview
  2. Docs
Git backend for Irmin

Install

Dune Dependency

Authors

Maintainers

Sources

irmin-3.11.0.tbz
sha256=09996fbcc2c43e117a9bd8e9028c635e81cccb264d5e02d425ab8b06bbacdbdb
sha512=0391a6bf7b94a1edd50a3a8df9e58961739fa78d7d689d61f56bc87144483bad2ee539df595c33d9d52c29b3458da5dddf3a73b5eb85e49c4667c26d2cd46be1

doc/src/irmin-git/irmin_git.ml.html

Source file irmin_git.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
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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
(*
 * Copyright (c) 2013-2022 Thomas Gazagnaire <thomas@gazagnaire.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

include Irmin_git_intf
open! Import
module Conf = Conf
module Metadata = Metadata
module Branch = Branch
module Reference = Reference
module Schema = Schema

let config = Conf.init

type reference = Reference.t [@@deriving irmin]

module Maker_ext
    (G : G)
    (S : Git.Sync.S with type hash := G.hash and type store := G.t) =
struct
  type endpoint = Mimic.ctx * Smart_git.Endpoint.t

  module Make
      (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 B = Backend.Make (G) (S) (Schema)
    include Irmin.Of_backend (B)

    let git_of_repo = B.git_of_repo
    let repo_of_git = B.repo_of_git

    let git_commit (repo : Repo.t) (h : commit) : G.Value.Commit.t option Lwt.t
        =
      let h = Commit.hash h in
      G.read (git_of_repo repo) h >|= function
      | Ok (Git.Value.Commit c) -> Some c
      | _ -> None

    module Git = G
  end
end

module Mem = struct
  include Git.Mem.Store

  let confs = Hashtbl.create 10
  let find_conf c = Hashtbl.find_opt confs c

  let add_conf c t =
    Hashtbl.replace confs c t;
    t

  let v' ?dotgit root = v ?dotgit root

  let v ?dotgit root =
    let conf = (dotgit, root) in
    match find_conf conf with
    | Some x -> Lwt.return x
    | None -> v' ?dotgit root >|= add_conf conf
end

module Maker
    (G : G)
    (S : Git.Sync.S with type hash := G.hash and type store := G.t) =
struct
  module Maker = Maker_ext (G) (S)

  type endpoint = Maker.endpoint

  module Make
      (Sc : Schema.S
              with type Hash.t = G.hash
               and type Node.t = G.Value.Tree.t
               and type Commit.t = G.Value.Commit.t) =
    Maker.Make (Sc)
end

module No_sync = struct
  type error =
    [ `Not_found | `Msg of string | `Exn of exn | `Cycle | `Invalid_flow ]

  let pp_error _ _ = assert false

  let fetch ?push_stdout:_ ?push_stderr:_ ?threads:_ ~ctx:_ _ _ ?version:_
      ?capabilities:_ ?deepen:_ _ =
    assert false

  let push ~ctx:_ _ _ ?version:_ ?capabilities:_ _ = assert false
end

module Content_addressable (G : Git.S) = struct
  module G = struct
    include G

    let v ?dotgit:_ _root = assert false
  end

  module type S =
    Irmin.Content_addressable.S with type _ t = G.t and type key = G.Hash.t

  module Maker = Maker_ext (G) (No_sync)

  module Make (V : Irmin.Type.S) = struct
    module V = struct
      include V

      let merge = Irmin.Merge.default Irmin.Type.(option V.t)
    end

    module Schema = Schema.Make (G) (V) (Reference)
    module M = Maker.Make (Schema)
    module X = M.Backend.Contents

    type 'a t = G.t

    let state t =
      let+ r = M.repo_of_git t in
      M.Backend.Repo.contents_t r

    type key = X.key
    type value = X.value

    let with_state0 f t =
      let* t = state t in
      f t

    let with_state1 f t x =
      let* t = state t in
      f t x

    let add = with_state1 X.add
    let pp_key = Irmin.Type.pp X.Key.t
    let equal_key = Irmin.Type.(unstage (equal X.Key.t))

    let unsafe_add t k v =
      let+ k' = with_state1 X.add t v in
      if equal_key k k' then ()
      else
        Fmt.failwith
          "[Git.unsafe_append] %a is not a valid key. Expecting %a instead.\n"
          pp_key k pp_key k'

    let find = with_state1 X.find
    let mem = with_state1 X.mem
    let close = with_state0 X.close
    let batch t f = f t
  end
end

module Atomic_write (G : Git.S) = struct
  module type S = Irmin.Atomic_write.S with type value = G.Hash.t

  module Make (K : Irmin.Branch.S) = struct
    module K = struct
      include K

      let main =
        match Irmin.Type.of_string K.t "main" with
        | Ok x -> x
        | Error (`Msg e) -> failwith e
    end

    module AW = Atomic_write.Make (Branch.Make (K)) (G)
    include Atomic_write.Check_closed (AW)
  end
end

module KV
    (G : G)
    (S : Git.Sync.S with type hash := G.hash and type store := G.t) =
struct
  module Maker = Maker (G) (S)
  module Branch = Branch.Make (Irmin.Branch.String)
  include Irmin.Key.Store_spec.Hash_keyed

  type endpoint = Maker.endpoint
  type metadata = Metadata.t
  type branch = Branch.t
  type hash = G.hash
  type info = Irmin.Info.default

  module Make (C : Irmin.Contents.S) = Maker.Make (Schema.Make (G) (C) (Branch))
end

module Ref
    (G : G)
    (S : Git.Sync.S with type hash := G.hash and type store := G.t) =
struct
  module Maker = Maker_ext (G) (S)

  type endpoint = Maker.endpoint
  type branch = reference

  module Make (C : Irmin.Contents.S) =
    Maker.Make (Schema.Make (G) (C) (Reference))
end

include Conf

module Generic_KV
    (CA : Irmin.Content_addressable.Maker)
    (AW : Irmin.Atomic_write.Maker) =
struct
  module G = Mem

  type endpoint = unit
  type metadata = Metadata.t
  type hash = G.hash
  type info = Irmin.Info.default

  include Irmin.Key.Store_spec.Hash_keyed

  module Schema (C : Irmin.Contents.S) = struct
    module Metadata = Metadata
    module Contents = C
    module Path = Irmin.Path.String_list
    module Branch = Branch.Make (Irmin.Branch.String)
    module Hash = Irmin.Hash.Make (Mem.Hash)
    module Node = Node.Make (G) (Path)
    module Commit = Commit.Make (G)
    module Info = Irmin.Info.Default
  end

  module Make (C : Irmin.Contents.S) = struct
    module Sc = Schema (C)

    (* We use a dummy store to get the serialisation functions. This is
       probably not necessary and we could use Git.Value.Raw instead. *)
    module Dummy = struct
      module G = Mem
      module Maker = Maker (G) (No_sync)
      module S = Maker.Make (Sc)
      include S.Backend
    end

    module CA = Irmin.Content_addressable.Check_closed (CA)
    module AW = Irmin.Atomic_write.Check_closed (AW)

    module X = struct
      module Schema = Sc
      module Hash = Dummy.Hash
      module Info = Irmin.Info.Default
      module Key = Irmin.Key.Of_hash (Hash)

      module Contents = struct
        module V = Dummy.Contents.Val
        module CA = CA (Hash) (V)
        include Irmin.Contents.Store (CA) (Hash) (V)
      end

      module Node = struct
        module V = Dummy.Node.Val
        module CA = CA (Hash) (V)

        include
          Irmin.Node.Store (Contents) (CA) (Hash) (V) (Dummy.Node.Metadata)
            (Schema.Path)
      end

      module Node_portable = Irmin.Node.Portable.Of_node (Node.Val)

      module Commit = struct
        module V = struct
          include Dummy.Commit.Val
          module Info = Schema.Info

          type hash = Hash.t [@@deriving irmin]
        end

        module CA = CA (Hash) (V)
        include Irmin.Commit.Store (Info) (Node) (CA) (Hash) (V)
      end

      module Commit_portable = Irmin.Commit.Portable.Of_commit (Commit.V)

      module Branch = struct
        module Key = Dummy.Branch.Key
        module Val = Dummy.Branch.Val
        include AW (Key) (Val)
      end

      module Slice = Dummy.Slice
      module Remote = Irmin.Backend.Remote.None (Branch.Val) (Branch.Key)

      module Repo = struct
        (* FIXME: remove duplication with irmin.mli *)
        type t = {
          config : Irmin.config;
          contents : read Contents.t;
          nodes : read Node.t;
          commits : read Commit.t;
          branch : Branch.t;
        }

        let contents_t t = t.contents
        let node_t t = t.nodes
        let commit_t t = t.commits
        let branch_t t = t.branch
        let config t = t.config

        let batch t f =
          Contents.CA.batch t.contents @@ fun c ->
          Node.CA.batch (snd t.nodes) @@ fun n ->
          Commit.CA.batch (snd t.commits) @@ fun ct ->
          let contents_t = c in
          let node_t = (contents_t, n) in
          let commit_t = (node_t, ct) in
          f contents_t node_t commit_t

        let v config =
          let* contents = Contents.CA.v config in
          let* nodes = Node.CA.v config in
          let* commits = Commit.CA.v config in
          let nodes = (contents, nodes) in
          let commits = (nodes, commits) in
          let+ branch = Branch.v config in
          { contents; nodes; commits; branch; config }

        let close t =
          Contents.CA.close t.contents >>= fun () ->
          Node.CA.close (snd t.nodes) >>= fun () ->
          Commit.CA.close (snd t.commits) >>= fun () -> Branch.close t.branch
      end
    end

    include Irmin.Of_backend (X)
  end
end

(* Enforce that {!KV} is a sub-type of {!Irmin.KV_maker}. *)
module KV_is_a_KV_maker : Irmin.KV_maker = KV (Mem) (No_sync)

(* Enforce that {!Generic_KV} is a sub-type of {!Irmin.KV_maker}. *)
module Generic_KV_is_a_KV_maker : Irmin.KV_maker =
  Generic_KV (Irmin_mem.Content_addressable) (Irmin_mem.Atomic_write)
OCaml

Innovation. Community. Security.