Ocamlformat integration

This adds a (ocamlformat) field to libraries and executables. When
present, it will setup a `@format` alias that will call `ocamlformat` on
source files. Reason files are ignored. It is possible to exclude more
modules using OSL. The ocamlformat configuration is determined by
ocamlformat itself.

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

src/dune_file.ml

@@ -666,6 +666,23 @@ end
 
 let modules_field name = Ordered_set_lang.field name
 
+module Ocamlformat = struct
+  type t =
+    | No_format
+    | Format of Ordered_set_lang.t
+
+  let of_repr = function
+    | None -> No_format
+    | Some modules -> Format modules
+
+  let params =
+    fields @@ modules_field "modules"
+
+  let field =
+    let%map repr = field_o "ocamlformat" params in
+    of_repr repr
+end
+
 module Buildable = struct
   type t =
     { loc                      : Loc.t
@@ -680,6 +697,7 @@ module Buildable = struct
     ; ocamlopt_flags           : Ordered_set_lang.Unexpanded.t
     ; js_of_ocaml              : Js_of_ocaml.t
     ; allow_overlapping_dependencies : bool
+    ; ocamlformat : Ocamlformat.t
     }
 
   let dparse =
@@ -700,6 +718,7 @@ module Buildable = struct
       field "js_of_ocaml" Js_of_ocaml.dparse ~default:Js_of_ocaml.default
     and allow_overlapping_dependencies =
       field_b "allow_overlapping_dependencies"
+    and ocamlformat = Ocamlformat.field
     in
     { loc
     ; preprocess
@@ -713,6 +732,7 @@ module Buildable = struct
     ; ocamlopt_flags
     ; js_of_ocaml
     ; allow_overlapping_dependencies
+    ; ocamlformat
     }
 
   let single_preprocess t =

src/dune_file.mli

@@ -127,6 +127,12 @@ module Dep_conf : sig
   val to_sexp : t Sexp.To_sexp.t
 end
 
+module Ocamlformat : sig
+  type t =
+    | No_format
+    | Format of Ordered_set_lang.t
+end
+
 module Buildable : sig
   type t =
     { loc                      : Loc.t
@@ -141,6 +147,7 @@ module Buildable : sig
     ; ocamlopt_flags           : Ordered_set_lang.Unexpanded.t
     ; js_of_ocaml              : Js_of_ocaml.t
     ; allow_overlapping_dependencies : bool
+    ; ocamlformat : Ocamlformat.t
     }
 
   (** Preprocessing specification used by all modules or [No_preprocessing] *)

src/gen_rules.ml

@@ -37,6 +37,7 @@ module Gen(P : Install_rules.Params) = struct
       Dir_contents.modules_of_executables dir_contents
         ~first_exe:(snd (List.hd exes.names))
     in
+    Ocamlformat_rules.gen_rules sctx exes.buildable ~dir ~scope modules;
 
     let preprocessor_deps =
       SC.Deps.interpret sctx exes.buildable.preprocessor_deps

src/lib_rules.ml

@@ -375,6 +375,7 @@ module Gen (P : Install_rules.Params) = struct
         ~lib_name:(Some lib.name)
         ~dir_kind
     in
+    Ocamlformat_rules.gen_rules sctx lib.buildable ~dir ~scope modules;
     let modules = Preprocessing.pp_modules pp modules in
 
     let modules =

src/ocamlformat_rules.ml

