dune formatting: style tweaks

CHANGES.md

@@ -72,6 +72,8 @@ Unreleased
 - instrumentations backends can now receive arguments via `(instrumentation
   (backend <name> <args>))`. (#3906, #3932, @nojb)
 
+- Tweak auto-formatting of `dune` files to improve readability. (#3928, @nojb)
+
 2.7.1 (2/09/2020)
 -----------------
 

bin/describe.ml

@@ -287,7 +287,8 @@ let print_as_sexp dyn =
     |> Dune_lang.Ast.add_loc ~loc:Loc.none
     |> Dune_lang.Cst.concrete
   in
-  Dune_engine.Format_dune_lang.pp_top_sexps Stdlib.Format.std_formatter [ cst ]
+  Pp.to_fmt Stdlib.Format.std_formatter
+    (Dune_engine.Format_dune_lang.pp_top_sexps [ cst ])
 
 let term =
   let+ common = Common.term

bin/dune

@@ -1,7 +1,20 @@
 (executable
  (name main)
- (libraries memo dune_lang fiber stdune unix cache_daemon cache dune_rules
-   dune_engine dune_util cmdliner threads.posix build_info dune_csexp)
+ (libraries
+  memo
+  dune_lang
+  fiber
+  stdune
+  unix
+  cache_daemon
+  cache
+  dune_rules
+  dune_engine
+  dune_util
+  cmdliner
+  threads.posix
+  build_info
+  dune_csexp)
  (bootstrap_info bootstrap-info))
 
 (rule

bin/printenv.ml

@@ -29,7 +29,8 @@ let pp ppf ~fields sexps =
       if do_print then
         Dune_lang.Ast.add_loc sexp ~loc:Loc.none
         |> Dune_lang.Cst.concrete |> List.singleton
-        |> Format.fprintf ppf "%a@?" Dune_engine.Format_dune_lang.pp_top_sexps)
+        |> Dune_engine.Format_dune_lang.pp_top_sexps
+        |> Format.fprintf ppf "%a@?" Pp.to_fmt)
 
 let term =
   let+ common = Common.term

otherlibs/action-plugin/src/dune

@@ -3,4 +3,4 @@
  (public_name dune-action-plugin)
  (libraries dune-private-libs.stdune dune-glob dune-private-libs.dune_csexp)
  (synopsis
-   "[Internal] Monadic interface for defining scripts with dynamic or complex sets of depencencies."))
+  "[Internal] Monadic interface for defining scripts with dynamic or complex sets of depencencies."))

src/dune_engine/dune

@@ -2,10 +2,28 @@
 
 (library
  (name dune_engine)
- (libraries unix stdune fiber incremental_cycles dag memo xdg dune_re
-   threads.posix opam_file_format dune_lang cache_daemon cache dune_glob
-   ocaml_config catapult jbuild_support dune_action_plugin dune_util
-   build_path_prefix_map dune_section)
+ (libraries
+  unix
+  stdune
+  fiber
+  incremental_cycles
+  dag
+  memo
+  xdg
+  dune_re
+  threads.posix
+  opam_file_format
+  dune_lang
+  cache_daemon
+  cache
+  dune_glob
+  ocaml_config
+  catapult
+  jbuild_support
+  dune_action_plugin
+  dune_util
+  build_path_prefix_map
+  dune_section)
  (synopsis "Internal Dune library, do not use!"))
 
 (ocamllex dune_lexer)

src/dune_engine/format_dune_lang.ml

@@ -1,5 +1,6 @@
 open! Stdune
 open! Import
+open Pp.O
 
 type dune_file =
   | OCaml_syntax of Loc.t
@@ -29,73 +30,63 @@ let can_be_displayed_wrapped =
       | Comment _ ->
         false)
 
-let pp_simple fmt t =
+let pp_simple t =
   Dune_lang.Cst.abstract t |> Option.value_exn |> Dune_lang.Ast.remove_locs
-  |> Dune_lang.Deprecated.pp fmt
+  |> Dune_lang.pp
 
