refactor(clerk): change to_string to format functions

build_system/clerk.ml

@@ -607,7 +607,9 @@ let driver (files_or_folders : string list) (command : string) (catala_exe : str
       else
         let out = open_out "build.ninja" in
         Cli.debug_print "writing build.ninja...";
-        Nj.write out (add_root_test_build ninja ctx.all_file_names ctx.all_test_builds);
+        Nj.format
+          (Format.formatter_of_out_channel out)
+          (add_root_test_build ninja ctx.all_file_names ctx.all_test_builds);
         close_out out;
         Cli.debug_print "executing 'ninja test'...";
         Sys.command "ninja test"

build_system/ninja_utils.ml

@@ -15,23 +15,31 @@
 module Expr = struct
   type t = Lit of string | Var of string | Seq of t list
 
-  let rec to_string = function
-    | Lit s -> s
-    | Var s -> "$" ^ s
-    | Seq ls -> List.fold_left (fun acc s -> acc ^ " " ^ to_string s) "" ls
-
-  let list_to_string ?(sep = " ") ls = ls |> List.map to_string |> String.concat sep
+  let rec format fmt = function
+    | Lit s -> Format.fprintf fmt "%s" s
+    | Var s -> Format.fprintf fmt "$%s" s
+    | Seq ls -> format_list fmt ls
+
+  and format_list fmt = function
+    | hd :: tl ->
+        Format.fprintf fmt "%a%a" format hd
+          (fun fmt tl -> tl |> List.fold_left (fun _ s -> Format.fprintf fmt " %a" format s) ())
+          tl
+    | [] -> ()
 end
 
 module Rule = struct
   type t = { name : string; command : Expr.t; description : Expr.t option }
 
   let make name ~command ~description = { name; command; description = Option.some description }
 
-  let to_string rule =
-    Printf.sprintf "rule %s\n  command =%s\n" rule.name (Expr.to_string rule.command)
-    ^ (rule.description
-      |> Option.fold ~some:(fun e -> "  description =" ^ Expr.to_string e ^ "\n") ~none:"")
+  let format fmt rule =
+    let format_description fmt = function
+      | Some e -> Format.fprintf fmt "  description = %a\n" Expr.format e
+      | None -> Format.fprintf fmt "\n"
+    in
+    Format.fprintf fmt "rule %s\n  command = %a\n%a" rule.name Expr.format rule.command
+      format_description rule.description
 end
 
 module Build = struct
@@ -56,13 +64,18 @@ module Build = struct
 
   let unpath ?(sep = "-") path = Re.Pcre.(substitute ~rex:(regexp "/") ~subst:(fun _ -> sep)) path
 
-  let to_string build =
-    Printf.sprintf "build %s: %s" (Expr.list_to_string build.outputs) build.rule
-    ^ (build.inputs |> Option.fold ~some:(fun ls -> " " ^ Expr.list_to_string ls) ~none:"")
-    ^ "\n"
-    ^ List.fold_left
-        (fun acc (name, exp) -> acc ^ Printf.sprintf "  %s = %s\n" name (Expr.to_string exp))
-        "" build.vars
+  let format fmt build =
+    let format_inputs fmt = function
+      | Some exs -> Format.fprintf fmt " %a" Expr.format_list exs
+      | None -> ()
+    in
+    let format_vars fmt vars =
+      List.fold_left
+        (fun _ (name, exp) -> Format.fprintf fmt "  %s = %a\n" name Expr.format exp)
+        () vars
+    in
+    Format.fprintf fmt "build %a: %s%a\n%a" Expr.format_list build.outputs build.rule format_inputs
+      build.inputs format_vars build.vars
 end
 
 module RuleMap : Map.S with type key = String.t = Map.Make (String)
@@ -73,9 +86,7 @@ type ninja = { rules : Rule.t RuleMap.t; builds : Build.t BuildMap.t }
 
 let empty = { rules = RuleMap.empty; builds = BuildMap.empty }
 
-let write out ninja =
-  let write_for_all iter to_string =
-    iter (fun _name rule -> Printf.fprintf out "%s\n" (to_string rule))
-  in
-  write_for_all RuleMap.iter Rule.to_string ninja.rules;
-  write_for_all BuildMap.iter Build.to_string ninja.builds
+let format fmt ninja =
+  let format_for_all iter format = iter (fun _name rule -> Format.fprintf fmt "%a\n" format rule) in
+  format_for_all RuleMap.iter Rule.format ninja.rules;
+  format_for_all BuildMap.iter Build.format ninja.builds

build_system/ninja_utils.mli

@@ -47,13 +47,12 @@ module Expr : sig
     | Seq of t list
     (* Sequence of sub-expressions. *)
 
+  val format : Format.formatter -> t -> unit
+  (** [format fmt exp] outputs in [fmt] the string representation of the ninja expression [exp]. *)
 
-  val to_string : t -> string
-  (** [to_string exp] returns the string representation of an ninja expression [exp]. *)
-
-  val list_to_string : ?sep:string -> t list -> string
-  (** [list_to_string ?sep ls] returns the string representation of a list [ls] of ninja expressions
-      concatenated with the separator [sep] -- by default ' '. *)
+  val format_list : Format.formatter -> t list -> unit
+  (** [format fmt ls] outputs in [fmt] the string representation of a list [ls]
+      of ninja expressions [exp] by adding a space between each expression. *)
 end
 
 (** {1 Ninja rules} *)
@@ -75,8 +74,8 @@ rule <name>
   val make : string -> command:Expr.t -> description:Expr.t -> t
   (** [make name ~command ~description] returns the corresponding ninja {!type: Rule.t}. *)
 
-  val to_string : t -> string
-  (** [to_string rule] returns the string representation of the [rule]. *)
+  val format : Format.formatter -> t -> unit
+  (** [format fmt rule] outputs in [fmt] the string representation of the ninja [rule]. *)
 end
 
 (** {1 Ninja builds} *)
@@ -116,7 +115,8 @@ build <outputs>: <rule> [<inputs>]
   (** [unpath ~sep path] replaces all [/] occurences with [sep] in [path] to avoid ninja writing the
       corresponding file and use it as sub command. By default, [sep] is set to ["-"]. *)
 
-  val to_string : t -> string
+  val format : Format.formatter -> t -> unit
+  (** [format fmt build] outputs in [fmt] the string representation of the ninja [build]. *)
 end
 
 (** {1 Maps} *)
@@ -133,6 +133,5 @@ type ninja = { rules : Rule.t RuleMap.t; builds : Build.t BuildMap.t }
 val empty : ninja
 (** [empty] returns the empty empty ninja structure. *)
 
-val write : out_channel -> ninja -> unit
-(** [write out ninja] writes in [out] the string representation of all [ninja.rules] and
-    [ninja.builds]. *)
+val format : Format.formatter -> ninja -> unit
+(** [format fmt build] outputs in [fmt] the string representation of all [ninja.rules] and [ninja.builds]. *)