Source file bounds.ml

open Base
open Liquid_syntax
open Syntax
open Tools

type bound_finders = {
    start : lex_token
  ; stop : lex_token
  ; other : lex_token list option
  ; conflicts : bound_finders list option
}

let p_to_b start stop = { start; stop; other = None; conflicts = None }
let pair_to_bounds start stop = Some (p_to_b start stop)

(* Several tags rely on the 'else' keyword. This list allows these tags to be tallied when needed *)
let else_conflicts =
  Some
    [
      p_to_b If EndIf
    ; p_to_b Case EndCase
    ; p_to_b Unless EndUnless
    ; p_to_b LexFor LexEndFor
    ]

let bounds_from_opener = function
  | If ->
      Some
        {
          start = If
        ; stop = EndIf
        ; other = Some [ Else; ElseIf ]
        ; conflicts = else_conflicts
        }
  | Case ->
      Some
        {
          start = Case
        ; stop = EndCase
        ; other = Some [ When; Else ]
        ; conflicts = else_conflicts
        }
  | Unless ->
      Some
        {
          start = Unless
        ; stop = EndUnless
        ; other = Some [ Else ]
        ; conflicts = else_conflicts
        }
  | LexFor ->
      Some
        {
          start = LexFor
        ; stop = LexEndFor
        ; other = Some [ Else ]
        ; conflicts = else_conflicts
        }
  | Raw -> pair_to_bounds Raw EndRaw
  | LexStyle -> pair_to_bounds LexStyle LexEndStyle
  | LexForm -> pair_to_bounds LexForm LexEndForm
  | Capture -> pair_to_bounds Capture EndCapture
  | Paginate -> pair_to_bounds Paginate EndPaginate
  | TableRow -> pair_to_bounds TableRow EndTableRow
  | _ -> None

let remove_last lst =
  match List.rev lst with _ :: hds -> List.rev hds | [] -> []

let pair_up_bounds bounds =
  let rec aux acc = function
    | ft :: sd :: td :: tl -> aux (acc @ [ (ft, sd); (sd, td) ]) (td :: tl)
    | ft :: sd :: tl -> aux (acc @ [ (ft, sd) ]) tl
    | [] | [ _ ] -> acc
  in
  aux [] bounds

type conflict_type = Start | End

let has_conflict conflict_type bounds token =
  match bounds.conflicts with
  | Some conflicts ->
      let extract_tag b =
        match conflict_type with Start -> b.start | End -> b.stop
      in
      let starts = List.map conflicts ~f:extract_tag in
      contains starts token
  | _ -> false

let has_start_conflict = has_conflict Start
let has_end_conflict = has_conflict End

let find_bounds tokens start_point =
  let first_token = nth tokens start_point in
  let bounds =
    match bounds_from_opener first_token with
    | Some b -> b
    | None -> raise (Failure "This is not an opening tag")
  in

  let other_bounds = unwrap_or bounds.other [] in

  let folder (tally, found) index =
    let token = nth tokens index in
    match token with
    | _ when token = bounds.start || has_start_conflict bounds token ->
        let acc = (tally @ [ index ], found) in
        Next (acc, index + 1)
    | _ when token = bounds.stop || has_end_conflict bounds token -> (
        let nt = remove_last tally in
        let nf =
          if List.hd_exn found = List.last_exn tally then found @ [ index ]
          else found
        in
        let acc = (nt, nf) in
        match nt with [] -> Stop acc | _ -> Next (acc, index + 1))
    | _ when contains other_bounds token ->
        let nf =
          if first found = List.last_exn tally then found @ [ index ] else found
        in
        let acc = (tally, nf) in
        Next (acc, index + 1)
    | _ ->
        let acc = (tally, found) in
        Next (acc, index + 1)
  in

  let _, found =
    unfold ([ start_point ], [ start_point ]) (start_point + 1) folder
  in
  found |> pair_up_bounds

let bounds_to_chunks tokens bounds =
  List.map bounds ~f:(fun (start_i, end_i) -> sub_list tokens start_i end_i)

let stop_point_from_bounds bounds =
  let _, sp = List.last_exn bounds in
  sp + 1