open StdLabels

let escape_dquote = Re.Str.regexp "'"
let escape content = Re.Str.global_replace escape_dquote "\\'" content

module E :
  Sym.SYM_CHUNK
    with type 'a obs = top:bool -> string
     and type 'a path_repr = 'a -> string = struct
  type 'a repr = top:bool -> string
  type 'a obs = top:bool -> string
  type 'a path_repr = 'a -> string

  let observe x = x

  let group : 'a repr list -> 'a repr =
   fun args ~top ->
    let args_repr = List.map ~f:(fun v -> v ~top) args in
    let args = String.concat ~sep:", " args_repr in
    "[" ^ args ^ "]"

  let arguments : 'a repr list -> 'a repr =
   fun args ~top ->
    let args_repr = List.map ~f:(fun v -> v ~top) args in
    let args = String.concat ~sep:", " args_repr in
    "(" ^ args ^ ")"

  let empty : unit -> 'a repr =
   fun () ~top ->
    match top with
    | false -> "''"
    | true -> ""

  let literal : string -> 'a repr =
   fun l ~top ->
    if String.equal String.empty l then (empty ()) ~top
    else
      match int_of_string_opt l with
      | Some _ -> l
      | None -> "'" ^ escape l ^ "'"

  let integer : string -> 'a repr =
   fun l ~top -> if String.equal String.empty l then (empty ()) ~top else l

  let expr : 'a repr -> 'a repr =
   fun expr ~top ->
    ignore top;
    String.concat ~sep:"" [ "("; expr ~top:false; ")" ]

  let path : 'b path_repr -> 'b -> 'a repr =
   fun path_repr p ~top ->
    ignore top;
    path_repr p

  let concat : 'a repr list -> 'a repr =
   fun elems ~top ->
    ignore top;
    let top = false in
    let strs = List.map elems ~f:(fun v -> v ~top) in
    String.concat ~sep:" ^ " strs

  let window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr =
   fun name g1 sort ~top ->
    ignore top;

    let args1 = group ~top:false g1
    and args2 = group ~top:false sort
    and f_name = T.name_of_window name in
    let args = [ args1; args2 ] in
    let args =
      match name with
      | T.Counter -> args
      | T.Min prefix_arg
      | T.Max prefix_arg
      | T.Previous prefix_arg
      | T.Sum prefix_arg -> prefix_arg ~top:false :: args
    in

    f_name ^ "(" ^ String.concat ~sep:", " args ^ ")"

  let nvl : 'a repr list -> 'a repr =
   fun elems ~top ->
    ignore top;
    let args = arguments ~top:false elems in
    "nvl" ^ args

  let join : string -> 'a repr list -> 'a repr =
   fun sep elems ~top ->
    ignore top;
    let header = literal sep in
    let args = arguments ~top:false (header :: elems) in
    "join" ^ args

  let boperator : T.binary_operator -> 'a repr -> 'a repr -> 'a repr =
   fun op arg1 arg2 ~top ->
    ignore top;
    let top = false in
    let sep = T.name_of_operator op in
    String.concat ~sep [ arg1 ~top; arg2 ~top ]

  let gequality : T.binary_operator -> 'a repr -> 'a repr list -> 'a repr =
   fun op arg1 arg2 ~top ->
    ignore top;
    let top = false in
    let sep = T.name_of_operator op in
    let args = group ~top:false arg2 in
    String.concat ~sep [ arg1 ~top; args ]

  let funct : string -> 'a repr list -> 'a repr =
   fun f args ~top ->
    ignore top;
    let args = arguments ~top:false args in
    f ^ args

  let function' : T.funct -> 'a repr list -> 'a repr =
   fun f args ~top ->
    ignore top;
    let args = arguments ~top:false args in
    T.name_of_function f ^ args
end

module M = Sym.M (E)

let repr : ?top:bool -> ('a -> string) -> 'a T.t -> string =
 fun ?(top = false) printer expr ->
  let repr = M.eval ~path_repr:printer expr in
  E.observe repr ~top