-let print_wrapped_list fmt =
-  Format.fprintf fmt "(@[<hov 1>%a@])"
-    (Format.pp_print_list
-       ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
-       pp_simple)
+let print_wrapped_list x =
+  Pp.hvbox ~indent:1
+    (Pp.char '(' ++ Pp.concat_map ~sep:Pp.space ~f:pp_simple x ++ Pp.char ')')
 
-let pp_comment_line fmt l = Format.fprintf fmt ";%s" l
+let pp_comment_line l = Pp.char ';' ++ Pp.verbatim l
 
-let pp_comment loc fmt (comment : Dune_lang.Cst.Comment.t) =
+let pp_comment loc (comment : Dune_lang.Cst.Comment.t) =
   match comment with
-  | Lines ls ->
-    Format.fprintf fmt "@[<v 0>%a@]"
-      (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt "@;")
-         pp_comment_line)
-      ls
+  | Lines ls -> Pp.vbox (Pp.concat_map ~sep:Pp.cut ~f:pp_comment_line ls)
   | Legacy ->
     User_error.raise ~loc
       [ Pp.text "Formatting is only supported with the dune syntax" ]
 
-let pp_break fmt attached =
+let pp_break attached =
   if attached then
-    Format.fprintf fmt " "
+    Pp.char ' '
   else
-    Format.fprintf fmt "@,"
+    Pp.cut
 
-let pp_list_with_comments pp_sexp fmt sexps =
-  let rec go fmt (l : Dune_lang.Cst.t list) =
+let pp_list_with_comments pp_sexp sexps =
+  let rec go (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
-    | [] -> ()
+      pp_sexp x ++ pp_break attached ++ pp_comment loc c ++ Pp.cut ++ go xs
+    | Comment (loc, c) :: xs -> pp_comment loc c ++ Pp.cut ++ go xs
+    | [ x ] -> pp_sexp x
+    | x :: xs -> pp_sexp x ++ Pp.cut ++ go xs
+    | [] -> Pp.nop
   in
-  go fmt sexps
+  go sexps
 
-let rec pp_sexp fmt : Dune_lang.Cst.t -> _ = function
-  | (Atom _ | Quoted_string _ | Template _) as sexp -> pp_simple fmt sexp
+let rec pp_sexp : Dune_lang.Cst.t -> _ = function
+  | (Atom _ | Quoted_string _ | Template _) as sexp -> pp_simple sexp
   | List (_, sexps) ->
-    Format.fprintf fmt "@[<v 1>%a@]"
+    Pp.vbox ~indent:1
       ( if can_be_displayed_wrapped sexps then
-        print_wrapped_list
+        print_wrapped_list sexps
       else
-        pp_sexp_list )
-      sexps
-  | Comment (loc, c) -> pp_comment loc fmt c
+        pp_sexp_list sexps )
+  | Comment (loc, c) -> pp_comment loc c
 
-and pp_sexp_list fmt = Format.fprintf fmt "(%a)" (pp_list_with_comments pp_sexp)
+and pp_sexp_list sexps =
+  Pp.char '(' ++ pp_list_with_comments pp_sexp sexps ++ Pp.char ')'
 
-let pp_top_sexp fmt sexp = Format.fprintf fmt "%a\n" pp_sexp sexp
+let pp_top_sexp sexp = pp_sexp sexp ++ Pp.char '\n'
 
-let pp_top_sexps =
-  Format.pp_print_list ~pp_sep:Format.pp_print_newline pp_top_sexp
+let pp_top_sexps = Pp.concat_map ~sep:Pp.newline ~f:pp_top_sexp
 
 let write_file ~path sexps =
   let f oc =
     let fmt = Format.formatter_of_out_channel oc in
-    Format.fprintf fmt "%a%!" pp_top_sexps sexps
+    Format.fprintf fmt "%a%!" Pp.to_fmt (pp_top_sexps sexps)
   in
   Io.with_file_out ~binary:true path ~f
 
