(*
 * SPDX-FileCopyrightText: 2024 The Forester Project Contributors
 *
 * SPDX-License-Identifier: GPL-3.0-or-later
 *)

open Forester_core

type error = {range: Grace.Range.t; msg: string} [@@deriving show]

let buffer_lexer lexer =
  let buf = ref [] in
  let rec loop lexbuf =
    match !buf with
    | v :: vs ->
      buf := vs;
      v
    | [] -> (
      match lexer lexbuf with
      | v :: vs ->
        buf := vs @ !buf;
        v
      | [] -> loop lexbuf)
  in
  loop

let lexer =
  let@ lexbuf = buffer_lexer in
  match Stack.top @@ Lexer.mode_stack with
  | Main -> Lexer.token lexbuf
  | Ident_init -> Lexer.ident_init lexbuf
  | Ident_fragments -> Lexer.ident_fragments lexbuf
  | Verbatim (herald, buffer) -> Lexer.verbatim herald buffer lexbuf

let parse source lexbuf =
  let module Parser = Grammar.Make (struct
    let v = source
  end) in
  try ok @@ Parser.main lexer lexbuf with
  | Parser.Error ->
    let range = Range.of_lexbuf ~source lexbuf in
    error @@ {msg = "parse error"; range}
  | exn ->
    let range = Range.of_lexbuf ~source lexbuf in
    let msg = Printexc.to_string exn in
    error @@ {msg; range}

let parse_channel filename ch =
  let lexbuf = Lexing.from_channel ch in
  if filename = "" then assert false;
  lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = filename};
  parse (`File filename) lexbuf

let parse_document doc : (Tree.(parsed tree), _) result =
  let uri = Lsp.Text_document.documentUri doc in
  let path = Lsp.Uri.to_path uri in
  let text = Lsp.Text_document.text doc in
  let source : Tree.source =
    if try Sys.is_regular_file path with _ -> false then `File path
    else `String {name = Some path; content = text}
  in
  let lexbuf = Lexing.from_string text in
  lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = path};
  parse (`String {content = text; name = Some path}) lexbuf
  |> Result.map (Tree.Parsed.create ~source)

let parse_file filename =
  let ch = open_in filename in
  Fun.protect ~finally:(fun _ -> close_in ch) @@ fun _ ->
  parse_channel filename ch