(** Source locations. Every form carries one: error messages, the step debugger
    and nREPL's find-definition all need them, and retrofitting locations onto a
    reader is far worse than carrying them from the start.

    A location is a *span*, not a point. The start is what [file:line:col]
    prints and what every consumer that wants one place uses; the end is what
    lets an error underline the thing it is about. A column number cannot draw
    a squiggle and a span can, which is the whole reason the two extra fields
    are here.

    The end is *exclusive* and defaults to the start, so a location nobody
    widened is a zero-width span at a point and every old call site keeps its
    old meaning. Only the reader knows where a form ends, so only the reader
    fills these in; a location the checker invents for a node with no syntax
    stays a point. *)

type t = {
  file  : string;
  line  : int;  (* 1-based *)
  col   : int;  (* 1-based *)
  eline : int;  (* 1-based, exclusive end *)
  ecol  : int;
}

let make file line col = { file; line; col; eline = line; ecol = col }
let unknown = make "<unknown>" 0 0

(** [upto start stop] is [start] widened to end where [stop] begins. A [stop]
    that is not after [start], or is in another file, leaves it alone: a span
    that runs backwards would draw nonsense. *)
let upto (start : t) (stop : t) =
  if
    stop.file = start.file
    && (stop.line > start.line
        || (stop.line = start.line && stop.col > start.col))
  then { start with eline = stop.line; ecol = stop.col }
  else start

(** True when the span covers more than its first line. The underline is drawn
    on the start line either way — a form that spans twenty lines is pointed
    at, not boxed — so this is what tells the renderer to run the underline to
    the end of that line rather than to [ecol]. *)
let multiline (t : t) = t.eline > t.line

(** How many columns to underline on the start line, or [None] when the span
    was never widened and there is nothing but a point to draw. *)
let width (t : t) =
  if t.eline = t.line && t.ecol > t.col then Some (t.ecol - t.col) else None

let to_string t = Printf.sprintf "%s:%d:%d" t.file t.line t.col

(* ── Diagnostics ──────────────────────────────────────────

   An error is a value rather than a location and a string, and the three parts
   that make it one each buy something the pair could not express.

   [kind] is a stable id — ["reader/unterminated-string"]. It classifies
   without any prose being parsed, so a message may be reworded freely and a
   test that asserts on *which* error this is keeps holding. It is not a
   replacement for the message: the messages here already state the reason and
   name what to write instead, and none of them changed.

   [dloc] is a span, so a report can underline the thing it is about.

   [notes] are the part that makes a message good. Each carries its own span
   and its own severity, so an error can say "this is wrong *here*" and
   "because of *that*, over there" and point at both. One string can only ever
   state one of the two, which is why volume of messages was never the whole
   of what was missing.

   [expansion] names the macro call an error came from. A form a macro produced
   carries the call site's location, so without this the report would point at
   the call and say nothing about the code not being what was written there. It
   is filled in for errors raised *during* expansion; a checker error on a form
   a macro produced gets the call site's location without the macro's name,
   which is a limitation and not a claim. *)

type severity = Info | Warning | Err

let severity_str = function
  | Info -> "info"
  | Warning -> "warning"
  | Err -> "error"

type note = {
  nmsg : string;
  nloc : t;
  nsev : severity;
}

type diag = {
  kind      : string;               (* stable id, never printed as the reason *)
  dloc      : t;                    (* the primary span *)
  dmsg      : string;
  notes     : note list;            (* in source order *)
  expansion : (string * t) option;  (* macro name, and its call site *)
}

(** Raised by every stage of the frontend, one diagnostic at a time.

    This is still the single-error channel, and that is deliberate: the daemon
    and [Session.eval] evaluate *one* form and have one failure to report, so
    they keep catching this and take a location and a message out of it with
    [summary]. Only the batch drivers — the ones that compile a whole file —
    raise the list below, and nothing interactive has to know it exists. *)
exception Error of diag

(** Raised by a driver that finished the file before reporting. Never empty,
    and never raised by a path that checks a single form. *)
exception Errors of diag list

(** The one location and one message a caller with a single line to print gets
    out of a diagnostic. Notes are dropped here on purpose. *)
let summary (d : diag) = (d.dloc, d.dmsg)

let before (a : t) (b : t) =
  if a.line <> b.line then compare a.line b.line else compare a.col b.col

(* Notes in source order, as jank sorts them: a reader follows a message that
   walks down the file and loses one that jumps about. *)
let sort_notes (d : diag) =
  { d with notes = List.stable_sort (fun x y -> before x.nloc y.nloc) d.notes }

let note ?(sev = Info) loc msg = { nmsg = msg; nloc = loc; nsev = sev }

let diag ?(kind = "error") ?(notes = []) ?expansion loc msg =
  sort_notes { kind; dloc = loc; dmsg = msg; notes; expansion }

let raise_diag d = raise (Error (sort_notes d))

(** The plain refusal: a span and a reason, with the generic kind. Every call
    site that existed before spans is one of these and says exactly what it
    said. [failk] is the same thing with a kind, notes and an expansion. *)
let fail loc fmt =
  Printf.ksprintf (fun msg -> raise_diag (diag loc msg)) fmt

let failk ?notes ?expansion kind loc fmt =
  Printf.ksprintf (fun msg -> raise_diag (diag ~kind ?notes ?expansion loc msg)) fmt