diff --git a/src/action_dune_lang.ml b/src/action_dune_lang.ml index 0e1354b1e9fb..1094f9d1fc3a 100644 --- a/src/action_dune_lang.ml +++ b/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) diff --git a/src/action_dune_lang.mli b/src/action_dune_lang.mli index 94cfea67ed80..7c8e137e0c5e 100644 --- a/src/action_dune_lang.mli +++ b/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 diff --git a/src/dialect.ml b/src/dialect.ml index 24c813e1ff4a..d1680c52e110 100644 --- a/src/dialect.ml +++ b/src/dialect.ml @@ -1,28 +1,11 @@ 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 } = @@ -30,8 +13,8 @@ module File_kind = struct 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 diff --git a/src/dialect.mli b/src/dialect.mli index 714ec3a35eb0..a878da250cff 100644 --- a/src/dialect.mli +++ b/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 diff --git a/src/format_rules.ml b/src/format_rules.ml index ce97fa7fba1d..3bbe2fa54086 100644 --- a/src/format_rules.ml +++ b/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 diff --git a/src/preprocessing.ml b/src/preprocessing.ml index eb48b4b4b9ed..a8a14aba10b3 100644 --- a/src/preprocessing.ml +++ b/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)