catala/build_system/clerk_driver.ml

(* 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>

   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 Ninja_utils
module Nj = Ninja_utils
module Scan = Clerk_scan

(* Version is synchronised with the catala version *)
let version = Catala_utils.Cli.version

(** {1 Command line interface} *)

module Cli = struct
  open Cmdliner

  let catala_exe =
    Arg.(
      value
      & opt (some string) None
      & info ["e"; "exe"] ~docv:"EXE" ~doc:"Catala compiler executable.")

  let catala_opts =
    Arg.(
      value
      & opt_all string []
      & info ["c"; "catala-opts"] ~docv:"FLAG"
          ~doc:"Option to pass to the Catala compiler. Can be repeated.")

  let build_dir =
    Arg.(
      value
      & opt (some string) None
      & info ["build-dir"] ~docv:"DIR"
          ~doc:
            "Directory where compilation artifacts should be written. Defaults \
             to '_build'.")

  let include_dirs =
    let arg =
      Arg.(
        value
        & opt_all (list ~sep:':' string) []
        & info ["I"; "include"] ~docv:"DIR"
            ~env:(Cmd.Env.info "CATALA_INCLUDE")
            ~doc:
              "Make modules from the given directory available from \
               everywhere. Several dirs can be specified by repeating the flag \
               or separating them with '$(b,:)'.")
    in
    Term.(const List.flatten $ arg)

  let test_flags =
    Arg.(
      value
      & opt (list string) []
      & info ["test-flags"] ~docv:"FLAGS"
          ~env:(Cmd.Env.info "CATALA_TEST_FLAGS")
          ~doc:
            "Flags to pass to the catala interpreter on $(b,catala test-scope) \
             tests. Comma-separated list. A subset may also be applied to the \
             compilation of modules, as needed.\n\
             WARNING: flag shortcuts are not allowed here (i.e. don't use \
             non-ambiguous prefixes such as $(b,--avoid-ex) for \
             $(b,--avoid-exceptions))\n\
             NOTE: if this is set, all inline tests that are $(i,not) \
             $(b,catala test-scope) are skipped to avoid redundant testing.")

  module Global : sig
    val term :
      (chdir:File.t option ->
      catala_exe:File.t option ->
      catala_opts:string list ->
      build_dir:File.t option ->
      include_dirs:string list ->
      color:Global.when_enum ->
      debug:bool ->
      ninja_output:File.t option ->
      'a) ->
      'a Term.t
  end = struct
    let chdir =
      Arg.(
        value
        & opt (some string) None
        & info ["C"] ~docv:"DIR"
            ~doc:"Change to the given directory before processing")

    let color =
      Arg.(
        value
        & opt ~vopt:Global.Always Cli.when_opt Auto
        & info ["color"]
            ~env:(Cmd.Env.info "CATALA_COLOR")
            ~doc:
              "Allow output of colored and styled text. Use $(i,auto), to \
               enable when the standard output is to a terminal, $(i,never) to \
               disable.")

    let debug =
      Arg.(value & flag & info ["debug"; "d"] ~doc:"Prints debug information")

    let ninja_output =
      Arg.(
        value
        & opt (some string) None
        & info ["o"; "output"] ~docv:"FILE"
            ~doc:
              "$(i,FILE) is the file that will contain the build.ninja file \
               output. If not specified, the build.ninja file is set to \
               $(i,<builddir>/clerk.ninja) in debug mode, and a temporary file \
               otherwise")

    let term f =
      Term.(
        const
          (fun
            chdir
            catala_exe
            catala_opts
            build_dir
            include_dirs
            color
            debug
            ninja_output
          ->
            f ~chdir ~catala_exe ~catala_opts ~build_dir ~include_dirs ~color
              ~debug ~ninja_output)
        $ chdir
        $ catala_exe
        $ catala_opts
        $ build_dir
        $ include_dirs
        $ color
        $ debug
        $ ninja_output)
  end

  let files_or_folders =
    Arg.(
      value
      & pos_all string []
      & info [] ~docv:"FILE(S)" ~doc:"File(s) or folder(s) to process")

  let single_file =
    Arg.(
      required
      & pos 0 (some file) None
      & info [] ~docv:"FILE" ~doc:"File to process")

  let reset_test_outputs =
    Arg.(
      value
      & flag
      & info ["r"; "reset"]
          ~doc:
            "Used with the `test` command, resets the test output to whatever \
             is output by the Catala compiler.")

  let scope =
    Arg.(
      required
      & opt (some string) None
      & info ["s"; "scope"] ~docv:"SCOPE"
          ~doc:
            "Used with the `run` command, selects which scope of a given \
             Catala file to run.")

  let targets =
    Arg.(
      value
      & pos_all string []
      & info [] ~docv:"TARGETS"
          ~doc:
            "Flags or targets to forward to Ninja directly (use $(b,-- \
             ninja_flags) to separate Ninja flags from Clerk flags)")

  let ninja_flags =
    let env =
      Cmd.Env.info
        ~doc:
          "make-compatible flags handling. Currently recognizes the -i and -j \
           options and forwards them through to Ninja."
        "MAKEFLAGS"
    in
    let makeflags =
      Arg.(
        value
        & opt (some string) None
        & info ["makeflags"] ~env ~docv:"FLAG"
            ~doc:
              "Provides the contents of a $(i, MAKEFLAGS) variable to pass on \
               to Ninja. Currently recognizes the -i and -j options.")
    in
    let makeflags_to_ninja_flags (makeflags : string option) =
      match makeflags with
      | None -> ["-k0"]
      | Some makeflags ->
        let ignore_rex = Re.(compile @@ word (char 'i')) in
        let has_ignore = Re.execp ignore_rex makeflags in
        let jobs_rex = Re.(compile @@ seq [str "-j"; group (rep digit)]) in
        let number_of_jobs =
          try ["-j" ^ Re.Group.get (Re.exec jobs_rex makeflags) 1]
          with _ -> []
        in
        (if has_ignore then ["-k0"] else []) @ number_of_jobs
    in
    Term.(const makeflags_to_ninja_flags $ makeflags)

  let info =
    let doc =
      "Build system for Catala, a specification language for tax and social \
       benefits computation rules."
    in
    let man =
      [
        `S Manpage.s_description;
        `P
          "$(b,clerk) is a build system for Catala, a specification language \
           for tax and social benefits computation rules";
        `S Manpage.s_authors;
        `P "Denis Merigoux <denis.merigoux@inria.fr>";
        `P "Emile Rolley <emile.rolley@tuta.io>";
        `P "Louis Gesbert <louis.gesbert@inria.fr>";
        `S Manpage.s_examples;
        `P "Typical usage:";
        `Pre "clerk test file.catala_en";
        `S Manpage.s_bugs;
        `P
          "Please file bug reports at \
           https://github.com/CatalaLang/catala/issues";
      ]
    in
    let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
    Cmd.info "clerk" ~version ~doc ~exits ~man
end

(** {1 System analysis} *)

(** 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))

  (** 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)

  let exec_dir : File.t = Catala_utils.Cli.exec_dir
  let clerk_exe : File.t Lazy.t = lazy (Unix.realpath Sys.executable_name)

  let catala_exe : File.t Lazy.t =
    lazy
      (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") ->
           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 d = File.clean_path dir in
    File.ensure_dir d;
    d
  (* Note: it could be safer here to use File.(Sys.getcwd () / "_build") by
     default, but Ninja treats relative and absolute paths separately so that
     you wouldn't then be able to build target _build/foo.ml but would have to
     write the full path every time *)

  (** Locates the main [lib] directory containing the OCaml libs *)
  let ocaml_libdir : File.t Lazy.t =
    lazy
      (try String.trim (File.process_out "opam" ["var"; "lib"])
       with Failure _ -> (
         try String.trim (File.process_out "ocamlc" ["-where"])
         with Failure _ -> (
           match File.(check_directory (exec_dir /../ "lib")) with
           | Some d -> d
           | None ->
             Message.error
               "Could not locate the OCaml library directory, make sure OCaml \
                or opam is installed")))

  (** Locates the directory containing the OCaml runtime to link to *)
  let ocaml_runtime_dir : File.t Lazy.t =
    lazy
      (let d =
         match Lazy.force catala_project_root with
         | Some root ->
           (* Relative dir when running from catala source *)
           File.(
             root
             / "_build"
             / "install"
             / "default"
             / "lib"
             / "catala"
             / "runtime_ocaml")
         | None -> (
           match
             File.check_directory
               File.(exec_dir /../ "lib" / "catala" / "runtime_ocaml")
           with
           | Some d -> d
           | None -> File.(Lazy.force ocaml_libdir / "catala" / "runtime_ocaml")
           )
       in
       match File.check_directory d with
       | Some dir ->
         Message.debug "Catala runtime libraries found at @{<bold>%s@}." dir;
         dir
       | None ->
         Message.error
           "@[<hov>Could not locate the Catala runtime library at %s.@ Make \
            sure that either catala is correctly installed,@ or you are \
            running from the root of a compiled source tree.@]"
           d)

  let ocaml_include_and_lib_flags : (string list * string list) Lazy.t =
    lazy
      (let link_libs = ["zarith"; "dates_calc"] in
       let includes_libs =
         List.map
           (fun lib ->
             match File.(check_directory (Lazy.force ocaml_libdir / lib)) with
             | None ->
               Message.error
                 "Required OCaml library not found at %a.@ Try `opam install \
                  %s'"
                 File.format
                 File.(Lazy.force ocaml_libdir / lib)
                 lib
             | Some d ->
               ( ["-I"; d],
                 String.map (function '-' -> '_' | c -> c) lib ^ ".cmxa" ))
           link_libs
       in
       let includes, libs = List.split includes_libs in
       ( List.concat includes @ ["-I"; Lazy.force ocaml_runtime_dir],
         libs @ [File.(Lazy.force ocaml_runtime_dir / "runtime_ocaml.cmxa")] ))

  let ocaml_include_flags : string list Lazy.t =
    lazy (fst (Lazy.force ocaml_include_and_lib_flags))

  let ocaml_link_flags : string list Lazy.t =
    lazy (snd (Lazy.force ocaml_include_and_lib_flags))

  let has_command cmd =
    let check_cmd = Printf.sprintf "type %s >/dev/null 2>&1" cmd in
    Sys.command check_cmd = 0

  let diff_command =
    lazy
      (if has_command "patdiff" then
         ["patdiff"; "-alt-old"; "reference"; "-alt-new"; "current-output"]
       else
         [
           "diff";
           "-u";
           "-b";
           "--color";
           "--label";
           "reference";
           "--label";
           "current-output";
         ])
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 *)
module Var = struct
  include Nj.Var

  (** Global vars: always defined, at toplevel *)

  let ninja_required_version = make "ninja_required_version"
  let builddir = make "builddir"
  let clerk_exe = make "CLERK_EXE"
  let catala_exe = make "CATALA_EXE"
  let catala_flags = make "CATALA_FLAGS"
  let catala_flags_ocaml = make "CATALA_FLAGS_OCAML"
  let catala_flags_python = make "CATALA_FLAGS_PYTHON"
  let clerk_flags = make "CLERK_FLAGS"
  let ocamlc_exe = make "OCAMLC_EXE"
  let ocamlopt_exe = make "OCAMLOPT_EXE"
  let ocaml_flags = make "OCAML_FLAGS"
  let runtime_ocaml_libs = make "RUNTIME_OCAML_LIBS"
  let diff = make "DIFF"
  let post_test = make "POST_TEST"

  (** Rule vars, Used in specific rules *)

  let input = make "in"
  let output = make "out"
  let pool = make "pool"
  let src = make "src"
  let orig_src = make "orig-src"
  let scope = make "scope"
  let test_id = make "test-id"
  let test_command = make "test-command"
  let ( ! ) = Var.v
