Source file `matching_report.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(* Yoann Padioleau
 *
 * Copyright (C) 2013 Facebook
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file license.txt.
 * 
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
 * license.txt for more details.
 *)
open Common

module PI = Parse_info
module J = Json_type

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)

(*****************************************************************************)
(* Types *)
(*****************************************************************************)

(* could perhaps create a special file related to display of code ? *)
type match_format =
  (* ex: tests/misc/foo4.php:3
   *  foo(
   *   1,
   *   2);
   *)
  | Normal
  (* ex: tests/misc/foo4.php:3: foo( *)
  | Emacs
  (* ex: tests/misc/foo4.php:3: foo(1,2) *)
  | OneLine
  (* ex: { check_id: ...; path: ...; start: ... end: ...; extra: ... *)
  | Json

(*****************************************************************************)
(* Globals *)
(*****************************************************************************)
(* used only for Json format *)
let first_entry = ref true

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

(* When we print in the OneLine format we want to normalize the matched
 * expression or code and so only print the tokens in the AST (and not
 * the extra whitespace, newlines or comments). It's not enough though
 * to just List.map str_of_info because some PHP expressions such as
 * '$x = print FOO' would then be transformed into $x=printFOO, hence
 * this function
 *)
let rec join_with_space_if_needed xs = 
  match xs with
  | [] -> ""
  | [x] -> x
  | x::y::xs ->
      if x =~ ".*[a-zA-Z0-9_]$" && 
         y =~ "^[a-zA-Z0-9_]"
      then x ^ " " ^ (join_with_space_if_needed (y::xs))
      else x ^ (join_with_space_if_needed (y::xs))

let info_to_json col_offset info = 
  let loc = PI.token_location_of_info info in
  J.Object [
    "line", J.Int loc.PI.line;
    "col", J.Int (loc.PI.column + col_offset);
  ]

(*****************************************************************************)
(* Entry point *)
(*****************************************************************************)
let print_match ?(format = Normal) ii = 
  let (mini, maxi) = PI.min_max_ii_by_pos ii in
  let (file, line) = 
    PI.file_of_info mini, PI.line_of_info mini in
  let prefix = spf "%s:%d" file line in
  let arr = Common2.cat_array file in
  let lines = Common2.enum (PI.line_of_info mini) (PI.line_of_info maxi) in
  
  match format with
  | Normal ->
      pr prefix;
      (* todo? some context too ? *)
      lines +> List.map (fun i -> arr.(i)) +> List.iter (fun s -> pr (" " ^ s));
  | Emacs ->
      pr (prefix ^ ": " ^ arr.(List.hd lines))
  | OneLine ->
      pr (prefix ^ ": " ^ (ii +> List.map PI.str_of_info 
                            +> join_with_space_if_needed))
  | Json ->
      if not !first_entry
      then pr ",";
      first_entry := false;

      let matched_str = ii |> List.map PI.str_of_info 
                            |> join_with_space_if_needed in
      let json = J.Object [
        (* r2c: quite specific to r2c *)
        "check_id", J.String "pfff-parse_js_r2c";
        "path", J.String file;
        "start", info_to_json 0 mini;
        "end", info_to_json (PI.str_of_info maxi |> String.length) maxi;
        "extra", J.Object [
          "matched_str", J.String matched_str;
          (* todo: put metavars content *)
        ];
      ] in
      let s = Json_io.string_of_json json in
      pr s


(*****************************************************************************)
(* Header/Trailer *)
(*****************************************************************************)
let print_header = function
  | Normal | Emacs | OneLine -> ()
  | Json -> 
     pr "{ \"results\": [";
     first_entry := true

let print_trailer = function
  | Normal | Emacs | OneLine -> ()
  | Json -> 
     pr "] }";
     first_entry := false