package irmin-git
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)
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>