Elaborate ocamlformat rule from dialect definition

Signed-off-by: Nicolás Ojeda Bär <[email protected]>

src/action_dune_lang.ml

@@ -43,3 +43,6 @@ let decode =
              "if you meant for this to be executed with bash, write \
               (bash \"...\") instead"
          ])
+
+let to_dyn a =
+  Dune_lang.to_dyn (encode a)

src/action_dune_lang.mli

@@ -18,3 +18,5 @@ include Action_intf.Helpers
   type path = String_with_vars.t
 
 val compare_no_locs : t -> t -> Ordering.t
+
+val to_dyn : t -> Dyn.t

src/dialect.ml

@@ -1,37 +1,20 @@
 open! Stdune
 
-module Filter = struct
-  type t =
-    | No_filter
-    | Action of Loc.t * Action_dune_lang.t
-
-  open Dyn.Encoder
-
-  let to_dyn = function
-    | No_filter ->
-        constr "no_filter" []
-    | Action (loc, action) ->
-        constr "action"
-          [ Loc.to_dyn loc
-          ; Dune_lang.to_dyn (Action_dune_lang.encode action)
-          ]
-end
-
 module File_kind = struct
   type t =
     { kind       : Ml_kind.t
     ; extension  : string
-    ; preprocess : Filter.t
-    ; format     : Filter.t
+    ; preprocess : (Loc.t * Action_dune_lang.t) option
+    ; format     : (Loc.t * Action_dune_lang.t * string list) option
     }
 
   let to_dyn { kind ; extension ; preprocess ; format } =
     let open Dyn.Encoder in
     record
       [ "kind"      , Ml_kind.to_dyn kind
       ; "extension" , string extension
-      ; "preprocess", Filter.to_dyn preprocess
-      ; "format"    , Filter.to_dyn format
+      ; "preprocess", option (pair Loc.to_dyn Action_dune_lang.to_dyn) preprocess
+      ; "format"    , option (triple Loc.to_dyn Action_dune_lang.to_dyn (list string)) format
       ]
 end
 
@@ -52,14 +35,9 @@ let to_dyn { name ; file_kinds } =
 let decode =
   let open Dune_lang.Decoder in
   let kind kind =
-    let filter name =
-      let f (loc, action) = Filter.Action (loc, action) in
-      field name ~default:Filter.No_filter
-        (map ~f (located Action_dune_lang.decode))
-    in
     let+ extension  = field "extension" (map ~f:(fun s -> "." ^ s) string)
-    and+ preprocess = filter "preprocess"
-    and+ format     = filter "format"
+    and+ preprocess = field_o "preprocess" (located Action_dune_lang.decode)
+    and+ format     = field_o "format" (map ~f:(fun (loc, x) -> loc, x, []) (located Action_dune_lang.decode))
     in
     { File_kind.kind ; extension ; preprocess ; format }
   in
@@ -82,12 +60,22 @@ let format { file_kinds = { Ml_kind.Dict.intf ; impl } ; _ } = function
   | Impl         -> impl.format
 
 let ocaml =
+  let format kind =
+    let flag_of_kind = function
+      | Ml_kind.Impl -> "--impl"
+      | Intf         -> "--intf"
+    in
+    let module S = String_with_vars in
+    Action_dune_lang.chdir (S.virt_var __POS__ "workspace_root")
+      (Action_dune_lang.run (S.virt __POS__ "ocamlformat")
+         [ S.virt __POS__ (flag_of_kind kind) ; S.virt_var __POS__ "input-file" ])
+  in
   let file_kind kind extension =
     { File_kind.
       kind
     ; extension
-    ; preprocess = Filter.No_filter
-    ; format     = Filter.No_filter
+    ; preprocess = None
+    ; format     = Some (Loc.none, format kind, [ ".ocamlformat" ; ".ocamlformat-ignore" ])
     }
   in
   let intf = file_kind Ml_kind.Intf ".mli" in
@@ -114,8 +102,8 @@ let reason =
     { File_kind.
       kind
     ; extension
-    ; preprocess = Filter.Action (Loc.none, preprocess)
-    ; format     = Filter.Action (Loc.none, format)
+    ; preprocess = Some (Loc.none, preprocess)
+    ; format     = Some (Loc.none, format, [])
     }
   in
   let intf = file_kind Ml_kind.Intf ".rei" in
@@ -126,7 +114,7 @@ let reason =
 
 let ml_suffix { file_kinds = { Ml_kind.Dict.intf ; impl } ; _ } ml_kind =
   match ml_kind, intf.preprocess, impl.preprocess with
-  | Ml_kind.Intf, Filter.No_filter, _ | Impl, _, No_filter -> None
+  | Ml_kind.Intf, None, _ | Impl, _, None -> None
   | _ -> Some (extension ocaml ml_kind)
 
 module S = struct

src/dialect.mli

@@ -19,14 +19,6 @@ open! Stdune
     but a way to specify custom file extensions for OCaml code.
 *)
 
