From 10ad8e5117f205419e509cca7221236c7ae38a06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 9 Nov 2020 14:26:07 +0100 Subject: [PATCH 1/5] dune formatting: style tweaks MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_engine/format_dune_lang.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune_engine/format_dune_lang.ml b/src/dune_engine/format_dune_lang.ml index f1a0e50bb00..e9065fad51b 100644 --- a/src/dune_engine/format_dune_lang.ml +++ b/src/dune_engine/format_dune_lang.ml @@ -34,7 +34,7 @@ let pp_simple fmt t = |> Dune_lang.Deprecated.pp fmt let print_wrapped_list fmt = - Format.fprintf fmt "(@[%a@])" + Format.fprintf fmt "@[(%a)@]" (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ") pp_simple) From 382c8624a6894fbd3c24a2bbb8f67bf456aea27f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 9 Nov 2020 14:32:38 +0100 Subject: [PATCH 2/5] Update tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/describe.t/run.t | 32 +++++++++---------- .../test-cases/format-dune-file.t/run.t | 13 ++++++-- 2 files changed, 27 insertions(+), 18 deletions(-) diff --git a/test/blackbox-tests/test-cases/describe.t/run.t b/test/blackbox-tests/test-cases/describe.t/run.t index 2c9d53d79a3..bce21e92422 100644 --- a/test/blackbox-tests/test-cases/describe.t/run.t +++ b/test/blackbox-tests/test-cases/describe.t/run.t @@ -42,11 +42,11 @@ Describe various things (requires (c17373aee51bab94097b4b7818553cf3 5dd4bd87ad37b4f5713085aff4bee9c9)) (modules - (((name Main) - (impl (_build/default/main.ml)) - (intf ()) - (cmt (_build/default/.main.eobjs/byte/dune__exe__Main.cmt)) - (cmti ())))) + (((name Main) + (impl (_build/default/main.ml)) + (intf ()) + (cmt (_build/default/.main.eobjs/byte/dune__exe__Main.cmt)) + (cmti ())))) (include_dirs (_build/default/.main.eobjs/byte)))) (library ((name foo) @@ -55,11 +55,11 @@ Describe various things (requires (c17373aee51bab94097b4b7818553cf3)) (source_dir _build/default) (modules - (((name Foo) - (impl (_build/default/foo.ml)) - (intf ()) - (cmt (_build/default/.foo.objs/byte/foo.cmt)) - (cmti ())))) + (((name Foo) + (impl (_build/default/foo.ml)) + (intf ()) + (cmt (_build/default/.foo.objs/byte/foo.cmt)) + (cmti ())))) (include_dirs (_build/default/.foo.objs/byte)))) (library ((name foo.x) @@ -68,11 +68,11 @@ Describe various things (requires ()) (source_dir _build/default) (modules - (((name Foo_x) - (impl (_build/default/foo_x.ml)) - (intf ()) - (cmt (_build/default/.foo_x.objs/byte/foo_x.cmt)) - (cmti ())))) + (((name Foo_x) + (impl (_build/default/foo_x.ml)) + (intf ()) + (cmt (_build/default/.foo_x.objs/byte/foo_x.cmt)) + (cmti ())))) (include_dirs (_build/default/.foo_x.objs/byte))))) Test other formats @@ -107,7 +107,7 @@ opam file listing $ dune describe --lang 0.1 opam-files | dune_cmd expand_lines ((foo.opam - "# This file is generated by dune, edit dune-project instead + "# This file is generated by dune, edit dune-project instead opam-version: \"2.0\" synopsis: \"foo bar baz\" depends: [ diff --git a/test/blackbox-tests/test-cases/format-dune-file.t/run.t b/test/blackbox-tests/test-cases/format-dune-file.t/run.t index 3ea083a7e9c..fad19762cb4 100644 --- a/test/blackbox-tests/test-cases/format-dune-file.t/run.t +++ b/test/blackbox-tests/test-cases/format-dune-file.t/run.t @@ -52,8 +52,17 @@ it gets wrapped. $ echo '(library (name dune) (libraries unix stdune fiber xdg dune_re threads opam_file_format dune_lang ocaml_config which_program) (synopsis "Internal Dune library, do not use!") (preprocess (action (run %{project_root}/src/let-syntax/pp.exe %{input-file}))))' | dune format-dune-file (library (name dune) - (libraries unix stdune fiber xdg dune_re threads opam_file_format dune_lang - ocaml_config which_program) + (libraries + unix + stdune + fiber + xdg + dune_re + threads + opam_file_format + dune_lang + ocaml_config + which_program) (synopsis "Internal Dune library, do not use!") (preprocess (action From ddbc8bfcab8a683097a2e7af9f594539bc3c3f1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 9 Nov 2020 16:02:35 +0100 Subject: [PATCH 3/5] make fmt MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- bin/dune | 17 ++++++++++++-- otherlibs/action-plugin/src/dune | 2 +- src/dune_engine/dune | 26 +++++++++++++++++---- src/dune_rules/dune | 28 +++++++++++++++++++---- test/blackbox-tests/utils/dune | 6 +++-- test/dune | 4 ++-- test/expect-tests/dune_action_plugin/dune | 10 ++++++-- 7 files changed, 76 insertions(+), 17 deletions(-) diff --git a/bin/dune b/bin/dune index 0bccec73fa2..a4b1d5d6e19 100644 --- a/bin/dune +++ b/bin/dune @@ -1,7 +1,20 @@ (executable (name main) - (libraries memo dune_lang fiber stdune unix cache_daemon cache dune_rules - dune_engine dune_util cmdliner threads.posix build_info dune_csexp) + (libraries + memo + dune_lang + fiber + stdune + unix + cache_daemon + cache + dune_rules + dune_engine + dune_util + cmdliner + threads.posix + build_info + dune_csexp) (bootstrap_info bootstrap-info)) (rule diff --git a/otherlibs/action-plugin/src/dune b/otherlibs/action-plugin/src/dune index 522a26029c1..23570059c91 100644 --- a/otherlibs/action-plugin/src/dune +++ b/otherlibs/action-plugin/src/dune @@ -3,4 +3,4 @@ (public_name dune-action-plugin) (libraries dune-private-libs.stdune dune-glob dune-private-libs.dune_csexp) (synopsis - "[Internal] Monadic interface for defining scripts with dynamic or complex sets of depencencies.")) + "[Internal] Monadic interface for defining scripts with dynamic or complex sets of depencencies.")) diff --git a/src/dune_engine/dune b/src/dune_engine/dune index d372cc3fc78..216b8f51935 100644 --- a/src/dune_engine/dune +++ b/src/dune_engine/dune @@ -2,10 +2,28 @@ (library (name dune_engine) - (libraries unix stdune fiber incremental_cycles dag memo xdg dune_re - threads.posix opam_file_format dune_lang cache_daemon cache dune_glob - ocaml_config catapult jbuild_support dune_action_plugin dune_util - build_path_prefix_map dune_section) + (libraries + unix + stdune + fiber + incremental_cycles + dag + memo + xdg + dune_re + threads.posix + opam_file_format + dune_lang + cache_daemon + cache + dune_glob + ocaml_config + catapult + jbuild_support + dune_action_plugin + dune_util + build_path_prefix_map + dune_section) (synopsis "Internal Dune library, do not use!")) (ocamllex dune_lexer) diff --git a/src/dune_rules/dune b/src/dune_rules/dune index 4feb0756448..efb4507257a 100644 --- a/src/dune_rules/dune +++ b/src/dune_rules/dune @@ -2,10 +2,30 @@ (library (name dune_rules) - (libraries unix stdune fiber incremental_cycles dag memo xdg dune_re - threads.posix opam_file_format dune_lang cache_daemon cache dune_glob - ocaml_config catapult jbuild_support dune_action_plugin dune_util - dune_meta_parser dune_section build_path_prefix_map dune_engine) + (libraries + unix + stdune + fiber + incremental_cycles + dag + memo + xdg + dune_re + threads.posix + opam_file_format + dune_lang + cache_daemon + cache + dune_glob + ocaml_config + catapult + jbuild_support + dune_action_plugin + dune_util + dune_meta_parser + dune_section + build_path_prefix_map + dune_engine) (synopsis "Internal Dune library, do not use!")) (ocamllex ocamlobjinfo cram_lexer) diff --git a/test/blackbox-tests/utils/dune b/test/blackbox-tests/utils/dune index c5a5e65a691..51a557e9d26 100644 --- a/test/blackbox-tests/utils/dune +++ b/test/blackbox-tests/utils/dune @@ -1,4 +1,6 @@ (executable (name dune_cmd) - (libraries dune-private-libs.stdune dune-private-libs.dune_re - dune-configurator)) + (libraries + dune-private-libs.stdune + dune-private-libs.dune_re + dune-configurator)) diff --git a/test/dune b/test/dune index f5c0b73bc20..c185b6d5d89 100644 --- a/test/dune +++ b/test/dune @@ -36,13 +36,13 @@ (glob_files *.{foo,bar})) (action (bash - "echo 'expected result: 10'\necho 'without locking:' $(< x)\necho 'with locking: ' $(< y)\nrm -f *.{foo,bar} x y"))) + "echo 'expected result: 10'\necho 'without locking:' $(< x)\necho 'with locking: ' $(< y)\nrm -f *.{foo,bar} x y"))) (rule (with-stdout-to incr.ml (echo - "let fn = Sys.argv.(1) in\nlet x =\n match open_in fn with\n | ic ->\n let x = int_of_string (input_line ic) in\n close_in ic;\n x\n | exception _ -> 0\nin\nUnix.sleepf 0.2;\nPrintf.fprintf (open_out fn) \"%d\\n\" (x + 1);\nPrintf.fprintf (open_out Sys.argv.(2)) \"%g\n%!\" (Sys.time ())\n"))) + "let fn = Sys.argv.(1) in\nlet x =\n match open_in fn with\n | ic ->\n let x = int_of_string (input_line ic) in\n close_in ic;\n x\n | exception _ -> 0\nin\nUnix.sleepf 0.2;\nPrintf.fprintf (open_out fn) \"%d\\n\" (x + 1);\nPrintf.fprintf (open_out Sys.argv.(2)) \"%g\n%!\" (Sys.time ())\n"))) (executable (name incr) diff --git a/test/expect-tests/dune_action_plugin/dune b/test/expect-tests/dune_action_plugin/dune index 42e521086f2..89c9cb48876 100644 --- a/test/expect-tests/dune_action_plugin/dune +++ b/test/expect-tests/dune_action_plugin/dune @@ -4,7 +4,13 @@ (name dune_action_unit_tests) (inline_tests (deps some_dir/some_file)) - (libraries dune_action_plugin ppx_expect.config ppx_expect.config_types - ppx_expect.common base ppx_inline_test.config dune-glob) + (libraries + dune_action_plugin + ppx_expect.config + ppx_expect.config_types + ppx_expect.common + base + ppx_inline_test.config + dune-glob) (preprocess (pps ppx_expect))) From e455b5a154e833117a292c69dfc976a9b5c8c6a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 13 Nov 2020 08:12:36 +0100 Subject: [PATCH 4/5] Use Pp instead for Format MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- bin/describe.ml | 3 +- bin/printenv.ml | 3 +- src/dune_engine/format_dune_lang.ml | 73 ++++++++++++---------------- src/dune_engine/format_dune_lang.mli | 2 +- src/dune_rules/upgrader.ml | 7 ++- 5 files changed, 42 insertions(+), 46 deletions(-) diff --git a/bin/describe.ml b/bin/describe.ml index d55ed21f783..eab55824676 100644 --- a/bin/describe.ml +++ b/bin/describe.ml @@ -287,7 +287,8 @@ let print_as_sexp dyn = |> Dune_lang.Ast.add_loc ~loc:Loc.none |> Dune_lang.Cst.concrete in - Dune_engine.Format_dune_lang.pp_top_sexps Stdlib.Format.std_formatter [ cst ] + Pp.to_fmt Stdlib.Format.std_formatter + (Dune_engine.Format_dune_lang.pp_top_sexps [ cst ]) let term = let+ common = Common.term diff --git a/bin/printenv.ml b/bin/printenv.ml index 0991835a1eb..5b911521573 100644 --- a/bin/printenv.ml +++ b/bin/printenv.ml @@ -29,7 +29,8 @@ let pp ppf ~fields sexps = if do_print then Dune_lang.Ast.add_loc sexp ~loc:Loc.none |> Dune_lang.Cst.concrete |> List.singleton - |> Format.fprintf ppf "%a@?" Dune_engine.Format_dune_lang.pp_top_sexps) + |> Dune_engine.Format_dune_lang.pp_top_sexps + |> Format.fprintf ppf "%a@?" Pp.to_fmt) let term = let+ common = Common.term diff --git a/src/dune_engine/format_dune_lang.ml b/src/dune_engine/format_dune_lang.ml index e9065fad51b..b80f4fbe878 100644 --- a/src/dune_engine/format_dune_lang.ml +++ b/src/dune_engine/format_dune_lang.ml @@ -1,5 +1,6 @@ open! Stdune open! Import +open Pp.O type dune_file = | OCaml_syntax of Loc.t @@ -29,73 +30,63 @@ let can_be_displayed_wrapped = | Comment _ -> false) -let pp_simple fmt t = +let pp_simple t = Dune_lang.Cst.abstract t |> Option.value_exn |> Dune_lang.Ast.remove_locs - |> Dune_lang.Deprecated.pp fmt + |> Dune_lang.pp -let print_wrapped_list fmt = - Format.fprintf fmt "@[(%a)@]" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ") - pp_simple) +let print_wrapped_list x = + Pp.hvbox ~indent:1 + (Pp.char '(' ++ Pp.concat_map ~sep:Pp.space ~f:pp_simple x ++ Pp.char ')') -let pp_comment_line fmt l = Format.fprintf fmt ";%s" l +let pp_comment_line l = Pp.char ';' ++ Pp.verbatim l -let pp_comment loc fmt (comment : Dune_lang.Cst.Comment.t) = +let pp_comment loc (comment : Dune_lang.Cst.Comment.t) = match comment with - | Lines ls -> - Format.fprintf fmt "@[%a@]" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@;") - pp_comment_line) - ls + | Lines ls -> Pp.vbox (Pp.concat_map ~sep:Pp.cut ~f:pp_comment_line ls) | Legacy -> User_error.raise ~loc [ Pp.text "Formatting is only supported with the dune syntax" ] -let pp_break fmt attached = +let pp_break attached = if attached then - Format.fprintf fmt " " + Pp.char ' ' else - Format.fprintf fmt "@," + Pp.cut -let pp_list_with_comments pp_sexp fmt sexps = - let rec go fmt (l : Dune_lang.Cst.t list) = +let pp_list_with_comments pp_sexp sexps = + let rec go (l : Dune_lang.Cst.t list) = match l with | x :: Comment (loc, c) :: xs -> let attached = Loc.on_same_line (Dune_lang.Cst.loc x) loc in - Format.fprintf fmt "%a%a%a@,%a" pp_sexp x pp_break attached - (pp_comment loc) c go xs - | Comment (loc, c) :: xs -> - Format.fprintf fmt "%a@,%a" (pp_comment loc) c go xs - | [ x ] -> Format.fprintf fmt "%a" pp_sexp x - | x :: xs -> Format.fprintf fmt "%a@,%a" pp_sexp x go xs - | [] -> () + pp_sexp x ++ pp_break attached ++ pp_comment loc c ++ Pp.cut ++ go xs + | Comment (loc, c) :: xs -> pp_comment loc c ++ Pp.cut ++ go xs + | [ x ] -> pp_sexp x + | x :: xs -> pp_sexp x ++ Pp.cut ++ go xs + | [] -> Pp.nop in - go fmt sexps + go sexps -let rec pp_sexp fmt : Dune_lang.Cst.t -> _ = function - | (Atom _ | Quoted_string _ | Template _) as sexp -> pp_simple fmt sexp +let rec pp_sexp : Dune_lang.Cst.t -> _ = function + | (Atom _ | Quoted_string _ | Template _) as sexp -> pp_simple sexp | List (_, sexps) -> - Format.fprintf fmt "@[%a@]" + Pp.vbox ~indent:1 ( if can_be_displayed_wrapped sexps then - print_wrapped_list + print_wrapped_list sexps else - pp_sexp_list ) - sexps - | Comment (loc, c) -> pp_comment loc fmt c + pp_sexp_list sexps ) + | Comment (loc, c) -> pp_comment loc c -and pp_sexp_list fmt = Format.fprintf fmt "(%a)" (pp_list_with_comments pp_sexp) +and pp_sexp_list sexps = + Pp.char '(' ++ pp_list_with_comments pp_sexp sexps ++ Pp.char ')' -let pp_top_sexp fmt sexp = Format.fprintf fmt "%a\n" pp_sexp sexp +let pp_top_sexp sexp = pp_sexp sexp ++ Pp.char '\n' -let pp_top_sexps = - Format.pp_print_list ~pp_sep:Format.pp_print_newline pp_top_sexp +let pp_top_sexps = Pp.concat_map ~sep:Pp.newline ~f:pp_top_sexp let write_file ~path sexps = let f oc = let fmt = Format.formatter_of_out_channel oc in - Format.fprintf fmt "%a%!" pp_top_sexps sexps + Format.fprintf fmt "%a%!" Pp.to_fmt (pp_top_sexps sexps) in Io.with_file_out ~binary:true path ~f @@ -116,4 +107,4 @@ let format_file ~input ~output = | Sexps sexps -> with_output (fun oc -> let oc = Format.formatter_of_out_channel oc in - Format.fprintf oc "%a%!" pp_top_sexps sexps) + Format.fprintf oc "%a%!" Pp.to_fmt (pp_top_sexps sexps)) diff --git a/src/dune_engine/format_dune_lang.mli b/src/dune_engine/format_dune_lang.mli index 35df7b137a8..196390f53c6 100644 --- a/src/dune_engine/format_dune_lang.mli +++ b/src/dune_engine/format_dune_lang.mli @@ -15,4 +15,4 @@ val write_file : path:Path.t -> Dune_lang.Cst.t list -> unit val format_file : input:Path.t option -> output:Path.t option -> unit (** Pretty-print a list of toplevel s-expressions *) -val pp_top_sexps : Format.formatter -> Dune_lang.Cst.t list -> unit +val pp_top_sexps : Dune_lang.Cst.t list -> _ Pp.t diff --git a/src/dune_rules/upgrader.ml b/src/dune_rules/upgrader.ml index 519aa75376e..3e48268b1c8 100644 --- a/src/dune_rules/upgrader.ml +++ b/src/dune_rules/upgrader.ml @@ -134,7 +134,8 @@ module Common = struct let string_of_sexps sexps comments = let new_csts = List.map sexps ~f:Dune_lang.Cst.concrete in Dune_lang.Parser.insert_comments new_csts comments - |> Format.asprintf "%a@?" Format_dune_lang.pp_top_sexps + |> Format_dune_lang.pp_top_sexps + |> Format.asprintf "%a@?" Pp.to_fmt end module V1 = struct @@ -324,7 +325,9 @@ module V1 = struct (List.map ~f:Dune_lang.Cst.concrete sexps) comments in - let contents = Format.asprintf "%a@?" Format_dune_lang.pp_top_sexps sexps in + let contents = + Format.asprintf "%a@?" Pp.to_fmt (Format_dune_lang.pp_top_sexps sexps) + in todo.to_rename_and_edit <- { original_file = file; new_file; extra_files_to_delete; contents } :: todo.to_rename_and_edit From c556c5bb91c2acb996e0ea262dc062a18d7cc150 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 13 Nov 2020 11:38:32 +0100 Subject: [PATCH 5/5] CHANGES.md 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 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index abe6f96baab..b7501be7890 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -72,6 +72,8 @@ Unreleased - instrumentations backends can now receive arguments via `(instrumentation (backend ))`. (#3906, #3932, @nojb) +- Tweak auto-formatting of `dune` files to improve readability. (#3928, @nojb) + 2.7.1 (2/09/2020) -----------------