Skip to content

Commit

Permalink
unstable-fmt: preserve comments (#1766)
Browse files Browse the repository at this point in the history
* unstable-fmt: preserve comments

This uses the new `Cst` module. Some cases require special care so that
closing parentheses are not part of the comments.

Signed-off-by: Etienne Millon <me@emillon.org>
  • Loading branch information
emillon authored Jan 23, 2019
1 parent cfabdd1 commit c49a83e
Show file tree
Hide file tree
Showing 10 changed files with 194 additions and 37 deletions.
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,8 @@ unreleased
`.merlin` with `S`-directives pointed to original source locations and thus
allowing merlin to see those.

- unstable-fmt: preserve comments (#1766, @emillon)

1.6.2 (05/12/2018)
------------------

Expand Down
93 changes: 69 additions & 24 deletions src/dune_fmt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,62 +14,107 @@ let parse_file path_opt =
let contents = String.concat ~sep:"\n" lines in
("<stdin>", contents)
in
Dune_lang.parse_string
~fname
~mode:Dune_lang.Parser.Mode.Many
contents
Dune_lang.parse_cst_string ~fname contents

let can_be_displayed_wrapped =
List.for_all ~f:(function
| Dune_lang.Atom _
| Dune_lang.Quoted_string _
| Dune_lang.Template _
| Dune_lang.List [_]
List.for_all ~f:(fun (c : Dune_lang.Cst.t) ->
match c with
| Atom _
| Quoted_string _
| Template _
| List (_, [_])
->
true
| Dune_lang.List _
| List _
| Comment _
->
false
)

let pp_simple fmt t =
Dune_lang.Cst.abstract t
|> Option.value_exn
|> Dune_lang.Ast.remove_locs
|> Dune_lang.pp Dune fmt

let print_wrapped_list fmt =
Format.fprintf fmt "(@[<hov 1>%a@])"
(Fmt.list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
(Dune_lang.pp Dune_lang.Dune)
pp_simple
)

let rec pp_sexp fmt =
let pp_comment_line fmt l =
Format.fprintf fmt ";%s" l

let pp_comment loc fmt (comment:Dune_lang.Cst.Comment.t) =
match comment with
| Lines ls ->
Format.fprintf fmt "@[<v 0>%a@]"
(Fmt.list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@;")
pp_comment_line)
ls
| Legacy ->
Errors.fail loc "Formatting is only supported with the dune syntax"

let pp_break fmt attached =
if attached then
Format.fprintf fmt " "
else
Format.fprintf fmt "@,"

let pp_list_with_comments pp_sexp fmt sexps =
let rec go fmt (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
| [] -> ()
in
go fmt sexps

let rec pp_sexp fmt : Dune_lang.Cst.t -> _ =
function
( Dune_lang.Atom _
| Dune_lang.Quoted_string _
| Dune_lang.Template _
| ( Atom _
| Quoted_string _
| Template _
) as sexp
->
Format.fprintf fmt "%a"
(Dune_lang.pp Dune_lang.Dune) sexp
| Dune_lang.List sexps
pp_simple fmt sexp
| List (_, sexps)
->
Format.fprintf fmt "@[<v 1>%a@]"
(if can_be_displayed_wrapped sexps then
print_wrapped_list
else
pp_sexp_list)
sexps
| Comment (loc, c)
->
pp_comment loc fmt c

and pp_sexp_list fmt =
let pp_sep fmt () = Format.fprintf fmt "@," in
Format.fprintf fmt "(%a)"
(Fmt.list ~pp_sep pp_sexp)
(pp_list_with_comments pp_sexp)

let pp_top_sexp fmt sexp =
Format.fprintf fmt "%a\n" pp_sexp sexp

let pp_top_sexps =
Fmt.list
~pp_sep:Fmt.nl
(fun fmt sexp ->
pp_top_sexp fmt (Dune_lang.Ast.remove_locs sexp))
Fmt.list ~pp_sep:Fmt.nl pp_top_sexp

let with_output path_opt k =
match path_opt with
Expand Down
2 changes: 1 addition & 1 deletion src/dune_fmt.mli
Original file line number Diff line number Diff line change
Expand Up @@ -7,4 +7,4 @@ val format_file :
unit

(** Pretty-print a list of toplevel s-expressions *)
val pp_top_sexps : Format.formatter -> Dune_lang.Ast.t list -> unit
val pp_top_sexps : Format.formatter -> Dune_lang.Cst.t list -> unit
23 changes: 22 additions & 1 deletion src/dune_lang/dune_lang.ml
Original file line number Diff line number Diff line change
Expand Up @@ -201,6 +201,19 @@ module Cst = struct
Comment (loc, Lines (String.split s ~on:'\n'))
in
loop t

let rec abstract : t -> Ast.t option = function
| Atom (loc, atom) -> Some (Atom (loc, atom))
| Quoted_string (loc, s) -> Some (Quoted_string (loc, s))
| Template t -> Some (Template t)
| List (loc, l) -> Some (List (loc, List.filter_map ~f:abstract l))
| Comment _ -> None

let rec concrete : Ast.t -> t = function
| Atom (loc, atom) -> Atom (loc, atom)
| Quoted_string (loc, s) -> Quoted_string (loc, s)
| Template t -> Template t
| List (loc, l) -> List (loc, List.map ~f:concrete l)
end

module Parse_error = struct
Expand Down Expand Up @@ -334,16 +347,24 @@ module Parser = struct
|> List.map ~f:cst_of_encoded_ast
end

let parse_string ~fname ~mode ?lexer str =
let lexbuf_from_string ~fname str =
let lb = Lexing.from_string str in
lb.lex_curr_p <-
{ pos_fname = fname
; pos_lnum = 1
; pos_bol = 0
; pos_cnum = 0
};
lb

let parse_string ~fname ~mode ?lexer str =
let lb = lexbuf_from_string ~fname str in
Parser.parse ~mode ?lexer lb

let parse_cst_string ~fname ?lexer str =
let lb = lexbuf_from_string ~fname str in
Parser.parse_cst ?lexer lb

type dune_lang = t

module Encoder = struct
Expand Down
10 changes: 10 additions & 0 deletions src/dune_lang/dune_lang.mli
Original file line number Diff line number Diff line change
Expand Up @@ -141,6 +141,10 @@ module Cst : sig
(** Replace all the [Comment Legacy] by [Comment (Lines _)] by
extracting the contents of comments from the original file. *)
val fetch_legacy_comments : t -> file_contents:string -> t

val abstract : t -> Ast.t option

val concrete : Ast.t -> t
end

module Parse_error : sig
Expand Down Expand Up @@ -202,6 +206,12 @@ val parse_string
-> string
-> 'a

val parse_cst_string
: fname:string
-> ?lexer:Lexer.t
-> string
-> Cst.t list

module Encoder : sig
type sexp = t
include Sexp_intf.Combinators with type 'a t = 'a -> t
Expand Down
7 changes: 7 additions & 0 deletions src/stdune/loc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -159,3 +159,10 @@ let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full
file (Exn.pp_uncaught ~backtrace) exn
| Ok () -> ()
end

let on_same_line loc1 loc2 =
let start1 = loc1.start in
let start2 = loc2.start in
let same_file = String.equal start1.pos_fname start2.pos_fname in
let same_line = Int.equal start1.pos_lnum start2.pos_lnum in
same_file && same_line
2 changes: 2 additions & 0 deletions src/stdune/loc.mli
Original file line number Diff line number Diff line change
Expand Up @@ -30,3 +30,5 @@ val pp_file_excerpt
-> Format.formatter
-> t
-> unit

val on_same_line : t -> t -> bool
1 change: 1 addition & 0 deletions src/upgrader.ml
Original file line number Diff line number Diff line change
Expand Up @@ -196,6 +196,7 @@ let upgrade_file todo file sexps ~look_for_jbuild_ignore =
(sexps, [jbuild_ignore])
end
in
let sexps = List.map ~f:Dune_lang.Cst.concrete sexps in
let contents = Format.asprintf "%a@?" Dune_fmt.pp_top_sexps sexps in
todo.to_rename_and_edit <-
{ original_file = file
Expand Down
10 changes: 0 additions & 10 deletions test/blackbox-tests/test-cases/fmt/multi-line-strings

This file was deleted.

81 changes: 80 additions & 1 deletion test/blackbox-tests/test-cases/fmt/run.t
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,86 @@ it gets wrapped.

In multi-line strings, newlines are escaped.

$ dune unstable-fmt < multi-line-strings
$ dune unstable-fmt <<EOF
> (echo "\> multi
> "\> line
> "\> string
> )
>
> (echo "\
> multi
> line
> string
> ")
> EOF
(echo "multi\nline\nstring\n")
(echo "multi\nline\nstring\n")
Comments are preserved.
$ dune unstable-fmt <<EOF
> ; comment
> (; first comment
> a b; comment for b
> ccc; multi
> ; line
> ; comment for ccc
> d
> e
> ; unattached comment
> f
> ; unattached
> ; multi-line
> ; comment
> g
> )
> EOF
; comment
(; first comment
a
b ; comment for b
ccc ; multi
; line
; comment for ccc
d
e
; unattached comment
f
; unattached
; multi-line
; comment
g)
When a comment is at the end of a list, the ")" is on a own line.
$ dune unstable-fmt <<EOF
> (a ; final attached comment
> )
> (a ; final multiline
> ; comment
> )
> (a
> ; final unattached
> )
> (a
> ; final unattached
> ; multiline
> )
> EOF
(a ; final attached comment
)
(a ; final multiline
; comment
)
(a
; final unattached
)
(a
; final unattached
; multiline
)

0 comments on commit c49a83e

Please sign in to comment.