diff --git a/lib/diag.ml b/lib/diag.ml new file mode 100644 index 0000000..5c18933 --- /dev/null +++ b/lib/diag.ml @@ -0,0 +1,70 @@ +type severity = Error | Warning | Note + +type t = { + severity : severity; + span : Span.t; + msg : string; + hint : string option; + notes : (Span.t * string) list; +} + +exception Stop of t list + +let make ?(severity = Error) ?(span = Span.none) ?hint ?(notes = []) msg = + { severity; span; msg; hint; notes } + +let error ?span ?hint ?notes fmt = + Printf.ksprintf (fun msg -> raise (Stop [ make ?span ?hint ?notes msg ])) fmt + +let errorf fmt = Printf.ksprintf (fun msg -> make msg) fmt + +let sources : (string, string array) Hashtbl.t = Hashtbl.create 8 + +let register file text = Hashtbl.replace sources file (Array.of_list (String.split_on_char '\n' text)) + +let line_of file n = + match Hashtbl.find_opt sources file with + | Some lines when n >= 1 && n <= Array.length lines -> Some lines.(n - 1) + | _ -> None + +let tag = function + | Error -> Style.red "error" + | Warning -> Style.yellow "warning" + | Note -> Style.blue "note" + +let gutter n = Style.dim (Style.pad_left 5 n ^ " " ^ Style.dim "\xe2\x94\x82") + +let caret_line span text = + let col = max 1 span.Span.col in + let len = max 1 span.Span.len in + let lead = String.make (min (String.length text + 1) (col - 1)) ' ' in + lead ^ String.make len '^' + +let render_span buf severity (span : Span.t) = + match line_of span.file span.line with + | None -> () + | Some text -> + let paint = match severity with Error -> Style.red | Warning -> Style.yellow | Note -> Style.blue in + Buffer.add_string buf (Printf.sprintf "%s\n" (gutter "")); + Buffer.add_string buf (Printf.sprintf "%s %s\n" (gutter (string_of_int span.line)) text); + Buffer.add_string buf (Printf.sprintf "%s %s\n" (gutter "") (paint (caret_line span text))) + +let render d = + let buf = Buffer.create 256 in + let loc = Span.to_string d.span in + Buffer.add_string buf + (Printf.sprintf "%s%s %s\n" + (if loc = "" then "" else Style.bold loc ^ " ") + (tag d.severity) d.msg); + render_span buf d.severity d.span; + List.iter + (fun (span, note) -> + Buffer.add_string buf (Printf.sprintf "%s %s %s\n" (gutter "") (Style.dim "note:") note); + render_span buf Note span) + d.notes; + (match d.hint with + | Some h -> Buffer.add_string buf (Printf.sprintf "%s %s %s\n" (gutter "") (Style.dim "=") h) + | None -> ()); + Buffer.contents buf + +let print ds = List.iter (fun d -> prerr_string (render d)) ds