From 54ca181126cccc455c9d7db1f924a09e139d4585 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Fri, 7 Dec 2018 14:44:15 +0000 Subject: [PATCH] dune unstable-fmt: use boxes (#1608) * dune unstable-fmt: put the paren at end of line Signed-off-by: Etienne Millon * Add failing test when formatting nested lists Signed-off-by: Etienne Millon * Fix indent in nested list Signed-off-by: Etienne Millon * Wrap some lists using boxes Closes #1153 Signed-off-by: Etienne Millon * Use boxes for indent Signed-off-by: Etienne Millon * Add a test for multi-line strings Signed-off-by: Etienne Millon * Add changelog entry Signed-off-by: Etienne Millon * Fix JS tests with newer js_of_ocaml Signed-off-by: Etienne Millon --- CHANGES.md | 6 ++ src/dune_fmt.ml | 79 ++++++------------- .../test-cases/fmt/multi-line-strings | 10 +++ test/blackbox-tests/test-cases/fmt/run.t | 33 +++++++- .../test-cases/js_of_ocaml/bin/technologic.ml | 1 + .../test-cases/js_of_ocaml/lib/x.ml | 4 +- 6 files changed, 74 insertions(+), 59 deletions(-) create mode 100644 test/blackbox-tests/test-cases/fmt/multi-line-strings diff --git a/CHANGES.md b/CHANGES.md index df413931eb16..af752187042e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,9 @@ +unreleased +---------- + +- unstable-fmt: use boxes to wrap some lists (#1608, fix #1153, @emillon, + thanks to @rgrinberg) + 1.6.2 (05/12/2018) ------------------ diff --git a/src/dune_fmt.ml b/src/dune_fmt.ml index 4b473545db48..0822a7534fde 100644 --- a/src/dune_fmt.ml +++ b/src/dune_fmt.ml @@ -19,7 +19,7 @@ let parse_file path_opt = ~mode:Dune_lang.Parser.Mode.Many contents -let can_be_displayed_inline = +let can_be_displayed_wrapped = List.for_all ~f:(function | Dune_lang.Atom _ | Dune_lang.Quoted_string _ @@ -32,73 +32,44 @@ let can_be_displayed_inline = false ) -let pp_indent fmt indent = - Format.pp_print_string fmt @@ String.make indent ' ' - -let print_inline_list fmt indent sexps = - Format.fprintf fmt "%a(" pp_indent indent; - let first = ref true in - List.iter sexps ~f:(fun sexp -> - if !first then - first := false - else - Format.pp_print_string fmt " "; - Dune_lang.pp Dune_lang.Dune fmt sexp - ); - Format.pp_print_string fmt ")" +let print_wrapped_list fmt = + Format.fprintf fmt "(@[%a@])" + (Fmt.list + ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ") + (Dune_lang.pp Dune_lang.Dune) + ) -let rec pp_sexp indent fmt = +let rec pp_sexp fmt = function ( Dune_lang.Atom _ | Dune_lang.Quoted_string _ | Dune_lang.Template _ ) as sexp -> - Format.fprintf fmt "%a%a" - pp_indent indent + Format.fprintf fmt "%a" (Dune_lang.pp Dune_lang.Dune) sexp | Dune_lang.List sexps -> - if can_be_displayed_inline sexps then - print_inline_list fmt indent sexps - else - pp_sexp_list indent fmt sexps + Format.fprintf fmt "@[%a@]" + (if can_be_displayed_wrapped sexps then + print_wrapped_list + else + pp_sexp_list) + sexps -and pp_sexp_list indent fmt sexps = - begin - Format.fprintf fmt "%a(" pp_indent indent; - let first = ref true in - List.iter sexps ~f:(fun sexp -> - let indent = - if !first then - begin - first := false; - 0 - end - else - indent + 1 - in - pp_sexp - indent - fmt - sexp; - Format.pp_print_string fmt "\n"; - ); - Format.fprintf fmt "%a)" pp_indent indent; - end +and pp_sexp_list fmt = + let pp_sep fmt () = Format.fprintf fmt "@," in + Format.fprintf fmt "(%a)" + (Fmt.list ~pp_sep pp_sexp) let pp_top_sexp fmt sexp = - Format.fprintf fmt "%a\n" (pp_sexp 0) sexp + Format.fprintf fmt "%a\n" pp_sexp sexp -let pp_top_sexps fmt sexps = - let first = ref true in - List.iter sexps ~f:(fun sexp -> - if !first then - first := false - else - Format.pp_print_string fmt "\n"; - pp_top_sexp fmt (Dune_lang.Ast.remove_locs sexp); - ) +let pp_top_sexps = + Fmt.list + ~pp_sep:Fmt.nl + (fun fmt sexp -> + pp_top_sexp fmt (Dune_lang.Ast.remove_locs sexp)) let with_output path_opt k = match path_opt with diff --git a/test/blackbox-tests/test-cases/fmt/multi-line-strings b/test/blackbox-tests/test-cases/fmt/multi-line-strings new file mode 100644 index 000000000000..7c13b5daf50d --- /dev/null +++ b/test/blackbox-tests/test-cases/fmt/multi-line-strings @@ -0,0 +1,10 @@ +(echo "\> multi + "\> line + "\> string +) + +(echo "\ +multi +line +string +") diff --git a/test/blackbox-tests/test-cases/fmt/run.t b/test/blackbox-tests/test-cases/fmt/run.t index b353e8d782bc..4cb2bc522728 100644 --- a/test/blackbox-tests/test-cases/fmt/run.t +++ b/test/blackbox-tests/test-cases/fmt/run.t @@ -17,8 +17,7 @@ Other lists are displayed one element per line: $ echo '(a (b c d) e)' | dune unstable-fmt (a (b c d) - e - ) + e) When there are several s-expressions, they are printed with an empty line between them: @@ -39,8 +38,7 @@ A file can be fixed in place: $ dune unstable-fmt --inplace dune_temp $ cat dune_temp (a - (b c) - ) + (b c)) The --inplace flag requires a file name: @@ -60,3 +58,30 @@ and files are not removed when there is an error: Parse error: unclosed parenthesis at end of input $ cat dune_temp (a + +When a list is indented, there is no extra space at the end. + + $ echo ' (a (b (c d)))' | dune unstable-fmt + (a + (b + (c d))) + +When there is a long list of atoms, quoted strings, templates and singletons, +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 unstable-fmt + (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})))) + +In multi-line strings, newlines are escaped. + + $ dune unstable-fmt < multi-line-strings + (echo "multi\nline\nstring\n") + + (echo "multi\nline\nstring\n") diff --git a/test/blackbox-tests/test-cases/js_of_ocaml/bin/technologic.ml b/test/blackbox-tests/test-cases/js_of_ocaml/bin/technologic.ml index c01b192efb64..56516774a03c 100644 --- a/test/blackbox-tests/test-cases/js_of_ocaml/bin/technologic.ml +++ b/test/blackbox-tests/test-cases/js_of_ocaml/bin/technologic.ml @@ -1,3 +1,4 @@ +module Js = Js_of_ocaml.Js let _ = print_endline X.buy_it; diff --git a/test/blackbox-tests/test-cases/js_of_ocaml/lib/x.ml b/test/blackbox-tests/test-cases/js_of_ocaml/lib/x.ml index ef6b39d2b812..2fc3a0273f46 100644 --- a/test/blackbox-tests/test-cases/js_of_ocaml/lib/x.ml +++ b/test/blackbox-tests/test-cases/js_of_ocaml/lib/x.ml @@ -1,3 +1,5 @@ +module Js = Js_of_ocaml.Js + let buy_it = "buy " ^ Y.it -let print x = Js_of_ocaml.Js.to_string x##.name +let print x = Js.to_string x##.name external external_print : Js.js_string Js.t -> unit = "jsPrint"