Integration with auto formatters

This adds a "fmt" extension in dune-project files. When used, it will
setup a `@fmt` alias that will call `ocamlformat` on ocaml source code,
and `refmt` on reason source code. The tools are not configured by dune.

Closes #1201

Signed-off-by: Etienne Millon <me@emillon.org>

doc/formatting.rst

@@ -0,0 +1,66 @@
+.. _formatting-main:
+
+********************
+Automatic formatting
+********************
+
+Dune can be set up to run automatic formatters for source code.
+
+It can use ocamlformat_ to format OCaml source code (``*.ml`` and ``*.mli``
+files) and refmt_ to format Reason source code (``*.re`` and ``*.rei`` files).
+
+.. _ocamlformat: https://github.com/ocaml-ppx/ocamlformat
+.. _refmt: https://github.com/facebook/reason/tree/master/src/refmt
+
+Enabling automatic formatting
+=============================
+
+This feature is enabled by adding the following to the ``dune-project`` file:
+
+.. code:: scheme
+
+    (using fmt 1.0)
+
+Formatting a project
+====================
+
+When this feature is active, an alias named ``fmt`` is defined. When built, it
+will format the source files in the corresponding project and display the
+differences:
+
+.. code::
+
+    $ dune build @fmt
+    --- hello.ml
+    +++ hello.ml.formatted
+    @@ -1,3 +1 @@
+    -let () =
+    -  print_endline
+    -    "hello, world"
+    +let () = print_endline "hello, world"
+
+It is then possible to accept the correction by calling ``dune promote`` to
+replace the source files by the corrected versions.
+
+.. code::
+
+    $ dune promote
+    Promoting _build/default/hello.ml.formatted to hello.ml.
+
+As usual with promotion, it is possible to combine these two steps by running
+``dune build @fmt --auto-promote``.
+
+Only enabling it for certain languages
+======================================
+
+By default, formatting will be enabled for all languages present in the project
+that dune knows about. This is not always desirable, for example if in a mixed
+Reason/OCaml project, one only wants to format the Reason files to avoid pulling
+``ocamlformat`` as a dependency.
+
+In these cases, it is possible to use the ``enabled_for`` argument to restrict
+the languages that are considered for formatting.
+
+.. code:: scheme
+
+    (using fmt 1.0 (enabled_for reason))

doc/index.rst

@@ -21,6 +21,7 @@ Welcome to dune's documentation!
    configurator
    menhir
    jsoo
+   formatting
    faq
    known-issues
    migration

src/dune_file.ml

@@ -628,6 +628,61 @@ end
 
 let modules_field name = Ordered_set_lang.field name
 
