(* Structural Menhir grammar for Org Mode documents.
   Consumes tokens from the structural lexer and produces Raw_ast.document. *)

%{
open Raw_ast

let convert_list_item (item : Token.list_item_data) : raw_list_item =
  { rli_indent = item.Token.lid_indent;
    rli_bullet = item.Token.lid_bullet;
    rli_counter_set = item.Token.lid_counter_set;
    rli_checkbox = item.Token.lid_checkbox;
    rli_tag = None;
    rli_body_lines = [item.Token.lid_rest];
  }

let parse_planning_entries (line : string) : raw_planning list =
  let results = ref [] in
  let keywords = ["DEADLINE"; "SCHEDULED"; "CLOSED"] in
  List.iter (fun kw ->
    let pat = kw ^ ":" in
    let len = String.length line in
    let plen = String.length pat in
    let rec find_from i =
      if i + plen > len then ()
      else if String.sub line i plen = pat then begin
        let rest_start = i + plen in
        let rest = String.trim (String.sub line rest_start (len - rest_start)) in
        let ts_end =
          let rec find_end j closer =
            if j >= String.length rest then j
            else if rest.[j] = closer then j + 1
            else find_end (j + 1) closer
          in
          if String.length rest > 0 && rest.[0] = '<' then find_end 1 '>'
          else if String.length rest > 0 && rest.[0] = '[' then find_end 1 ']'
          else 0
        in
        if ts_end > 0 then
          results := { rpl_keyword = kw; rpl_timestamp = String.sub rest 0 ts_end } :: !results
      end
      else find_from (i + 1)
    in
    find_from 0
  ) keywords;
  List.rev !results
%}

%token BLANK
%token <int * string> HEADING
%token <string * string> KEYWORD
%token <string * string option * string> AFFILIATED_KEYWORD
%token <string * string option> BEGIN_BLOCK
%token <string> END_BLOCK
%token <string> DRAWER_BEGIN
%token DRAWER_END
%token <string * string option> PROPERTY
%token <string> PLANNING
%token <Token.list_item_data> LIST_ITEM
%token <string> TABLE_ROW
%token <string> FIXED_WIDTH
%token <string> COMMENT_LINE
%token HORIZONTAL_RULE
%token <string> TEXT_LINE
%token EOF

%start <Raw_ast.document> document

%%

document:
  | preamble = list(element) headings = list(heading) EOF
    { { rd_preamble = preamble; rd_headings = headings } }
;

heading:
  | h = HEADING body = list(element)
    { let (level, raw_title) = h in
      { rh_level = level; rh_raw_title = raw_title; rh_body = body } }
;

element:
  | BLANK
    { Raw_paragraph [] }
  | lines = nonempty_list(TEXT_LINE)
    { Raw_paragraph lines }
  | items = nonempty_list(list_item_tok)
    { Raw_list_items (List.map convert_list_item items) }
  | rows = nonempty_list(table_row_tok)
    { Raw_table rows }
  | b = block
    { Raw_block b }
  | d = drawer
    { Raw_drawer d }
  | k = KEYWORD
    { let (key, value) = k in Raw_keyword (key, value) }
  | a = AFFILIATED_KEYWORD
    { let (name, opt, value) = a in Raw_affiliated (name, opt, value) }
  | comments = nonempty_list(COMMENT_LINE)
    { Raw_comment comments }
  | lines = nonempty_list(FIXED_WIDTH)
    { Raw_fixed_width lines }
  | HORIZONTAL_RULE
    { Raw_horizontal_rule }
  | p = PLANNING
    { Raw_planning (parse_planning_entries p) }
;

list_item_tok:
  | item = LIST_ITEM { item }
;

table_row_tok:
  | row = TABLE_ROW
    { if String.length row > 1 && row.[1] = '-' then Raw_table_rule
      else Raw_table_standard row }
;

block:
  | b = BEGIN_BLOCK body = list(block_body_line) e = END_BLOCK
    { let (name, params) = b in let _ = e in
      { rb_name = name; rb_params = params; rb_body = Opaque_body (String.concat "\n" body) } }
  | b = BEGIN_BLOCK body = list(block_body_line) EOF
    { let (name, params) = b in
      { rb_name = name; rb_params = params; rb_body = Opaque_body (String.concat "\n" body) } }
;

block_body_line:
  | t = TEXT_LINE { t }
  | BLANK { "" }
  | k = KEYWORD { let (key, value) = k in "#+" ^ key ^ ": " ^ value }
  | a = AFFILIATED_KEYWORD { let (n, _, v) = a in "#+" ^ n ^ ": " ^ v }
  | c = COMMENT_LINE { "# " ^ c }
  | f = FIXED_WIDTH { ": " ^ f }
  | HORIZONTAL_RULE { "-----" }
  | item = LIST_ITEM { item.Token.lid_rest }
  | row = TABLE_ROW { row }
  | p = PLANNING { p }
  | prop = PROPERTY { let (n, v) = prop in ":" ^ n ^ ": " ^ (Option.value ~default:"" v) }
  | d = DRAWER_BEGIN { ":" ^ d ^ ":" }
  | DRAWER_END { ":END:" }
;

(* A drawer handles both property drawers and regular drawers.
   Property drawers are distinguished during normalization by their name. *)
drawer:
  | name = DRAWER_BEGIN contents = drawer_contents DRAWER_END
    { { rd_name = name; rd_contents = contents } }
  | name = DRAWER_BEGIN contents = drawer_contents EOF
    { { rd_name = name; rd_contents = contents } }
;

(* Drawer contents can include properties (for property drawers)
   or regular elements (for other drawers). We parse them uniformly
   as elements, with properties becoming text that normalization handles. *)
drawer_contents:
  | items = list(drawer_item)
    { items }
;

drawer_item:
  | BLANK { Raw_paragraph [] }
  | lines = nonempty_list(TEXT_LINE) { Raw_paragraph lines }
  | p = PROPERTY
    { let (name, value) = p in Raw_keyword (name, Option.value ~default:"" value) }
  | k = KEYWORD { let (key, value) = k in Raw_keyword (key, value) }
  | a = AFFILIATED_KEYWORD { let (n, _, v) = a in Raw_affiliated (n, None, v) }
  | items = nonempty_list(list_item_tok)
    { Raw_list_items (List.map convert_list_item items) }
  | rows = nonempty_list(table_row_tok) { Raw_table rows }
  | comments = nonempty_list(COMMENT_LINE) { Raw_comment comments }
  | lines = nonempty_list(FIXED_WIDTH) { Raw_fixed_width lines }
  | HORIZONTAL_RULE { Raw_horizontal_rule }
  | pl = PLANNING { Raw_planning (parse_planning_entries pl) }
;