type t = {
  file : string;
  span : Location.span;
  message : string;
}

exception Error of t

let current_file = ref ""

let set_file file = current_file := file

let file_label () = if !current_file = "" then "<none>" else !current_file

let file () = file_label ()

let error span fmt =
  Printf.ksprintf
    (fun message -> raise (Error { file = file_label (); span = span; message = message }))
    fmt

let make span message = { file = file_label (); span = span; message = message }

let header d =
  if Location.is_none d.span then Printf.sprintf "%s: error: %s" d.file d.message
  else Printf.sprintf "%s:%d:%d: error: %s" d.file d.span.Location.start.Location.line
      d.span.Location.start.Location.col d.message

let to_string d = header d

let source_line text line =
  if line <= 0 then None
  else
    let lines = String.split_on_char '\n' text in
    let rec nth items index =
      match items with
      | [] -> None
      | head :: tail -> if index = 1 then Some head else nth tail (index - 1)
    in
    nth lines line

let render source d =
  let head = header d in
  match source with
  | None -> head
  | Some text -> (
      match source_line text d.span.Location.start.Location.line with
      | None -> head
      | Some line ->
          let col = max 1 d.span.Location.start.Location.col in
          let width =
            if d.span.Location.stop.Location.line = d.span.Location.start.Location.line then
              max 1 (d.span.Location.stop.Location.col - col)
            else max 1 (String.length line - col + 1)
          in
          let padding = String.make (col - 1) ' ' in
          let carets = String.make width '^' in
          Printf.sprintf "%s\n  %s\n  %s%s" head line padding carets)