dune unstable-fmt: use boxes (ocaml#1608)

* dune unstable-fmt: put the paren at end of line

Signed-off-by: Etienne Millon <[email protected]>

* Add failing test when formatting nested lists

Signed-off-by: Etienne Millon <[email protected]>

* Fix indent in nested list

Signed-off-by: Etienne Millon <[email protected]>

* Wrap some lists using boxes

Closes ocaml#1153

Signed-off-by: Etienne Millon <[email protected]>

* Use boxes for indent

Signed-off-by: Etienne Millon <[email protected]>

* Add a test for multi-line strings

Signed-off-by: Etienne Millon <[email protected]>

* Add changelog entry

Signed-off-by: Etienne Millon <[email protected]>

* Fix JS tests with newer js_of_ocaml

Signed-off-by: Etienne Millon <[email protected]>

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)
 ------------------
 

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 "(@[<hov 1>%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 "@[<v 1>%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

test/blackbox-tests/test-cases/fmt/multi-line-strings

@@ -0,0 +1,10 @@
+(echo "\> multi
+      "\> line
+      "\> string
+)
+
+(echo "\
+multi
+line
+string
+")

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")

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;

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"