When there are extra parentheses, display the exn

CHANGES.md

@@ -36,6 +36,8 @@ next
 - Add an emacs mode providing helpers to promote correction files
   (#1192, @diml)
 
+- Improve message suggesting to remove parentheses (#1196, fix #1173, @emillon)
+
 1.1.1 (08/08/2018)
 ------------------
 

src/js_of_ocaml_rules.ml

@@ -14,7 +14,7 @@ let sourcemap sctx = if dev_mode sctx then ["--source-map-inline"] else []
 
 let standard sctx = pretty sctx @ sourcemap sctx
 
-let install_jsoo_hint = "opam install js_of_ocaml-compiler"
+let install_jsoo_hint = "try: opam install js_of_ocaml-compiler"
 
 let in_build_dir ~ctx =
   let init = Path.relative ctx.Context.build_dir ".js" in

src/lib.ml

@@ -1229,16 +1229,14 @@ let () =
            match !Clflags.external_lib_deps_hint with
            | [] -> (* during bootstrap *) None
            | l ->
-             Some (List.map l ~f:quote_for_shell |> String.concat ~sep:" "))
+             let cmdline =
+               List.map l ~f:quote_for_shell |> String.concat ~sep:" "
+             in
+             Some ("try: " ^ cmdline))
         | Private_deps_not_allowed t ->
           (Some t.pd_loc, None)
         | _ -> (None, None)
       in
-      Some
-        { Report_error.
-          loc
-        ; hint
-        ; pp = (fun ppf -> report_lib_error ppf e)
-        ; backtrace = false
-        }
+      let pp ppf = report_lib_error ppf e in
+      Some (Report_error.make_printer ?loc ?hint pp)
     | _ -> None)

src/menhir.ml

@@ -71,7 +71,7 @@ module Run (P : PARAMS) = struct
   (* Find the menhir binary. *)
 
   let menhir_binary =
-    SC.resolve_program sctx "menhir" ~loc:None ~hint:"opam install menhir"
+    SC.resolve_program sctx "menhir" ~loc:None ~hint:"try: opam install menhir"
 
   (* [menhir args] generates a Menhir command line (a build action). *)
 

src/odoc.ml

@@ -85,7 +85,7 @@ module Gen (S : sig val sctx : SC.t end) = struct
     let setup_deps m files = SC.add_alias_deps sctx (alias m) files
   end
 
-  let odoc = SC.resolve_program sctx "odoc" ~hint:"opam install odoc" ~loc:None
+  let odoc = SC.resolve_program sctx "odoc" ~hint:"try: opam install odoc" ~loc:None
   let odoc_ext = ".odoc"
 
   module Mld : sig

src/preprocessing.ml

@@ -417,7 +417,7 @@ let cookie_library_name lib_name =
 let setup_reason_rules sctx (m : Module.t) =
   let ctx = SC.context sctx in
   let refmt =
-    SC.resolve_program sctx ~loc:None "refmt" ~hint:"opam install reason" in
+    SC.resolve_program sctx ~loc:None "refmt" ~hint:"try: opam install reason" in
   let rule src target =
     Build.run ~context:ctx refmt
       [ A "--print"

src/report_error.ml

@@ -10,15 +10,81 @@ type printer =
   ; backtrace : bool
   }
 