@@ -116,4 +107,4 @@ let format_file ~input ~output =
   | Sexps sexps ->
     with_output (fun oc ->
         let oc = Format.formatter_of_out_channel oc in
-        Format.fprintf oc "%a%!" pp_top_sexps sexps)
+        Format.fprintf oc "%a%!" Pp.to_fmt (pp_top_sexps sexps))

src/dune_engine/format_dune_lang.mli

@@ -15,4 +15,4 @@ val write_file : path:Path.t -> Dune_lang.Cst.t list -> unit
 val format_file : input:Path.t option -> output:Path.t option -> unit
 
 (** Pretty-print a list of toplevel s-expressions *)
-val pp_top_sexps : Format.formatter -> Dune_lang.Cst.t list -> unit
+val pp_top_sexps : Dune_lang.Cst.t list -> _ Pp.t

src/dune_rules/dune

@@ -2,10 +2,30 @@
 
 (library
  (name dune_rules)
- (libraries unix stdune fiber incremental_cycles dag memo xdg dune_re
-   threads.posix opam_file_format dune_lang cache_daemon cache dune_glob
-   ocaml_config catapult jbuild_support dune_action_plugin dune_util
-   dune_meta_parser dune_section build_path_prefix_map dune_engine)
+ (libraries
+  unix
+  stdune
+  fiber
+  incremental_cycles
+  dag
+  memo
+  xdg
+  dune_re
+  threads.posix
+  opam_file_format
+  dune_lang
+  cache_daemon
+  cache
+  dune_glob
+  ocaml_config
+  catapult
+  jbuild_support
+  dune_action_plugin
+  dune_util
+  dune_meta_parser
+  dune_section
+  build_path_prefix_map
+  dune_engine)
  (synopsis "Internal Dune library, do not use!"))
 
 (ocamllex ocamlobjinfo cram_lexer)

src/dune_rules/upgrader.ml

@@ -134,7 +134,8 @@ module Common = struct
   let string_of_sexps sexps comments =
     let new_csts = List.map sexps ~f:Dune_lang.Cst.concrete in
     Dune_lang.Parser.insert_comments new_csts comments
-    |> Format.asprintf "%a@?" Format_dune_lang.pp_top_sexps
+    |> Format_dune_lang.pp_top_sexps
+    |> Format.asprintf "%a@?" Pp.to_fmt
 end
 
 module V1 = struct
@@ -324,7 +325,9 @@ module V1 = struct
         (List.map ~f:Dune_lang.Cst.concrete sexps)
         comments
     in
-    let contents = Format.asprintf "%a@?" Format_dune_lang.pp_top_sexps sexps in
+    let contents =
+      Format.asprintf "%a@?" Pp.to_fmt (Format_dune_lang.pp_top_sexps sexps)
+    in
     todo.to_rename_and_edit <-
       { original_file = file; new_file; extra_files_to_delete; contents }
       :: todo.to_rename_and_edit

test/blackbox-tests/test-cases/describe.t/run.t

@@ -42,11 +42,11 @@ Describe various things
      (requires
       (c17373aee51bab94097b4b7818553cf3 5dd4bd87ad37b4f5713085aff4bee9c9))
      (modules
-       (((name Main)
-         (impl (_build/default/main.ml))
-         (intf ())
-         (cmt (_build/default/.main.eobjs/byte/dune__exe__Main.cmt))
-         (cmti ()))))
+      (((name Main)
+        (impl (_build/default/main.ml))
+        (intf ())
+        (cmt (_build/default/.main.eobjs/byte/dune__exe__Main.cmt))
+        (cmti ()))))
      (include_dirs (_build/default/.main.eobjs/byte))))
    (library
     ((name foo)
@@ -55,11 +55,11 @@ Describe various things
      (requires (c17373aee51bab94097b4b7818553cf3))
      (source_dir _build/default)
      (modules
-       (((name Foo)
-         (impl (_build/default/foo.ml))
-         (intf ())
-         (cmt (_build/default/.foo.objs/byte/foo.cmt))
-         (cmti ()))))
+      (((name Foo)
+        (impl (_build/default/foo.ml))
+        (intf ())
+        (cmt (_build/default/.foo.objs/byte/foo.cmt))
+        (cmti ()))))
      (include_dirs (_build/default/.foo.objs/byte))))
    (library
     ((name foo.x)
@@ -68,11 +68,11 @@ Describe various things
      (requires ())
      (source_dir _build/default)
      (modules
-       (((name Foo_x)
-         (impl (_build/default/foo_x.ml))
-         (intf ())
-         (cmt (_build/default/.foo_x.objs/byte/foo_x.cmt))
-         (cmti ()))))
+      (((name Foo_x)
+        (impl (_build/default/foo_x.ml))
+        (intf ())
+        (cmt (_build/default/.foo_x.objs/byte/foo_x.cmt))
+        (cmti ()))))
      (include_dirs (_build/default/.foo_x.objs/byte)))))
 
 Test other formats
