From c79092a58901ca811e774b71f2fc491becb55fa4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 24 Nov 2020 07:55:44 +0100 Subject: [PATCH] Allow (formatting ...) field in (env ...) stanza. (#3942) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 3 + doc/dune-files.rst | 3 + src/dune_engine/dune_project.ml | 7 +- src/dune_engine/dune_project.mli | 2 +- src/dune_engine/format_config.ml | 115 +++++++++++------- src/dune_engine/format_config.mli | 10 +- src/dune_rules/dune_env.ml | 8 +- src/dune_rules/dune_env.mli | 1 + src/dune_rules/env_node.ml | 27 ++++ src/dune_rules/env_node.mli | 4 + src/dune_rules/gen_rules.ml | 4 +- src/dune_rules/super_context.ml | 7 +- src/dune_rules/super_context.mli | 3 + .../test-cases/formatting.t/run.t | 58 +++++++++ 14 files changed, 200 insertions(+), 52 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 1fdc1469f20..fd2ebc15174 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -83,6 +83,9 @@ Unreleased possible to use library dependencies shadowed by local modules (#3825, @rgrinberg) +- Allow (formatting ...) field in (env ...) stanza to set per-directory + formatting specification. (#3942, @nojb) + 2.7.1 (2/09/2020) ----------------- diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 8717dcdedb5..9ce7a026bd5 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -1405,6 +1405,9 @@ Fields supported in ```` are: - ``(coq (flags ))``. This allows to pass options to Coq, see :ref:`coq-theory` for more details. +- ``(formatting )``. This allows to set auto-formatting in the current + directory subtree, see :ref:`formatting`. + .. _dune-subdirs: dirs (since 1.6) diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml index 915088d6c48..503c60b5db7 100644 --- a/src/dune_engine/dune_project.ml +++ b/src/dune_engine/dune_project.ml @@ -238,7 +238,7 @@ let to_dyn ; ("file_key", string file_key) ; ("dialects", Dialect.DB.to_dyn dialects) ; ("explicit_js_mode", bool explicit_js_mode) - ; ("format_config", (option Format_config.to_dyn) format_config) + ; ("format_config", option Format_config.to_dyn format_config) ; ("strict_package_deps", bool strict_package_deps) ; ("cram", bool cram) ] @@ -562,7 +562,8 @@ let format_extension_key = let format_config t = let ext = find_extension_args t format_extension_key in let dune_lang = t.format_config in - Format_config.of_config ~ext ~dune_lang + let version = t.dune_version in + Format_config.of_config ~ext ~dune_lang ~version let default_name ~dir ~(packages : Package.t Package.Name.Map.t) = match Package.Name.Map.min_binding packages with @@ -682,7 +683,7 @@ let parse ~dir ~lang ~opam_packages ~file = and+ explicit_js_mode = field_o_b "explicit_js_mode" ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 11)) - and+ format_config = Format_config.field + and+ format_config = Format_config.field ~since:(2, 0) and+ strict_package_deps = field_o_b "strict_package_deps" ~check:(Dune_lang.Syntax.since Stanza.syntax (2, 3)) diff --git a/src/dune_engine/dune_project.mli b/src/dune_engine/dune_project.mli index 9d069ab0ace..243e2e12efb 100644 --- a/src/dune_engine/dune_project.mli +++ b/src/dune_engine/dune_project.mli @@ -71,7 +71,7 @@ val dialects : t -> Dialect.DB.t val explicit_js_mode : t -> bool -val format_config : t -> Format_config.t option +val format_config : t -> Format_config.t val equal : t -> t -> bool diff --git a/src/dune_engine/format_config.ml b/src/dune_engine/format_config.ml index 8ad47c9ef7e..497ae06fdde 100644 --- a/src/dune_engine/format_config.ml +++ b/src/dune_engine/format_config.ml @@ -11,23 +11,36 @@ let syntax = ] module Language = struct - type t = - | Dialect of string - | Dune - - let to_dyn = - let open Dyn.Encoder in - function - | Dialect name -> constr "dialect" [ string name ] - | Dune -> constr "dune" [] + module Key = struct + type t = + | Dialect of string + | Dune + + let compare t1 t2 = + match (t1, t2) with + | Dune, Dune -> Eq + | Dune, Dialect _ -> Lt + | Dialect _, Dune -> Gt + | Dialect s1, Dialect s2 -> String.compare s1 s2 + + let to_dyn = + let open Dyn.Encoder in + function + | Dialect name -> constr "dialect" [ string name ] + | Dune -> constr "dune" [] + end + + module Map = Map.Make (Key) + module Set = Set.Make (Key) (Map) + include Key let of_string = function | "dune" -> Dune | s -> Dialect s - let in_ext_1_0 = [ Dialect "ocaml"; Dialect "reason" ] + let in_ext_1_0 = Set.of_list [ Dialect "ocaml"; Dialect "reason" ] - let in_ext_1_1 = Dune :: in_ext_1_0 + let in_ext_1_1 = Set.add in_ext_1_0 Dune let encode = let open Dune_lang.Encoder in @@ -38,18 +51,18 @@ end module Enabled_for = struct type t = - | Only of Language.t list + | Only of Language.Set.t | All let to_dyn = let open Dyn.Encoder in function - | Only l -> constr "only" (List.map ~f:Language.to_dyn l) + | Only l -> constr "only" [ Language.Set.to_dyn l ] | All -> string "all" let includes t = match t with - | Only l -> List.mem ~set:l + | Only l -> Language.Set.mem l | All -> fun _ -> true let field = field_o "enabled_for" (repeat (map ~f:Language.of_string string)) @@ -58,13 +71,19 @@ module Enabled_for = struct let+ list_opt = field and+ ext_version = Dune_lang.Syntax.get_exn syntax in match (list_opt, ext_version) with - | Some l, _ -> Only l + | Some l, _ -> Only (Language.Set.of_list l) | None, (1, 0) -> Only Language.in_ext_1_0 | None, (1, 1) -> Only Language.in_ext_1_1 | None, (1, 2) -> All | None, _ -> Code_error.raise "This fmt version does not exist" [ ("version", Dune_lang.Syntax.Version.to_dyn ext_version) ] + + let equal t1 t2 = + match (t1, t2) with + | All, All -> true + | Only l1, Only l2 -> Language.Set.equal l1 l2 + | _ -> false end type 'enabled_for generic_t = @@ -86,36 +105,41 @@ let dparse_args = ({ loc; enabled_for }, []) let dune2_record_syntax = + let+ ef = Enabled_for.field in + match ef with + | Some l -> Enabled_for.Only (Language.Set.of_list l) + | None -> All + +let dune2_dec = let+ loc = loc - and+ ef = Enabled_for.field in - let enabled_for = - match ef with - | Some l -> Enabled_for.Only l - | None -> All + and+ enabled_for = + keyword "disabled" + >>> return (Enabled_for.Only Language.Set.empty) + <|> fields dune2_record_syntax in - Some { loc; enabled_for } + { loc; enabled_for } -let dune2_dec = - keyword "disabled" >>> return None <|> fields dune2_record_syntax +let enabled_for_all = { loc = Loc.none; enabled_for = Enabled_for.All } -let dune2_default = Some { loc = Loc.none; enabled_for = Enabled_for.All } +let disabled = + { loc = Loc.none; enabled_for = Enabled_for.Only Language.Set.empty } -let field_dune2 = field "formatting" dune2_dec ~default:dune2_default +let field ~since = + field_o "formatting" (Dune_lang.Syntax.since Stanza.syntax since >>> dune2_dec) -let field = - let* dune_lang_version = Dune_lang.Syntax.get_exn Stanza.syntax in - match Dune_lang.Syntax.Version.compare dune_lang_version (2, 0) with - | Lt -> return None - | Gt - | Eq -> - field_dune2 +let is_empty = function + | { enabled_for = Enabled_for.Only l; _ } -> Language.Set.is_empty l + | { enabled_for = All; _ } -> false let loc t = t.loc -let encode_formatting { loc = _; enabled_for } = +let encode_formatting enabled_for = let open Dune_lang.Encoder in record_fields - [ field_i "enabled_for" (List.map ~f:Language.encode) enabled_for ] + [ field_i "enabled_for" + (List.map ~f:Language.encode) + (Language.Set.to_list enabled_for) + ] let encode_explicit conf = let open Dune_lang.Encoder in @@ -126,16 +150,21 @@ let to_explicit { loc; enabled_for } = | Enabled_for.All -> None | Only l -> Some { loc; enabled_for = l } -let of_config ~ext ~dune_lang = - match (ext, dune_lang) with - | None, None -> None - | Some x, None -> Some x - | None, Some x -> Some x - | Some ext, Some _ -> +let of_config ~ext ~dune_lang ~version = + let dune2 = version >= (2, 0) in + match (ext, dune_lang, dune2) with + | None, None, true -> enabled_for_all + | None, None, false -> disabled + | Some x, None, false + | None, Some x, true -> + x + | _, Some _, false -> + Code_error.raise "(formatting ...) stanza requires version 2.0" [] + | Some ext, _, true -> let suggestion = match to_explicit ext with - | Some explicit -> - let dlang = encode_explicit explicit in + | Some { enabled_for; _ } -> + let dlang = encode_explicit enabled_for in [ Pp.textf "To port it to the new syntax, you can replace this part by:" ; Pp.tag User_message.Style.Details (Dune_lang.pp dlang) ] @@ -146,3 +175,5 @@ let of_config ~ext ~dune_lang = ( Pp.textf "Starting with (lang dune 2.0), formatting is enabled by default." :: suggestion ) + +let equal { enabled_for; _ } t = Enabled_for.equal enabled_for t.enabled_for diff --git a/src/dune_engine/format_config.mli b/src/dune_engine/format_config.mli index 9313620e48a..f8de91d640e 100644 --- a/src/dune_engine/format_config.mli +++ b/src/dune_engine/format_config.mli @@ -13,7 +13,8 @@ end type t -val of_config : ext:t option -> dune_lang:t option -> t option +val of_config : + ext:t option -> dune_lang:t option -> version:Dune_lang.Syntax.Version.t -> t (** The syntax corresponding to the dune 1.x [(using fmt)] extension. *) val syntax : Dune_lang.Syntax.t @@ -25,10 +26,15 @@ val loc : t -> Loc.t (** Should we emit formatting rules for a particular [language]? *) val includes : t -> Language.t -> bool +val is_empty : t -> bool + (** Parse arguments for the 1.x extension. *) val dparse_args : (t * Stanza.Parser.t list) Dune_lang.Decoder.t val to_dyn : t -> Dyn.t (** Parse the contents of the dune2 [(formatting)] option.*) -val field : t option Dune_lang.Decoder.fields_parser +val field : + since:Dune_lang.Syntax.Version.t -> t option Dune_lang.Decoder.fields_parser + +val equal : t -> t -> bool diff --git a/src/dune_rules/dune_env.ml b/src/dune_rules/dune_env.ml index 965d980c063..470cfe87461 100644 --- a/src/dune_rules/dune_env.ml +++ b/src/dune_rules/dune_env.ml @@ -80,6 +80,7 @@ module Stanza = struct ; menhir_flags : Ordered_set_lang.Unexpanded.t ; odoc : Odoc.t ; coq : Ordered_set_lang.Unexpanded.t + ; format_config : Format_config.t option } let equal_config @@ -91,6 +92,7 @@ module Stanza = struct ; menhir_flags ; odoc ; coq + ; format_config } t = Ocaml_flags.Spec.equal flags t.flags && Foreign_language.Dict.equal Ordered_set_lang.Unexpanded.equal @@ -101,6 +103,7 @@ module Stanza = struct && Ordered_set_lang.Unexpanded.equal menhir_flags t.menhir_flags && Odoc.equal odoc t.odoc && Ordered_set_lang.Unexpanded.equal coq t.coq + && Option.equal Format_config.equal format_config t.format_config let hash_config = Hashtbl.hash @@ -114,6 +117,7 @@ module Stanza = struct ; menhir_flags = Ordered_set_lang.Unexpanded.standard ; odoc = Odoc.empty ; coq = Ordered_set_lang.Unexpanded.standard + ; format_config = None } type pattern = @@ -177,7 +181,8 @@ module Stanza = struct and+ inline_tests = inline_tests_field and+ menhir_flags = menhir_flags ~since:(Some (2, 1)) and+ odoc = odoc_field - and+ coq = coq_field in + and+ coq = coq_field + and+ format_config = Format_config.field ~since:(2, 8) in { flags ; foreign_flags ; env_vars @@ -186,6 +191,7 @@ module Stanza = struct ; menhir_flags ; odoc ; coq + ; format_config } let rule = diff --git a/src/dune_rules/dune_env.mli b/src/dune_rules/dune_env.mli index 1421bfa3d21..6862c72bd34 100644 --- a/src/dune_rules/dune_env.mli +++ b/src/dune_rules/dune_env.mli @@ -34,6 +34,7 @@ module Stanza : sig ; menhir_flags : Ordered_set_lang.Unexpanded.t ; odoc : Odoc.t ; coq : Ordered_set_lang.Unexpanded.t + ; format_config : Format_config.t option } type pattern = diff --git a/src/dune_rules/env_node.ml b/src/dune_rules/env_node.ml index fce3e9c4a33..7ae7657c064 100644 --- a/src/dune_rules/env_node.ml +++ b/src/dune_rules/env_node.ml @@ -24,6 +24,7 @@ type t = ; menhir_flags : string list Build.t Memo.Lazy.t ; odoc : Odoc.t Memo.Lazy.t ; coq : Coq.t Memo.Lazy.t + ; format_config : Format_config.t Memo.Lazy.t } let scope t = t.scope @@ -42,6 +43,11 @@ let inline_tests t = Memo.Lazy.force t.inline_tests let menhir_flags t = Memo.Lazy.force t.menhir_flags +let format_config t = Memo.Lazy.force t.format_config + +let set_format_config t format_config = + { t with format_config = Memo.Lazy.of_val format_config } + let odoc t = Memo.Lazy.force t.odoc let coq t = Memo.Lazy.force t.coq @@ -57,6 +63,16 @@ let make ~dir ~inherit_from ~scope ~config_stanza ~profile ~expander | None -> root | Some t -> field (Memo.Lazy.force t) )) in + let inherited_if_absent ~field ~root f_absent = + Memo.lazy_ (fun () -> + match root with + | None -> + f_absent + ( match inherit_from with + | None -> None + | Some t -> Some (field (Memo.Lazy.force t)) ) + | Some x -> x) + in let local_binaries = inherited ~field:local_binaries ~root:[] (fun binaries -> binaries @@ -131,6 +147,16 @@ let make ~dir ~inherit_from ~scope ~config_stanza ~profile ~expander { warnings = Option.value config.odoc.warnings ~default:warnings }) in let coq = inherited ~field:coq ~root:config.coq (fun x -> x) in + let format_config = + inherited_if_absent ~field:format_config ~root:config.format_config + (function + | None -> + Code_error.raise + "format config should always have a default value taken from the \ + project root" + [] + | Some x -> x) + in { scope ; ocaml_flags ; foreign_flags @@ -141,4 +167,5 @@ let make ~dir ~inherit_from ~scope ~config_stanza ~profile ~expander ; menhir_flags ; odoc ; coq + ; format_config } diff --git a/src/dune_rules/env_node.mli b/src/dune_rules/env_node.mli index 8f9f45d9212..a1ed8576190 100644 --- a/src/dune_rules/env_node.mli +++ b/src/dune_rules/env_node.mli @@ -49,3 +49,7 @@ val odoc : t -> Odoc.t val coq : t -> Coq.t val menhir_flags : t -> string list Build.t + +val format_config : t -> Format_config.t + +val set_format_config : t -> Format_config.t -> t diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index f14946078d7..40e15781e0d 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -153,8 +153,8 @@ end * See: https://github.com/ocaml/dune/pull/1354#issuecomment-427922592 *) let with_format sctx ~dir ~f = - Super_context.find_scope_by_dir sctx dir - |> Scope.project |> Dune_project.format_config |> Option.iter ~f + let f config = if not (Format_config.is_empty config) then f config in + Super_context.format_config sctx ~dir |> f let gen_format_rules sctx ~expander ~output_dir = let scope = Super_context.find_scope_by_dir sctx output_dir in diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index 5d1fbf618df..f36ba8463fd 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -106,7 +106,10 @@ end = struct let scope = Scope.DB.find_by_dir t.scopes dir in let inherit_from = if Path.Build.equal dir (Scope.root scope) then - t.default_env + let format_config = Dune_project.format_config (Scope.project scope) in + Memo.lazy_ (fun () -> + let default_env = Memo.Lazy.force t.default_env in + Env_node.set_format_config default_env format_config) else match Path.Build.parent dir with | None -> @@ -352,6 +355,8 @@ let odoc t ~dir = get_node t.env_tree ~dir |> Env_node.odoc let coq t ~dir = get_node t.env_tree ~dir |> Env_node.coq +let format_config t ~dir = get_node t.env_tree ~dir |> Env_node.format_config + let dump_env t ~dir = let t = t.env_tree in let open Build.O in diff --git a/src/dune_rules/super_context.mli b/src/dune_rules/super_context.mli index ba816b1b907..280d13eef89 100644 --- a/src/dune_rules/super_context.mli +++ b/src/dune_rules/super_context.mli @@ -82,6 +82,9 @@ val odoc : t -> dir:Path.Build.t -> Env_node.Odoc.t (** coq config in the corresponding [(env)] stanza. *) val coq : t -> dir:Path.Build.t -> Env_node.Coq.t +(** Formatting settings in the corresponding [(env)] stanza. *) +val format_config : t -> dir:Path.Build.t -> Format_config.t + (** Dump a directory environment in a readable form *) val dump_env : t -> dir:Path.Build.t -> Dune_lang.t list Build.t diff --git a/test/blackbox-tests/test-cases/formatting.t/run.t b/test/blackbox-tests/test-cases/formatting.t/run.t index d60b036546c..6cd4ddbaa5c 100644 --- a/test/blackbox-tests/test-cases/formatting.t/run.t +++ b/test/blackbox-tests/test-cases/formatting.t/run.t @@ -177,3 +177,61 @@ Sometimes, the suggestion is to just remove the configuration. Error: Starting with (lang dune 2.0), formatting is enabled by default. To port it to the new syntax, you can delete this part. [1] + +Formatting can also be set in the (env ...) stanza + + $ mkdir -p using-env + $ cat >using-env/dune-project < (lang dune 2.7) + > EOF + $ cat >using-env/dune < (env (_ (formatting disabled))) + > EOF + $ mkdir -p using-env/subdir + $ cat >using-env/subdir/dune < (executable (name foo)) + > EOF + $ cat >using-env/subdir/foo.ml < let x = 12 + > EOF + $ (cd using-env && dune build @fmt) + File "dune", line 1, characters 8-29: + 1 | (env (_ (formatting disabled))) + ^^^^^^^^^^^^^^^^^^^^^ + Error: 'formatting' is only available since version 2.8 of the dune language. + Please update your dune-project file to have (lang dune 2.8). + [1] + $ cat >using-env/dune-project < (lang dune 2.8) + > EOF + $ (cd using-env && dune build @fmt) + $ cat >using-env/dune < (env (_ (formatting (enabled_for ocaml)))) + > EOF + $ touch using-env/.ocamlformat + $ (cd using-env && dune build @fmt) + File "subdir/foo.ml", line 1, characters 0-0: + Error: Files _build/default/subdir/foo.ml and + _build/default/subdir/.formatted/foo.ml differ. + [1] + +We check that the formatting stanza in (env ...) takes precedence over that in +dune-project: + + $ cat >>using-env/dune-project < (formatting disabled) + > EOF + $ (cd using-env && dune build @fmt) + File "subdir/foo.ml", line 1, characters 0-0: + Error: Files _build/default/subdir/foo.ml and + _build/default/subdir/.formatted/foo.ml differ. + [1] + +Next we check that the new logic does not interfere with default per-project +settings as dictated by the dune language version. + + $ cat >using-env/subdir/dune-project < (lang dune 1.7) + > ;; formatting disabled by default + > EOF + $ (cd using-env && dune build @fmt)