cache marshaled row values

ocaml/database/database_test.ml

@@ -285,9 +285,8 @@ functor
                     let row = Db_cache_types.Table.find r table in
                     let s =
                       Db_cache_types.Row.fold_over_recent g
-                        (fun k _ v acc ->
-                          Printf.sprintf "%s %s=%s" acc k
-                            (Schema.Value.marshal v)
+                        (fun k _ (_, cached) acc ->
+                          Printf.sprintf "%s %s=%s" acc k cached
                         )
                         row ""
                     in

ocaml/database/db_backend.ml

@@ -38,7 +38,7 @@ let blow_away_non_persistent_fields (schema : Schema.t) db =
   (* Generate a new row given a table schema *)
   let row schema row : Row.t * int64 =
     Row.fold
-      (fun name {Stat.created; modified; _} v (acc, max_upd) ->
+      (fun name {Stat.created; modified; _} (v, _) (acc, max_upd) ->
         try
           let col = Schema.Table.find name schema in
           let empty = col.Schema.Column.empty in

ocaml/database/db_cache_impl.ml

@@ -116,19 +116,18 @@ let read_record_internal db tblname objref =
       else
         None
     in
-    let map_fvlist v = Schema.Value.marshal v in
     (* Unfortunately the interface distinguishes between Set(Ref _) types and
        ordinary fields *)
     Row.fold
-      (fun k _ d (accum_fvlist, accum_setref) ->
+      (fun k _ (d, cached) (accum_fvlist, accum_setref) ->
         let accum_setref =
           match map_setref_opt k d with
           | Some v ->
               (k, v) :: accum_setref
           | None ->
               accum_setref
         in
-        let accum_fvlist = (k, map_fvlist d) :: accum_fvlist in
+        let accum_fvlist = (k, cached) :: accum_fvlist in
         (accum_fvlist, accum_setref)
       )
       row ([], [])
@@ -146,7 +145,7 @@ let delete_row_locked t tblname objref =
     Database.notify (PreDelete (tblname, objref)) db ;
     update_database t (remove_row tblname objref) ;
     Database.notify
-      (Delete (tblname, objref, Row.fold (fun k _ v acc -> (k, v) :: acc) row [])
+      (Delete (tblname, objref, Row.fold (fun k _ (v, _) acc -> (k, v) :: acc) row [])
       )
       (get_database t)
   with Not_found -> raise (DBCache_NotFound ("missing row", tblname, objref))
@@ -182,7 +181,7 @@ let create_row_locked t tblname kvs' new_objref =
   update_database t (add_row tblname new_objref row) ;
   Database.notify
     (Create
-       (tblname, new_objref, Row.fold (fun k _ v acc -> (k, v) :: acc) row [])
+       (tblname, new_objref, Row.fold (fun k _ (v, _) acc -> (k, v) :: acc) row [])
     )
     (get_database t)
 

ocaml/database/db_cache_types.ml

@@ -136,10 +136,17 @@ functor
   end
 
 module Row = struct
-  include Make (Schema.Value)
+  module CachedValue = struct
+    type t = Schema.Value.t * string
+
+    let v v = (v, Schema.Value.marshal v)
+  end
+
+  include Make (CachedValue)
 
   let add gen key v =
     add gen key
+    @@ CachedValue.v
     @@
     match v with
     | Schema.Value.String x ->
@@ -153,8 +160,17 @@ module Row = struct
 
   type value = Schema.Value.t
 
+  let iter f t = iter (fun k (v, _) -> f k v) t
+
+  let touch generation key default row =
+    touch generation key (CachedValue.v default) row
+
+  let update gen key default f row =
+    let f (v, _) = f v |> CachedValue.v in
+    update gen key (CachedValue.v default) f row
+
   let find key t =
-    try find key t
+    try find key t |> fst
     with Not_found -> raise (DBCache_NotFound ("missing field", key, ""))
 
   let add_defaults g (schema : Schema.Table.t) t =
@@ -175,7 +191,8 @@ module Row = struct
         else
           t
       )
-      t (Schema.ColumnMap.to_list schema.Schema.Table.columns)
+      t
+      (Schema.ColumnMap.to_list schema.Schema.Table.columns)
 end
 
 module Table = struct

ocaml/database/db_cache_types.mli

@@ -81,6 +81,12 @@ end
 
 module Row : sig
   include MAP with type value = Schema.Value.t
+
+  val fold : (string -> Stat.t -> (value * string) -> 'b -> 'b) -> t -> 'b -> 'b
+  (** [fold f t initial] folds [f key stats value acc] over the items in [t] *)
+
+  val fold_over_recent :
+    Time.t -> (string -> Stat.t -> (value * string) -> 'b -> 'b) -> t -> 'b -> 'b
 
   val add_defaults : Time.t -> Schema.Table.t -> t -> t
   (** [add_defaults now schema t]: returns a row which is [t] extended to contain

ocaml/database/db_xml.ml

@@ -67,7 +67,7 @@ module To = struct
         make_tag "row"
           (List.rev
              (Row.fold
-                (fun k _ v acc ->
+                (fun k _ (v, _) acc ->
                   (k, Xml_spaces.protect (Schema.Value.marshal v)) :: acc
                 )
                 row preamble