Ocamlformat integration

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.

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

src/dune_file.ml

@@ -650,6 +650,19 @@ 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 Stanza.t += T
+
+  let () =
+    Dune_project.Extension.register syntax
+      (return [("fmt", return [T])])
+end
+
 module Buildable = struct
   type t =
     { loc                      : Loc.t

src/dune_file.mli

@@ -127,6 +127,12 @@ module Dep_conf : sig
   val to_sexp : t Sexp.To_sexp.t
 end
 
+module Auto_format : sig
+  val syntax : Syntax.t
+
+  type Stanza.t += T
+end
+
 module Buildable : sig
   type t =
     { loc                      : Loc.t

src/dune_project.ml

@@ -215,6 +215,7 @@ module Extension = struct
     }
 
   let extensions = Hashtbl.create 32
+  let instanciated_extensions = Hashtbl.create 32
 
   let register ?(experimental=false) syntax stanzas =
     let name = Syntax.name syntax in
@@ -223,13 +224,18 @@ module Extension = struct
         [ "name", Sexp.To_sexp.string name ];
     Hashtbl.add extensions name { syntax; stanzas ; experimental }
 
+  let get_instance syntax =
+    let name = Syntax.name syntax in
+    Hashtbl.find instanciated_extensions name
+
   let instantiate ~loc ~parse_args (name_loc, name) (ver_loc, ver) =
     match Hashtbl.find extensions name with
     | None ->
       Errors.fail name_loc "Unknown extension %S.%s" name
         (hint name (Hashtbl.keys extensions))
     | Some t ->
       Syntax.check_supported t.syntax (ver_loc, ver);
+      Hashtbl.add instanciated_extensions name loc;
       { extension = t
       ; version = ver
       ; loc

src/dune_project.mli

@@ -68,6 +68,8 @@ module Extension : sig
     -> Syntax.t
     -> Stanza.Parser.t list Dsexp.Of_sexp.t
     -> unit
+
+  val get_instance : Syntax.t -> Loc.t option
 end
 
 (** Load a project description from the following directory. [files]

src/format_rules.ml

@@ -0,0 +1,128 @@
+open Import
+
+let flag_of_kind : Ml_kind.t -> _ =
+  function
+  | Impl -> "--impl"
+  | Intf -> "--intf"
+
+let dep loc x = String_with_vars.make_macro loc "dep" x
+
+type outcome =
+  | Format_using of Action.Unexpanded.t
+  | Not_formattable
+  | Missing_tool of string
+
+let ocamlformat_bin = lazy (Bin.which "ocamlformat")
+
+let ocamlformat_action ofmt kind loc path =
+  let flag = flag_of_kind kind in
+  let exe = dep loc @@ Path.to_string ofmt in
+  let args =
+    [ String_with_vars.make_text loc flag
+    ; dep loc path
+    ; String_with_vars.make_text loc "-o"
+    ; String_with_vars.make_var loc "targets"
+    ]
+  in
+  Action.Unexpanded.Run (exe, args)
+
+let ocamlformat kind loc path =
+  match Lazy.force ocamlformat_bin with
+  | Some ofmt -> Format_using (ocamlformat_action ofmt kind loc path)
+  | None -> Missing_tool "ocamlformat"
+
+let refmt_action rfmt loc path =
+  let exe = dep loc @@ Path.to_string rfmt in
+  let args = [dep loc path] in
+  Action.Unexpanded.Redirect
+    ( Stdout
+    , String_with_vars.make_var loc "targets"
+    , Run (exe, args)
+    )
+
+let refmt_bin = lazy (Bin.which "refmt")
+
+let refmt loc path =
+  match Lazy.force refmt_bin with
+  | Some rfmt -> Format_using (refmt_action rfmt loc path)
+  | None -> Missing_tool "refmt"
+
+let formatter_for_path loc path =
+  match Filename.extension path with
+  | ".ml" -> ocamlformat Ml_kind.Impl loc path
+  | ".mli" -> ocamlformat Ml_kind.Intf loc path
+  | ".re"
+  | ".rei" -> refmt loc path
+  | _ -> Not_formattable
+
+let add_alias_format sctx loc ~dir ~scope action =
+  let alias_conf =
+    { Dune_file.Alias_conf.name = "fmt"
+    ; deps = []
+    ; action = Some (loc, action)
+    ; locks = []
+    ; package = None
+    ; enabled_if = None
+    ; loc
+    }
+  in
+  Simple_rules.alias sctx ~dir ~scope alias_conf
+
+let run_rule ~target ~action ~loc =
+  { Dune_file.Rule.targets = Static [target]
+  ; action = (loc, action)
+  ; mode = Standard
+  ; deps = []
+  ; locks = []
+  ; loc
+  }
+
+let diff file1 file2 =
+  Action.Unexpanded.Diff
+    { optional = false
+    ; mode = Text
+    ; file1
+    ; file2
+    }
+
+let rules_for_file action loc path =
+  let target = path ^ ".formatted" in
+  let format_rule = run_rule ~loc ~target ~action in
+  let diff_action =
+    diff
+      (dep loc path)
+      (String_with_vars.make_text loc target)
+  in
+  (format_rule, diff_action)
+
+let setup_formatters files loc ~setup_rules =
+  Path.Set.fold files ~init:String.Set.empty ~f:(fun file acc ->
+    let path = Path.basename file in
+    match formatter_for_path loc path with
+    | Format_using action ->
+      setup_rules (rules_for_file action loc path);
+      acc
+    | Not_formattable -> acc
+    | Missing_tool tool -> String.Set.add acc tool)
+
+let gen_rules sctx ~loc ~dir ~scope =
+  let add_alias action = add_alias_format sctx loc ~dir ~scope action in
+  let setup_rules (format_rule, diff_action) =
+    let _ : Path.t list =
+      Simple_rules.user_rule sctx ~dir ~scope format_rule
+    in
+    add_alias diff_action
+  in
+  let files =
+    File_tree.files_of
+      (Super_context.file_tree sctx)
+      (Path.drop_build_context_exn dir)
+  in
+  let unknown_tools = setup_formatters files loc ~setup_rules in
+  if not (String.Set.is_empty unknown_tools) then
+    let msg =
+      Printf.sprintf
+        "Cannot find the following tools, skipping associated files: %s\n"
+        (String.concat ~sep:", " (String.Set.to_list unknown_tools))
+    in
+    add_alias (Echo [String_with_vars.make_text loc msg])

src/format_rules.mli

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

src/gen_rules.ml

@@ -211,12 +211,19 @@ module Gen(P : Install_rules.Params) = struct
     executables_rules t.exes ~dir ~scope ~dir_kind
       ~dir_contents
 
+  let gen_format_rules sctx ~dir ~scope =
+    match Dune_project.Extension.get_instance Auto_format.syntax with
+    | None -> ()
+    | Some loc ->
+      Format_rules.gen_rules sctx ~loc ~dir ~scope
+
   (* +-----------------------------------------------------------------+
      | Stanza                                                          |
      +-----------------------------------------------------------------+ *)
 
   let gen_rules dir_contents
         { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } =
+    gen_format_rules sctx ~dir:ctx_dir ~scope;
     let merlins, cctxs =
       let rec loop stanzas merlins cctxs =
         let dir = ctx_dir in

src/string_with_vars.ml

@@ -20,16 +20,22 @@ let make ?(quoted=false) loc part =
 let make_text ?quoted loc s =
   make ?quoted loc (Text s)
 
-let make_var ?quoted loc name =
+let make_var_args ?quoted loc name payload =
   let var =
     { loc
     ; name
-    ; payload = None
+    ; payload
     ; syntax = Percent
   }
   in
   make ?quoted loc (Var var)
 
+let make_var ?quoted loc name =
+  make_var_args ?quoted loc name None
+
+let make_macro ?quoted loc macro param =
+  make_var_args ?quoted loc macro (Some param)
+
 let literal ~quoted ~loc s =
   { parts = [Text s]
   ; quoted

src/string_with_vars.mli

@@ -27,6 +27,7 @@ val virt_var   : ?quoted: bool -> (string * int * int * int) -> string -> t
 val virt_text  : (string * int * int * int) -> string -> t
 val make_var   : ?quoted: bool -> Loc.t -> string -> t
 val make_text  : ?quoted: bool -> Loc.t -> string -> t
+val make_macro : ?quoted: bool -> Loc.t -> string -> string -> t
 
 val is_var : t -> name:string -> bool
 

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))
@@ -965,6 +973,7 @@
   (alias findlib-error)
   (alias fmt)
   (alias force-test)
+  (alias formatting)
   (alias gen-opam-install-file)
   (alias github1019)
   (alias github1099)
@@ -1080,6 +1089,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/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/run.t

@@ -0,0 +1,36 @@
+Formatting can be checked using the @fmt target:
+
+  $ cp enabled/ocaml_file.ml.orig enabled/ocaml_file.ml
+  $ cp enabled/reason_file.re.orig enabled/reason_file.re
+  $ dune build --root enabled @fmt
+  Entering directory 'enabled'
+  File "reason_file.rei", line 1, characters 0-0:
+  Files _build/default/reason_file.rei and _build/default/reason_file.rei.formatted differ.
+  File "reason_file.re", line 1, characters 0-0:
+  Files _build/default/reason_file.re and _build/default/reason_file.re.formatted differ.
+  File "ocaml_file.mli", line 1, characters 0-0:
+  Files _build/default/ocaml_file.mli and _build/default/ocaml_file.mli.formatted differ.
+  File "ocaml_file.ml", line 1, characters 0-0:
+  Files _build/default/ocaml_file.ml and _build/default/ocaml_file.ml.formatted differ.
+  File "subdir/lib.ml", line 1, characters 0-0:
+  Files _build/default/subdir/lib.ml and _build/default/subdir/lib.ml.formatted differ.
+  [1]
+
+And fixable files can be promoted:
+
+  $ cd enabled; dune promote ocaml_file.ml reason_file.re
+  Promoting _build/default/ocaml_file.ml.formatted to ocaml_file.ml.
+  Promoting _build/default/reason_file.re.formatted to reason_file.re.
+  $ cat enabled/ocaml_file.ml
+  let y = ()
+  $ cat enabled/reason_file.re
+  let y = ();
+
+For projects without (using fmt), this does nothing:
+
+  $ dune build --root disabled @fmt
+  Entering directory 'disabled'
+  From the command line:
+  Error: Alias "fmt" is empty.
+  It is not defined in . or any of its descendants.
+  [1]