Distinguish between append-only vs. content-addressable stores

Fix #576

src/irmin-fs/irmin_fs.ml

@@ -116,31 +116,26 @@ struct
 
 end
 
-module Content_addressable_ext
+module Append_only_ext
     (IO: IO)
     (S: Config)
-    (K: Irmin.Hash.S)
+    (K: Irmin.Type.S)
     (V: Irmin.Type.S) =
 struct
 
   include Read_only_ext(IO)(S)(K)(V)
 
   let temp_dir t = t.path / "tmp"
 
-  let add t value =
-    let str = Irmin.Type.encode_bin V.t value in
-    let key = K.digest str in
+  let add t key value =
     Log.debug (fun f -> f "add %a" pp_key key);
     let file = file_of_key t key in
     let temp_dir = temp_dir t in
-    (IO.file_exists file >>= function
-      | true  -> Lwt.return_unit
-      | false ->
-        Lwt.catch
-          (fun () -> IO.write_file ~temp_dir file str)
-          (fun e -> Lwt.fail e))
-    >|= fun () ->
-    key
+    IO.file_exists file >>= function
+    | true  -> Lwt.return_unit
+    | false ->
+      let str = Irmin.Type.encode_bin V.t value in
+      IO.write_file ~temp_dir file str
 
 end
 
@@ -263,9 +258,9 @@ module Make_ext (IO: IO) (Obj: Config) (Ref: Config)
     (B: Irmin.Branch.S)
     (H: Irmin.Hash.S)
 = struct
-  module CA = Content_addressable_ext(IO)(Obj)
+  module AO = Append_only_ext(IO)(Obj)
   module AW = Atomic_write_ext(IO)(Ref)
-  include Irmin.Make(CA)(AW)(M)(C)(P)(B)(H)
+  include Irmin.Make(Irmin.Content_addressable(AO))(AW)(M)(C)(P)(B)(H)
 end
 
 let string_chop_prefix ~prefix str =
@@ -328,7 +323,7 @@ module Links = struct
 
 end
 
-module Content_addressable (IO: IO) = Content_addressable_ext (IO)(Obj)
+module Append_only (IO: IO) = Append_only_ext (IO)(Obj)
 module Link (IO: IO) = Link_ext (IO)(Links)
 module Atomic_write (IO: IO) = Atomic_write_ext (IO)(Ref)
 module Make (IO: IO) = Make_ext (IO)(Obj)(Ref)

src/irmin-fs/irmin_fs.mli

@@ -65,7 +65,7 @@ module type IO = sig
 
 end
 
-module Content_addressable (IO: IO): Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
+module Append_only (IO: IO): Irmin.APPEND_ONLY_STORE_MAKER
 module Link (IO: IO): Irmin.LINK_STORE_MAKER
 module Atomic_write (IO: IO): Irmin.ATOMIC_WRITE_STORE_MAKER
 module Make (IO: IO): Irmin.S_MAKER
@@ -89,8 +89,7 @@ module type Config = sig
 
 end
 
-module Content_addressable_ext (IO: IO) (C: Config):
-  Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
+module Append_only_ext (IO: IO) (C: Config): Irmin.APPEND_ONLY_STORE_MAKER
 module Link_ext (IO: IO) (C: Config): Irmin.LINK_STORE_MAKER
 module Atomic_write_ext (IO: IO) (C: Config): Irmin.ATOMIC_WRITE_STORE_MAKER
 module Make_ext (IO: IO) (Obj: Config) (Ref: Config): Irmin.S_MAKER

src/irmin-mem/irmin_mem.ml

@@ -45,16 +45,14 @@ module Read_only (K: Irmin.Type.S) (V: Irmin.Type.S) = struct
 
 end
 
-module Content_addressable (K: Irmin.Hash.S) (V: Irmin.Type.S) = struct
+module Append_only (K: Irmin.Type.S) (V: Irmin.Type.S) = struct
 
   include Read_only(K)(V)
 
-  let add t value =
-    let str = Irmin.Type.encode_bin V.t value in
-    let key = K.digest str in
+  let add t key value =
     Log.debug (fun f -> f "add -> %a" pp_key key);
     t.t <- KMap.add key value t.t;
-    Lwt.return key
+    Lwt.return ()
 
 end
 
