From 7e81fe6c9c67cb596b6535e9ea9f96f25273d1cc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= <code@bnwr.net>
Date: Wed, 14 Nov 2018 14:32:48 +0800
Subject: [PATCH] Shell/mempool: pretty-printing

---
 src/lib_shell/mempool_peer_worker.ml | 12 ++++++++--
 src/lib_shell/mempool_worker.ml      | 35 ++++++++++++++++++++++------
 2 files changed, 38 insertions(+), 9 deletions(-)

diff --git a/src/lib_shell/mempool_peer_worker.ml b/src/lib_shell/mempool_peer_worker.ml
index 3b370a771..4360fd130 100644
--- a/src/lib_shell/mempool_peer_worker.ml
+++ b/src/lib_shell/mempool_peer_worker.ml
@@ -68,7 +68,11 @@ module Make (Static: STATIC) (Mempool_worker: Mempool_worker.T)
     | Mempool_result of Mempool_worker.result
   type output = result Operation_hash.Map.t
 
-  let pp_input = Format.pp_print_list Operation_hash.pp
+  let pp_input ppf input =
+    Format.fprintf ppf
+      "@[<v 0>%a@]"
+      (Format.pp_print_list Operation_hash.pp)
+      input
   let result_encoding =
     let open Data_encoding in
     union
@@ -257,7 +261,11 @@ module Make (Static: STATIC) (Mempool_worker: Mempool_worker.T)
     let encoding =
       let open Data_encoding in
       list Operation_hash.encoding
-    let pp = Format.pp_print_list Operation_hash.pp
+    let pp ppf os =
+      Format.fprintf ppf
+        "@[<v 2>Request:@,%a@]"
+        (Format.pp_print_list Operation_hash.pp)
+        os
   end
 
   module Event = struct
diff --git a/src/lib_shell/mempool_worker.ml b/src/lib_shell/mempool_worker.ml
index 39d7304a7..20711cbdc 100644
--- a/src/lib_shell/mempool_worker.ml
+++ b/src/lib_shell/mempool_worker.ml
@@ -126,6 +126,14 @@ module Make(Static: STATIC)(Proto: Registered_protocol.T)
           (fun () -> Not_in_branch) ;
       ]
 
+  let pp_result ppf = function
+    | Applied _ -> Format.pp_print_string ppf "applied"
+    | Branch_delayed _ -> Format.pp_print_string ppf "branch delayed"
+    | Branch_refused _ -> Format.pp_print_string ppf "branch refused"
+    | Refused _ -> Format.pp_print_string ppf "refused"
+    | Duplicate -> Format.pp_print_string ppf "duplicate"
+    | Not_in_branch -> Format.pp_print_string ppf "not in branch"
+
   let operation_encoding =
     let open Data_encoding in
     conv
@@ -211,15 +219,12 @@ module Make(Static: STATIC)(Proto: Registered_protocol.T)
       | Debug msg -> Format.fprintf ppf "%s" msg
       | Request (view, { pushed ; treated ; completed }, None)  ->
           Format.fprintf ppf
-            "@[<v 0>%a@,\
-             Pushed: %a, Treated: %a, Completed: %a@]"
+            "@[<v 0>%a@,Pushed: %a, Treated: %a, Completed: %a@]"
             Request.pp view
             Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
       | Request (view, { pushed ; treated ; completed }, Some errors)  ->
           Format.fprintf ppf
-            "@[<v 0>%a@,\
-             Pushed: %a, Treated: %a, Failed: %a@,\
-             %a@]"
+            "@[<v 0>%a@,Pushed: %a, Treated: %a, Failed: %a@,Errors: %a@]"
             Request.pp view
             Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
             (Format.pp_print_list Error_monad.pp) errors
@@ -272,6 +277,17 @@ module Make(Static: STATIC)(Proto: Registered_protocol.T)
           Operation.encoding
       )
 
+    let pp break ppf table =
+      let open Format in
+      Operation_hash.Table.iter
+        (fun h (r, _) ->
+           fprintf ppf "Operation %a: %a"
+             Operation_hash.pp_short h
+             pp_result r;
+           break ppf
+        )
+        table
+
     let create () = Operation_hash.Table.create 1000
 
     let add t parsed_op result =
@@ -377,8 +393,13 @@ module Make(Static: STATIC)(Proto: Registered_protocol.T)
         (fun cache -> { cache })
         ValidatedCache.encoding
 
-    let pp ppf _view =
-      Format.fprintf ppf "lots of operations"
+    let pp ppf { cache } =
+      ValidatedCache.pp
+        (fun ppf ->
+           Format.pp_print_string ppf ";";
+           Format.pp_print_space ppf ())
+        ppf
+        cache
 
   end