syntax/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

(** Report built over the differents analysis in the file *)

type level = Error | Warn | Debug
[@@deriving show { with_path = false }, enum, eq]

type pos = Lexing.position * Lexing.position

let level_of_string : string -> (level, string) result =
 fun level ->
  match String.lowercase_ascii level with
  | "error" -> Ok Error
  | "warn" -> Ok Warn
  | "debug" -> Ok Debug
  | _ ->
      Error
        (Format.sprintf
           "Unknown report level '%s'. Accepted values are error, warn, debug"
           level)

let pp_pos : Format.formatter -> pos -> unit =
 fun f (start_pos, end_pos) ->
  let start_c = start_pos.Lexing.pos_cnum - start_pos.Lexing.pos_bol
  and end_c = end_pos.Lexing.pos_cnum - end_pos.Lexing.pos_bol
  and start_line = start_pos.Lexing.pos_lnum
  and end_line = end_pos.Lexing.pos_lnum in

  if start_line != end_line then
    Format.fprintf f "Lines %d-%d" start_line end_line
  else Format.fprintf f "Line %d %d:%d" start_line start_c end_c

type t = { level : level; loc : pos; message : string }
[@@deriving show { with_path = false }]

let warn : pos -> string -> t =
 fun loc message -> { level = Warn; loc; message }

let error : pos -> string -> t =
 fun loc message -> { level = Error; loc; message }

let message level loc message = { level; loc; message }