Improve user error messages

CHANGES.md

@@ -4,6 +4,7 @@
 
   + Add an option `--margin-check` to emit a warning if the formatted output exceeds the margin (#1110) (Guillaume Petiot)
   + Preserve comment indentation when `wrap-comments` is unset (#1138, #1159) (Jules Aguillon)
+  + Improve error messages (#1147) (Jules Aguillon)
 
 #### Packaging
 

bin/ocamlformat_reason.ml

@@ -60,8 +60,9 @@ let to_output_file output_file data =
 let run_action action opts =
   match action with
   | Conf.Inplace __ ->
-      user_error "Cannot convert Reason code with --inplace" []
-  | Check _ -> user_error "Cannot check Reason code with --check" []
+      Error (fun () -> failwith "Cannot convert Reason code with --inplace")
+  | Check _ ->
+      Error (fun () -> failwith "Cannot check Reason code with --check")
   | In_out ({kind; file; name= input_name; conf}, output_file) -> (
       let (Pack {parse; xunit}) = pack_of_kind kind in
       let t =

lib/Conf.ml

@@ -1754,6 +1754,12 @@ let ocp_indent_janestreet_profile =
   ; ("align_ops", "true")
   ; ("align_params", "always") ]
 
+let string_of_user_error = function
+  | `Malformed line -> Format.sprintf "Invalid format %S" line
+  | `Misplaced (name, _) -> Format.sprintf "%s not allowed here" name
+  | `Unknown (name, _) -> Format.sprintf "Unknown option %S" name
+  | `Bad_value (name, msg) -> Format.sprintf "For option %S: %s" name msg
+
 let parse_line config ~from s =
   let update ~config ~from ~name ~value =
     let name = String.strip name in
@@ -1765,8 +1771,8 @@ let parse_line config ~from s =
         else
           Error
             (`Bad_value
-              ( value
-              , Format.sprintf "expecting %s but got %s" Version.version
+              ( name
+              , Format.sprintf "expecting %S but got %S" Version.version
                   value ))
     | name, `File x ->
         C.update ~config ~from:(`Parsed (`File x)) ~name ~value ~inline:false
@@ -1870,6 +1876,15 @@ let rec collect_files ~enable_outside_detected_project ~root ~segs ~ignores
         collect_files ~enable_outside_detected_project ~root ~segs:upper_segs
           ~ignores ~enables ~files
 
+exception Conf_error of string
+
+let failwith_user_errors ~kind errors =
+  let open Format in
+  let pp_error pp e = pp_print_string pp (string_of_user_error e) in
+  let pp_errors = pp_print_list ~pp_sep:pp_print_newline pp_error in
+  let msg = asprintf "Error while parsing %s:@ %a" kind pp_errors errors in
+  raise (Conf_error msg)
+
 let read_config_file conf filename_kind =
   match filename_kind with
   | `Ocp_indent _ when not !ocp_indent_config -> conf
@@ -1896,17 +1911,7 @@ let read_config_file conf filename_kind =
                 | `Ocp_indent _ -> dot_ocp_indent
                 | `Ocamlformat _ -> dot_ocamlformat
               in
-              user_error
-                (Format.sprintf "malformed %s file" kind)
-                (List.map l ~f:(function
-                  | `Malformed line -> ("invalid format", Sexp.Atom line)
-                  | `Misplaced (name, _) ->
-                      ("not allowed here", Sexp.Atom name)
-                  | `Unknown (name, _value) ->
-                      ("unknown option", Sexp.Atom name)
-                  | `Bad_value (name, reason) ->
-                      ( "bad value for"
-                      , Sexp.List [Sexp.Atom name; Sexp.Atom reason] ))))
+              failwith_user_errors ~kind l)
     with Sys_error _ -> conf )
 
 let update_using_env conf =
@@ -1916,19 +1921,9 @@ let update_using_env conf =
     | Error e -> (config, e :: errors)
   in
   let conf, errors = List.fold_left !config ~init:(conf, []) ~f in
-  try
-    match List.rev errors with
-    | [] -> conf
-    | l ->
-        user_error "malformed OCAMLFORMAT environment variable"
-          (List.map l ~f:(function
-            | `Malformed line -> ("invalid format", Sexp.Atom line)
-            | `Misplaced (name, _) -> ("not allowed here", Sexp.Atom name)
-            | `Unknown (name, _value) -> ("unknown option", Sexp.Atom name)
-            | `Bad_value (name, reason) ->
-                ( "bad value for"
-                , Sexp.List [Sexp.Atom name; Sexp.Atom reason] )))
-  with Sys_error _ -> conf
+  match List.rev errors with
+  | [] -> conf
+  | l -> failwith_user_errors ~kind:"OCAMLFORMAT environment variable" l
 
 let xdg_config =
   let xdg_config_home =
@@ -2189,6 +2184,7 @@ let validate () =
     >>= fun inputs ->
     make_action ~enable_outside_detected_project ~root action inputs
   with
+  | exception Conf_error e -> `Error (false, e)
   | Error e -> `Error (false, e)
   | Ok action ->
       let opts = {debug= !debug; margin_check= !margin_check} in
@@ -2212,25 +2208,18 @@ let update ?(quiet = false) c {attr_name= {txt; loc}; attr_payload; _} =
                   , [] )
             ; _ } ] ->
           parse_line ~from:`Attribute c str
-      | _ -> Error (`Malformed "string expected") )
+          |> Result.map_error ~f:string_of_user_error
+      | _ -> Error "Invalid format: String expected" )
     | _ when String.is_prefix ~prefix:"ocamlformat." txt ->
         Error
-          (`Malformed
-            (Format.sprintf "unknown suffix %S"
-               (String.chop_prefix_exn ~prefix:"ocamlformat." txt)))
+          (Format.sprintf "Invalid format: Unknown suffix %S"
+             (String.chop_prefix_exn ~prefix:"ocamlformat." txt))
     | _ -> Ok c
   in
   match result with
   | Ok conf -> conf
   | Error error ->
-      let reason = function
-        | `Malformed line -> Format.sprintf "Invalid format %S" line
-        | `Misplaced (name, _) -> Format.sprintf "%s not allowed here" name
-        | `Unknown (name, _) -> Format.sprintf "Unknown option %s" name
-        | `Bad_value (name, value) ->
-            Format.sprintf "Invalid value for %s: %S" name value
-      in
-      let w = Warnings.Attribute_payload (txt, reason error) in
+      let w = Warnings.Attribute_payload (txt, error) in
       if (not c.quiet) && not quiet then Compat.print_warning loc w ;
       c
 

lib/Literal_lexer.mll

@@ -32,7 +32,7 @@ rule string mode = parse
       { reset_string_buffer ();
         string_aux mode lexbuf;
         get_stored_string () }
-  | _ { user_error "not a string literal" [] }
+  | _ { failwith "not a string literal" }
 
 
 and string_aux mode = parse
@@ -82,7 +82,7 @@ and string_aux mode = parse
       { store_string (Lexing.lexeme lexbuf);
         string_aux mode lexbuf }
   | eof
-      { user_error "not a string literal" [] }
+      { failwith "not a string literal" }
   | _
       { store_string_char (Lexing.lexeme_char lexbuf 0);
         string_aux mode lexbuf }
@@ -101,4 +101,4 @@ and char = parse
   | "\'" ("\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] as x) "\'"
       { x }
   | _
-      { user_error "not a char literal" [] }
+      { failwith "not a char literal" }

lib/Reason.ml

@@ -52,10 +52,10 @@ module Binary_reason = struct
     let rec loop = function
       | [] ->
           if is_intf_or_impl magic then
-            user_error "Unknown version" [("magic", Sexp.Atom magic)]
+            failwith (Format.sprintf "Unknown version (magic: %s)" magic)
           else
-            user_error "Not a binary reason file"
-              [("prefix", Sexp.Atom magic)]
+            failwith
+              (Format.sprintf "Not a binary reason file (prefix: %s)" magic)
       | (module Frontend : Migrate_parsetree.Versions.OCaml_version) :: tail
         ->
           if String.equal Frontend.Ast.Config.ast_impl_magic_number magic
@@ -224,7 +224,7 @@ let input_bin_impl ic : Migrate_ast.Parsetree.structure t =
       { origin_filename
       ; ast_and_comment= {Parse_with_comments.ast; comments; prefix= ""} }
   | Binary_reason.Intf _ ->
-      user_error "expected serialized implementation, found interface" []
+      failwith "expected serialized implementation, found interface"
 
 let input_bin_intf ic : Migrate_ast.Parsetree.signature t =
   let origin_filename, comments, x = Binary_reason.input ic in
@@ -243,7 +243,7 @@ let input_bin_intf ic : Migrate_ast.Parsetree.signature t =
       { origin_filename
       ; ast_and_comment= {Parse_with_comments.ast; comments; prefix= ""} }
   | Binary_reason.Impl _ ->
-      user_error "expected serialized interface, found implementation" []
+      failwith "expected serialized interface, found implementation"
 
 let norm_impl c {Parse_with_comments.ast; comments; prefix= _} =
   Migrate_ast.Mapper.structure

lib/import/Import.ml

@@ -32,9 +32,6 @@ let ( >> ) f g x = g (f x)
 
 let impossible msg = failwith msg
 
-let user_error msg kvs =
-  Error.raise_s (Sexp.message ("User Error: " ^ msg) kvs)
-
 let check f x =
   assert (
     ignore (f x) ;

lib/import/Import.mli

@@ -40,9 +40,6 @@ val ( >> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
 val impossible : string -> _
 (** Indicate why the call is expected to be impossible. *)
 
-val user_error : string -> (string * Sexp.t) list -> _
-(** Raise a user error (e.g. due to malformed or illegal input). *)
-
 val check : ('a -> _) -> 'a -> 'a
 (** Asserting identity: [check f x] asserts that [f x] does not raise and
     returns [x]. *)

test/cli/conf_malformed1.expected

@@ -0,0 +1,2 @@
+ocamlformat: Error while parsing .ocamlformat:
+             Invalid format "a = b = c"

test/cli/conf_unknown_option.expected

@@ -0,0 +1,2 @@
+ocamlformat: Error while parsing .ocamlformat:
+             Unknown option "unknown_option"

test/cli/conf_unknown_value.expected

@@ -0,0 +1,2 @@
+ocamlformat: Error while parsing .ocamlformat:
+             For option "field-space": invalid value `unknown_value', expected one of `loose', `tight' or `tight-decl'

test/cli/dune

@@ -297,3 +297,103 @@
  (name runtest)
  (action
   (diff max_iter_1_failing.expected max_iter_1_failing.output)))
+
+;; This test's stderr is ignored because it's not stable
+;; (it contains the current git rev)
+(rule
+ (targets conf_bad_version.output)
+ (deps
+  (source_tree roots/bad_version))
+ (action
+  (with-outputs-to
+   %{targets}
+   (chdir
+    roots/bad_version
+    (system "! %{bin:ocamlformat} --impl - < %{dep:sample/a.ml} 2>/dev/null")))))
+
+(alias
+ (name runtest)
+ (action
+  (diff conf_bad_version.expected conf_bad_version.output)))
+
+(rule
+ (targets conf_malformed1.output)
+ (deps
+  (source_tree roots/malformed1))
+ (action
+  (with-outputs-to
+   %{targets}
+   (chdir
+    roots/malformed1
+    (system "! %{bin:ocamlformat} --impl - < %{dep:sample/a.ml}")))))
+
+(alias
+ (name runtest)
+ (action
+  (diff conf_malformed1.expected conf_malformed1.output)))
+
+(rule
+ (targets conf_unknown_option.output)
+ (deps
+  (source_tree roots/unknown_option))
+ (action
+  (with-outputs-to
+   %{targets}
+   (chdir
+    roots/unknown_option
+    (system "! %{bin:ocamlformat} --impl - < %{dep:sample/a.ml}")))))
+
+(alias
+ (name runtest)
+ (action
+  (diff conf_unknown_option.expected conf_unknown_option.output)))
+
+(rule
+ (targets conf_unknown_value.output)
+ (deps
+  (source_tree roots/unknown_value))
+ (action
+  (with-outputs-to
+   %{targets}
+   (chdir
+    roots/unknown_value
+    (system "! %{bin:ocamlformat} --impl - < %{dep:sample/a.ml}")))))
+
+(alias
+ (name runtest)
+ (action
+  (diff conf_unknown_value.expected conf_unknown_value.output)))
+
+(rule
+ (targets env_unknown_option.output)
+ (deps
+  (source_tree roots/unknown_value))
+ (action
+  (with-outputs-to
+   %{targets}
+   (setenv
+    OCAMLFORMAT
+    "unknown=true"
+    (system "! %{bin:ocamlformat} --impl - < %{dep:sample/a.ml}")))))
+
+(alias
+ (name runtest)
+ (action
+  (diff env_unknown_option.expected env_unknown_option.output)))
+
+(rule
+ (targets env_unknown_value.output)
+ (deps
+  (source_tree roots/unknown_value))
+ (action
+  (with-outputs-to
+   %{targets}
+   (setenv
+    OCAMLFORMAT
+    "type-decl=unknown"
+    (system "! %{bin:ocamlformat} --impl - < %{dep:sample/a.ml}")))))
+
+(alias
+ (name runtest)
+ (action
+  (diff env_unknown_value.expected env_unknown_value.output)))

test/cli/env_unknown_option.expected

@@ -0,0 +1,2 @@
+ocamlformat: Error while parsing OCAMLFORMAT environment variable:
+             Unknown option "unknown"

test/cli/env_unknown_value.expected

@@ -0,0 +1,2 @@
+ocamlformat: Error while parsing OCAMLFORMAT environment variable:
+             For option "type-decl": invalid value `unknown', expected either `compact' or `sparse'

test/cli/roots/bad_version/.ocamlformat

@@ -0,0 +1 @@
+version = bad

test/cli/roots/malformed1/.ocamlformat

@@ -0,0 +1 @@
+a = b = c

test/cli/roots/unknown_option/.ocamlformat

@@ -0,0 +1 @@
+unknown_option = true

test/cli/roots/unknown_value/.ocamlformat

@@ -0,0 +1 @@
+field-space = unknown_value

test/passing/option.ml.ref

@@ -3,16 +3,16 @@ Warning 47: illegal payload for attribute 'ocamlformat'.
 margin not allowed here
 File "option.ml", line 13, characters 3-19:
 Warning 47: illegal payload for attribute 'ocamlformat.typo'.
-Invalid format "unknown suffix \"typo\""
+Invalid format: Unknown suffix "typo"
 File "option.ml", line 21, characters 3-14:
 Warning 47: illegal payload for attribute 'ocamlformat'.
-Invalid format "string expected"
+Invalid format: String expected
 File "option.ml", line 28, characters 3-14:
 Warning 47: illegal payload for attribute 'ocamlformat'.
-Invalid value for if-then-else: "invalid value `bad', expected one of `compact', `fit-or-vertical', `keyword-first' or `k-r'"
+For option "if-then-else": invalid value `bad', expected one of `compact', `fit-or-vertical', `keyword-first' or `k-r'
 File "option.ml", line 39, characters 14-25:
 Warning 47: illegal payload for attribute 'ocamlformat'.
-Invalid value for if-then-else: "invalid value `bad', expected one of `compact', `fit-or-vertical', `keyword-first' or `k-r'"
+For option "if-then-else": invalid value `bad', expected one of `compact', `fit-or-vertical', `keyword-first' or `k-r'
 let _ =
   if b
   then e