+module Auto_format = struct
+  let syntax =
+    Syntax.create ~name:"fmt"
+      ~desc:"integration with automatic formatters"
+      [ (1, 0) ]
+
+  type language =
+    | Ocaml
+    | Reason
+
+  let language_to_sexp = function
+    | Ocaml -> Sexp.Atom "ocaml"
+    | Reason -> Sexp.Atom "reason"
+
+  let language =
+    sum
+      [ ("ocaml", return Ocaml)
+      ; ("reason", return Reason)
+      ]
+
+  type enabled_for =
+    | Default
+    | Only of language list
+
+  let enabled_for_field =
+    let%map r = field_o "enabled_for" (repeat language) in
+    match r with
+    | Some l -> Only l
+    | None -> Default
+
+  let enabled_for_to_sexp =
+    function
+      | Default -> Sexp.Atom "default"
+      | Only l -> List [Atom "only"; List (List.map ~f:language_to_sexp l)]
+
+  type t =
+    { loc : Loc.t
+    ; enabled_for : enabled_for
+    }
+
+  let to_sexp {enabled_for; loc = _} =
+    Sexp.List
+      [ List [Atom "enabled_for"; enabled_for_to_sexp enabled_for]
+      ]
+
+  let dparse_args =
+    let%map loc = loc
+    and enabled_for = record enabled_for_field
+    in
+    ({loc; enabled_for}, [])
+
+  let key =
+    Dune_project.Extension.register syntax dparse_args to_sexp
+end
+
 module Buildable = struct
   type t =
     { loc                      : Loc.t

src/dune_file.mli

@@ -117,6 +117,25 @@ module Dep_conf : sig
   val to_sexp : t Sexp.Encoder.t
 end
 
+module Auto_format : sig
+  type language =
+    | Ocaml
+    | Reason
+
+  type enabled_for =
+    | Default
+    | Only of language list
+
+  type t =
+    { loc : Loc.t
+    ; enabled_for : enabled_for
+    }
+
+  val syntax : Syntax.t
+
+  val key : t Dune_project.Extension.t
+end
+
 module Buildable : sig
   type t =
     { loc                      : Loc.t

src/format_rules.ml

@@ -0,0 +1,99 @@
+open Import
+
+let flag_of_kind : Ml_kind.t -> _ =
+  function
+  | Impl -> "--impl"
+  | Intf -> "--intf"
+
+let config_includes (config : Dune_file.Auto_format.t) s =
+  match config.enabled_for with
+  | Default -> true
+  | Only set -> List.mem s ~set
+
+let add_diff sctx loc alias ~dir input output =
+  let module SC = Super_context in
+  let open Build.O in
+  let action = Action.diff input output in
+  SC.add_alias_action sctx alias ~loc:(Some loc) ~locks:[] ~stamp:input
+    (Build.paths [input; output]
+     >>>
+     Build.action
+       ~dir
+       ~targets:[]
+       action)
+
+let gen_rules sctx (config : Dune_file.Auto_format.t) ~dir =
+  let loc = config.loc in
+  let files =
+    File_tree.files_of
+      (Super_context.file_tree sctx)
+      (Path.drop_build_context_exn dir)
+  in
+  let subdir = ".formatted" in
+  let output_dir = Path.relative dir subdir in
+  let alias = Build_system.Alias.make "fmt" ~dir in
+  let alias_formatted = Build_system.Alias.make "fmt" ~dir:output_dir in
+  let resolve_program = Super_context.resolve_program sctx ~loc:(Some loc) in
+  let setup_formatting file (arrows_acc, extra_deps_acc) =
+    let input_basename = Path.basename file in
+    let input = Path.relative dir input_basename in
+    let output = Path.relative output_dir input_basename in
+
+    let ocaml kind =
+      if config_includes config Ocaml then
+        let exe = resolve_program "ocamlformat" in
+        let args =
+          let open Arg_spec in
+          [ A (flag_of_kind kind)
+          ; Dep input
+          ; A "--name"
+          ; Path file
+          ; A "-o"
+          ; Target output
+          ]
+        in
+        Some (Build.run ~dir exe args)
+      else
+        None
+    in
+
+    let formatter =
+      match Path.extension file with
+      | ".ml" -> ocaml Impl
+      | ".mli" -> ocaml Intf
+      | ".re"
+      | ".rei" when config_includes config Reason ->
+        let exe = resolve_program "refmt" in
+        let args = [Arg_spec.Dep input] in
+        Some (Build.run ~dir ~stdout_to:output exe args)
+      | _ -> None
+    in
+
+    let new_extra_deps_acc =
+      if String.equal input_basename ".ocamlformat" then
+        input::extra_deps_acc
+      else
+        extra_deps_acc
+    in
+
+    let new_arrows_acc =
+      match formatter with
+      | None -> arrows_acc
+      | Some arr -> (arr, input, output)::arrows_acc
+    in
+
+    (new_arrows_acc, new_extra_deps_acc)
+  in
+  Super_context.on_load_dir sctx ~dir:output_dir ~f:(fun () ->
+    let arrows, extra_deps =
+      Path.Set.fold files ~init:([], []) ~f:setup_formatting
+    in
+    List.iter
+      arrows
+      ~f:(fun (format_arr, input, output) ->
+        let open Build.O in
+        let arr = Build.paths extra_deps >>> format_arr in
+        Super_context.add_rule sctx ~mode:Standard ~loc arr;
+        add_diff sctx loc alias_formatted ~dir input output));
+  Super_context.add_alias_deps sctx alias
+    (Path.Set.singleton (Build_system.Alias.stamp_file alias_formatted))

src/format_rules.mli

@@ -0,0 +1,10 @@
+open Import
+
+(** Setup automatic format rules for the given dir.
+    If tools like ocamlformat are not available in $PATH, just display an error
+    message when the alias is built. *)
+val gen_rules:
+  Super_context.t
+  -> Dune_file.Auto_format.t
+  -> dir:Path.t
+  -> unit

src/gen_rules.ml

@@ -211,6 +211,14 @@ module Gen(P : Install_rules.Params) = struct
     executables_rules t.exes ~dir ~scope ~dir_kind
       ~dir_contents
 
+  let gen_format_rules sctx ~dir =
+    let scope = SC.find_scope_by_dir sctx dir in
+    let project = Scope.project scope in
+    match Dune_project.find_extension_args project Auto_format.key with
+    | None -> ()
+    | Some config ->
+      Format_rules.gen_rules sctx config ~dir
+
   (* +-----------------------------------------------------------------+
      | Stanza                                                          |
      +-----------------------------------------------------------------+ *)
@@ -303,6 +311,7 @@ module Gen(P : Install_rules.Params) = struct
       | _ -> ())
 
   let gen_rules dir_contents ~dir =
+    gen_format_rules sctx ~dir;
     match SC.stanzas_in sctx ~dir with
     | None -> ()
     | Some d -> gen_rules dir_contents d

test/blackbox-tests/dune.inc

@@ -247,6 +247,14 @@
    test-cases/force-test
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name formatting)
+ (deps (package dune) (source_tree test-cases/formatting))
+ (action
+  (chdir
+   test-cases/formatting
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name gen-opam-install-file)
  (deps (package dune) (source_tree test-cases/gen-opam-install-file))
@@ -981,6 +989,7 @@
   (alias findlib-error)
   (alias fmt)
   (alias force-test)
+  (alias formatting)
   (alias gen-opam-install-file)
   (alias github1019)
   (alias github1099)
@@ -1098,6 +1107,7 @@
   (alias findlib-error)
   (alias fmt)
   (alias force-test)
+  (alias formatting)
   (alias github1019)
   (alias github1099)
   (alias github1231)

test/blackbox-tests/test-cases/formatting/disabled/dune

@@ -0,0 +1,3 @@
+(library
+ (name lib)
+)

test/blackbox-tests/test-cases/formatting/disabled/dune-project

@@ -0,0 +1 @@
+(lang dune 1.2)

test/blackbox-tests/test-cases/formatting/disabled/lib.ml

@@ -0,0 +1 @@
+let x  = 1

test/blackbox-tests/test-cases/formatting/disabled/lib.mli

@@ -0,0 +1 @@
+val x :  int

test/blackbox-tests/test-cases/formatting/enabled/dune

@@ -0,0 +1,3 @@
+(library
+ (name lib_reason)
+)

test/blackbox-tests/test-cases/formatting/enabled/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.2)
+(using fmt 1.0)

