feat(diag): render errors with a caret and the offending line

Formats file:line:col, re-reads the source to print the line, underlines the
span and leaves a slot for a suggestion.

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