end

let base_bindings catala_exe catala_flags build_dir include_dirs test_flags =
  let includes =
    List.fold_right
      (fun dir flags ->
        if Filename.is_relative dir then
          "-I" :: File.(Var.(!builddir) / dir) :: flags
        else "-I" :: dir :: flags)
      include_dirs []
  in
  let catala_flags = ("--directory=" ^ Var.(!builddir)) :: catala_flags in
  let catala_flags_ocaml =
    List.filter
      (function
        | "--avoid-exceptions" | "-O" | "--optimize" -> true | _ -> false)
      test_flags
  in
  let catala_flags_python =
    List.filter
      (function
        | "--avoid-exceptions" | "-O" | "--optimize" | "--closure-conversion" ->
          true
        | _ -> false)
      test_flags
  in
  let ocaml_flags = Lazy.force Poll.ocaml_include_flags in
  [
    Nj.binding Var.ninja_required_version ["1.7"];
    (* use of implicit outputs *)
    Nj.binding Var.builddir [build_dir];
    Nj.binding Var.clerk_exe [Lazy.force Poll.clerk_exe];
    Nj.binding Var.catala_exe
      [
        (match catala_exe with
        | Some e -> File.check_exec e
        | None -> Lazy.force Poll.catala_exe);
      ];
    Nj.binding Var.catala_flags (catala_flags @ includes);
    Nj.binding Var.catala_flags_ocaml catala_flags_ocaml;
    Nj.binding Var.catala_flags_python catala_flags_python;
    Nj.binding Var.clerk_flags
      ("-e"
       :: Var.(!catala_exe)
       :: ("--test-flags=" ^ String.concat "," test_flags)
       :: includes
      @ List.map (fun f -> "--catala-opts=" ^ f) catala_flags);
    Nj.binding Var.ocamlc_exe ["ocamlc"];
    Nj.binding Var.ocamlopt_exe ["ocamlopt"];
    Nj.binding Var.ocaml_flags (ocaml_flags @ includes);
    Nj.binding Var.runtime_ocaml_libs (Lazy.force Poll.ocaml_link_flags);
    Nj.binding Var.diff (Lazy.force Poll.diff_command);
    Nj.binding Var.post_test [Var.(!diff)];
  ]