@@ -107,7 +107,7 @@ opam file listing
 
   $ dune describe --lang 0.1 opam-files | dune_cmd expand_lines
   ((foo.opam
-     "# This file is generated by dune, edit dune-project instead
+    "# This file is generated by dune, edit dune-project instead
   opam-version: \"2.0\"
   synopsis: \"foo bar baz\"
   depends: [

test/blackbox-tests/test-cases/format-dune-file.t/run.t

@@ -52,8 +52,17 @@ 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 format-dune-file
   (library
    (name dune)
-   (libraries unix stdune fiber xdg dune_re threads opam_file_format dune_lang
-     ocaml_config which_program)
+   (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

test/blackbox-tests/utils/dune

@@ -1,4 +1,6 @@
 (executable
  (name dune_cmd)
- (libraries dune-private-libs.stdune dune-private-libs.dune_re
-   dune-configurator))
+ (libraries
+  dune-private-libs.stdune
+  dune-private-libs.dune_re
+  dune-configurator))

test/dune

@@ -36,13 +36,13 @@
   (glob_files *.{foo,bar}))
  (action
   (bash
-    "echo 'expected result: 10'\necho 'without locking:' $(< x)\necho 'with locking:   ' $(< y)\nrm -f *.{foo,bar} x y")))
+   "echo 'expected result: 10'\necho 'without locking:' $(< x)\necho 'with locking:   ' $(< y)\nrm -f *.{foo,bar} x y")))
 
 (rule
  (with-stdout-to
   incr.ml
   (echo
-    "let fn = Sys.argv.(1) in\nlet x =\n  match open_in fn with\n  | ic ->\n    let x = int_of_string (input_line ic) in\n    close_in ic;\n    x\n  | exception _ -> 0\nin\nUnix.sleepf 0.2;\nPrintf.fprintf (open_out fn) \"%d\\n\" (x + 1);\nPrintf.fprintf (open_out Sys.argv.(2)) \"%g\n%!\" (Sys.time ())\n")))
+   "let fn = Sys.argv.(1) in\nlet x =\n  match open_in fn with\n  | ic ->\n    let x = int_of_string (input_line ic) in\n    close_in ic;\n    x\n  | exception _ -> 0\nin\nUnix.sleepf 0.2;\nPrintf.fprintf (open_out fn) \"%d\\n\" (x + 1);\nPrintf.fprintf (open_out Sys.argv.(2)) \"%g\n%!\" (Sys.time ())\n")))
 
 (executable
  (name incr)

test/expect-tests/dune_action_plugin/dune

@@ -4,7 +4,13 @@
  (name dune_action_unit_tests)
  (inline_tests
   (deps some_dir/some_file))
- (libraries dune_action_plugin ppx_expect.config ppx_expect.config_types
-   ppx_expect.common base ppx_inline_test.config dune-glob)
+ (libraries
+  dune_action_plugin
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_expect.common
+  base
+  ppx_inline_test.config
+  dune-glob)
  (preprocess
   (pps ppx_expect)))