-module Filter : sig
-  type t =
-    | No_filter
-    | Action of Loc.t * Action_dune_lang.t
-
-  val to_dyn : t -> Dyn.t
-end
-
 type t
 
 val name : t -> string
@@ -37,9 +29,9 @@ val decode : t Dune_lang.Decoder.t
 
 val extension : t -> Ml_kind.t -> string
 
-val preprocess : t -> Ml_kind.t -> Filter.t
+val preprocess : t -> Ml_kind.t -> (Loc.t * Action_dune_lang.t) option
 
-val format : t -> Ml_kind.t -> Filter.t
+val format : t -> Ml_kind.t -> (Loc.t * Action_dune_lang.t * string list) option
 
 val ocaml : t
 

src/format_rules.ml

@@ -1,10 +1,5 @@
 open Import
 
-let flag_of_kind : Ml_kind.t -> _ =
-  function
-  | Impl -> "--impl"
-  | Intf -> "--intf"
-
 let add_diff sctx loc alias ~dir ~input ~output =
   let open Build.O in
   let action = Action.diff input output in
@@ -37,31 +32,12 @@ let gen_rules_output sctx (config : Dune_file.Auto_format.t) ~dialects ~expander
   let alias_formatted = Alias.fmt ~dir:output_dir in
   let resolve_program =
     Super_context.resolve_program ~dir sctx ~loc:(Some loc) in
-  let ocamlformat_deps = lazy (
-    depend_on_files ~named:[".ocamlformat"; ".ocamlformat-ignore"]
-      (Path.source source_dir)
-  ) in
+  let depend_on_files named = depend_on_files ~named (Path.source source_dir) in
   let setup_formatting file =
     let input_basename = Path.Source.basename file in
     let input = Path.Build.relative dir input_basename in
     let output = Path.Build.relative output_dir input_basename in
 
-    let ocaml kind =
-      let exe = resolve_program "ocamlformat" in
-      let args =
-        [ Command.Args.A (flag_of_kind kind)
-        ; Dep (Path.build input)
-        ; A "--name"
-        ; Path (Path.source file)
-        ; A "-o"
-        ; Target output
-        ]
-      in
-      Build.S.seq (Build.S.ignore (Lazy.force ocamlformat_deps))
-        (Command.run
-           ~dir:(Path.build (Super_context.build_dir sctx)) exe args)
-    in
-
     let formatter =
       let input = Path.build input in
       match Path.Source.basename file with
@@ -73,25 +49,35 @@ let gen_rules_output sctx (config : Dune_file.Auto_format.t) ~dialects ~expander
       | _ ->
         let ext = Path.Source.extension file in
         begin match Dialect.S.find_by_extension dialects ext with
-        | Some (dialect, kind) when Dialect.name dialect = "ocaml" ->
-          if Dune_file.Auto_format.includes config (Dialect "ocaml") then
-            Some (ocaml kind)
-          else
-            None
         | Some (dialect, kind) ->
           if not (Dune_file.Auto_format.includes config (Dialect (Dialect.name dialect))) then
             None
           else begin
-            match Dialect.format dialect kind with
-            | Dialect.Filter.No_filter ->
-              begin match Dialect.preprocess dialect kind with
-              | Dialect.Filter.No_filter -> Some (ocaml kind)
-              | Action _ -> None
-              end
-            | Action (loc, action) ->
+            let format =
+              match Dialect.format dialect kind with
+              | Some _ as action ->
+                action
+              | None ->
+                begin match Dialect.preprocess dialect kind with
+                | None -> Dialect.format Dialect.ocaml kind
+                | Some _ -> None
+                end
+            in
+            match format with
+            | None ->
+              None
+            | Some (loc, action, extra_deps) ->
               let src = Path.as_in_build_dir_exn input in
-              Some (Preprocessing.action_for_pp sctx ~dep_kind:Lib_deps_info.Kind.Required
-                      ~loc ~expander ~action ~src ~target:(Some output))
+              let extra_deps =
+                match extra_deps with
+                | [] ->
+                    Build.return ()
+                | extra_deps ->
+                    Build.S.ignore (depend_on_files extra_deps)
+              in
+              Some (Build.S.seq extra_deps
+                      (Preprocessing.action_for_pp sctx ~dep_kind:Lib_deps_info.Kind.Required
+                         ~loc ~expander ~action ~src ~target:(Some output)))
           end
         | None -> None
         end

src/preprocessing.ml

@@ -663,8 +663,8 @@ let setup_dialect_rules sctx ~dir ~dep_kind ~expander (m : Module.t) =
   let ml = Module.ml_source m in
   Module.iter m ~f:(fun ml_kind f ->
     match Dialect.preprocess f.dialect ml_kind with
-    | Dialect.Filter.No_filter -> ()
-    | Action (loc, action) ->
+    | None -> ()
+    | Some (loc, action) ->
       let src = Path.as_in_build_dir_exn f.path in
       let dst =
         Option.value_exn (Module.file ml ~ml_kind)