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_commit.ml.html
Source file git_commit.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
(* * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org> * and Romain Calascibetta <romain.calascibetta@gmail.com> * * 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. *) module SHA1 = Digestif.SHA1 type t = { tree: Digestif.SHA1.t; parents: Digestif.SHA1.t list; author: Git_user.t; committer: Git_user.t; extra: (string * string list) list; message: string option; } (* XXX(dinosaure): git seems to be very resilient with the commit. Indeed, it's not a mandatory to have an author or a committer and for these information, it's not mandatory to have a date. Follow this issue if we have any problem with the commit format. *) let make ~tree ~ ~committer ?(parents = []) ?(extra = []) message = {tree; parents; author; committer; extra; message} module Syntax = struct let safe_exn f x = try f x with _ -> raise Encore.Bij.Bijection let hex = Encore.Bij.v ~fwd:(safe_exn Digestif.SHA1.of_hex) ~bwd:(safe_exn Digestif.SHA1.to_hex) let user = Encore.Bij.v ~fwd:(fun str -> match Angstrom.parse_string ~consume:Angstrom.Consume.All (Encore.to_angstrom Git_user.format) str with | Ok v -> v | Error _ -> raise Encore.Bij.Bijection) ~bwd:(fun v -> Encore.Lavoisier.emit_string v (Encore.to_lavoisier Git_user.format)) let commit = Encore.Bij.v ~fwd:(fun ((_, tree), parents, (_, ), (_, committer), extra, message) -> let parents = List.map snd parents in {tree; parents; author; committer; extra; message}) ~bwd:(fun {tree; parents; ; committer; extra; message} -> let parents = List.map (fun x -> "parent", x) parents in ( ("tree", tree), parents, ("author", author), ("committer", committer), extra, message )) let is_not_sp chr = chr <> ' ' let is_not_lf chr = chr <> '\x0a' let always x _ = x let rest = let open Encore.Syntax in let open Encore.Either in fix @@ fun m -> let cons = Encore.Bij.cons <$> (while0 (always true) <* commit <*> m) in let nil = pure ~compare:(fun () () -> true) () in Encore.Bij.v ~fwd:(function L cons -> cons | R () -> []) ~bwd:(function _ :: _ as lst -> L lst | [] -> R ()) <$> peek cons nil let rest : string Encore.t = let open Encore.Syntax in Encore.Bij.v ~fwd:(String.concat "") ~bwd:(fun x -> [x]) <$> rest let value = let open Encore.Syntax in let sep = Encore.Bij.string "\n " <$> const "\n " in sep_by0 ~sep (while0 is_not_lf) let extra = let open Encore.Syntax in while1 (fun chr -> is_not_sp chr && is_not_lf chr) <* (Encore.Bij.char ' ' <$> any) <*> (value <* (Encore.Bij.char '\x0a' <$> any)) let binding ?key value = let open Encore.Syntax in let value = value <$> (while1 is_not_lf <* (Encore.Bij.char '\x0a' <$> any)) in match key with | Some key -> const key <* (Encore.Bij.char ' ' <$> any) <*> value | None -> while1 is_not_sp <* (Encore.Bij.char ' ' <$> any) <*> value let rest = let open Encore.Syntax in let open Encore.Either in let fwd = function L str -> Some str | R _ -> None in let bwd = function Some str -> L str | None -> R "" in map (Encore.Bij.v ~fwd ~bwd) (peek ((Encore.Bij.char '\x0a' <$> any) *> rest) (const "")) let t = let open Encore.Syntax in binding ~key:"tree" hex <*> rep0 (binding ~key:"parent" hex) <*> binding ~key:"author" user <*> binding ~key:"committer" user <*> rep0 extra <*> rest let format = Encore.Syntax.map Encore.Bij.(compose obj6 commit) t end let format = Syntax.format let length t = let string x = Int64.of_int (String.length x) in let ( + ) = Int64.add in let parents = List.fold_left (fun acc _ -> string "parent" + 1L + Int64.of_int (Digestif.SHA1.digest_size * 2) + 1L + acc) 0L t.parents in let values l = let rec go a = function | [] -> 1L + a | [x] -> string x + 1L + a | x :: r -> go (string x + 2L + a) r in go 0L l in string "tree" + 1L + Int64.of_int (Digestif.SHA1.digest_size * 2) + 1L + parents + string "author" + 1L + Git_user.length t.author + 1L + string "committer" + 1L + Git_user.length t.committer + 1L + List.fold_left (fun acc (key, v) -> string key + 1L + values v + acc) 0L t.extra + match t.message with Some str -> 1L + string str | None -> 0L let pp ppf {tree; parents; ; committer; extra; message} = let fn = function '\000' .. '\031' | '\127' -> '.' | x -> x in let chr = Fmt.using fn Fmt.char in let pp_message ppf x = Fmt.iter ~sep:Fmt.nop String.iter chr ppf x in Fmt.pf ppf "{ @[<hov>tree = %a;@ parents = [ %a ];@ author = %a;@ committer = %a;@ \ extra = %a;@ message = %a;@] }" (Fmt.hvbox Digestif.SHA1.pp) tree (Fmt.hvbox (Fmt.list ~sep:(Fmt.any ";@ ") Digestif.SHA1.pp)) parents (Fmt.hvbox Git_user.pp) author (Fmt.hvbox Git_user.pp) committer Fmt.(hvbox (Dump.list (Dump.pair string (Dump.list string)))) extra Fmt.(option (hvbox pp_message)) message let digest value : Digestif.SHA1.t = Git_digest.digest Git_digest.sha1 SHA1.empty `Commit length (Encore.to_lavoisier format) value let equal = ( = ) let hash = Hashtbl.hash let parents {parents; _} = parents let tree {tree; _} = tree let committer {committer; _} = committer let {; _} = author let message {message; _} = message let extra {extra; _} = extra let compare_by_date a b = Int64.compare (fst a.author.Git_user.date) (fst b.author.Git_user.date) let compare = compare_by_date module Set = Set.Make (struct type nonrec t = t let compare = compare end) module Map = Map.Make (struct type nonrec t = t let compare = compare end)
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>