@@ -0,0 +1,112 @@
+open Import
+
+let flag_of_kind : Ml_kind.t -> _ =
+  function
+  | Impl -> "--impl"
+  | Intf -> "--intf"
+
+let add_alias_format sctx loc ~dir ~scope action =
+  let alias_conf =
+    { Dune_file.Alias_conf.name = "format"
+    ; deps = []
+    ; action = Some (loc, action)
+    ; locks = []
+    ; package = None
+    ; enabled_if = None
+    ; loc
+    }
+  in
+  Simple_rules.alias sctx ~dir ~scope alias_conf
+
+let sv = String_with_vars.virt_text __POS__
+
+let target_var = String_with_vars.virt_var __POS__ "targets"
+
+let run_rule ~target ~exe ~args ~loc =
+  { Dune_file.Rule.targets = Static [target]
+  ; action = (loc, Run (exe, args))
+  ; mode = Standard
+  ; deps = []
+  ; locks = []
+  ; loc
+  }
+
+let diff file1 file2 =
+  Action.Unexpanded.Diff
+    { optional = false
+    ; mode = Text
+    ; file1
+    ; file2
+    }
+
+let rules_for_ocaml_file loc ocamlformat kind path =
+  let flag = flag_of_kind kind in
+  let path = Path.basename path in
+  let formatted = path ^ ".formatted" in
+  let dep x = String_with_vars.make_macro loc "dep" x in
+  let format_rule =
+    run_rule
+      ~loc
+      ~target:formatted
+      ~exe:(dep @@ Path.to_string ocamlformat)
+      ~args:[sv flag; dep path; sv "-o"; target_var]
+  in
+  let diff_action = diff (dep path) (sv formatted) in
+  (format_rule, diff_action)
+
+let rules_for_file loc ocamlformat kind (src:Module.File.t) =
+  match src.syntax with
+  | Reason -> None
+  | OCaml -> Some (rules_for_ocaml_file loc ocamlformat kind src.path)
+
+module Value = struct
+  type t = Module.t
+  type key = Module.Name.t
+  let key m = Module.name m
+end
+
+module OSL = Ordered_set_lang.Make(Module.Name)(Value)
+
+let iter_modules loc all_modules modules_to_format ~f =
+  let parse ~loc:_ s =
+    let name = Module.Name.of_string s in
+    match Module.Name.Map.find all_modules name with
+    | Some m -> m
+    | None -> Errors.fail loc "Cannot find module %s" s
+  in
+  let modules =
+    OSL.eval
+      modules_to_format
+      ~standard:(Module.Name.Map.values all_modules)
+      ~parse
+  in
+  List.iter modules ~f
+
+let gen_rules sctx (buildable:Dune_file.Buildable.t) ~dir ~scope all_modules =
+  let loc = buildable.loc in
+  let add_alias action = add_alias_format sctx loc ~dir ~scope action in
+  let gen_rules_for_module ocamlformat m =
+    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
+    Module.iter m ~f:(fun kind src ->
+      Option.iter
+        ~f:setup_rules
+        (rules_for_file loc ocamlformat kind src))
+  in
+  match buildable.ocamlformat with
+  | No_format -> ()
+  | Format modules_to_format ->
+    match Bin.which "ocamlformat" with
+    | None ->
+      let msg = "Cannot find ocamlformat, skipping.\n" in
+      add_alias (Echo [sv msg])
+    | Some ocamlformat ->
+      iter_modules
+        loc
+        all_modules
+        modules_to_format
+        ~f:(gen_rules_for_module ocamlformat)

src/ocamlformat_rules.mli

@@ -0,0 +1,12 @@
+open Import
+
+(** Setup ocamlformat rules for the given [Buildable.t].
+    If ocamlformat is not available in $PATH, just display an error message
+    when the alias is built. *)
+val gen_rules :
+  Super_context.t
+  -> Dune_file.Buildable.t
+  -> dir:Path.t
+  -> scope:Scope.t
+  -> Module.t Module.Name.Map.t
+  -> unit

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

