Io_infer.with_color

Reviewed By: jvillard

Differential Revision: D13572262

fbshipit-source-id: eb40fa96b

infer/src/IR/DecompiledExp.ml

@@ -140,8 +140,8 @@ let to_string de = F.asprintf "%a" pp de
 let pp_vpath pe fmt vpath =
   let pp fmt = function Some de -> pp fmt de | None -> () in
   if Pp.equal_print_kind pe.Pp.kind Pp.HTML then
-    F.fprintf fmt " %a{vpath: %a}%a" Io_infer.Html.pp_start_color Pp.Orange pp vpath
-      Io_infer.Html.pp_end_color ()
+    let pp f vpath = F.fprintf f "{vpath: %a}" pp vpath in
+    Io_infer.Html.with_color Orange pp fmt vpath
   else pp fmt vpath
 
 

infer/src/IR/Io_infer.ml

@@ -98,11 +98,9 @@ h1 { font-size:14pt }
   (** Print a horizontal line *)
   let pp_hline fmt () = F.pp_print_string fmt "\n<hr width=\"100%\">\n"
 
-  (** Print start color *)
-  let pp_start_color fmt color = F.fprintf fmt "<span class='%s'>" (Pp.color_string color)
+  let with_color color pp f x =
+    F.fprintf f "<span class='%s'>%a</span>" (Pp.color_string color) pp x
 
-  (** Print end color *)
-  let pp_end_color fmt () = F.pp_print_string fmt "</span>"
 
   let pp_link ?(name = None) ?(pos = None) ~path fmt text =
     let link_str =

infer/src/IR/Io_infer.mli

@@ -39,9 +39,6 @@ module Html : sig
   val pp_hline : Format.formatter -> unit -> unit
   (** Print a horizontal line *)
 
-  val pp_end_color : Format.formatter -> unit -> unit
-  (** Print end color *)
-
   val pp_node_link :
        DB.Results_dir.path
     -> Typ.Procname.t
@@ -71,8 +68,8 @@ module Html : sig
     -> unit
   (** Print an html link given node id and session *)
 
-  val pp_start_color : Format.formatter -> Pp.color -> unit
-  (** Print start color *)
+  val with_color : Pp.color -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+  (** Print using color *)
 end
 
 (** Create and print xml trees *)

infer/src/IR/Sil.ml

@@ -225,15 +225,14 @@ end)
 let color_wrapper pe ppf x ~f =
   if Config.print_using_diff && pe.Pp.kind <> Pp.TEXT then
     let color = pe.Pp.cmap_norm (Obj.repr x) in
-    if color <> pe.Pp.color then (
-      Io_infer.Html.pp_start_color ppf color ;
+    if color <> pe.Pp.color then
       let pe' =
         if Pp.equal_color color Pp.Red then
           (* All subexpressions red *)
           Pp.{pe with cmap_norm= colormap_red; color= Red}
         else Pp.{pe with color}
       in
-      f pe' ppf x ; Io_infer.Html.pp_end_color ppf () )
+      Io_infer.Html.with_color color (f pe') ppf x
     else f pe ppf x
   else f pe ppf x
 
@@ -774,9 +773,7 @@ let update_inst inst_old inst_new =
 (** describe an instrumentation with a string *)
 let pp_inst_if_trace pe f inst =
   if Config.trace_error then
-    if Pp.equal_print_kind pe.Pp.kind Pp.HTML then
-      F.fprintf f " %a%a%a" Io_infer.Html.pp_start_color Pp.Orange pp_inst inst
-        Io_infer.Html.pp_end_color ()
+    if Pp.equal_print_kind pe.Pp.kind Pp.HTML then Io_infer.Html.with_color Orange pp_inst f inst
     else F.fprintf f "%s%a%s" (Binop.str pe Lt) pp_inst inst (Binop.str pe Gt)
 
 

infer/src/backend/Summary.ml

@@ -116,9 +116,8 @@ let pp_text fmt summary =
 
 
 let pp_html source fmt summary =
-  Io_infer.Html.pp_start_color fmt Black ;
-  F.fprintf fmt "@\n%a" pp_no_stats_specs summary ;
-  Io_infer.Html.pp_end_color fmt () ;
+  F.pp_force_newline fmt () ;
+  Io_infer.Html.with_color Black pp_no_stats_specs fmt summary ;
   F.fprintf fmt "<br />%a<br />@\n" Stats.pp summary.stats ;
   Errlog.pp_html source [] fmt (get_err_log summary) ;
   Io_infer.Html.pp_hline fmt () ;

infer/src/biabduction/BiabductionSummary.ml

@@ -258,9 +258,9 @@ let pp_spec0 pe num_opt fmt spec =
   | HTML ->
       F.fprintf fmt "--------------------------- %a ---------------------------@\n" pp_num_opt
         num_opt ;
-      F.fprintf fmt "PRE:@\n%a%a%a@\n" Io_infer.Html.pp_start_color Pp.Blue
-        (Prop.pp_prop (Pp.html Blue))
-        pre Io_infer.Html.pp_end_color () ;
+      F.fprintf fmt "PRE:@\n" ;
+      Io_infer.Html.with_color Blue (Prop.pp_prop (Pp.html Blue)) fmt pre ;
+      F.pp_force_newline fmt () ;
       Propgraph.pp_proplist pe_post "POST" (pre, true) fmt post_list ;
       F.pp_print_string fmt "----------------------------------------------------------------"
 

infer/src/biabduction/Prop.ml

@@ -291,7 +291,7 @@ let prop_pred_env prop =
 (** Pretty print a proposition. *)
 let pp_prop pe0 f prop =
   let pe = prop_update_obj_sub pe0 prop in
-  let do_print f =
+  let do_print f () =
     let subl = Sil.sub_to_list prop.sub in
     (* since prop diff is based on physical equality, we need to extract the sub verbatim *)
     let pi = prop.pi in
@@ -315,10 +315,9 @@ let pp_prop pe0 f prop =
   in
   match pe0.Pp.kind with
   | Pp.HTML ->
-      F.fprintf f "%a%t%a" Io_infer.Html.pp_start_color Pp.Blue do_print Io_infer.Html.pp_end_color
-        ()
+      Io_infer.Html.with_color Blue do_print f ()
   | TEXT ->
-      do_print f
+      do_print f ()
 
 
 let pp_prop_with_typ pe f p = pp_prop {pe with opt= SIM_WITH_TYP} f p