make it compile

src/dune

@@ -1,4 +1,4 @@
 (library
   (name git_kv)
   (public_name git-kv)
-  (libraries git mirage-kv))
+  (libraries git ptime mirage-kv))

src/git_kv.ml

@@ -5,6 +5,9 @@ module Search = Git.Search.Make(Digestif.SHA1)(Store)
 module Git_commit = Git.Commit.Make(Store.Hash)
 
 type t = {
+  ctx : Mimic.ctx ;
+  edn : Smart_git.Endpoint.t;
+  branch : Git.Reference.t ;
   store : Store.t ;
   mutable head : Store.hash option ;
 }
@@ -33,28 +36,48 @@ let split_url s =
   | _ ->
     Smart_git.Endpoint.of_string s |> to_invalid, main
 
+let pull t =
+  let open Lwt.Infix in
+  Sync.fetch ~capabilities ~ctx:t.ctx t.edn t.store ~deepen:(`Depth 1) `All >>= fun r ->
+  let data =
+    Result.map_error
+      (fun e -> `Msg (Fmt.str "error fetching: %a" Sync.pp_error e))
+      r
+  in
+  match data with
+  | Error _ as e -> Lwt.return e
+  | Ok None -> Lwt.return (Ok [])
+  | Ok Some (_, _) ->
+    Store.Ref.resolve t.store t.branch >>= fun r ->
+    let head =
+      Result.map_error
+        (fun e -> `Msg (Fmt.str "error resolving branch %s: %a"
+                          (Git.Reference.to_string t.branch)
+                          Store.pp_error e))
+        r |> to_invalid
+    in
+    t.head <- Some head;
+    Lwt.return (Ok [])
+
 let connect ctx endpoint =
   let open Lwt.Infix in
   init_store () >>= fun store ->
   let store = to_invalid store in
   let edn, branch = split_url endpoint in
-  Sync.fetch ~capabilities ~ctx edn store ~deepen:(`Depth 1) `All >>= fun r ->
+  let t = { ctx ; edn ; branch ; store ; head = None } in
-  let data =
+  pull t >>= fun r ->
-    Result.map_error
+  let _r = to_invalid r in
-      (fun e -> `Msg (Fmt.str "error fetching: %a" Sync.pp_error e))
+  Lwt.return t
-      r |> to_invalid
+
-  in
+type key = Mirage_kv.Key.t
-  match data with
+
-  | None -> Lwt.return { store ; head = None }
+type change = [
-  | Some (_, _) ->
+  | `Add of key
-    Store.Ref.resolve store branch >>= fun r ->
+  | `Remove of key
-    let head =
+  | `Change of key
-      Result.map_error
+]
-        (fun e -> `Msg (Fmt.str "error resolving branch %s: %a"
+
-                          (Git.Reference.to_string branch) Store.pp_error e))
+let pull _ = assert false
-        r |> to_invalid
-    in
-    Lwt.return { store ; head = Some head }
 
 type error = Mirage_kv.error
 
@@ -63,6 +86,7 @@ let pp_error ppf = Mirage_kv.pp_error ppf
 let disconnect _t = Lwt.return_unit
 
 let to_octets t =
+  (* TODO maybe preserve edn and branch as well? *)
   let open Lwt.Infix in
   match t.head with
   | None -> Lwt.return ""
@@ -73,7 +97,8 @@ let to_octets t =
       Encore.Lavoisier.emit_string c l
     | _ -> assert false
 
-let of_octets data =
+let of_octets ctx ~remote data =
+  (* TODO maybe recover edn and branch from data as well? *)
   let open Lwt_result.Infix in
   let l = Encore.to_angstrom Git_commit.format in
   Lwt.return
@@ -81,9 +106,8 @@ let of_octets data =
        (Angstrom.parse_string ~consume:All l data)) >>= fun head ->
   let head = Git_commit.tree head in
   init_store () >|= fun store ->
-  { store ; head = Some head }
+  let edn, branch = split_url remote in
-
+  { ctx ; edn ; branch ; store ; head = Some head }
-type key = Mirage_kv.Key.t
 
 let exists _t _key =
   (*  Search.find t.store t.head (`Path (Mirage_kv.Key.segments key)) >>= function *)
@@ -115,12 +139,36 @@ let list _t _key =
   (* ((string * [`Value | `Dictionary]) list, error) result Lwt.t *)
   assert false
 
-let last_modified _t _key =
+let last_modified t key =
-  (* (int * int64, error) result Lwt.t *)
+  let open Lwt.Infix in
-  assert false
+  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 (Ptime.(Span.to_d_ps (to_span ts)))
+        | _ -> assert false)
+    t.head
 
-let digest t _key =
+let digest t key =
-  Lwt.return (Ok (Option.fold ~none:"0" ~some:Store.Hash.to_hex t.head))
+  Option.fold
+    ~none:(Error (`Not_found key))
+    ~some:(fun x -> Ok (Store.Hash.to_hex x))
+    t.head |> Lwt.return
 
 let size t key =
   let open Lwt_result.Infix in

src/git_kv.mli

@@ -10,7 +10,8 @@ val connect : Mimic.ctx -> string -> t Lwt.t
 
 val to_octets : t -> string Lwt.t
 
-val of_octets : string -> (t, [`Msg of string]) result Lwt.t
+val of_octets : Mimic.ctx -> remote:string -> string ->
+  (t, [`Msg of string]) result Lwt.t
 
 type change = [
   | `Add of key