@@ -610,6 +610,14 @@
    test-cases/ocamldep-multi-stanzas
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name ocamlformat)
+ (deps (package dune) (source_tree test-cases/ocamlformat))
+ (action
+  (chdir
+   test-cases/ocamlformat
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name ocamllex-jbuild)
  (deps (package dune) (source_tree test-cases/ocamllex-jbuild))
@@ -960,6 +968,7 @@
   (alias ocaml-config-macro)
   (alias ocaml-syntax)
   (alias ocamldep-multi-stanzas)
+  (alias ocamlformat)
   (alias ocamllex-jbuild)
   (alias odoc)
   (alias odoc-unique-mlds)
@@ -1064,6 +1073,7 @@
   (alias ocaml-config-macro)
   (alias ocaml-syntax)
   (alias ocamldep-multi-stanzas)
+  (alias ocamlformat)
   (alias ocamllex-jbuild)
   (alias output-obj)
   (alias package-dep)

test/blackbox-tests/test-cases/ocamlformat/dune

@@ -0,0 +1,3 @@
+(executable
+ (name ignored)
+)

test/blackbox-tests/test-cases/ocamlformat/dune-project

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

test/blackbox-tests/test-cases/ocamlformat/exe/dune

@@ -0,0 +1,4 @@
+(executable
+ (name hello)
+ (ocamlformat)
+)

test/blackbox-tests/test-cases/ocamlformat/exe/hello.ml

@@ -0,0 +1,2 @@
+let () = print_endline
+"hello"

test/blackbox-tests/test-cases/ocamlformat/ignored.ml

@@ -0,0 +1,3 @@
+let () =
+  print_endline
+  "hello"

test/blackbox-tests/test-cases/ocamlformat/lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name lib)
+ (ocamlformat)
+)

test/blackbox-tests/test-cases/ocamlformat/lib/lib.ml.orig

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

test/blackbox-tests/test-cases/ocamlformat/lib/lib.mli

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

test/blackbox-tests/test-cases/ocamlformat/lib_osl/a.ml

@@ -0,0 +1,4 @@
+let
+n
+=
+1

test/blackbox-tests/test-cases/ocamlformat/lib_osl/b.ml

@@ -0,0 +1,4 @@
+let
+n
+=
+1

test/blackbox-tests/test-cases/ocamlformat/lib_osl/dune

@@ -0,0 +1,6 @@
+(library
+ (name lib_osl)
+ (ocamlformat
+  (modules :standard \ excluded)
+ )
+)

test/blackbox-tests/test-cases/ocamlformat/lib_osl/excluded.ml

@@ -0,0 +1,4 @@
+let
+n
+=
+1

test/blackbox-tests/test-cases/ocamlformat/lib_reason/dune

@@ -0,0 +1,4 @@
+(library
+ (name lib_reason)
+ (ocamlformat)
+)

test/blackbox-tests/test-cases/ocamlformat/lib_reason/ocaml_file.ml

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

test/blackbox-tests/test-cases/ocamlformat/lib_reason/ocaml_file.mli

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

test/blackbox-tests/test-cases/ocamlformat/lib_reason/reason_file.re

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

test/blackbox-tests/test-cases/ocamlformat/lib_reason/reason_file.rei

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

test/blackbox-tests/test-cases/ocamlformat/run.t

@@ -0,0 +1,28 @@
+Formatting can be checked using the @format target:
+
+  $ cp lib/lib.ml.orig lib/lib.ml
+  $ dune build @format --diff-command false
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false exe/hello.ml exe/hello.ml.formatted')
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false lib/lib.ml lib/lib.ml.formatted')
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false lib/lib.mli lib/lib.mli.formatted')
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false lib_osl/b.ml lib_osl/b.ml.formatted')
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false lib_osl/a.ml lib_osl/a.ml.formatted')
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false lib_reason/ocaml_file.ml lib_reason/ocaml_file.ml.formatted')
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false lib_reason/ocaml_file.mli lib_reason/ocaml_file.mli.formatted')
+            sh (internal) (exit 1)
+  (cd _build/default && /bin/sh -c 'false test/test.ml test/test.ml.formatted')
+  [1]
+
+And fixable files can be promoted:
+
+  $ dune promote lib/lib.ml
+  Promoting _build/default/lib/lib.ml.formatted to lib/lib.ml.
+  $ cat lib/lib.ml
+  let x = 1

test/blackbox-tests/test-cases/ocamlformat/test/dune

@@ -0,0 +1,4 @@
+(test
+ (name test)
+ (ocamlformat)
+)

test/blackbox-tests/test-cases/ocamlformat/test/test.ml

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