Clerk: add support for basic configuration files

Not much there at the moment, but being able to specify the include directories
is already pretty useful to run clerk directly e.g. on `catala-examples`.

(you had to explicitely specify variable `CATALA_INCLUDE`, the `-I` flags or to
go through `make` without that)

build_system/clerk_config.ml

@@ -0,0 +1,112 @@
+(* This file is part of the Catala build system, a specification language for
+   tax and social benefits computation rules. Copyright (C) 2024 Inria,
+   contributors: Louis Gesbert <louis.gesbert@inria.fr>
+
+   Licensed under the Apache License, Version 2.0 (the "License"); you may not
+   use this file except in compliance with the License. You may obtain a copy of
+   the License at
+
+   http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+   License for the specific language governing permissions and limitations under
+   the License. *)
+
+open Catala_utils
+open Otoml
+
+type t = {
+  catala_opts : string list;
+  build_dir : File.t;
+  include_dirs : File.t list;
+}
+
+let default = { catala_opts = []; build_dir = "_build"; include_dirs = [] }
+
+let toml_to_config toml =
+  {
+    catala_opts = Helpers.find_strings_exn toml ["build"; "catala_opts"];
+    build_dir = Helpers.find_string_exn toml ["build"; "build_dir"];
+    include_dirs = Helpers.find_strings_exn toml ["project"; "include_dirs"];
+  }
+
+let config_to_toml t =
+  table
+    [
+      ( "build",
+        table
+          [
+            "catala_opts", array (List.map string t.catala_opts);
+            "build_dir", string t.build_dir;
+          ] );
+      "project", table ["include_dirs", array (List.map string t.include_dirs)];
+    ]
+
+let default_toml = config_to_toml default
+
+(* joins default and supplied conf, ensuring types match. The filename is for
+   error reporting *)
+let rec join ?(rpath = []) fname t1 t2 =
+  match t1, t2 with
+  | TomlString _, TomlString _
+  | TomlInteger _, TomlInteger _
+  | TomlFloat _, TomlFloat _
+  | TomlBoolean _, TomlBoolean _
+  | TomlOffsetDateTime _, TomlOffsetDateTime _
+  | TomlLocalDateTime _, TomlLocalDateTime _
+  | TomlLocalDate _, TomlLocalDate _
+  | TomlLocalTime _, TomlLocalTime _
+  | TomlArray _, TomlArray _
+  | TomlTableArray _, TomlTableArray _ ->
+    t2
+  | TomlTable tt1, TomlTable tt2 | TomlInlineTable tt1, TomlInlineTable tt2 ->
+    let m1 = String.Map.of_list tt1 in
+    let m2 = String.Map.of_list tt2 in
+    TomlTable
+      (String.Map.merge
+         (fun key t1 t2 ->
+           match t1, t2 with
+           | None, Some _ ->
+             Message.error
+               "While parsing %a: invalid key @{<red>%S@} at @{<bold>%s@}"
+               File.format fname key
+               (if rpath = [] then "file root"
+                else String.concat "." (List.rev rpath))
+           | Some t1, Some t2 -> Some (join ~rpath:(key :: rpath) fname t1 t2)
+           | Some t1, None -> Some t1
+           | None, None -> assert false)
+         m1 m2
+      |> String.Map.bindings)
+  | _ ->
+    Message.error
+      "While parsing %a: Wrong type for config value @{<bold>%s@}, was \
+       expecting @{<bold>%s@}"
+      File.format fname
+      (String.concat "." (List.rev rpath))
+      (match t1 with
+      | TomlString _ -> "a string"
+      | TomlInteger _ -> "an integer"
+      | TomlFloat _ -> "a float"
+      | TomlBoolean _ -> "a boolean"
+      | TomlOffsetDateTime _ -> "an offsetdatetime"
+      | TomlLocalDateTime _ -> "a localdatetime"
+      | TomlLocalDate _ -> "a localdate"
+      | TomlLocalTime _ -> "a localtime"
+      | TomlArray _ | TomlTableArray _ -> "an array"
+      | TomlTable _ | TomlInlineTable _ -> "a table")
+
+let read f =
+  let toml =
+    try Parser.from_file f
+    with Parse_error (Some (li, col), msg) ->
+      Message.error
+        ~pos:(Pos.from_info f li col li (col + 1))
+        "Error in Clerk configuration:@ %a" Format.pp_print_text msg
+  in
+  toml_to_config (join f default_toml toml)
+
+let write f t =
+  let toml = config_to_toml t in
+  File.with_out_channel f @@ fun oc -> Printer.to_channel oc toml

