open StdLabels

module I =   Parser.MenhirInterpreter

let sound_to_string
  : Sounds.t list -> string
  = fun t ->
    let buff = Buffer.create 16 in
    List.iter t
      ~f:(fun f -> Buffer.add_string buff (Sounds.repr (module Repr.Default) f));
    Buffer.contents buff

let succeed (res : Sounds.t list) =
  Ok (sound_to_string res)

let fail (_ : 'a I.checkpoint) =
  Error ("Syntax Error")

let rec loop get_element (checkpoint : Sounds.t list I.checkpoint) =
  match checkpoint with
  | I.InputNeeded _env ->
    (* The parser needs a token. Request one from the lexer,
       and offer it to the parser, which will produce a new
       checkpoint. Then, repeat. *)
    let checkpoint = get_element checkpoint in
    loop get_element checkpoint
  | I.Shifting _
  | I.AboutToReduce _ ->
    let checkpoint = I.resume checkpoint in
    loop get_element checkpoint
  | I.HandlingError _env ->
    fail checkpoint
  | I.Accepted v ->
    (* The parser has succeeded and produced a semantic value. Print it. *)
    succeed v
  | I.Rejected ->
    (* The parser rejects this input. This cannot happen, here, because
       we stop as soon as the parser reports [HandlingError]. *)
    assert false

let build_processor ll =
  let l = ref ll in
  fun checkpoint ->
    match !l with
    | [] -> raise (Failure "Empty")
    | hd::tl ->
      l := tl;
      I.offer checkpoint (hd, Lexing.dummy_pos, Lexing.dummy_pos)

let process (line : string) =
  let lexbuf = Lexing.from_string line in
  let content =
    Prononciation.main Lexer.letter lexbuf
    |> build_processor in
  try
    loop content (Parser.Incremental.main lexbuf.lex_curr_p)
  with
  | Lexer.Error msg -> Error msg