Source file loc.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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
include Loc0
module O = Comparable.Make (Loc0)
include O

let in_file p = Lexbuf.Loc.in_file ~fname:(Path.to_string p) |> of_lexbuf_loc
let in_dir = in_file

let drop_position (t : t) =
  let pos = Lexbuf.Position.in_file ~fname:(start t).pos_fname in
  create ~start:pos ~stop:pos
;;

let of_lexbuf lexbuf : t =
  create ~start:(Lexing.lexeme_start_p lexbuf) ~stop:(Lexing.lexeme_end_p lexbuf)
;;

let of_pos pos = Lexbuf.Loc.of_pos pos |> of_lexbuf_loc

let to_file_colon_line t =
  let start = start t in
  Printf.sprintf "%s:%d" start.pos_fname start.pos_lnum
;;

let to_dyn_hum t : Dyn.t = String (to_file_colon_line t)
let pp_file_colon_line t = Pp.verbatim (to_file_colon_line t)

let pp_left_pad n s =
  let needed_spaces = n - String.length s in
  Pp.verbatim (if needed_spaces > 0 then String.make needed_spaces ' ' ^ s else s)
;;

let pp_line padding_width (lnum, l) =
  let open Pp.O in
  pp_left_pad padding_width lnum ++ Pp.verbatim " | " ++ Pp.verbatim l ++ Pp.newline
;;

type tag = Loc

let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full loc : tag Pp.t =
  let start = start loc in
  let stop = stop loc in
  let start_c = start.pos_cnum - start.pos_bol in
  let stop_c = stop.pos_cnum - start.pos_bol in
  let file = start.pos_fname in
  let pp_file_excerpt () =
    let open Result.O in
    match if start.pos_lnum <> stop.pos_lnum then `Multiline else `Singleline with
    | `Singleline ->
      let line_num = start.pos_lnum in
      let line_num_str = string_of_int line_num in
      let padding_width = String.length line_num_str in
      let* line = Result.try_with (fun () -> Io.String_path.file_line file line_num) in
      let len = stop_c - start_c in
      let open Pp.O in
      Ok
        (pp_line padding_width (line_num_str, line)
         ++ pp_left_pad (stop_c + padding_width + 3) (String.make len '^')
         ++ Pp.newline)
    | `Multiline ->
      let get_padding lines =
        let lnum, _ = Option.value_exn (List.last lines) in
        String.length lnum
      in
      let print_ellipsis padding_width =
        (* We add 2 to the width of max line to account for the extra space and
           the `|` character at the end of a line number *)
        let line = String.make (padding_width + 2) '.' in
        let open Pp.O in
        Pp.verbatim line ++ Pp.newline
      in
      let print_lines lines padding_width =
        Pp.concat_map lines ~f:(pp_line padding_width)
      in
      let file_lines ~start ~stop =
        Result.try_with (fun () -> Io.String_path.file_lines file ~start ~stop)
      in
      let num_lines = stop.pos_lnum - start.pos_lnum in
      if num_lines <= max_lines_to_print_in_full
      then
        let+ lines = file_lines ~start:start.pos_lnum ~stop:stop.pos_lnum in
        print_lines lines (get_padding lines)
      else
        (* We need to send the padding width from the last four lines so the two
           blocks of lines align if they have different number of digits in
           their line numbers *)
        let* first_shown_lines =
          file_lines ~start:start.pos_lnum ~stop:(start.pos_lnum + context_lines)
        in
        let+ last_shown_lines =
          file_lines ~start:(stop.pos_lnum - context_lines) ~stop:stop.pos_lnum
        in
        let padding_width = get_padding last_shown_lines in
        let open Pp.O in
        print_lines first_shown_lines padding_width
        ++ print_ellipsis padding_width
        ++ print_lines last_shown_lines padding_width
  in
  let whole_file = start_c = 0 && stop_c = 0 in
  if whole_file
  then Pp.nop
  else (
    match
      let open Result.O in
      let* exists = Result.try_with (fun () -> Sys.file_exists start.pos_fname) in
      if exists then pp_file_excerpt () else Result.Ok Pp.nop
    with
    | Ok pp -> pp
    | Error exn ->
      let backtrace = Printexc.get_backtrace () in
      Format.eprintf
        "Raised when trying to print location %s@.%a@."
        (Loc0.to_dyn loc |> Dyn.to_string)
        (Exn.pp_uncaught ~backtrace)
        exn;
      Pp.nop)
;;

let pp loc =
  let start = start loc in
  let stop = stop loc in
  let start_c = start.pos_cnum - start.pos_bol in
  let stop_c = stop.pos_cnum - start.pos_bol in
  let lnum =
    if start.pos_lnum = stop.pos_lnum
    then Printf.sprintf "line %d" start.pos_lnum
    else Printf.sprintf "lines %d-%d" start.pos_lnum stop.pos_lnum
  in
  let open Pp.O in
  Pp.tag
    Loc
    (Pp.verbatim
       (Printf.sprintf
          "File \"%s\", %s, characters %d-%d:"
          start.pos_fname
          lnum
          start_c
          stop_c))
  ++ Pp.newline
  ++ pp_file_excerpt ~context_lines:2 ~max_lines_to_print_in_full:10 loc
;;

let on_same_line loc1 loc2 =
  let start1 = start loc1 in
  let start2 = start loc2 in
  let same_file = String.equal start1.pos_fname start2.pos_fname in
  let same_line = Int.equal start1.pos_lnum start2.pos_lnum in
  same_file && same_line
;;

let span (a : t) (b : t) =
  let earliest_start =
    if (start a).pos_cnum < (start b).pos_cnum then start a else start b
  in
  let latest_stop = if (stop a).pos_cnum > (stop b).pos_cnum then stop a else stop b in
  create ~start:earliest_start ~stop:latest_stop
;;

let rec render ppf pp =
  Pp.to_fmt_with_tags ppf pp ~tag_handler:(fun ppf Loc pp ->
    Format.fprintf ppf "@{<loc>%a@}" render pp)
;;