let[@ocamlformat "disable"] static_base_rules =
  let open Var in
  let color = Message.has_color stdout in
  let shellout l = Format.sprintf "$$(%s)" (String.concat " " l) in
  [
    Nj.rule "copy"
      ~command:["cp"; "-f"; !input; !output]
      ~description:["<copy>"; !input];

    Nj.rule "catala-ocaml"
      ~command:[!catala_exe; "ocaml"; !catala_flags; !catala_flags_ocaml;
                !input; "-o"; !output]
      ~description:["<catala>"; "ocaml"; "⇒"; !output];

    Nj.rule "ocaml-object"
      ~command:[!ocamlc_exe; "-i"; !ocaml_flags; !input; ">"; !input^"i"; "&&";
                !ocamlc_exe; "-opaque"; !ocaml_flags; !input^"i"; "&&";
                !ocamlc_exe; "-c"; !ocaml_flags; !input; "&&";
                !ocamlopt_exe; "-c"; "-intf-suffix"; ".ml"; !ocaml_flags; !input]
      ~description:["<ocaml>"; "⇒"; !output];

    Nj.rule "ocaml-module"
      ~command:
        [!ocamlopt_exe; "-shared"; !ocaml_flags; !input; "-o"; !output]
      ~description:["<ocaml>"; "⇒"; !output];

    Nj.rule "ocaml-exec"
      ~command: [
        !ocamlopt_exe; !ocaml_flags; !runtime_ocaml_libs;
        shellout [!catala_exe; "depends";
                  "--prefix="^ !builddir; "--extension=cmx";
                  !catala_flags; !orig_src];
        "-o"; !output;
      ]
      ~description:["<ocaml>"; "⇒"; !output];

    Nj.rule "python"
      ~command:[!catala_exe; "python"; !catala_flags; !catala_flags_python;
                !input; "-o"; !output]
      ~description:["<catala>"; "python"; "⇒"; !output];

    Nj.rule "out-test"
      ~command: [
        !catala_exe; !test_command; "--plugin-dir="; "-o -"; !catala_flags;
        !input; ">"; !output; "2>&1";
        "||"; "true";
      ]
      ~description:
        ["<catala>"; "test"; !test_id; "⇐"; !input; "(" ^ !test_command ^ ")"];

    Nj.rule "inline-tests"
      ~command:
        [!clerk_exe; "runtest"; !clerk_flags; !input; ">"; !output; "2>&1";
         "||"; "true"]
      ~description:["<catala>"; "inline-tests"; "⇐"; !input];

    Nj.rule "post-test"
      ~command:[
        !post_test; !input; ";";
        "echo"; "-n"; "$$?"; ">"; !output;
      ]
      ~description:["<test>"; !test_id];

    Nj.rule "interpret"
      ~command:
        [!catala_exe; "interpret"; !catala_flags; !input; "--scope=" ^ !scope]
      ~description:["<catala>"; "interpret"; !scope; "⇐"; !input]
      ~vars:[pool, ["console"]];

    Nj.rule "dir-tests"
      ~command:["cat"; !input; ">"; !output; ";"]
      ~description:["<test>"; !test_id];

    Nj.rule "test-results"
      ~command:[
        "out=" ^ !output; ";";
        "success=$$("; "tr"; "-cd"; "0"; "<"; !input; "|"; "wc"; "-c"; ")"; ";";
        "total=$$("; "wc"; "-c"; "<"; !input; ")"; ";";
        "pass=$$(";  ")"; ";";
        "if"; "test"; "\"$$success\""; "-eq"; "\"$$total\""; ";"; "then";
          "printf";
          (if color then "\"\\n[\\033[32mPASS\\033[m] \\033[1m%s\\033[m: \
                          \\033[32m%3d\\033[m/\\033[32m%d\\033[m\\n\""
           else "\"\\n[PASS] %s: %3d/%d\\n\"");
          "$${out%@test}"; "$$success"; "$$total"; ";";
        "else";
          "printf";
          (if color then "\"\\n[\\033[31mFAIL\\033[m] \\033[1m%s\\033[m: \
                          \\033[31m%3d\\033[m/\\033[32m%d\\033[m\\n\""
           else "\"\\n[FAIL] %s: %3d/%d\\n\"");
          "$${out%@test}"; "$$success"; "$$total"; ";";
          "return"; "1"; ";";
        "fi";
      ]
      ~description:["<test>"; !output];
  (* Note: this last rule looks horrible, but the processing is pretty simple:
     in the rules above, we output the returning code of diffing individual
     tests to a [<testfile>@test] file, then the rules for directories just
     concat these files. What this last rule does is then just count the number
     of `0` and the total number of characters in the file, and print a readable
     message. Instead of this disgusting shell code embedded in the ninja file,
     this could be a specialised subcommand of clerk, e.g. `clerk
     test-diagnostic <results-file@test>` *)
  ]

