open StdLabels

let truncate buffer n = Buffer.truncate buffer (Buffer.length buffer - n)

module E :
  Sym.SYM_CHUNK
    with type 'a obs = buffer:Buffer.t -> unit
     and type 'a path_repr = 'a -> Buffer.t -> unit = struct
  type 'a repr = buffer:Buffer.t -> unit
  type 'a obs = buffer:Buffer.t -> unit
  type 'a path_repr = 'a -> Buffer.t -> unit

  let group : 'a repr list -> 'a repr =
   fun args ~buffer ->
    Buffer.add_string buffer "[";
    List.iter args ~f:(fun v ->
        v ~buffer;
        Buffer.add_string buffer ", ");

    truncate buffer 2;
    Buffer.add_string buffer "]"

  let arguments : 'a repr list -> 'a repr =
   fun expressions ~buffer ->
    Buffer.add_string buffer "(";
    List.iter expressions ~f:(fun v ->
        v ~buffer;
        Buffer.add_string buffer ", ");

    truncate buffer 2;
    Buffer.add_string buffer ")"

  let observe x ~buffer = x ~buffer
  let empty : unit -> 'a repr = fun _ ~buffer -> Buffer.add_string buffer "''"
  let path printer p ~buffer = printer p buffer
  let literal l ~buffer = Buffer.add_string buffer l
  let integer l ~buffer = Buffer.add_string buffer l

  let expr expr ~buffer =
    Buffer.add_char buffer '(';
    expr ~buffer;
    Buffer.add_char buffer ')'

  let nvl expression ~buffer =
    Buffer.add_string buffer "nvl";
    arguments ~buffer expression

  let concat expression ~buffer = List.iter expression ~f:(fun v -> v ~buffer)

  let join sep expression ~buffer =
    List.iter expression ~f:(fun v ->
        v ~buffer;
        Buffer.add_string buffer sep);
    truncate buffer (String.length sep)

  let window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr =
   fun name expressions order ~buffer ->
    ignore order;
    let name = T.name_of_window name in

    Buffer.add_string buffer name;
    arguments ~buffer expressions

  let boperator name e1 e2 ~buffer =
    e1 ~buffer;
    Buffer.add_string buffer (T.name_of_operator name);
    e2 ~buffer

  let gequality name e1 e2 ~buffer =
    e1 ~buffer;
    Buffer.add_string buffer (T.name_of_operator name);
    group ~buffer e2

  let funct name expressions ~buffer =
    Buffer.add_string buffer name;
    arguments ~buffer expressions

  let function' name expressions ~buffer =
    Buffer.add_string buffer (T.name_of_function name);
    arguments ~buffer expressions
end

module M = Sym.M (E)

let headers_of_expression :
    Buffer.t -> ('a -> Buffer.t -> unit) -> 'a T.t -> unit =
 fun buffer printer expr ->
  let repr = M.eval expr ~path_repr:printer in
  E.observe repr ~buffer