test/blackbox-tests/test-cases/formatting/enabled/ocaml_file.ml.orig

@@ -0,0 +1 @@
+let  y=()

test/blackbox-tests/test-cases/formatting/enabled/ocaml_file.mli

@@ -0,0 +1,2 @@
+val y   :
+  unit

test/blackbox-tests/test-cases/formatting/enabled/other-project/a.ml

@@ -0,0 +1 @@
+let   x=2

test/blackbox-tests/test-cases/formatting/enabled/other-project/dune

@@ -0,0 +1,3 @@
+(library
+ (name lib_other_project)
+)

test/blackbox-tests/test-cases/formatting/enabled/other-project/dune-project

@@ -0,0 +1 @@
+(lang dune 1.2)

test/blackbox-tests/test-cases/formatting/enabled/reason_file.re.orig

@@ -0,0 +1 @@
+let  y = ();

test/blackbox-tests/test-cases/formatting/enabled/reason_file.rei

@@ -0,0 +1 @@
+let y : unit;

test/blackbox-tests/test-cases/formatting/enabled/subdir/dune

@@ -0,0 +1,3 @@
+(library
+ (name lib)
+)

test/blackbox-tests/test-cases/formatting/enabled/subdir/lib.ml

@@ -0,0 +1 @@
+let   x = 2

test/blackbox-tests/test-cases/formatting/fake-tools/dune

@@ -0,0 +1,3 @@
+(executables
+ (public_names ocamlformat refmt)
+)

test/blackbox-tests/test-cases/formatting/fake-tools/dune-project

@@ -0,0 +1 @@
+(lang dune 1.2)

test/blackbox-tests/test-cases/formatting/fake-tools/ocamlformat.ml

@@ -0,0 +1,10 @@
+let process args ~output =
+  let oc = open_out output in
+  Printf.fprintf oc "Sys.argv: %s\n" (String.concat " " (Array.to_list args));
+  Printf.fprintf oc "ocamlformat output\n";
+  close_out oc
+
+let () =
+  match Sys.argv with
+  | [| _ ; _; _; "--name"; _; "-o"; output|] -> process Sys.argv ~output
+  | _ -> assert false

test/blackbox-tests/test-cases/formatting/fake-tools/refmt.ml

@@ -0,0 +1,8 @@
+let process args =
+  Printf.printf "Sys.argv: %s\n" (String.concat " " (Array.to_list args));
+  Printf.printf "refmt output\n"
+
+let () =
+  match Sys.argv with
+  | [| _ ; _|] -> process Sys.argv
+  | _ -> assert false

test/blackbox-tests/test-cases/formatting/partial/a.ml

@@ -0,0 +1 @@
+let   x = 2

test/blackbox-tests/test-cases/formatting/partial/b.re

@@ -0,0 +1 @@
+let y    =1