let gen_build_statements
    (include_dirs : string list)
    (same_dir_modules : (string * File.t) list)
    (item : Scan.item) : Nj.ninja =
  let open File in
  let ( ! ) = Var.( ! ) in
  let src = item.file_name in
  let modules = List.rev item.used_modules in
  let modfile ext modname =
    match List.assoc_opt modname same_dir_modules with
    | Some f -> (!Var.builddir / Filename.remove_extension f) ^ ext
    | None -> modname ^ ext
  in
  let inc x = !Var.builddir / x in
  let modd x = modfile "@module" x in
  let def_src = Nj.binding Var.src [Filename.remove_extension src] in
  let srcv = !Var.src ^ Filename.extension src in
  let include_deps =
    Nj.build "copy" ~inputs:[srcv]
      ~implicit_in:(List.map inc item.included_files @ List.map modd modules)
      ~outputs:[inc srcv]
  in
  let target_file ext = (!Var.builddir / !Var.src) ^ "." ^ ext in
  let module_deps =
    Option.map
      (fun m ->
        Nj.build "phony"
          ~inputs:[inc srcv; target_file "cmi"; target_file "cmxs"]
          ~outputs:[modd m])
      item.module_def
  in
  let ml_file = target_file "ml" in
  let py_file = target_file "py" in
  let ocaml, python =
    if item.extrnal then
      ( Nj.build "copy"
          ~implicit_in:[inc srcv]
          ~inputs:[src -.- "ml"]
          ~outputs:[ml_file],
        Nj.build "copy"
          ~implicit_in:[inc srcv]
          ~inputs:[src -.- "py"]
          ~outputs:[py_file] )
    else
      ( Nj.build "catala-ocaml"
          ~inputs:[inc srcv]
          ~implicit_in:[!Var.catala_exe] ~outputs:[ml_file],
        Nj.build "python"
          ~inputs:[inc srcv]
          ~implicit_in:[!Var.catala_exe] ~outputs:[py_file] )
  in
  let ocamlopt =
    let obj =
      Nj.build "ocaml-object" ~inputs:[ml_file]
        ~implicit_in:(!Var.catala_exe :: List.map modd modules)
        ~outputs:(List.map target_file ["mli"; "cmi"; "cmo"; "cmx"; "cmt"; "o"])
        ~vars:
          [
            ( Var.ocaml_flags,
              !Var.ocaml_flags
              :: "-I"
              :: (!Var.builddir / src /../ "")
              :: List.concat_map
                   (fun d ->
                     [
                       "-I";
                       (if Filename.is_relative d then !Var.builddir / d else d);
                     ])
                   include_dirs );
          ]
    in
    let modexec =
      match item.module_def with
      | Some _ ->
        Nj.build "ocaml-module"
          ~inputs:[target_file "cmx"]
          ~outputs:[target_file "cmxs"]
      | None ->
        Nj.build "ocaml-exec"
          ~inputs:[target_file "cmx"]
          ~outputs:[target_file "exe"]
          ~vars:[Var.orig_src, [inc srcv]]
    in
    [obj; modexec]
  in
  let expose_module =
    match item.module_def with
    | Some m when List.mem (dirname src) include_dirs ->
      Some (Nj.build "phony" ~outputs:[m ^ "@module"] ~inputs:[modd m])
    | _ -> None
  in
  let interp_deps =
    !Var.catala_exe
    :: List.map
         (fun m ->
           match List.assoc_opt m same_dir_modules with
           | Some f -> (!Var.builddir / Filename.remove_extension f) ^ ".cmxs"
           | None -> m ^ "@module")
         modules
  in
  let interpret =
    Nj.build "interpret"
      ~outputs:[srcv ^ "@interpret"]
      ~inputs:[inc srcv]
      ~implicit_in:interp_deps
  in
  let legacy_test_reference test =
    (src /../ "output" / Filename.basename src) -.- test.Scan.id
  in
  let tests =
    let legacy_tests =
      List.fold_left
        (fun acc test ->
          let vars =
            [Var.test_id, [test.Scan.id]; Var.test_command, test.Scan.cmd]
          in
          let reference = legacy_test_reference test in
          let test_out =
            (!Var.builddir / src /../ "output" / Filename.basename src)
            -.- test.id
          in
          Nj.build "out-test"
            ~inputs:[inc srcv]
            ~implicit_in:interp_deps ~outputs:[test_out] ~vars
          :: (* The test reference is an input because of the cases when we run
                diff; it should actually be an output for the cases when we
                reset but that shouldn't cause trouble. *)
             Nj.build "post-test" ~inputs:[reference; test_out]
               ~implicit_in:["always"]
               ~outputs:[(!Var.builddir / reference) ^ "@post"]
               ~vars:[Var.test_id, [reference]]
          :: acc)
        [] item.legacy_tests
    in
    let inline_tests =
      if not item.has_inline_tests then []
      else
        [
          Nj.build "inline-tests"
            ~inputs:[inc srcv]
            ~implicit_in:(!Var.clerk_exe :: interp_deps)
            ~outputs:[(!Var.builddir / srcv) ^ "@out"];
        ]
    in
    let tests =
      let results =
        Nj.build "test-results"
          ~outputs:[srcv ^ "@test"]
          ~inputs:[inc (srcv ^ "@test")]
      in
      let inline_test label =
        Nj.build "post-test"
          ~outputs:[inc (srcv ^ label)]
          ~inputs:[srcv; inc (srcv ^ "@out")]
          ~implicit_in:["always"]
          ~vars:[Var.test_id, [srcv]]
      in
      match item.legacy_tests with
      | [] ->
        if item.has_inline_tests then [inline_test "@test"; results] else []
      | legacy ->
        let inline =
          if item.has_inline_tests then [inline_test "@inline"] else []
        in
        inline
        @ [
            Nj.build "dir-tests"
              ~outputs:[inc (srcv ^ "@test")]
              ~inputs:
                ((if item.has_inline_tests then [inc (srcv ^ "@inline")] else [])
                @ List.map
                    (fun test ->
                      (!Var.builddir / legacy_test_reference test) ^ "@post")
                    legacy)
              ~vars:[Var.test_id, [srcv]];
            results;
          ]
    in
    legacy_tests @ inline_tests @ tests
  in
  Seq.concat
  @@ List.to_seq
       [
         Seq.return (Nj.comment "");
         Seq.return def_src;
         Seq.return include_deps;
         Option.to_seq module_deps;
         Option.to_seq expose_module;
         Seq.return ocaml;
         List.to_seq ocamlopt;
         Seq.return python;
         List.to_seq tests;
         Seq.return interpret;
       ]

let gen_build_statements_dir
    (include_dirs : string list)
    (items : Scan.item list) : Nj.ninja =
  let same_dir_modules =
    List.filter_map
      (fun item ->
        Option.map (fun name -> name, item.Scan.file_name) item.Scan.module_def)
      items
  in
  Seq.flat_map
    (gen_build_statements include_dirs same_dir_modules)
    (List.to_seq items)

let dir_test_rules dir subdirs items =
  let open File in
  let inputs =
    List.rev_append
      (List.rev_map (fun s -> (Var.(!builddir) / s) ^ "@test") subdirs)
      (List.filter_map
         (fun item ->
           if item.Scan.legacy_tests = [] && not item.Scan.has_inline_tests then
             None
           else Some ((Var.(!builddir) / item.Scan.file_name) ^ "@test"))
         items)
  in
  List.to_seq
    [
      Nj.Comment "";
      Nj.build "dir-tests"
        ~outputs:[(Var.(!builddir) / dir) ^ "@test"]
        ~inputs
        ~vars:[Var.test_id, [dir]];
      Nj.build "test-results"
        ~outputs:[dir ^ "@test"]
        ~inputs:[(Var.(!builddir) / dir) ^ "@test"];
    ]

let build_statements include_dirs dir =
  Scan.tree dir
  |> Seq.flat_map
     @@ fun (dir, subdirs, items) ->
     Seq.append
       (gen_build_statements_dir include_dirs items)
       (dir_test_rules dir subdirs items)

let gen_ninja_file catala_exe catala_flags build_dir include_dirs test_flags dir
    =
  let build_dir =
    match test_flags with
    | [] -> build_dir
    | flags -> File.((build_dir / "test") ^ String.concat "" flags)
  in
  let ( @+ ) = Seq.append in
  Seq.return
    (Nj.Comment (Printf.sprintf "File generated by Clerk v.%s\n" version))
  @+ Seq.return (Nj.Comment "- Global variables - #\n")
  @+ List.to_seq
       (base_bindings catala_exe catala_flags build_dir include_dirs test_flags)
  @+ Seq.return (Nj.Comment "\n- Base rules - #\n")
  @+ List.to_seq static_base_rules
  @+ Seq.return (Nj.build "phony" ~outputs:["always"])
  @+ Seq.return (Nj.Comment "\n- Project-specific build statements - #")
  @+ build_statements include_dirs dir
  @+ Seq.return (Nj.build "phony" ~outputs:["test"] ~inputs:[".@test"])

(** {1 Driver} *)

let ninja_init
    ~chdir
    ~catala_exe
    ~catala_opts
    ~build_dir
    ~include_dirs
    ~color
    ~debug
    ~ninja_output :
    extra:def Seq.t -> test_flags:string list -> (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
  in
  Option.iter Sys.chdir chdir;
  let build_dir = Poll.build_dir ?dir:build_dir () in
  let with_ninja_output k =
    match ninja_output with
    | Some f -> k f
    | None when debug -> k File.(build_dir / "clerk.ninja")
    | None -> File.with_temp_file "clerk_build_" ".ninja" k
  in
  fun ~extra ~test_flags k ->
    Message.debug "building ninja rules...";
    with_ninja_output
    @@ fun nin_file ->
    File.with_formatter_of_file nin_file (fun nin_ppf ->
        let ninja_contents =
          Seq.concat
          @@ List.to_seq
               [
                 gen_ninja_file catala_exe catala_opts build_dir include_dirs
                   test_flags ".";
                 Seq.return (Nj.comment "\n - Command-specific targets - #");
                 extra;
               ]
        in
        Nj.format nin_ppf ninja_contents);
    k nin_file

let cleaned_up_env () =
  let passthrough_vars =
    ["CATALA_BIN="; "CATALA_INCLUDE="; "CATALA_TEST_FLAGS="]
  in
  Unix.environment ()
  |> Array.to_seq
  |> Seq.filter (fun s ->
         (not (String.starts_with ~prefix:"CATALA_" s))
         || List.exists
              (fun prefix -> String.starts_with ~prefix s)
              passthrough_vars
         ||
         (Message.warning "Ignoring environment variable %s" s;
          false))
  |> Array.of_seq

let ninja_cmdline ninja_flags nin_file targets =
  ("ninja" :: "-f" :: nin_file :: ninja_flags)
  @ (if Catala_utils.Global.options.debug then ["-v"] else [])
  @ targets

let run_ninja ~clean_up_env cmdline =
  let cmd = List.hd cmdline in
  let env = if clean_up_env then cleaned_up_env () else Unix.environment () in
  Unix.execvpe cmd (Array.of_list cmdline) env

open Cmdliner

let build_cmd =
  let run ninja_init (targets : string list) (ninja_flags : string list) =
    ninja_init ~extra:Seq.empty ~test_flags:[]
    @@ fun nin_file ->
    let targets =
      List.map
        (fun f ->
          if String.exists (function '/' | '.' -> true | _ -> false) f then
            fix_path f
          else f)
        targets
    in
    let ninja_cmd = ninja_cmdline ninja_flags nin_file targets in
    Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
    run_ninja ~clean_up_env:false ninja_cmd
  in
  let doc =
    "Low-level build command: can be used to forward build targets or options \
     directly to Ninja"
  in
  Cmd.v (Cmd.info ~doc "build")
    Term.(
      const run $ Cli.Global.term ninja_init $ Cli.targets $ Cli.ninja_flags)

let test_cmd =
  let run
      ninja_init
      (files_or_folders : string list)
      (reset_test_outputs : bool)
      (test_flags : string list)
      (ninja_flags : string list) =
    let targets =
      let fs = if files_or_folders = [] then ["."] else files_or_folders in
      List.map (fun f -> fix_path f ^ "@test") fs
    in
    let extra =
      List.to_seq
        ((if reset_test_outputs then
            [
              Nj.binding Var.post_test
                [
                  "test_reset() { if ! diff -q $$1 $$2 >/dev/null; then cp -f \
                   $$2 $$1; fi; }";
                  ";";
                  "test_reset";
                ];
            ]
          else [])
        @ [Nj.default targets])
    in
    ninja_init ~extra ~test_flags
    @@ fun nin_file ->
    let ninja_cmd = ninja_cmdline ninja_flags nin_file targets in
    Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
    run_ninja ~clean_up_env:true ninja_cmd
  in
  let doc =
    "Scan the given files or directories for catala tests, build their \
     requirement and run them all. With $(b,--reset) the expected results are \
     updated in-place ; otherwise, 0 is returned if the output matches the \
     reference, or 1 is returned and a diff is printed to stdout"
  in
  Cmd.v (Cmd.info ~doc "test")
    Term.(
      const run
      $ Cli.Global.term ninja_init
      $ Cli.files_or_folders
      $ Cli.reset_test_outputs
      $ Cli.test_flags
      $ Cli.ninja_flags)

let run_cmd =
  let run
      ninja_init
      (files_or_folders : string list)
      (scope : string)
      (ninja_flags : string list) =
    let extra =
      Seq.cons
        (Nj.binding Var.scope [scope])
        (Seq.return
           (Nj.default
              (List.map (fun file -> file ^ "@interpret") files_or_folders)))
    in
    ninja_init ~extra ~test_flags:[]
    @@ fun nin_file ->
    let ninja_cmd = ninja_cmdline ninja_flags nin_file [] in
    Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
    run_ninja ~clean_up_env:false ninja_cmd
  in
  let doc =
    "Runs the Catala interpreter on the given files, after building their \
     dependencies. The scope to be executed must be specified using the \
     $(i,-s) option."
  in
  Cmd.v (Cmd.info ~doc "run")
    Term.(
      const run
      $ Cli.Global.term ninja_init
      $ Cli.files_or_folders
      $ Cli.scope
      $ Cli.ninja_flags)

let runtest_cmd =
  let run catala_exe catala_opts include_dirs test_flags file =
    let catala_opts =
      List.fold_left
        (fun opts dir -> "-I" :: dir :: opts)
        catala_opts include_dirs
    in
    Clerk_runtest.run_inline_tests
      (Option.value ~default:"catala" catala_exe)
      catala_opts test_flags file;
    0
  in
  let doc =
    "Mainly for internal purposes. Runs inline tests from a Catala file, and \
     outputs their results to stdout"
  in
  Cmd.v (Cmd.info ~doc "runtest")
    Term.(
      const run
      $ Cli.catala_exe
      $ Cli.catala_opts
      $ Cli.include_dirs
      $ Cli.test_flags
      $ Cli.single_file)

let main_cmd = Cmd.group Cli.info [build_cmd; test_cmd; run_cmd; runtest_cmd]

let main () =
  try exit (Cmdliner.Cmd.eval' ~catch:false main_cmd) with
  | Catala_utils.Cli.Exit_with n -> exit n
  | Message.CompilerError content ->
    let bt = Printexc.get_raw_backtrace () in
    Message.Content.emit content Error;
    if Catala_utils.Global.options.debug then
      Printexc.print_raw_backtrace stderr bt;
    exit Cmd.Exit.some_error
  | Sys_error msg ->
    let bt = Printexc.get_raw_backtrace () in
    Message.Content.emit
      (Message.Content.of_string ("System error: " ^ msg))
      Error;
    if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
    exit Cmd.Exit.internal_error
  | e ->
    let bt = Printexc.get_raw_backtrace () in
    Message.Content.emit
      (Message.Content.of_string ("Unexpected error: " ^ Printexc.to_string e))
      Error;
    if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
    exit Cmd.Exit.internal_error