qsp_parser/lib/qparser/lex_state.ml

(** This module provide functions used to parse the strings. 

 *)

exception Out_of_context

let space = [%sedlex.regexp? ' ' | '\t']
let spaces = [%sedlex.regexp? Plus space]
let single_quote = [%sedlex.regexp? '\'']
let double_quote = [%sedlex.regexp? '"']

let leave_text end_wrapper buf buffer =
  Lexbuf.leave_state buffer;
  Lexbuf.enter_state buffer (Lexbuf.EndString end_wrapper);
  Lexbuf.rollback buffer;
  Tokens.LITERAL (Buffer.contents buf)

let rec nestedQuotedStringWraper : Lexbuf.stringWraper =
  let start_string f buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    (* There is no more way to add start a quoted string here *)
    | _ -> f buffer
  in

  {
    start_string;
    wrap =
      (fun f ?(nested = false) buf buffer ->
        let lexbuf = Lexbuf.buffer buffer in
        match%sedlex lexbuf with
        | "''" -> leave_text nestedQuotedStringWraper buf buffer
        | _ -> f ~nested buf buffer);
    end_string =
      (fun buffer ->
        let lexbuf = Lexbuf.buffer buffer in
        match%sedlex lexbuf with
        | "''" ->
            Lexbuf.leave_state buffer;
            TEXT_MARKER
        | _ -> raise Not_found);
  }

and nestedDquotedStringWraper : Lexbuf.stringWraper =
  let start_string f buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    (* There is no more way to add start a quoted string here *)
    | _ -> f buffer
  in

  let rec wrap (f : Lexbuf.buffer_builder) ?(nested = false) buf buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    | double_quote ->
        Buffer.add_char buf '"';
        wrap ~nested:true f buf buffer
    | double_quote, double_quote ->
        leave_text nestedDquotedStringWraper buf buffer
    | _ -> f ~nested buf buffer
  in
  {
    start_string;
    wrap;
    end_string =
      (fun buffer ->
        let lexbuf = Lexbuf.buffer buffer in
        match%sedlex lexbuf with
        | double_quote, double_quote ->
            Lexbuf.leave_state buffer;
            TEXT_MARKER
        | _ -> raise Not_found);
  }

and quotedStringWraper : Lexbuf.stringWraper =
  let rec start_string f buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    | spaces -> start_string f buffer
    | single_quote -> raise Out_of_context
    | single_quote, single_quote ->
        Lexbuf.enter_state buffer (Lexbuf.String nestedQuotedStringWraper);
        Tokens.TEXT_MARKER
    | _ -> f buffer
  in

  let rec quoted_wrap (f : Lexbuf.buffer_builder) ?(nested = false) buf buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    | single_quote, single_quote ->
        Buffer.add_char buf '\'';
        quoted_wrap ~nested f buf buffer
    | single_quote -> leave_text quotedStringWraper buf buffer
    | _ -> f ~nested buf buffer
  in
  {
    start_string;
    wrap = quoted_wrap;
    end_string =
      (fun buffer ->
        let lexbuf = Lexbuf.buffer buffer in
        match%sedlex lexbuf with
        | single_quote ->
            Lexbuf.leave_state buffer;
            TEXT_MARKER
        | _ -> raise Not_found);
  }

and dQuotedStringWraper : Lexbuf.stringWraper =
  let rec wrap (f : Lexbuf.buffer_builder) ?(nested = false) buf buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    | single_quote ->
        Buffer.add_char buf '\'';
        wrap ~nested:true f buf buffer
    | double_quote, double_quote ->
        Buffer.add_char buf '"';
        wrap f buf buffer
    | double_quote -> leave_text dQuotedStringWraper buf buffer
    | _ -> f ~nested buf buffer
  in

  let rec start_string f buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    | spaces -> start_string f buffer
    | double_quote -> raise Out_of_context
    | double_quote, double_quote ->
        Lexbuf.enter_state buffer (Lexbuf.String nestedDquotedStringWraper);
        Tokens.TEXT_MARKER
    | _ -> f buffer
  in

  {
    start_string;
    wrap;
    end_string =
      (fun buffer ->
        let lexbuf = Lexbuf.buffer buffer in
        match%sedlex lexbuf with
        | double_quote ->
            Lexbuf.leave_state buffer;
            TEXT_MARKER
        | _ -> raise Not_found);
  }

let defaultWraper : Lexbuf.stringWraper =
  let rec start_string f buffer =
    let lexbuf = Lexbuf.buffer buffer in
    match%sedlex lexbuf with
    | spaces -> start_string f buffer
    | single_quote ->
        Lexbuf.enter_state buffer (Lexbuf.String quotedStringWraper);
        Tokens.TEXT_MARKER
    | double_quote ->
        Lexbuf.enter_state buffer (Lexbuf.String dQuotedStringWraper);
        Tokens.TEXT_MARKER
    | '{' ->
        Lexbuf.enter_state buffer (Lexbuf.MString 0);
        Tokens.TEXT_MARKER
    | _ -> f buffer
  in
  {
    start_string;
    wrap =
      (fun _f ?nested _buf _buffer ->
        ignore nested;
        raise Out_of_context);
    end_string = (fun _buffer -> raise Out_of_context);
  }

let readLongStringWraper : Lexbuf.stringWraper =
  {
    defaultWraper with
    end_string =
      (fun buffer ->
        let lexbuf = Lexbuf.buffer buffer in
        match%sedlex lexbuf with
        | "}" ->
            Lexbuf.leave_state buffer;
            TEXT_MARKER
        | _ -> raise Not_found);
  }