Merge pull request #595 from mirage/some-functions

Add few functions to introspect target when we encode and be able to construct objects with source

src/carton/dec.ml

@@ -622,6 +622,9 @@ module W = struct
     with Found -> !slice
 end
 
+type raw = { raw0 : Bigstringaf.t; raw1 : Bigstringaf.t; flip : bool }
+type v = { kind : kind; raw : raw; len : int; depth : int }
+
 type ('fd, 'uid) t = {
   ws : 'fd W.t;
   fd : 'uid -> int64;
@@ -948,9 +951,6 @@ let length_of_offset : type fd uid. map:fd W.map -> (fd, uid) t -> int64 -> int
       let _, size, _, _ = header_of_entry ~map t cursor slice in
       size
 
-type raw = { raw0 : Bigstringaf.t; raw1 : Bigstringaf.t; flip : bool }
-type v = { kind : kind; raw : raw; len : int; depth : int }
-
 let v ~kind ?(depth = 1) raw =
   let len = Bigstringaf.length raw in
   {
@@ -978,6 +978,29 @@ let raw { raw; _ } = get_payload raw
 let len { len; _ } = len
 let depth { depth; _ } = depth
 
+let copy ?(flip = false) ?weight v =
+  let weight =
+    match weight with
+    | Some weight -> weight
+    | None -> Bigstringaf.length v.raw.raw0
+  in
+  let raw = Bigstringaf.create (weight * 2) in
+  Bigstringaf.unsafe_blit v.raw.raw0 ~src_off:0 raw ~dst_off:0
+    ~len:(Bigstringaf.length v.raw.raw0);
+  Bigstringaf.unsafe_blit v.raw.raw1 ~src_off:0 raw ~dst_off:weight
+    ~len:(Bigstringaf.length v.raw.raw1);
+  {
+    kind = v.kind;
+    raw =
+      {
+        raw0 = Bigstringaf.sub raw ~off:0 ~len:weight;
+        raw1 = Bigstringaf.sub raw ~off:weight ~len:weight;
+        flip = (if not flip then v.raw.flip else not v.raw.flip);
+      };
+    len = v.len;
+    depth = v.depth;
+  }
+
 let uncompress :
     type fd uid.
     map:fd W.map -> (fd, uid) t -> kind -> raw -> cursor:int64 -> W.slice -> v =
@@ -1337,6 +1360,11 @@ let of_offset_with_path :
   in
   if path.depth > 1 then go (path.depth - 1) (flip raw) else base
 
+let of_offset_with_source :
+    type fd uid. map:fd W.map -> (fd, uid) t -> v -> cursor:int64 -> v =
+ fun ~map t { kind; raw; depth; _ } ~cursor ->
+  of_offset_with_source ~map t kind raw ~depth ~cursor
+
 type 'uid digest = kind:kind -> ?off:int -> ?len:int -> Bigstringaf.t -> 'uid
 
 let uid_of_offset :

src/carton/dec.mli

@@ -199,6 +199,9 @@ val len : v -> int
 val depth : v -> int
 (** [depth v] is the depth of the object into the PACK file it came from. *)
 
+val copy : ?flip:bool -> ?weight:weight -> v -> v
+(** [copy v] creates a fresh new object which is equal to the given [v]. *)
+
 val make :
   'fd ->
   ?sector:int64 ->
@@ -364,6 +367,12 @@ val of_offset_with_path :
     at [cursor] into [t]. This function is {i tail-recursive} and bound to the
     given [path]. *)
 
+val of_offset_with_source :
+  map:'fd W.map -> ('fd, 'uid) t -> v -> cursor:int64 -> v
+(** [of_offset_with_source ~map t ~path source ~cursor] is the object available
+    at [cursor] into [t]. This function is {i tail-recursive} and use the given
+    [source] if the requested object is a patch. *)
+
 (** {3 Uid of object.}
 
     Unique identifier of objects is a user-defined type which is not described

src/carton/enc.ml

@@ -89,6 +89,8 @@ type 'uid q = {
 
 let target_uid { entry; _ } = entry.uid
 let target_length { entry; _ } = entry.length
+let target_patch { patch; _ } = patch
+let source_of_patch { source; _ } = source
 
 let pp_patch target_length pp_uid ppf patch =
   Fmt.pf ppf

src/carton/enc.mli

@@ -24,6 +24,8 @@ type 'uid uid = { uid_ln : int; uid_rw : 'uid -> string }
 val target_to_source : 'uid q -> 'uid p
 val target_uid : 'uid q -> 'uid
 val target_length : 'uid q -> int
+val target_patch : 'uid q -> 'uid patch option
+val source_of_patch : 'uid patch -> 'uid
 
 val entry_to_target :
   's scheduler -> load:('uid, 's) load -> 'uid entry -> ('uid q, 's) io