CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

refactor(clerk): change to_string to format functions

Browse Source
This commit is contained in:
Emile Rolley 2022-02-24 17:58:24 +01:00
parent 79c39889bd
commit 4a83360220
3 changed files with 47 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
build_system/clerk.ml
View File

@ -534,7 +534,7 @@ let collect_in_folder (ctx : ninja_building_context) (folder : string) (ninja_st
last_valid_ninja = ninja_start;
curr_ninja;
all_file_names = folder :: ctx.all_file_names;
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_dir_name;
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_dir_name;
}
else
{
@ -555,7 +555,7 @@ let collect_in_file (ctx : ninja_building_context) (tested_file : string) (ninja
last_valid_ninja = ninja;
curr_ninja = Some ninja;
all_file_names = tested_file :: ctx.all_file_names;
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_file_name;
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_file_name;
}
| None ->
{
@ -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"

53
build_system/ninja_utils.ml
View File

@ -15,12 +15,17 @@
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 rec format fmt = function
| Lit s -> Format.fprintf fmt "%s" s
| Var s -> Format.fprintf fmt "$%s" s
| Seq ls -> format_list fmt ls
let list_to_string ?(sep = " ") ls = ls |> List.map to_string |> String.concat sep
and format_list fmt = function
| hd :: tl ->
Format.fprintf fmt "%a%a" format hd
(fun fmt tl -> tl |> List.iter (fun s -> Format.fprintf fmt " %a" format s))
tl
| [] -> ()
end
module Rule = struct
@ -28,10 +33,13 @@ module Rule = struct
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,16 @@ 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.iter (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 +84,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

23
build_system/ninja_utils.mli
View File

@ -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]. *)