select which kind of errors one wants to show

src/frontend/new/new_commands.ml

@@ -173,6 +173,14 @@ increasing size of all entities surrounding the position.
   ;
 
   command "errors"
+    ~spec:[
+      arg "-lexing" "<bool> Whether to report lexing errors or not"
+        (Marg.bool (fun l (_,p,t) -> (l,p,t)));
+      arg "-parsing" "<bool> Whether to report parsing errors or not"
+        (Marg.bool (fun p (l,_,t) -> (l,p,t)));
+      arg "-typing" "<bool> Whether to report typing errors or not"
+        (Marg.bool (fun t (l,p,_) -> (l,p,t)));
+    ]
     ~doc:"Returns a list of errors in current buffer.
 The value is a list where each item as the shape:
 
@@ -194,10 +202,9 @@ mark this range.
 It reflects whether Merlin was expecting such an error to be possible or not, \
 and is useful for debugging purposes.
 `message` is the error description to be shown to the user."
-    ~spec:[]
-    ~default:()
-    begin fun buffer () ->
-      run buffer (Query_protocol.Errors)
+    ~default:(true, true, true)
+    begin fun buffer (lexing, parsing, typing) ->
+      run buffer (Query_protocol.Errors { lexing; parsing; typing })
     end
   ;
 

src/frontend/old/old_IO.ml

@@ -176,7 +176,7 @@ let request_of_json context =
     | [`String "refresh"] ->
       request (Sync Refresh)
     | [`String "errors"] ->
-      request (Query Errors)
+      request (Query (Errors { lexing = true; parsing = true; typing = true }))
     | (`String "dump" :: args) ->
       request (Query (Dump args))
     | [`String "which"; `String "path"; `String name] ->

src/frontend/query_commands.ml

@@ -587,7 +587,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
     let pos = Mpipeline.get_lexing_pos pipeline pos in
     Outline.shape pos [Browse_tree.of_browse browse]
 
-  | Errors ->
+  | Errors { lexing; parsing; typing }->
     with_typer pipeline @@ fun typer ->
     let verbosity = verbosity pipeline in
     Printtyp.wrap_printing_env (Mtyper.get_env typer) ~verbosity @@ fun () ->
@@ -650,8 +650,12 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
       if n <> 0 then n else
         Lexing.compare_pos (error_end e1) (error_end e2)
     in
-    let errors = List.sort_uniq ~cmp
-        (lexer_errors @ parser_errors @ typer_errors) in
+    let errors =
+      List.sort_uniq ~cmp
+        ((if lexing then lexer_errors else []) @
+         (if parsing then parser_errors else []) @
+         (if typing then typer_errors else []))
+    in
     (* Filter anything after first parse error *)
     let limit = !first_syntax_error in
     if limit = Lexing.dummy_pos then errors else (

src/frontend/query_json.ml

@@ -134,7 +134,17 @@ let dump (type a) : a t -> json =
       "end", mk_position pos_end;
     ]
   | Outline -> mk "outline" []
-  | Errors -> mk "errors" []
+  | Errors { lexing; parsing; typing } ->
+    let args =
+      if lexing && parsing && typing
+      then []
+      else [
+        "lexing", `Bool lexing;
+        "parsing", `Bool parsing;
+        "typing", `Bool typing;
+      ]
+    in
+    mk "errors" args
   | Shape pos ->
     mk "shape" [
       "position", mk_position pos;
@@ -358,7 +368,7 @@ let json_of_response (type a) (query : a t) (response : a) : json =
     `List (json_of_outline outlines)
   | Shape _, shapes ->
     `List (List.map ~f:json_of_shape shapes)
-  | Errors, errors ->
+  | Errors _, errors ->
     `List (List.map ~f:json_of_error errors)
   | Dump _, json -> json
   | Path_of_source _, str -> `String str

src/frontend/query_protocol.ml

@@ -87,6 +87,12 @@ type shape = {
   shape_sub : shape list;
 }
 
+type error_filter = {
+  lexing : bool;
+  parsing : bool;
+  typing : bool;
+}
+
 type is_tail_position = [`No | `Tail_position | `Tail_call]
 
 type _ _bool = bool
@@ -150,7 +156,8 @@ type _ t =
     :  Msource.position
     -> shape list t
   | Errors(* *)
-    :  Location.error list t
+    :  error_filter
+    -> Location.error list t
   | Dump
     :  Std.json list
     -> Std.json t

tests/errors/dune

@@ -0,0 +1,8 @@
+(alias
+ (name runtest)
+ (deps (:t test.t) test.ml)
+ (action
+   (progn
+     (setenv MERLIN %{dep:../merlin-wrapper}
+       (run %{bin:mdx} test --syntax=cram %{t}))
+     (diff? %{t} %{t}.corrected))))

tests/errors/test.ml

@@ -0,0 +1,11 @@
+(* First a typing error *)
+
+let () = 3
+
+(* Then a parsing error *)
+
+let () = | 3
+
+(* Then a typing error again *)
+
+let () = 3

tests/errors/test.t

@@ -0,0 +1,88 @@
+First ask for all the errors:
+
+  $ $MERLIN single errors -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": [
+      {
+        "start": {
+          "line": 3,
+          "col": 9
+        },
+        "end": {
+          "line": 3,
+          "col": 10
+        },
+        "type": "typer",
+        "sub": [],
+        "valid": true,
+        "message": "This expression has type int but an expression was expected of type unit"
+      },
+      {
+        "start": {
+          "line": 7,
+          "col": 9
+        },
+        "end": {
+          "line": 7,
+          "col": 10
+        },
+        "type": "parser",
+        "sub": [],
+        "valid": true,
+        "message": "Syntax error, expecting expr"
+      }
+    ],
+    "notifications": []
+  }
+
+Notice that the second type error is not returned, as it happens after the first
+syntax error.
+
+Now let's just ask for typing errors:
+
+  $ $MERLIN single errors -lexing false -parsing false -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": [
+      {
+        "start": {
+          "line": 3,
+          "col": 9
+        },
+        "end": {
+          "line": 3,
+          "col": 10
+        },
+        "type": "typer",
+        "sub": [],
+        "valid": true,
+        "message": "This expression has type int but an expression was expected of type unit"
+      }
+    ],
+    "notifications": []
+  }
+
+And let's also try filtering out type errors:
+
+  $ $MERLIN single errors -typing false -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": [
+      {
+        "start": {
+          "line": 7,
+          "col": 9
+        },
+        "end": {
+          "line": 7,
+          "col": 10
+        },
+        "type": "parser",
+        "sub": [],
+        "valid": true,
+        "message": "Syntax error, expecting expr"
+      }
+    ],
+    "notifications": []
+  }