@@ -134,7 +132,7 @@ end
 
 let config () = Irmin.Private.Conf.empty
 
-module Make = Irmin.Make(Content_addressable)(Atomic_write)
+module Make = Irmin.Make(Irmin.Content_addressable(Append_only))(Atomic_write)
 
 module KV (C: Irmin.Contents.S) =
   Make

src/irmin-mem/irmin_mem.mli

@@ -24,8 +24,8 @@
 val config: unit -> Irmin.config
 (** Configuration values. *)
 
-module Content_addressable: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
-(** An in-memory store for content-adressable values. *)
+module Append_only: Irmin.APPEND_ONLY_STORE_MAKER
+(** An in-memory store for append-only values. *)
 
 module Link: Irmin.LINK_STORE_MAKER
 (** An in-memory store for immutable links. *)

src/irmin-unix/fs.ml

@@ -311,11 +311,11 @@ module IO = struct
 
 end
 
-module Content_addressable = Irmin_fs.Content_addressable(IO)
+module Append_only = Irmin_fs.Append_only(IO)
 module Link = Irmin_fs.Link(IO)
 module Atomic_write = Irmin_fs.Atomic_write(IO)
 module Make = Irmin_fs.Make(IO)
 module KV = Irmin_fs.KV(IO)
-module Content_addressable_ext = Irmin_fs.Content_addressable_ext(IO)
+module Append_only_ext = Irmin_fs.Append_only_ext(IO)
 module Atomic_write_ext = Irmin_fs.Atomic_write_ext(IO)
 module Make_ext = Irmin_fs.Make_ext(IO)

src/irmin-unix/fs.mli

@@ -14,15 +14,12 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Content_addressable: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
+module Append_only: Irmin.APPEND_ONLY_STORE_MAKER
 module Link: Irmin.LINK_STORE_MAKER
 module Atomic_write: Irmin.ATOMIC_WRITE_STORE_MAKER
 module Make: Irmin.S_MAKER
 module KV: Irmin.KV_MAKER
 
-module Content_addressable_ext (C: Irmin_fs.Config)
-  : Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
-
+module Append_only_ext (C: Irmin_fs.Config): Irmin.APPEND_ONLY_STORE_MAKER
 module Atomic_write_ext (C: Irmin_fs.Config): Irmin.ATOMIC_WRITE_STORE_MAKER
-
 module Make_ext (Obj: Irmin_fs.Config) (Ref: Irmin_fs.Config): Irmin.S_MAKER

src/irmin-unix/irmin_unix.mli

@@ -48,8 +48,8 @@ module FS: sig
 
   (** {1 File-system Store} *)
 
-  module Content_addressable: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
-  (** Content-addressable store maker. *)
+  module Append_only: Irmin.APPEND_ONLY_STORE_MAKER
+  (** Append-only store maker. *)
 
   module Link: Irmin.LINK_STORE_MAKER
   (** Immutable store for links. *)
@@ -64,9 +64,8 @@ module FS: sig
   (** Irmin store make, where only the Contents have to be specified:
       branches are strings and paths are string lists. *)
 
-  module Content_addressable_ext (C: Irmin_fs.Config)
-    : Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
-  (** Content-addressable store maker, with control over the filenames shapes. *)
+  module Append_only_ext (C: Irmin_fs.Config): Irmin.APPEND_ONLY_STORE_MAKER
+  (** Append-only store maker, with control over the filenames shapes. *)
 
   module Atomic_write_ext (C: Irmin_fs.Config): Irmin.ATOMIC_WRITE_STORE_MAKER
   (** Read-write store maker, with control over the filename shapes. *)

src/irmin/irmin.ml

@@ -41,6 +41,31 @@ module Path = struct
   module type S = S.PATH
 end
 
+
+module type APPEND_ONLY_STORE = sig
+  include S.READ_ONLY_STORE
+  val add: t -> key -> value -> unit Lwt.t
+end
+
+module type APPEND_ONLY_STORE_MAKER = functor (K: Type.S) (V: Type.S) ->
+sig
+  include APPEND_ONLY_STORE with type key = K.t and type value = V.t
+  val v: Conf.t -> t Lwt.t
+end
+
+module Content_addressable (AO: APPEND_ONLY_STORE_MAKER)
+    (K: S.HASH) (V: Type.S) =
+struct
+  include AO(K)(V)
+
+  let add t v =
+    let s = Type.encode_bin V.t v in
+    let k = K.digest s in
+    add t k v >|= fun () ->
+    k
+
+end
+
 module Make_ext
     (CA: S.CONTENT_ADDRESSABLE_STORE_MAKER)
     (AW: S.ATOMIC_WRITE_STORE_MAKER)