-let p =
-  { loc       = None
-  ; pp        = ignore
-  ; hint      = None
-  ; backtrace = false
+let make_printer ?(backtrace=false) ?hint ?loc pp =
+  { loc
+  ; pp
+  ; hint
+  ; backtrace
   }
 
-let reporters = ref []
-let register f = reporters := f :: !reporters
+let set_loc p ~loc =
+  {p with loc = Some loc}
+
+let set_hint p ~hint =
+  {p with hint = Some hint}
+
+let builtin_printer = function
+  | Dsexp.Of_sexp.Of_sexp (loc, msg, hint') ->
+    let loc =
+      { loc with
+        start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
+      }
+    in
+    let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s%s\n" msg
+                   (match hint' with
+                    | None -> ""
+                    | Some { Dsexp.Of_sexp. on; candidates } ->
+                      hint on candidates)
+    in
+    Some (make_printer ~loc pp)
+  | Exn.Loc_error (loc, msg) ->
+    let loc =
+      { loc with
+        start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
+      }
+    in
+    let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s\n" msg in
+    Some (make_printer ~loc pp)
+  | Dsexp.Parse_error e ->
+    let loc = Dsexp.Parse_error.loc     e in
+    let msg = Dsexp.Parse_error.message e in
+    let map_pos (pos : Lexing.position) =
+      { pos with pos_fname = !map_fname pos.pos_fname }
+    in
+    let loc : Loc.t =
+      { start = map_pos loc.start
+      ; stop  = map_pos loc.stop
+      }
+    in
+    let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s\n" msg in
+    Some (make_printer ~loc pp)
+  | Exn.Fatal_error msg ->
+    let pp ppf =
+      if msg.[String.length msg - 1] = '\n' then
+        Format.fprintf ppf "%s" msg
+      else
+        Format.fprintf ppf "%s\n" (String.capitalize msg)
+    in
+    Some (make_printer pp)
+  | Stdune.Exn.Code_error sexp ->
+    let pp = fun ppf ->
+          Format.fprintf ppf "@{<error>Internal error, please report upstream \
+                              including the contents of _build/log.@}\n\
+                              Description:%a\n"
+            Sexp.pp sexp
+    in
+    Some (make_printer ~backtrace:true pp)
+  | Unix.Unix_error (err, func, fname) ->
+    let pp ppf =
+      Format.fprintf ppf "@{<error>Error@}: %s: %s: %s\n"
+        func fname (Unix.error_message err)
+    in
+    Some (make_printer pp)
+  | _ -> None
+
+let printers = ref [builtin_printer]
+
+let register f = printers := f :: !printers
 
 let i_must_not_segfault =
   let x = lazy (at_exit (fun () ->
@@ -31,79 +97,24 @@ cases are handled there will be nothing.  Only I will remain."))
   in
   fun () -> Lazy.force x
 
+let find_printer exn =
+  List.find_map !printers ~f:(fun f -> f exn)
+
+let exn_printer exn =
+  let pp ppf =
+    let s = Printexc.to_string exn in
+    if String.is_prefix s ~prefix:"File \"" then
+      Format.fprintf ppf "%s\n" s
+    else
+      Format.fprintf ppf "@{<error>Error@}: exception %s\n" s
+  in
+  make_printer ~backtrace:true pp
+
 (* Firt return value is [true] if the backtrace was printed *)
 let report_with_backtrace exn =
-  match List.find_map !reporters ~f:(fun f -> f exn) with
+  match find_printer exn with
   | Some p -> p
-  | None ->
-    match exn with
-    | Exn.Loc_error (loc, msg) ->
-      let loc =
-        { loc with
-          start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
-        }
-      in
-      let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s\n" msg in
-      { p with loc = Some loc; pp }
-    | Dsexp.Of_sexp.Of_sexp (loc, msg, hint') ->
-      let loc =
-        { loc with
-          start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
-        }
-      in
-      let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s%s\n" msg
-                     (match hint' with
-                      | None -> ""
-                      | Some { Dsexp.Of_sexp. on; candidates } ->
-                        hint on candidates)
-      in
-      { p with loc = Some loc; pp }
-    | Dsexp.Parse_error e ->
-      let loc = Dsexp.Parse_error.loc     e in
-      let msg = Dsexp.Parse_error.message e in
-      let map_pos (pos : Lexing.position) =
-        { pos with pos_fname = !map_fname pos.pos_fname }
-      in
-      let loc : Loc.t =
-        { start = map_pos loc.start
-        ; stop  = map_pos loc.stop
-        }
-      in
-      { p with
-        loc = Some loc
-      ; pp  = fun ppf -> Format.fprintf ppf "@{<error>Error@}: %s\n" msg
-      }
-    | Exn.Fatal_error msg ->
-      { p with pp = fun ppf ->
-          if msg.[String.length msg - 1] = '\n' then
-            Format.fprintf ppf "%s" msg
-          else
-            Format.fprintf ppf "%s\n" (String.capitalize msg)
-      }
-    | Stdune.Exn.Code_error sexp ->
-      { p with
-        backtrace = true
-      ; pp = fun ppf ->
-          Format.fprintf ppf "@{<error>Internal error, please report upstream \
-                              including the contents of _build/log.@}\n\
-                              Description:%a\n"
-            Sexp.pp sexp
-      }
-    | Unix.Unix_error (err, func, fname) ->
-      { p with pp = fun ppf ->
-          Format.fprintf ppf "@{<error>Error@}: %s: %s: %s\n"
-            func fname (Unix.error_message err)
-      }
-    | _ ->
-      { p with
-        backtrace = true
-      ; pp = fun ppf ->
-          let s = Printexc.to_string exn in
-          if String.is_prefix s ~prefix:"File \"" then
-            Format.fprintf ppf "%s\n" s
-          else
-            Format.fprintf ppf "@{<error>Error@}: exception %s\n" s
-      }
+  | None -> exn_printer exn
 
 let reported = ref String.Set.empty
 
@@ -157,7 +168,7 @@ let report exn =
       if dependency_path <> [] then
         Format.fprintf ppf "%a@\n" Dep_path.Entries.pp
           (List.rev dependency_path);
-      Option.iter p.hint ~f:(fun s -> Format.fprintf ppf "Hint: try: %s\n" s);
+      Option.iter p.hint ~f:(fun s -> Format.fprintf ppf "Hint: %s\n" s);
       Format.pp_print_flush ppf ();
       let s = Buffer.contents err_buf in
       Buffer.clear err_buf;

src/report_error.mli

@@ -11,15 +11,24 @@ open! Stdune
     We cache what is actually printed to the screen.  *)
 val report : exn -> unit
 
-type printer =
-  { loc       : Loc.t option
-  ; pp        : Format.formatter -> unit
-  ; hint      : string option
-  ; backtrace : bool
-  }
-
-(** Register an error reporter. *)
+type printer
+
+val make_printer :
+  ?backtrace:bool ->
+  ?hint:string ->
+  ?loc:Loc.t ->
+  (Format.formatter -> unit) ->
+  printer
+
+val set_loc : printer -> loc:Loc.t -> printer
+
+val set_hint : printer -> hint:string -> printer
+
+(** Register an error printer. *)
 val register : (exn -> printer option) -> unit
 
+(** Find an error printer *)
+val find_printer : exn -> printer option
+
 (**/**)
 val map_fname : (string -> string) ref

src/stanza.ml

@@ -27,21 +27,22 @@ let file_kind () =
 module Of_sexp = struct
   include Dsexp.Of_sexp
 
-  exception Parens_no_longer_necessary of Loc.t
+  exception Parens_no_longer_necessary of Loc.t * exn
 
   let () =
     Report_error.register
       (function
-        | Parens_no_longer_necessary loc ->
-          Some
-            { loc = Some loc
-            ; hint = None
-            ; backtrace = false
-            ; pp = fun ppf ->
-                Format.fprintf ppf
-                  "These parentheses are no longer necessary with dune, \
-                   please remove them.@\n"
-            }
+        | Parens_no_longer_necessary (loc, exn) ->
+          let hint =
+            "dune files require less parentheses than jbuild files.\n\
+             If you just converted this file from a jbuild file, try removing these parentheses."
+          in
+          Option.map (Report_error.find_printer exn)
+            ~f:(fun printer ->
+              printer
+              |> Report_error.set_loc ~loc
+              |> Report_error.set_hint ~hint
+            )
         | _ -> None)
 
   let switch_file_kind ~jbuild ~dune =
@@ -64,12 +65,12 @@ module Of_sexp = struct
                   (if is_record then
                      peek >>= function
                      | Some (List _) ->
-                       raise (Parens_no_longer_necessary loc)
+                       raise (Parens_no_longer_necessary (loc, exn))
                      | _ -> t
                    else
                      t)
                   >>= fun _ ->
-                  raise (Parens_no_longer_necessary loc)))
+                  raise (Parens_no_longer_necessary (loc, exn))))
               (function
                 | Parens_no_longer_necessary _ as exn -> raise exn
                 | _ -> raise exn))

test/blackbox-tests/test-cases/too-many-parens/e/dune

@@ -0,0 +1,5 @@
+(alias
+ (name a)
+ (deps (glob *)) ; this form doesn't exist
+ (action (echo test))
+)

test/blackbox-tests/test-cases/too-many-parens/e/dune-project

@@ -0,0 +1 @@
+(lang dune 1.0)

test/blackbox-tests/test-cases/too-many-parens/run.t

@@ -8,25 +8,44 @@ are readable.
   3:   (public_name hello)
   4:   (libraries (lib))
   5: ))
-  These parentheses are no longer necessary with dune, please remove them.
+  Error: Atom expected
+  Hint: dune files require less parentheses than jbuild files.
+  If you just converted this file from a jbuild file, try removing these parentheses.
   [1]
 
   $ dune build --root b
   File "dune", line 4, characters 12-17:
    (libraries (lib)))
               ^^^^^
-  These parentheses are no longer necessary with dune, please remove them.
+  Error: 'select' expected
+  Hint: dune files require less parentheses than jbuild files.
+  If you just converted this file from a jbuild file, try removing these parentheses.
   [1]
 
   $ dune build --root c
   File "dune", line 3, characters 7-14:
    (deps (x y z)))
          ^^^^^^^
-  These parentheses are no longer necessary with dune, please remove them.
+  Error: Unknown constructor x
+  Hint: dune files require less parentheses than jbuild files.
+  If you just converted this file from a jbuild file, try removing these parentheses.
   [1]
 
 Checking that extra long stanzas (over 10 lines) are not printed
   $ dune build --root d
   File "dune", line 3, characters 13-192:
-  These parentheses are no longer necessary with dune, please remove them.
+  Error: 'select' expected
+  Hint: dune files require less parentheses than jbuild files.
+  If you just converted this file from a jbuild file, try removing these parentheses.
+  [1]
+
+When the inner syntax is wrong, do not warn about the parens:
+
+  $ dune build --root e
+  File "dune", line 3, characters 7-15:
+   (deps (glob *)) ; this form doesn't exist
+         ^^^^^^^^
+  Error: Unknown constructor glob
+  Hint: dune files require less parentheses than jbuild files.
+  If you just converted this file from a jbuild file, try removing these parentheses.
   [1]