From e342f8539a6eb421eac01df602dda45f7cf84609 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Wed, 18 Dec 2024 16:22:30 +0100 Subject: [PATCH 1/2] last_modified: don't find_blob; find the commit! To get the last_modified timestamp we need the commit object not the blob. This is closer to the old behavior. --- src/git_kv.ml | 56 ++++++++++++++++++++++++++------------------------- 1 file changed, 29 insertions(+), 27 deletions(-) diff --git a/src/git_kv.ml b/src/git_kv.ml index 2fea998..14740d4 100644 --- a/src/git_kv.ml +++ b/src/git_kv.ml @@ -463,33 +463,35 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct let last_modified t key = let open Lwt.Infix in - find_blob t key >>= - Option.fold - ~none:(Lwt.return (Error (`Not_found key))) - ~some:(fun head -> - Store.read_exn t.store head >|= function - | Commit c -> - let author = Git_commit.author c in - let secs, tz_offset = author.Git.User.date in - let secs = - Option.fold ~none:secs - ~some:(fun { Git.User.sign ; hours ; minutes } -> - let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in - match sign with - | `Plus -> Int64.(sub secs tz_off) - | `Minus -> Int64.(add secs tz_off)) - tz_offset - in - let ts = - Option.fold - ~none:Ptime.epoch - ~some:Fun.id (Ptime.of_float_s (Int64.to_float secs)) - in - Ok ts - | _ -> - Ok (Option.fold - ~none:Ptime.epoch - ~some:Fun.id (Ptime.of_float_s (Int64.to_float (now ()))))) + match t.committed, t.head with + | None, None -> + Lwt.return (Error (`Not_found key)) + | Some _, _ -> + Lwt.return_ok + (Option.fold + ~none:Ptime.epoch + ~some:Fun.id (Ptime.of_float_s (Int64.to_float (now ())))) + | None, Some head -> + Store.read_exn t.store head >|= function + | Commit c -> + let author = Git_commit.author c in + let secs, tz_offset = author.Git.User.date in + let secs = + Option.fold ~none:secs + ~some:(fun { Git.User.sign ; hours ; minutes } -> + let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in + match sign with + | `Plus -> Int64.(sub secs tz_off) + | `Minus -> Int64.(add secs tz_off)) + tz_offset + in + let ts = + Option.fold + ~none:Ptime.epoch + ~some:Fun.id (Ptime.of_float_s (Int64.to_float secs)) + in + Ok ts + | _ -> assert false let digest t key = let open Lwt.Infix in From d2a0e526dad259f71fc7f741129aba8e476c8f7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Thu, 19 Dec 2024 15:05:48 +0100 Subject: [PATCH 2/2] Remove an assert false, and silence warning 8 --- src/git_kv.ml | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/src/git_kv.ml b/src/git_kv.ml index 14740d4..090d87d 100644 --- a/src/git_kv.ml +++ b/src/git_kv.ml @@ -472,26 +472,27 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct ~none:Ptime.epoch ~some:Fun.id (Ptime.of_float_s (Int64.to_float (now ())))) | None, Some head -> - Store.read_exn t.store head >|= function - | Commit c -> - let author = Git_commit.author c in - let secs, tz_offset = author.Git.User.date in - let secs = - Option.fold ~none:secs - ~some:(fun { Git.User.sign ; hours ; minutes } -> - let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in - match sign with - | `Plus -> Int64.(sub secs tz_off) - | `Minus -> Int64.(add secs tz_off)) - tz_offset - in - let ts = - Option.fold - ~none:Ptime.epoch - ~some:Fun.id (Ptime.of_float_s (Int64.to_float secs)) - in - Ok ts - | _ -> assert false + (* See https://github.com/ocaml/ocaml/issues/9301 why we have the + intermediate [r] value. *) + let+ r = Store.read_exn t.store head in + let[@warning "-8"] Commit c = r in + let author = Git_commit.author c in + let secs, tz_offset = author.Git.User.date in + let secs = + Option.fold ~none:secs + ~some:(fun { Git.User.sign ; hours ; minutes } -> + let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in + match sign with + | `Plus -> Int64.(sub secs tz_off) + | `Minus -> Int64.(add secs tz_off)) + tz_offset + in + let ts = + Option.fold + ~none:Ptime.epoch + ~some:Fun.id (Ptime.of_float_s (Int64.to_float secs)) + in + Ok ts let digest t key = let open Lwt.Infix in