(*
 * Copyright (c) 2016 - present Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD style license found in the
 * LICENSE file in the root directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *)

(** Module for parsing stack traces and using them to guide Infer analysis *)

open! Utils

module F = Format

type frame = {
  class_str : string;
  method_str : string;
  file_str : string;
  line_num : int option;
}

type t = {
  exception_name: string;
  frames: frame list;
}

let new_line_regexp = Str.regexp "\n"

(* Pre-compute the regular expression matchers used to parse: *)
(* Stack frames into (procedure, location) tuples. *)
let frame_regexp = Str.regexp "\t*at \\(.*\\)(\\(.*\\))"
(* procedures into class and method name. *)
let procname_regexp = Str.regexp "\\(.*\\)\\.\\(.*\\)"
(* locations into file and line number information. *)
let file_and_line_regexp = Str.regexp "\\(.*\\):\\([0-9]+\\)"
(* exception information lines into thread id and exception type *)
let exception_regexp = Str.regexp "Exception in thread \"\\(.*\\)\" \\(.*\\)"

let make exception_name frames = { exception_name; frames; }

let make_frame class_str method_str file_str line_num =
  { class_str; method_str; file_str; line_num; }

let frame_matches_location frame_obj loc =
  let lfname = DB.source_file_to_string loc.Location.file in
  let matches_file = Utils.string_is_suffix frame_obj.file_str lfname in
  let matches_line = match frame_obj.line_num with
    | None -> false
    | Some line -> line = loc.Location.line in
  matches_file && matches_line

let parse_stack_frame frame_str =
  (* separate the qualified method name and the parenthesized text/line number*)
  ignore(Str.string_match frame_regexp frame_str 0);
  let qualified_procname = Str.matched_group 1 frame_str in
  let file_and_line = Str.matched_group 2 frame_str in
  (* separate the class name from the method name *)
  ignore(Str.string_match procname_regexp qualified_procname 0);
  let class_str = Str.matched_group 1 qualified_procname in
  let method_str = Str.matched_group 2 qualified_procname in
  (* Native methods don't have debugging info *)
  if string_equal file_and_line "Native Method" then
    make_frame class_str method_str "Native Method" None
  else begin
    (* Separate the filename and line number.
       note that a few methods might not have line number information,
       for those, file_and_line includes only the filename. *)
    let is_file_line = Str.string_match file_and_line_regexp file_and_line 0 in
    let file_str, line_num = if is_file_line
      then Str.matched_group 1 file_and_line,
           Some (int_of_string (Str.matched_group 2 file_and_line))
      else file_and_line, None in
    make_frame class_str method_str file_str line_num
  end

let parse_exception_line exception_line =
  ignore(Str.string_match exception_regexp exception_line 0);
  let exception_name = Str.matched_group 2 exception_line in
  exception_name

let of_string s =
  let lines = Str.split new_line_regexp s in
  match lines with
  | exception_line :: trace ->
      let exception_name = parse_exception_line exception_line in
      let parsed = IList.map parse_stack_frame trace in
      make exception_name parsed
  | [] -> failwith "Empty stack trace"

let of_json json =
  let exception_name_key = "exception_type" in
  let frames_key = "stack_trace" in
  let extract_json_member key =
    match Yojson.Basic.Util.member key json with
    | `Null -> failwith ("Missing key in supplied JSON \
                          data: " ^ key)
    | item -> item in
  let exception_name =
    Yojson.Basic.Util.to_string (extract_json_member exception_name_key) in
  let frames =
    Yojson.Basic.Util.to_list (extract_json_member frames_key)
    |> IList.map Yojson.Basic.Util.to_string
    |> IList.map String.trim
    |> IList.filter (fun s -> s <> "")
    |> IList.map parse_stack_frame in
  make exception_name frames

let of_json_file filename =
  match Utils.read_optional_json_file filename with
  | Ok json -> of_json json
  | Error msg -> failwith (Printf.sprintf "Could not read or parse the supplied JSON \
                                           stacktrace file %s :\n %s" filename msg)