build_system/clerk_config.mli

@@ -0,0 +1,27 @@
+(* This file is part of the Catala build system, a specification language for
+   tax and social benefits computation rules. Copyright (C) 2024 Inria,
+   contributors: Louis Gesbert <louis.gesbert@inria.fr>
+
+   Licensed under the Apache License, Version 2.0 (the "License"); you may not
+   use this file except in compliance with the License. You may obtain a copy of
+   the License at
+
+   http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+   License for the specific language governing permissions and limitations under
+   the License. *)
+
+open Catala_utils
+
+type t = {
+  catala_opts : string list;
+  build_dir : File.t;
+  include_dirs : File.t list;
+}
+
+val default : t
+val read : File.t -> t
+val write : File.t -> t -> unit

build_system/clerk_driver.ml

@@ -1,7 +1,7 @@
 (* This file is part of the Catala build system, a specification language for
    tax and social benefits computation rules. Copyright (C) 2020 Inria,
    contributors: Denis Merigoux <denis.merigoux@inria.fr>, Emile Rolley
-   <emile.rolley@tuta.io>
+   <emile.rolley@tuta.io>, Louis Gesbert <louis.gesbert@inria.fr>
 
    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License. You may obtain a copy of
@@ -101,7 +101,7 @@ module Cli = struct
     val debug : bool Term.t
 
     val term :
-      (chdir:File.t option ->
+      (config_file:File.t option ->
       catala_exe:File.t option ->
       catala_opts:string list ->
       build_dir:File.t option ->
@@ -112,12 +112,14 @@ module Cli = struct
       'a) ->
       'a Term.t
   end = struct
-    let chdir =
+    let config_file =
       Arg.(
         value
-        & opt (some string) None
-        & info ["C"] ~docv:"DIR"
-            ~doc:"Change to the given directory before processing")
+        & opt (some file) None
+        & info ["config"] ~docv:"FILE"
+            ~doc:
+              "Clerk configuration file to use, instead of looking up \
+               \"clerk.toml\" in parent directories.")
 
     let color =
       Arg.(
@@ -148,7 +150,7 @@ module Cli = struct
       Term.(
         const
           (fun
-            chdir
+            config_file
             catala_exe
             catala_opts
             build_dir
@@ -157,9 +159,9 @@ module Cli = struct
             debug
             ninja_output
           ->
-            f ~chdir ~catala_exe ~catala_opts ~build_dir ~include_dirs ~color
-              ~debug ~ninja_output)
-        $ chdir
+            f ~config_file ~catala_exe ~catala_opts ~build_dir ~include_dirs
+              ~color ~debug ~ninja_output)
+        $ config_file
         $ catala_exe
         $ catala_opts
         $ build_dir
@@ -300,36 +302,18 @@ end
 
 (** Some functions that poll the surrounding systems (think [./configure]) *)
 module Poll = struct
-  let project_root_absrel : (File.t option * File.t) Lazy.t =
-    lazy
-      (let open File in
-       let home = try Sys.getenv "HOME" with Not_found -> "" in
-       let rec lookup dir rel =
-         if
-           Sys.file_exists (dir / "catala.opam")
-           || Sys.file_exists (dir / ".git")
-           || Sys.file_exists (dir / "clerk.toml")
-         then Some dir, rel
-         else if dir = home then None, Filename.current_dir_name
-         else
-           let parent = Filename.dirname dir in
-           if parent = dir then None, Filename.current_dir_name
-           else lookup parent (rel / Filename.parent_dir_name)
-       in
-       lookup (Sys.getcwd ()) Filename.current_dir_name)
-
-  let project_root = lazy (fst (Lazy.force project_root_absrel))
-  let project_root_relative = lazy (snd (Lazy.force project_root_absrel))
+  (** This module is sensitive to the CWD at first use. Therefore it's expected
+      that [chdir] has been run beforehand to the project root. *)
+  let root = lazy (Sys.getcwd ())
 
   (** Scans for a parent directory being the root of the Catala source repo *)
   let catala_project_root : File.t option Lazy.t =
-    lazy
-      (match Lazy.force project_root with
-      | Some root
-        when Sys.file_exists File.(root / "catala.opam")
-             && Sys.file_exists File.(root / "dune-project") ->
-        Some root
-      | _ -> None)
+    root
+    |> Lazy.map
+       @@ fun root ->
+       if File.(exists (root / "catala.opam") && exists (root / "dune-project"))
+       then Some root
+       else None
 
   let exec_dir : File.t = Catala_utils.Cli.exec_dir
   let clerk_exe : File.t Lazy.t = lazy (Unix.realpath Sys.executable_name)
@@ -339,14 +323,14 @@ module Poll = struct
       (let f = File.(exec_dir / "catala") in
        if Sys.file_exists f then Unix.realpath f
        else
-         match Lazy.force project_root with
-         | Some root when Sys.file_exists File.(root / "catala.opam") ->
+         match catala_project_root with
+         | (lazy (Some root)) ->
            Unix.realpath
              File.(root / "_build" / "default" / "compiler" / "catala.exe")
          | _ -> File.check_exec "catala")
 
-  let build_dir : ?dir:File.t -> unit -> File.t =
-   fun ?(dir = "_build") () ->
+  let build_dir : dir:File.t -> unit -> File.t =
+   fun ~dir () ->
     let d = File.clean_path dir in
     File.ensure_dir d;
     d
@@ -434,14 +418,6 @@ module Poll = struct
     lazy (snd (Lazy.force ocaml_include_and_lib_flags))
 end
 
-(* Adjusts paths specified from the command-line relative to the user cwd to be
-   instead relative to the project root *)
-let fix_path =
-  let from_dir = Sys.getcwd () in
-  fun d ->
-    let to_dir = Lazy.force Poll.project_root_relative in
-    Catala_utils.File.reverse_path ~from_dir ~to_dir d
-
 (**{1 Building rules}*)
 
 (** Ninja variable names *)
@@ -793,8 +769,10 @@ let gen_ninja_file catala_exe catala_flags build_dir include_dirs test_flags dir
 
 (** {1 Driver} *)
 
+(* Last argument is a continuation taking as arguments [build_dir], the
+   [fix_path] function, and the ninja file name *)
 let ninja_init
-    ~chdir
+    ~config_file
     ~catala_exe
     ~catala_opts
     ~build_dir
@@ -802,14 +780,58 @@ let ninja_init
     ~color
     ~debug
     ~ninja_output :
-    extra:def Seq.t -> test_flags:string list -> (File.t -> File.t -> 'a) -> 'a
-    =
+    extra:def Seq.t ->
+    test_flags:string list ->
+    (File.t -> (File.t -> File.t) -> File.t -> 'a) ->
+    'a =
   let _options = Catala_utils.Global.enforce_options ~debug ~color () in
-  let chdir =
-    match chdir with None -> Lazy.force Poll.project_root | some -> some
+  let default_config_file = "clerk.toml" in
+  let set_root_dir dir =
+    Message.debug "Entering directory %a" File.format dir;
+    Sys.chdir dir
   in
-  Option.iter Sys.chdir chdir;
-  let build_dir = Poll.build_dir ?dir:build_dir () in
+  (* fix_path adjusts paths specified from the command-line relative to the user
+     cwd to be instead relative to the project root *)
+  let fix_path, config =
+    let from_dir = Sys.getcwd () in
+    match config_file with
+    | None -> (
+      match
+        File.(find_in_parents (fun dir -> exists (dir / default_config_file)))
+      with
+      | Some (root, rel) ->
+        set_root_dir root;
+        ( Catala_utils.File.reverse_path ~from_dir ~to_dir:rel,
+          Clerk_config.read default_config_file )
+      | None -> (
+        match
+          File.(
+            find_in_parents (function dir ->
+                exists (dir / "catala.opam") || exists (dir / ".git")))
+        with
+        | Some (root, rel) ->
+          set_root_dir root;
+          ( Catala_utils.File.reverse_path ~from_dir ~to_dir:rel,
+            Clerk_config.default )
+        | None -> Fun.id, Clerk_config.default))
+    | Some f ->
+      let root = Filename.dirname f in
+      let config = Clerk_config.read f in
+      set_root_dir root;
+      ( (fun d ->
+          let r = Catala_utils.File.reverse_path ~from_dir ~to_dir:root d in
+          Message.debug "%a => %a" File.format d File.format r;
+          r),
+        config )
+  in
+  let build_dir =
+    let dir =
+      match build_dir with None -> config.build_dir | Some dir -> dir
+    in
+    Poll.build_dir ~dir ()
+  in
+  let catala_opts = config.catala_opts @ catala_opts in
+  let include_dirs = config.include_dirs @ include_dirs in
   let with_ninja_output k =
     match ninja_output with
     | Some f -> k f
@@ -837,7 +859,7 @@ let ninja_init
                ]
         in
         Nj.format nin_ppf ninja_contents);
-    k build_dir nin_file
+    k build_dir fix_path nin_file
 
 let cleaned_up_env () =
   let passthrough_vars =
@@ -879,7 +901,7 @@ open Cmdliner
 let build_cmd =
   let run ninja_init (targets : string list) (ninja_flags : string list) =
     ninja_init ~extra:Seq.empty ~test_flags:[]
-    @@ fun _build_dir nin_file ->
+    @@ fun _build_dir fix_path nin_file ->
     let targets =
       List.map
         (fun f ->
@@ -920,7 +942,7 @@ let test_cmd =
     set_report_verbosity verbosity;
     Clerk_report.set_display_flags ~use_patdiff ();
     ninja_init ~extra:Seq.empty ~test_flags
-    @@ fun build_dir nin_file ->
+    @@ fun build_dir fix_path nin_file ->
     let targets =
       let fs = if files_or_folders = [] then ["."] else files_or_folders in
       List.map File.(fun f -> (build_dir / fix_path f) ^ "@test") fs
@@ -1005,7 +1027,7 @@ let run_cmd =
               (List.map (fun file -> file ^ "@interpret") files_or_folders)))
     in
     ninja_init ~extra ~test_flags:[]
-    @@ fun _build_dir nin_file ->
+    @@ fun _build_dir _fix_path nin_file ->
     let ninja_cmd = ninja_cmdline ninja_flags nin_file [] in
     Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
     raise (Catala_utils.Cli.Exit_with (run_ninja ~clean_up_env:false ninja_cmd))

build_system/dune

@@ -8,8 +8,9 @@
   ninja_utils
   cmdliner
   re
-  ocolor)
- (modules clerk_scan clerk_report clerk_runtest clerk_driver))
+  ocolor
+  otoml)
+ (modules clerk_scan clerk_report clerk_runtest clerk_config clerk_driver))
 
 (rule
  (target custom_linking.sexp)

catala.opam

@@ -51,6 +51,7 @@ depends: [
   "conf-pandoc" {cataladevmode}
   "z3" {catalaz3mode}
   "conf-ninja"
+  "otoml" {>= "1.0"}
 ]
 depopts: ["z3"]
 conflicts: [

compiler/catala_utils/file.ml

@@ -66,6 +66,8 @@ let clean_path p =
   in
   if p = "" then "." else p
 
+let exists = Sys.file_exists
+
 let rec ensure_dir dir =
   match Sys.is_directory dir with
   | true -> ()
@@ -104,6 +106,20 @@ let reverse_path ?(from_dir = Sys.getcwd ()) ~to_dir f =
     String.concat Filename.dir_sep
       (aux (path_to_list f) rbase (path_to_list to_dir))
 
+let find_in_parents predicate =
+  let home = try Sys.getenv "HOME" with Not_found -> "" in
+  let rec lookup dir rel =
+    if predicate dir then Some dir, rel
+    else if dir = home then None, Filename.current_dir_name
+    else
+      let parent = Filename.dirname dir in
+      if parent = dir then None, Filename.current_dir_name
+      else lookup parent (rel / Filename.parent_dir_name)
+  in
+  match lookup (Sys.getcwd ()) Filename.current_dir_name with
+  | Some dir, rel -> Some (dir, rel)
+  | None, _ -> None
+
 let with_out_channel filename f =
   ensure_dir (Filename.dirname filename);
   let oc = open_out filename in

compiler/catala_utils/file.mli

@@ -89,6 +89,9 @@ val ensure_dir : t -> unit
 (** Creates the directory (and parents recursively) if it doesn't exist already.
     Errors out if the file exists but is not a directory *)
 
+val exists : t -> bool
+(** Alias for Sys.file_exists*)
+
 val check_file : t -> t option
 (** Returns its argument if it exists and is a plain file, [None] otherwise.
     Does not do resolution like [check_directory]. *)
@@ -122,6 +125,12 @@ val reverse_path : ?from_dir:t -> to_dir:t -> t -> t
     leading to [f] from [to_dir]. The results attempts to be relative to
     [to_dir]. *)
 
+val find_in_parents : (t -> bool) -> (t * t) option
+(** Checks for the first directory matching the given predicate from the current
+    directory upwards. Recursion stops at home. Returns a pair [dir, rel_path],
+    where [dir] is the ancestor directory matching the predicate, and [rel_path]
+    is a path pointing to it from the current dir. *)
+
 val ( /../ ) : t -> t -> t
 (** Sugar for [parent a / b] *)