package git-kv
A Mirage_kv implementation using git
Install
Dune Dependency
Authors
Maintainers
Sources
git-kv-0.2.0.tbz
sha256=40de3010d82dd8e9229e7df09c0a649e81efd47e991ef6eb31ee0c713dfe400d
sha512=fe70e3d1ad0f2a07dfd594ea87b4a4fcc1fe5633ced537206e61d566a2f97061dd0b348b1e93b8de1196af5878f307b7a3f595b1b51b25da89ee918328b977d9
doc/src/git-kv.mem/git_store.ml.html
Source file git_store.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
module SHA1 = Digestif.SHA1 module Reference = Git_reference module Commit = Git_commit module Tree = Git_tree module Blob = Git_blob module Tag = Git_tag module Object = Git_object module User = Git_user module Endpoint = Git_endpoint let src = Logs.Src.create "git.store" module Log = (val Logs.src_log src : Logs.LOG) type t = { values: (SHA1.t, Git_object.t) Hashtbl.t; refs: (Git_reference.t, [ `H of SHA1.t | `R of Git_reference.t ]) Hashtbl.t; shallows: Git_shallow.t; root: Fpath.t; mutable head: Git_reference.contents option; } let read_exn t h = Hashtbl.find t.values h let is_shallowed t hash = Git_shallow.exists t.shallows ~equal:SHA1.equal hash let shallowed t = Git_shallow.get t.shallows let shallow t hash = Git_shallow.append t.shallows hash let unshallow t hash = Git_shallow.remove t.shallows ~equal:SHA1.equal hash let read t h = try Ok (read_exn t h) with _ -> Error (`Not_found h) let write t value = let hash = Git_object.digest value in Hashtbl.replace t.values hash value; Ok hash let v root = { values= Hashtbl.create 0x7ff; refs= Hashtbl.create 0x7ff; shallows= Git_shallow.make []; root; head= None; } |> Lwt.return_ok module Traverse = Traverse_bfs.Make (struct type nonrec t = t let root {root; _} = root let read_exn = read_exn let is_shallowed = is_shallowed end) let fold = Traverse.fold let iter = Traverse.iter module Ref = struct module Graph = Git_reference.Map let list t = Log.debug (fun l -> l "Ref.list."); let graph, rest = Hashtbl.fold (fun k -> function | `R ptr -> fun (a, r) -> a, (k, ptr) :: r | `H hash -> fun (a, r) -> Graph.add k hash a, r) t.refs (Graph.empty, []) in let graph = List.fold_left (fun a (k, ptr) -> try let v = Graph.find ptr a in Graph.add k v a with Not_found -> a) graph rest in let r = Graph.fold (fun k v a -> (k, v) :: a) graph [] in Lwt.return r let mem t r = Log.debug (fun l -> l "Ref.mem %a." Git_reference.pp r); try let _ = Hashtbl.find t.refs r in Lwt.return true with Not_found -> Lwt.return false exception Cycle let resolve t r = let rec go ~visited r = Log.debug (fun l -> l "Ref.resolve %a." Git_reference.pp r); try if List.exists (Git_reference.equal r) visited then raise Cycle; match Hashtbl.find t.refs r with | `H s -> Log.debug (fun l -> l "Ref.resolve %a found: %a." Git_reference.pp r SHA1.pp s); Lwt.return_ok s | `R r' -> let visited = r :: visited in go ~visited r' with | Not_found -> Log.err (fun l -> l "%a not found." Git_reference.pp r); Lwt.return_error (`Reference_not_found r) | Cycle -> Log.err (fun l -> l "Got a reference cycle"); Lwt.return_error `Cycle in go ~visited:[] r let read t r = try match Hashtbl.find t.refs r with | `H hash -> Lwt.return_ok (Git_reference.uid hash) | `R refname -> Lwt.return_ok (Git_reference.ref refname) with Not_found -> Lwt.return_error (`Reference_not_found r) let remove t r = Log.debug (fun l -> l "Ref.remove %a." Git_reference.pp r); Hashtbl.remove t.refs r; Lwt.return_ok () let write t r value = Log.debug (fun l -> l "Ref.write %a." Git_reference.pp r); let head_contents = match value with | Git_reference.Uid hash -> `H hash | Ref refname -> `R refname in Hashtbl.replace t.refs r head_contents; Lwt.return_ok () end type error = [ `Not_found of SHA1.t | `Reference_not_found of Git_reference.t | `Msg of string ] let pp_error ppf = function | `Not_found hash -> Fmt.pf ppf "%a not found" SHA1.pp hash | `Reference_not_found ref -> Fmt.pf ppf "Reference %a not found" Git_reference.pp ref | `Msg str -> Fmt.string ppf str
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>