src/irmin/irmin.mli

@@ -836,6 +836,21 @@ module type CONTENT_ADDRESSABLE_STORE = sig
 
 end
 
+(** Append-onlye backend store. *)
+module type APPEND_ONLY_STORE = sig
+
+  (** {1 Append-only stores}
+
+      Append-onlye stores are store where it is possible to read
+      and add new values. *)
+
+  include READ_ONLY_STORE
+
+  val add: t -> key -> value -> unit Lwt.t
+  (** Write the contents of a value to the store. *)
+
+end
+
 (** Immutable Link store. *)
 module type LINK_STORE = sig
 
@@ -3321,7 +3336,20 @@ end
     }
 *)
 
-(** [CONTENT_ADDRESSABLE_STORE_MAKER] is the signature exposed by
+(** [APPEND_ONLY_STORE_MAKER] is the signature exposed by
+    append-only store backends. [K] is the implementation of keys
+    and [V] is the implementation of values. *)
+module type APPEND_ONLY_STORE_MAKER = functor (K: Type.S) (V: Type.S) ->
+sig
+
+  include APPEND_ONLY_STORE with type key = K.t and type value = V.t
+
+  val v: config -> t Lwt.t
+  (** [v config] is a function returning fresh store handles, with the
+      configuration [config], which is provided by the backend. *)
+end
+
+(** [CONTENT_ADDRESSABLE_STOREMAKER] is the signature exposed by
     content-addressable store backends. [K] is the implementation of keys
     and [V] is the implementation of values. *)
 module type CONTENT_ADDRESSABLE_STORE_MAKER = functor (K: Hash.S) (V: Type.S) ->
@@ -3334,6 +3362,9 @@ sig
       configuration [config], which is provided by the backend. *)
 end
 
+module Content_addressable (S: APPEND_ONLY_STORE_MAKER):
+  CONTENT_ADDRESSABLE_STORE_MAKER
+
 (** [LINK_MAKER] is the signature exposed by store which enable adding
     relation between keys. This is used to decouple the way keys are
     manipulated by the Irmin runtime and the keys used for

test/irmin-chunk/test_chunk.ml

@@ -37,21 +37,22 @@ module type S = sig
   val create: unit -> t Lwt.t
 end
 
+module Content_addressable = Irmin.Content_addressable(Irmin_mem.Append_only)
+
 module Mem = struct
-  include Irmin_mem.Content_addressable(Key)(Value)
+  include Content_addressable(Key)(Value)
   let create () = v @@ Irmin_mem.config ()
 end
 
 module MemChunk = struct
-  include Irmin_chunk.Content_addressable
-      (Irmin_mem.Content_addressable)(Key)(Value)
+  include Content_addressable(Key)(Value)
   let small_config = Irmin_chunk.config ~min_size:44 ~size:44 ()
   let create () = v small_config
 end
 
 module MemChunkStable = struct
   include Irmin_chunk.Stable_content_addressable
-      (Irmin_mem.Link)(Irmin_mem.Content_addressable)(Key)(Value)
+      (Irmin_mem.Link)(Content_addressable)(Key)(Value)
   let small_config = Irmin_chunk.config ~min_size:44 ~size:44 ()
   let create () = v small_config
 end
@@ -61,7 +62,7 @@ let init () =
 
 let store = Irmin_test.store
     (module Irmin.Make
-         (Irmin_chunk.Content_addressable(Irmin_mem.Content_addressable))
+         (Irmin_chunk.Content_addressable(Content_addressable))
          (Irmin_mem.Atomic_write))
   (module Irmin.Metadata.None)
 

test/irmin-git/test_git.ml

@@ -52,7 +52,7 @@ end
 module Generic = struct
 
   include Irmin_git.Generic_KV
-      (Irmin_mem.Content_addressable)
+      (Irmin.Content_addressable(Irmin_mem.Append_only))
       (Irmin_mem.Atomic_write)
       (Irmin.Contents.String)