From 5f39f2ceec4079fc9f4b31b08f1c0cd13c61d80d Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Mon, 23 Apr 2018 16:27:36 +0200
Subject: [PATCH] Data_encoding: add lazy_encoding combinator

---
 src/lib_data_encoding/data_encoding.ml        | 41 +++++++++++++++++++
 src/lib_data_encoding/data_encoding.mli       | 19 +++++++++
 .../sigs/v1/data_encoding.mli                 |  7 ++++
 .../tezos_protocol_environment.ml             |  1 +
 .../tezos_protocol_environment.mli            |  1 +
 5 files changed, 69 insertions(+)

diff --git a/src/lib_data_encoding/data_encoding.ml b/src/lib_data_encoding/data_encoding.ml
index 45b5ec544..4b019aa22 100644
--- a/src/lib_data_encoding/data_encoding.ml
+++ b/src/lib_data_encoding/data_encoding.ml
@@ -60,6 +60,47 @@ struct
 
   end
 
+  type 'a lazy_state =
+    | Value of 'a
+    | Bytes of MBytes.t
+    | Both of MBytes.t * 'a
+  type 'a lazy_t =
+    { mutable state : 'a lazy_state ;
+      encoding : 'a t }
+  let force_decode le =
+    match le.state with
+    | Value value -> Some value
+    | Both (_, value) -> Some value
+    | Bytes bytes ->
+        match Binary_reader.of_bytes le.encoding bytes with
+        | Some expr -> le.state <- Both (bytes, expr) ; Some expr
+        | None -> None
+  let force_bytes le =
+    match le.state with
+    | Bytes bytes -> bytes
+    | Both (bytes, _) -> bytes
+    | Value value ->
+        let bytes = Binary_writer.to_bytes_exn le.encoding value in
+        le.state <- Both (bytes, value) ;
+        bytes
+  let lazy_encoding encoding =
+    let binary =
+      Encoding.conv
+        force_bytes
+        (fun bytes -> { state = Bytes bytes ; encoding })
+        Encoding.bytes in
+    let json =
+      Encoding.conv
+        (fun le ->
+           match force_decode le with
+           | Some r -> r
+           | None -> raise Exit)
+        (fun value -> { state = Value value ; encoding })
+        encoding in
+    splitted ~json ~binary
+  let make_lazy encoding value =
+    { encoding ; state = Value value }
+
 end
 
 include Encoding
diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli
index 33315ecf9..6c9ea00c1 100644
--- a/src/lib_data_encoding/data_encoding.mli
+++ b/src/lib_data_encoding/data_encoding.mli
@@ -459,6 +459,25 @@ module Encoding: sig
   (** Give a name to an encoding. *)
   val def : string -> 'a encoding -> 'a encoding
 
+  (** See {!lazy_encoding} below.*)
+  type 'a lazy_t
+
+  (** Combinator to have a part of the binary encoding lazily deserialized.
+      This is transparent on the JSON side. *)
+  val lazy_encoding : 'a encoding -> 'a lazy_t encoding
+
+  (** Force the decoding (memoized for later calls), and return the
+      value if successful. *)
+  val force_decode : 'a lazy_t -> 'a option
+
+  (** Obtain the bytes without actually deserializing.  Will serialize
+      and memoize the result if the value is not the result of a lazy
+      deserialization. *)
+  val force_bytes : 'a lazy_t -> MBytes.t
+
+  (** Make a lazy value from an immediate one. *)
+  val make_lazy : 'a encoding -> 'a -> 'a lazy_t
+
 end
 
 include module type of Encoding with type 'a t = 'a Encoding.t
diff --git a/src/lib_protocol_environment/sigs/v1/data_encoding.mli b/src/lib_protocol_environment/sigs/v1/data_encoding.mli
index 9da96e7ba..cb05f2b90 100644
--- a/src/lib_protocol_environment/sigs/v1/data_encoding.mli
+++ b/src/lib_protocol_environment/sigs/v1/data_encoding.mli
@@ -184,6 +184,13 @@ val conv :
 
 val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding
 
+type 'a lazy_t
+
+val lazy_encoding : 'a encoding -> 'a lazy_t encoding
+val force_decode : 'a lazy_t -> 'a option
+val force_bytes : 'a lazy_t -> MBytes.t
+val make_lazy : 'a encoding -> 'a -> 'a lazy_t
+
 module Json : sig
 
   val schema : 'a encoding -> json_schema
diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml
index 05de4ec4c..3c49e1c06 100644
--- a/src/lib_protocol_environment/tezos_protocol_environment.ml
+++ b/src/lib_protocol_environment/tezos_protocol_environment.ml
@@ -109,6 +109,7 @@ module Make (Context : CONTEXT) = struct
     include Tezos_protocol_environment_sigs.V1.T
       with type Format.formatter = Format.formatter
        and type 'a Data_encoding.t = 'a Data_encoding.t
+       and type 'a Data_encoding.lazy_t = 'a Data_encoding.lazy_t
        and type 'a Lwt.t = 'a Lwt.t
        and type ('a, 'b) Pervasives.result = ('a, 'b) result
        and type Block_hash.t = Block_hash.t
diff --git a/src/lib_protocol_environment/tezos_protocol_environment.mli b/src/lib_protocol_environment/tezos_protocol_environment.mli
index d99173cf8..516d3d604 100644
--- a/src/lib_protocol_environment/tezos_protocol_environment.mli
+++ b/src/lib_protocol_environment/tezos_protocol_environment.mli
@@ -102,6 +102,7 @@ module Make (Context : CONTEXT) : sig
     include Tezos_protocol_environment_sigs.V1.T
       with type Format.formatter = Format.formatter
        and type 'a Data_encoding.t = 'a Data_encoding.t
+       and type 'a Data_encoding.lazy_t = 'a Data_encoding.lazy_t
        and type 'a Lwt.t = 'a Lwt.t
        and type ('a, 'b) Pervasives.result = ('a, 'b) result
        and type Block_hash.t = Block_hash.t