Allow (formatting ...) field in (env ...) stanza. (#3942)

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

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)
 -----------------
 

doc/dune-files.rst

@@ -1405,6 +1405,9 @@ Fields supported in ``<settings>`` are:
 - ``(coq (flags <flags>))``. This allows to pass options to Coq, see
   :ref:`coq-theory` for more details.
 
+- ``(formatting <settings>)``. This allows to set auto-formatting in the current
+  directory subtree, see :ref:`formatting`.
+
 .. _dune-subdirs:
 
 dirs (since 1.6)

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))

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
 

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

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

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 =

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 =

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
   }

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