(** Get effective system_id, preferring location's system_id over the passed one *)
let get_system_id ?system_id loc_system_id =
  loc_system_id
  |> Option.fold ~none:system_id ~some:Option.some
  |> Option.value ~default:"input"

let format_text ?system_id messages =
  let buf = Buffer.create 1024 in
  List.iter (fun msg ->
    let loc_str = match msg.Message.location with
      | Some loc ->
        let sid = get_system_id ?system_id loc.Message.system_id in
        let col_info = match loc.end_line, loc.end_column with
          | Some el, Some ec when el = loc.line && ec > loc.column ->
            Printf.sprintf "%d.%d-%d" loc.line loc.column ec
          | Some el, Some ec when el > loc.line ->
            Printf.sprintf "%d.%d-%d.%d" loc.line loc.column el ec
          | _ ->
            Printf.sprintf "%d.%d" loc.line loc.column
        in
        Printf.sprintf "%s:%s" sid col_info
      | None ->
        Option.value system_id ~default:"input"
    in
    let elem_str = Option.fold ~none:"" ~some:(Printf.sprintf " (element: %s)") msg.Message.element in
    let attr_str = Option.fold ~none:"" ~some:(Printf.sprintf " (attribute: %s)") msg.Message.attribute in
    Buffer.add_string buf (Printf.sprintf "%s: %s [%s]: %s%s%s\n"
      loc_str
      (Message.severity_to_string msg.Message.severity)
      (Message.error_code_to_string msg.Message.error_code)
      msg.Message.message
      elem_str
      attr_str)
  ) messages;
  Buffer.contents buf

let format_gnu ?system_id messages =
  let buf = Buffer.create 1024 in
  List.iter (fun msg ->
    let loc_str = match msg.Message.location with
      | Some loc ->
        Printf.sprintf "%s:%d:%d"
          (get_system_id ?system_id loc.Message.system_id)
          loc.line loc.column
      | None ->
        Option.value system_id ~default:"input" ^ ":0:0"
    in
    Buffer.add_string buf (Printf.sprintf "%s: %s [%s]: %s\n"
      loc_str
      (Message.severity_to_string msg.Message.severity)
      (Message.error_code_to_string msg.Message.error_code)
      msg.Message.message)
  ) messages;
  Buffer.contents buf

let message_to_json ?system_id msg =
  let open Jsont in
  let str s = String (s, Meta.none) in
  let num n = Number (float_of_int n, Meta.none) in
  let field name value = ((name, Meta.none), value) in

  let base = [
    field "type" (str (Message.severity_to_string msg.Message.severity));
    field "message" (str msg.Message.message);
    field "subType" (str (Message.error_code_to_string msg.Message.error_code));
  ] in

  let with_location = match msg.Message.location with
    | Some loc ->
      let url = get_system_id ?system_id loc.Message.system_id in
      let loc_fields = [
        field "url" (str url);
        field "firstLine" (num loc.line);
        field "firstColumn" (num loc.column);
      ] in
      let loc_fields = Option.fold ~none:loc_fields
        ~some:(fun el -> field "lastLine" (num el) :: loc_fields)
        loc.Message.end_line in
      let loc_fields = Option.fold ~none:loc_fields
        ~some:(fun ec -> field "lastColumn" (num ec) :: loc_fields)
        loc.Message.end_column in
      loc_fields @ base
    | None ->
      field "url" (str (Option.value system_id ~default:"input")) :: base
  in

  let with_extract = Option.fold ~none:with_location
    ~some:(fun e -> field "extract" (str e) :: with_location)
    msg.Message.extract in

  Object (with_extract, Meta.none)

let messages_to_json ?system_id messages =
  let open Jsont in
  let msg_array = Array (List.map (message_to_json ?system_id) messages, Meta.none) in
  Object ([ (("messages", Meta.none), msg_array) ], Meta.none)

let format_json ?system_id messages =
  let obj = messages_to_json ?system_id messages in
  match Jsont_bytesrw.encode_string ~format:Minify Jsont.json obj with
  | Ok s -> s
  | Error e -> failwith ("JSON encoding error: " ^ e)