aboutsummaryrefslogtreecommitdiff
path: root/syntax/report.ml
diff options
context:
space:
mode:
Diffstat (limited to 'syntax/report.ml')
-rw-r--r--syntax/report.ml40
1 files changed, 40 insertions, 0 deletions
diff --git a/syntax/report.ml b/syntax/report.ml
new file mode 100644
index 0000000..0c7d731
--- /dev/null
+++ b/syntax/report.ml
@@ -0,0 +1,40 @@
+(** Report built over the differents analysis in the file *)
+
+type level = Error | Warn | Debug
+[@@deriving show { with_path = false }, enum]
+
+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 }