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)
|
||||
|
||||
- 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)
|
||||
------------------
|
||||
|
||||
|
|
38
bin/main.ml
38
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 =
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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 input_lines : in_channel -> string list
|
||||
val lines_of_file : Path.t -> string list
|
||||
|
||||
val read_file : ?binary:bool -> Path.t -> string
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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