Merge pull request 'last_modified: don't find_blob; find the commit!' (!10) from fix-last_modified into main
Reviewed-on: #10 Reviewed-by: dinosaure <romain.calascibetta@gmail.com>
This commit is contained in:
commit
aec833f991
1 changed files with 30 additions and 27 deletions
|
@ -463,33 +463,36 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
|
||||||
|
|
||||||
let last_modified t key =
|
let last_modified t key =
|
||||||
let open Lwt.Infix in
|
let open Lwt.Infix in
|
||||||
find_blob t key >>=
|
match t.committed, t.head with
|
||||||
Option.fold
|
| None, None ->
|
||||||
~none:(Lwt.return (Error (`Not_found key)))
|
Lwt.return (Error (`Not_found key))
|
||||||
~some:(fun head ->
|
| Some _, _ ->
|
||||||
Store.read_exn t.store head >|= function
|
Lwt.return_ok
|
||||||
| Commit c ->
|
(Option.fold
|
||||||
let author = Git_commit.author c in
|
~none:Ptime.epoch
|
||||||
let secs, tz_offset = author.Git.User.date in
|
~some:Fun.id (Ptime.of_float_s (Int64.to_float (now ()))))
|
||||||
let secs =
|
| None, Some head ->
|
||||||
Option.fold ~none:secs
|
(* See https://github.com/ocaml/ocaml/issues/9301 why we have the
|
||||||
~some:(fun { Git.User.sign ; hours ; minutes } ->
|
intermediate [r] value. *)
|
||||||
let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in
|
let+ r = Store.read_exn t.store head in
|
||||||
match sign with
|
let[@warning "-8"] Commit c = r in
|
||||||
| `Plus -> Int64.(sub secs tz_off)
|
let author = Git_commit.author c in
|
||||||
| `Minus -> Int64.(add secs tz_off))
|
let secs, tz_offset = author.Git.User.date in
|
||||||
tz_offset
|
let secs =
|
||||||
in
|
Option.fold ~none:secs
|
||||||
let ts =
|
~some:(fun { Git.User.sign ; hours ; minutes } ->
|
||||||
Option.fold
|
let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in
|
||||||
~none:Ptime.epoch
|
match sign with
|
||||||
~some:Fun.id (Ptime.of_float_s (Int64.to_float secs))
|
| `Plus -> Int64.(sub secs tz_off)
|
||||||
in
|
| `Minus -> Int64.(add secs tz_off))
|
||||||
Ok ts
|
tz_offset
|
||||||
| _ ->
|
in
|
||||||
Ok (Option.fold
|
let ts =
|
||||||
~none:Ptime.epoch
|
Option.fold
|
||||||
~some:Fun.id (Ptime.of_float_s (Int64.to_float (now ())))))
|
~none:Ptime.epoch
|
||||||
|
~some:Fun.id (Ptime.of_float_s (Int64.to_float secs))
|
||||||
|
in
|
||||||
|
Ok ts
|
||||||
|
|
||||||
let digest t key =
|
let digest t key =
|
||||||
let open Lwt.Infix in
|
let open Lwt.Infix in
|
||||||
|
|
Loading…
Reference in a new issue