[suppressions] compute list of errors

Summary:
Make `Suppressions.parse_lines` return a list of errors instead of
reporting them as we go. This will allow us to test which errors are
reported in unit tests. Use a simple error monad to simplify notations.

Reviewed By: skcho

Differential Revision: D66700714

fbshipit-source-id: e51f61b7295a52cf4bf2bff547eb659f378f4ba8

infer/src/integration/Suppressions.ml

@@ -75,23 +75,77 @@ let substring_after_match rx s =
 
 let regex_cache = ref IString.Map.empty
 
+module ParseResult = struct
+  type error = UserError of (unit -> string)
+
+  let pp_error fmt (UserError error) = F.pp_print_string fmt (error ())
+
+  type 'a parse_result = 'a * error list
+
+  let _pp_parse_result pp fmt ((x, errors) : _ parse_result) =
+    if List.is_empty errors then pp fmt x
+    else
+      F.fprintf fmt "@[RESULT: @[%a@]@\nERRORS: @[%a@]@]" pp x
+        (Pp.semicolon_seq ~print_env:Pp.text_break pp_error)
+        errors
+
+
+  let bind (x, errors) f =
+    let x', errors' = f x in
+    (x', errors' @ errors)
+
+
+  let ret x = (x, [])
+
+  let map x f = bind x (fun x' -> ret (f x'))
+
+  let ( >>= ) x f = bind x f
+
+  let ( >>| ) x f = map x f
+
+  let ( let* ) x f = bind x f
+
+  let ( let+ ) x f = map x f
+
+  let error f = ((), [UserError f])
+
+  let result_list_fold l ~init ~f =
+    let acc, rev_errors =
+      List.fold l ~init:(init, []) ~f:(fun (acc, rev_errors) x ->
+          let acc, errors = f acc x in
+          let rev_errors = List.rev_append errors rev_errors in
+          (acc, rev_errors) )
+    in
+    (acc, List.rev rev_errors)
+
+
+  let result_list_filter l ~f =
+    result_list_fold l ~init:[] ~f:(fun rev_l' x ->
+        let+ b = f x in
+        if b then x :: rev_l' else rev_l' )
+    >>| List.rev
+end
+
+include ParseResult
+
 let get_regex s =
   match IString.Map.find_opt s !regex_cache with
   | None -> (
     try
       let r = Str.regexp s in
       regex_cache := IString.Map.add s r !regex_cache ;
-      Some r
+      ret (Some r)
     with _ ->
-      L.user_error "Invalid regex: %s@\n" s ;
+      let+ () = error (fun () -> F.asprintf "Invalid regex: %s@\n" s) in
       None )
-  | v ->
-      v
+  | Some _ as v ->
+      ret v
 
 
 (* return all matching issue_types for a given regex-string *)
 let matching_issue_types s =
-  match get_regex s with
+  let+ regex = get_regex s in
+  match regex with
   | Some rx ->
       IssueType.all_issues ()
       |> List.map ~f:(fun {IssueType.unique_id} -> unique_id)
@@ -102,19 +156,24 @@ let matching_issue_types s =
 
 (* does a given regex-string match any issue_type (but not all of them) *)
 let valid_issue_type s =
-  let matching = matching_issue_types s in
+  let+ matching = matching_issue_types s in
   List.is_empty matching |> not && List.length matching <> List.length (IssueType.all_issues ())
 
 
 (* return valid bug types / wildcards from a comma-separated string *)
 let extract_valid_issue_types s =
   s |> String.split ~on:',' |> List.map ~f:String.strip
   |> List.filter ~f:(fun s -> s |> String.is_empty |> not)
-  |> List.filter ~f:(fun s ->
-         let valid = valid_issue_type s in
-         if not valid then L.user_error "%s not a valid issue_type / wildcard@\n" s ;
-         valid )
-  |> IString.Set.of_list
+  |> ret
+  >>= result_list_filter ~f:(fun s ->
+          let* valid = valid_issue_type s in
+          let+ () =
+            if not valid then
+              error (fun () -> F.asprintf "%s not a valid issue_type / wildcard@\n" s)
+            else ret ()
+          in
+          valid )
+  >>| IString.Set.of_list
 
 
 (* trailing space intentional *)
@@ -123,30 +182,37 @@ let ignore_rx = Str.regexp_string "@infer-ignore "
 let ignore_all_rx = Str.regexp_string "@infer-ignore-every "
 
 let parse_lines ?file lines =
-  let parse_result =
-    List.fold lines
+  let+ parse_result =
+    result_list_fold lines
       ~init:
         {current_line= 1; block_start= None; issue_types= IString.Set.empty; res= IString.Map.empty}
       ~f:(fun {current_line; block_start; issue_types; res} line ->
         let next_line = current_line + 1 in
         match (substring_after_match ignore_all_rx line, substring_after_match ignore_rx line) with
         | None, None ->
-            { current_line= next_line
-            ; block_start= None
-            ; issue_types= IString.Set.empty
-            ; res= update_suppressions block_start current_line issue_types res }
+            ret
+              { current_line= next_line
+              ; block_start= None
+              ; issue_types= IString.Set.empty
+              ; res= update_suppressions block_start current_line issue_types res }
         | Some s, other ->
-            if Option.is_some other then
-              L.user_error "Both @infer-ignore-every and @infer-ignore found in %s line %d@\n"
-                (Option.value ~default:"" file) next_line ;
+            let* () =
+              if Option.is_some other then
+                error (fun () ->
+                    F.asprintf "Both @infer-ignore-every and @infer-ignore found in %s line %d@\n"
+                      (Option.value ~default:"" file) next_line )
+              else ret ()
+            in
+            let+ valid_issue_types = extract_valid_issue_types s in
             { current_line= next_line
             ; block_start= None
             ; issue_types= IString.Set.empty
-            ; res= update_suppressions_every (extract_valid_issue_types s) res }
+            ; res= update_suppressions_every valid_issue_types res }
         | _, Some s ->
+            let+ valid_issue_types = extract_valid_issue_types s in
             { current_line= next_line
             ; block_start= (if Option.is_some block_start then block_start else Some current_line)
-            ; issue_types= IString.Set.union issue_types (extract_valid_issue_types s)
+            ; issue_types= IString.Set.union issue_types valid_issue_types
             ; res } )
   in
   L.debug Report Verbose "Parse state: %a@\n" pp_fold_state parse_result ;
@@ -158,10 +224,20 @@ let parse_lines ?file lines =
   res
 
 
+let parse_lines ?file lines =
+  let suppressions, errors = parse_lines ?file lines in
+  List.iter errors ~f:(fun (UserError error) -> L.user_error "%s" (error ())) ;
+  suppressions
+
+
 let first_key_match ~suppressions s =
   IString.Map.to_seq suppressions
   |> Seq.find (fun (k, _) ->
-         match get_regex k with Some rx -> Str.string_match rx s 0 | _ -> false )
+         match IString.Map.find_opt k !regex_cache with
+         | Some rx ->
+             Str.string_match rx s 0
+         | None ->
+             false )
   |> Option.map ~f:snd