From a611205ff8c92de2d4c2972b5353c2702a914423 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Tue, 14 Aug 2018 14:04:12 +0200 Subject: [PATCH] Initial implementation of `dune fmt` This is a first draft with three main limitations: - it is language agnostic, so it does not know about field names - it is not able to parse comments - it does not break long lines The formatting rules are pretty simple: - lists composed only of atoms, quoted strings, templates, and singletons are displayed on a single line - other lists are displayed with a line break after each element - an empty line is inserted between toplevel stanzas The CLI is pretty light: it can either read a file or standard input, and fix a file in place. In addition, the command is named `unstable-fmt` for now, until some guarantees are given. Closes #940 Signed-off-by: Etienne Millon --- CHANGES.md | 3 + bin/main.ml | 38 +++++++ doc/dune.inc | 9 ++ src/dune_fmt.ml | 121 +++++++++++++++++++++++ src/dune_fmt.mli | 7 ++ src/stdune/io.mli | 1 + test/blackbox-tests/dune.inc | 10 ++ test/blackbox-tests/test-cases/fmt/dune | 2 + test/blackbox-tests/test-cases/fmt/run.t | 62 ++++++++++++ 9 files changed, 253 insertions(+) create mode 100644 src/dune_fmt.ml create mode 100644 src/dune_fmt.mli create mode 100644 test/blackbox-tests/test-cases/fmt/dune create mode 100644 test/blackbox-tests/test-cases/fmt/run.t diff --git a/CHANGES.md b/CHANGES.md index ee6f6d4c..417075ca 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,9 @@ next - Display actual stanza when package is ambiguous (#1126, fix #1123, @emillon) +- Add `dune unstable-fmt` to format `dune` files. The interface and syntax are + still subject to change, so use with caution. (#1130, fix #940, @emillon) + 1.1.1 (08/08/2018) ------------------ diff --git a/bin/main.ml b/bin/main.ml index 8cf16934..24457577 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1480,6 +1480,43 @@ let printenv = in (term, Term.info "printenv" ~doc ~man ) +let fmt = + let doc = "Format dune files" in + let man = + [ `S "DESCRIPTION" + ; `P {|$(b,dune unstable-fmt) reads a dune file and outputs a formatted + version. This feature is unstable, and its interface or behaviour + might change. + |} + ] in + let term = + let%map path_opt = + let docv = "FILE" in + let doc = "Path to the dune file to parse." in + Arg.(value & pos 0 (some path) None & info [] ~docv ~doc) + and inplace = + let doc = "Modify the file in place" in + Arg.(value & flag & info ["inplace"] ~doc) + in + if true then + let (input, output) = + match path_opt, inplace with + | None, false -> + (None, None) + | Some path, true -> + let path = Arg.Path.path path in + (Some path, Some path) + | Some path, false -> + (Some (Arg.Path.path path), None) + | None, true -> + die "--inplace requires a file name" + in + Dune_fmt.format_file ~input ~output + else + die "This command is unstable. Please pass --unstable to use it nonetheless." + in + (term, Term.info "unstable-fmt" ~doc ~man ) + module Help = struct let config = ("dune-config", 5, "", "Dune", "Dune manual"), @@ -1600,6 +1637,7 @@ let all = ; promote ; printenv ; Help.help + ; fmt ] let default = diff --git a/doc/dune.inc b/doc/dune.inc index e0ed61ff..2369443f 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -116,6 +116,15 @@ (package dune) (files dune-uninstall.1)) +(rule + (with-stdout-to dune-unstable-fmt.1 + (run dune unstable-fmt --help=groff))) + +(install + (section man) + (package dune) + (files dune-unstable-fmt.1)) + (rule (with-stdout-to dune-utop.1 (run dune utop --help=groff))) diff --git a/src/dune_fmt.ml b/src/dune_fmt.ml new file mode 100644 index 00000000..7630c2c7 --- /dev/null +++ b/src/dune_fmt.ml @@ -0,0 +1,121 @@ +open! Import + +let parse_file path_opt = + let fname, contents = + match path_opt with + | Some path -> + Io.with_file_in path ~f:(fun ic -> + let contents = Io.read_all ic in + (Path.to_string path, contents) + ) + | None -> + let lines = Io.input_lines stdin in + let contents = String.concat ~sep:"\n" lines in + ("", contents) + in + Sexp.parse_string + ~fname + ~mode:Usexp.Parser.Mode.Many + contents + +let can_be_displayed_inline = + List.for_all ~f:(function + | Usexp.Atom _ + | Usexp.Quoted_string _ + | Usexp.Template _ + | Usexp.List [_] + -> + true + | Usexp.List _ + -> + 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 " "; + Usexp.pp Usexp.Dune fmt sexp + ); + Format.pp_print_string fmt ")" + +let rec pp_sexp indent fmt = + function + ( Usexp.Atom _ + | Usexp.Quoted_string _ + | Usexp.Template _ + ) as sexp + -> + Format.fprintf fmt "%a%a" + pp_indent indent + (Usexp.pp Usexp.Dune) sexp + | Usexp.List sexps + -> + if can_be_displayed_inline sexps then + print_inline_list fmt indent sexps + else + pp_sexp_list indent fmt 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 + +let pp_top_sexp fmt sexp = + Format.fprintf fmt "%a\n" (pp_sexp 0) 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 (Sexp.Ast.remove_locs sexp); + ) + +let with_output path_opt k = + match path_opt with + | None -> + k Format.std_formatter + | Some path -> + Io.with_file_out ~binary:true path ~f:(fun oc -> + k @@ Format.formatter_of_out_channel oc + ) + +let format_file ~input ~output = + match parse_file input with + | exception Usexp.Parse_error e -> + Printf.printf + "Parse error: %s\n" + (Usexp.Parse_error.message e) + | sexps -> + with_output output (fun fmt -> + pp_top_sexps fmt sexps; + Format.pp_print_flush fmt () + ) diff --git a/src/dune_fmt.mli b/src/dune_fmt.mli new file mode 100644 index 00000000..b64921fb --- /dev/null +++ b/src/dune_fmt.mli @@ -0,0 +1,7 @@ +open Import + +(** Reformat a dune file. [None] corresponds to stdin/stdout. *) +val format_file : + input:Path.t option -> + output:Path.t option -> + unit diff --git a/src/stdune/io.mli b/src/stdune/io.mli index c236b3b1..31ca8143 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -11,6 +11,7 @@ val with_file_out : ?binary:bool (* default true *) -> Path.t -> f:(out_channel val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a +val input_lines : in_channel -> string list val lines_of_file : Path.t -> string list val read_file : ?binary:bool -> Path.t -> string diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 4a4b3d8b..14165f47 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -207,6 +207,14 @@ test-cases/findlib-error (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name fmt) + (deps (package dune) (source_tree test-cases/fmt)) + (action + (chdir + test-cases/fmt + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name force-test) (deps (package dune) (source_tree test-cases/force-test)) @@ -816,6 +824,7 @@ (alias fallback-dune) (alias findlib) (alias findlib-error) + (alias fmt) (alias force-test) (alias gen-opam-install-file) (alias github1019) @@ -914,6 +923,7 @@ (alias fallback-dune) (alias findlib) (alias findlib-error) + (alias fmt) (alias force-test) (alias github1019) (alias github1099) diff --git a/test/blackbox-tests/test-cases/fmt/dune b/test/blackbox-tests/test-cases/fmt/dune new file mode 100644 index 00000000..e1b720b0 --- /dev/null +++ b/test/blackbox-tests/test-cases/fmt/dune @@ -0,0 +1,2 @@ +(a +b) diff --git a/test/blackbox-tests/test-cases/fmt/run.t b/test/blackbox-tests/test-cases/fmt/run.t new file mode 100644 index 00000000..b353e8d7 --- /dev/null +++ b/test/blackbox-tests/test-cases/fmt/run.t @@ -0,0 +1,62 @@ +The empty list and atoms are printed as is: + + $ echo '()' | dune unstable-fmt + () + + $ echo 'a' | dune unstable-fmt + a + +Lists containing only atoms, quoted strings, templates, and singleton lists are +printed inline: + + $ echo '(atom "string" %{template} (singleton))' | dune unstable-fmt + (atom "string" %{template} (singleton)) + +Other lists are displayed one element per line: + + $ echo '(a (b c d) e)' | dune unstable-fmt + (a + (b c d) + e + ) + +When there are several s-expressions, they are printed with an empty line +between them: + + $ echo '(a b) (c d)' | dune unstable-fmt + (a b) + + (c d) + +It is possible to pass a file name: + + $ dune unstable-fmt dune + (a b) + +A file can be fixed in place: + + $ echo '(a (b c))' > dune_temp + $ dune unstable-fmt --inplace dune_temp + $ cat dune_temp + (a + (b c) + ) + +The --inplace flag requires a file name: + + $ dune unstable-fmt --inplace + --inplace requires a file name + [1] + +Parse errors are displayed: + + $ echo '(' | dune unstable-fmt + Parse error: unclosed parenthesis at end of input + +and files are not removed when there is an error: + + $ echo '(a' > dune_temp + $ dune unstable-fmt --inplace dune_temp + Parse error: unclosed parenthesis at end of input + $ cat dune_temp + (a