Merge pull request #1130 from ocaml/dune-fmt
Initial implementation of `dune fmt`
This commit is contained in:
commit
99d82c235c
|
@ -11,6 +11,9 @@ next
|
||||||
|
|
||||||
- Display actual stanza when package is ambiguous (#1126, fix #1123, @emillon)
|
- 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)
|
1.1.1 (08/08/2018)
|
||||||
------------------
|
------------------
|
||||||
|
|
||||||
|
|
38
bin/main.ml
38
bin/main.ml
|
@ -1480,6 +1480,43 @@ let printenv =
|
||||||
in
|
in
|
||||||
(term, Term.info "printenv" ~doc ~man )
|
(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
|
module Help = struct
|
||||||
let config =
|
let config =
|
||||||
("dune-config", 5, "", "Dune", "Dune manual"),
|
("dune-config", 5, "", "Dune", "Dune manual"),
|
||||||
|
@ -1600,6 +1637,7 @@ let all =
|
||||||
; promote
|
; promote
|
||||||
; printenv
|
; printenv
|
||||||
; Help.help
|
; Help.help
|
||||||
|
; fmt
|
||||||
]
|
]
|
||||||
|
|
||||||
let default =
|
let default =
|
||||||
|
|
|
@ -116,6 +116,15 @@
|
||||||
(package dune)
|
(package dune)
|
||||||
(files dune-uninstall.1))
|
(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
|
(rule
|
||||||
(with-stdout-to dune-utop.1
|
(with-stdout-to dune-utop.1
|
||||||
(run dune utop --help=groff)))
|
(run dune utop --help=groff)))
|
||||||
|
|
|
@ -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
|
||||||
|
("<stdin>", 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 ()
|
||||||
|
)
|
|
@ -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
|
|
@ -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 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 lines_of_file : Path.t -> string list
|
||||||
|
|
||||||
val read_file : ?binary:bool -> Path.t -> string
|
val read_file : ?binary:bool -> Path.t -> string
|
||||||
|
|
|
@ -207,6 +207,14 @@
|
||||||
test-cases/findlib-error
|
test-cases/findlib-error
|
||||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
(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
|
(alias
|
||||||
(name force-test)
|
(name force-test)
|
||||||
(deps (package dune) (source_tree test-cases/force-test))
|
(deps (package dune) (source_tree test-cases/force-test))
|
||||||
|
@ -816,6 +824,7 @@
|
||||||
(alias fallback-dune)
|
(alias fallback-dune)
|
||||||
(alias findlib)
|
(alias findlib)
|
||||||
(alias findlib-error)
|
(alias findlib-error)
|
||||||
|
(alias fmt)
|
||||||
(alias force-test)
|
(alias force-test)
|
||||||
(alias gen-opam-install-file)
|
(alias gen-opam-install-file)
|
||||||
(alias github1019)
|
(alias github1019)
|
||||||
|
@ -914,6 +923,7 @@
|
||||||
(alias fallback-dune)
|
(alias fallback-dune)
|
||||||
(alias findlib)
|
(alias findlib)
|
||||||
(alias findlib-error)
|
(alias findlib-error)
|
||||||
|
(alias fmt)
|
||||||
(alias force-test)
|
(alias force-test)
|
||||||
(alias github1019)
|
(alias github1019)
|
||||||
(alias github1099)
|
(alias github1099)
|
||||||
|
|
|
@ -0,0 +1,2 @@
|
||||||
|
(a
|
||||||
|
b)
|
|
@ -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
|
Loading…
Reference in New Issue