type value =
  | Str of string
  | Bool of bool
  | List of value list
  | Obj of (string * value) list

type node =
  | Text of string
  | Var of string list
  | Section of string list * node list
  | Inverted of string list * node list

type tag = TVar of string list | TOpen of string list | TInv of string list | TClose of string list | TComment

let trim = String.trim

let path s =
  String.split_on_char '.' (trim s) |> List.map trim |> List.filter (fun x -> x <> "")

(* Lex into a flat list of text and tags. Returns Error on an unterminated tag
   rather than treating the remainder as text: silently swallowing "{{name" is
   how a typo becomes invisible missing output. *)
let lex src =
  let n = String.length src in
  let out = ref [] in
  let buf = Buffer.create 256 in
  let flush () =
    if Buffer.length buf > 0 then (out := `Text (Buffer.contents buf) :: !out; Buffer.clear buf)
  in
  let rec go i =
    if i >= n then (flush (); Ok (List.rev !out))
    else if i + 1 < n && src.[i] = '{' && src.[i + 1] = '{' then
      match String.index_from_opt src (i + 2) '}' with
      | Some j when j + 1 < n && src.[j + 1] = '}' ->
          let body = String.sub src (i + 2) (j - i - 2) in
          flush ();
          let tag =
            let b = trim body in
            if b = "" then Error "empty tag {{}}"
            else
              (* Every sigil form (var, #, ^, /) resolves a dotted path; an
                 empty path ("{{.}}", "{{#}}", "{{^}}", "{{/}}") names
                 nothing -- there is no "current context" concept for a bare
                 dot to mean, so it is a parse error rather than an invented
                 behaviour Task 3 would have to define. *)
              let with_path ctor rest =
                match path rest with
                | [] -> Error "empty tag path: {{.}} and {{#}} name nothing"
                | p -> Ok (ctor p)
              in
              match b.[0] with
              | '#' -> with_path (fun p -> TOpen p) (String.sub b 1 (String.length b - 1))
              | '^' -> with_path (fun p -> TInv p) (String.sub b 1 (String.length b - 1))
              | '/' -> with_path (fun p -> TClose p) (String.sub b 1 (String.length b - 1))
              | '!' -> Ok TComment
              | '>' -> Error "partials are not supported: a template may not include another file"
              | _ -> with_path (fun p -> TVar p) b
          in
          (match tag with
           | Error e -> Error e
           | Ok t -> out := `Tag t :: !out; go (j + 2))
      | _ -> Error "unterminated tag: '{{' with no matching '}}'"
    else (Buffer.add_char buf src.[i]; go (i + 1))
  in
  go 0

(* Fold the flat list into a tree, checking that every close matches its open. *)
let build items =
  let rec go acc stack items =
    match items with
    | [] -> (
        match stack with
        | [] -> Ok (List.rev acc)
        | (p, _, _) :: _ -> Error ("unclosed section {{#" ^ String.concat "." p ^ "}}"))
    | `Text "" :: rest -> go acc stack rest
    | `Text t :: rest -> go (Text t :: acc) stack rest
    | `Tag TComment :: rest -> go acc stack rest
    | `Tag (TVar p) :: rest -> go (Var p :: acc) stack rest
    | `Tag (TOpen p) :: rest -> go [] ((p, `Sec, acc) :: stack) rest
    | `Tag (TInv p) :: rest -> go [] ((p, `Inv, acc) :: stack) rest
    | `Tag (TClose p) :: rest -> (
        match stack with
        | [] -> Error ("close tag {{/" ^ String.concat "." p ^ "}} with no open section")
        | (op, kind, outer) :: tl ->
            if op <> p then
              Error
                ("mismatched close: {{#" ^ String.concat "." op ^ "}} closed by {{/"
               ^ String.concat "." p ^ "}}")
            else
              let inner = List.rev acc in
              let node = match kind with `Sec -> Section (op, inner) | `Inv -> Inverted (op, inner) in
              go (node :: outer) tl rest)
  in
  go [] [] items

let parse src = match lex src with Error e -> Error e | Ok items -> build items