(** This module evaluate the sql query to use in order to filter an expression

    The result is built over [Query] except for the group function, which are
    translated into a CTE in sql
 *)

open StdLabels
module Q = Query

type 'a result = {
  repr : Format.formatter -> nested:Query.QueryParameter.t -> unit;
  group : 'a T.t option;
}

module Filter = struct
  type 'a repr = {
    repr : 'a Q.Query.repr;
    with_group : 'a T.t option;
  }

  type 'a obs = 'a result
  type 'a path_repr = 'a Q.Query.path_repr

  let observe : 'a Ast.obs * 'a repr -> 'a obs =
   fun (_, v) -> { repr = Q.Query.observe v.repr; group = v.with_group }

  let empty : 'a Ast.obs -> 'a repr =
   fun _ -> { repr = Q.Query.empty (); with_group = None }

  let expr : 'a Ast.obs * 'a repr -> 'a Ast.obs -> 'a repr =
   fun (_, expr) _ ->
    { repr = Q.Query.expr expr.repr; with_group = expr.with_group }

  let path : 'a path_repr -> 'a -> 'a Ast.obs -> 'a repr =
   fun repr p _ -> { repr = Q.Query.path repr p; with_group = None }

  let literal : string -> 'a Ast.obs -> 'a repr =
   fun l _ -> { repr = Q.Query.literal l; with_group = None }

  let integer : string -> 'a Ast.obs -> 'a repr =
   fun l _ -> { repr = Q.Query.integer l; with_group = None }

  let nvl : ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
   fun expression _ ->
    let expr_repr = List.map ~f:(fun v -> (snd v).repr) expression in
    let with_group =
      List.find_map ~f:(fun v -> (snd v).with_group) expression
    in
    match with_group with
    | None -> { repr = Q.Query.nvl expr_repr; with_group }
    | Some _ -> raise ImportErrors.MisplacedWindow

  let concat : ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
   fun expression _ ->
    let expr_repr = List.map ~f:(fun v -> (snd v).repr) expression in
    let with_group =
      List.find_map ~f:(fun v -> (snd v).with_group) expression
    in
    match with_group with
    | None -> { repr = Q.Query.concat expr_repr; with_group }
    | Some _ -> raise ImportErrors.MisplacedWindow

  let join : string -> ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
   fun sep expression _ ->
    let expr_repr = List.map ~f:(fun v -> (snd v).repr) expression
    and with_group =
      List.find_map ~f:(fun v -> (snd v).with_group) expression
    in
    match with_group with
    | None -> { repr = Q.Query.join sep expr_repr; with_group }
    | Some _ -> raise ImportErrors.MisplacedWindow

  let boperator :
      T.binary_operator ->
      'a Ast.obs * 'a repr ->
      'a Ast.obs * 'a repr ->
      'a Ast.obs ->
      'a repr =
   fun name (_, e1) (_, e2) _ ->
    let with_group =
      match (e1.with_group, e2.with_group) with
      | Some e, None -> Some e
      | None, Some e -> Some e
      | None, None -> None
      | _ -> raise ImportErrors.MisplacedWindow
    in
    { repr = Q.Query.boperator name e1.repr e2.repr; with_group }

  let gequality :
      T.binary_operator ->
      'a Ast.obs * 'a repr ->
      ('a Ast.obs * 'a repr) list ->
      'a Ast.obs ->
      'a repr =
   fun name (_, e1) group _ ->
    let group_repr = List.map ~f:(fun v -> (snd v).repr) group
    and with_group = List.find_map ~f:(fun v -> (snd v).with_group) group in

    match with_group with
    | None ->
        {
          repr = Q.Query.gequality name e1.repr group_repr;
          with_group = e1.with_group;
        }
    | _ -> raise ImportErrors.MisplacedWindow

  let funct : string -> ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
   fun name expressions _ ->
    let expr_repr = List.map ~f:(fun v -> (snd v).repr) expressions in
    let with_group =
      List.find_map ~f:(fun v -> (snd v).with_group) expressions
    in
    match with_group with
    | None -> { repr = Q.Query.funct name expr_repr; with_group }
    | Some _ -> raise ImportErrors.MisplacedWindow

  let function' :
      T.funct -> ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
   fun name expressions _ ->
    let expr_repr = List.map ~f:(fun v -> (snd v).repr) expressions in
    let with_group =
      List.find_map ~f:(fun v -> (snd v).with_group) expressions
    in
    match with_group with
    | None ->
        { repr = Q.Query.funct (T.name_of_function name) expr_repr; with_group }
    | Some _ -> raise ImportErrors.MisplacedWindow

  (** Window functions are not handled in the filters, we save them as an AST
  in order to process them in a separated handler. 

  It is not allowed to build nested window functions. *)
  let window :
      ('a Ast.obs * 'a repr) T.window ->
      ('a Ast.obs * 'a repr) list ->
      ('a Ast.obs * 'a repr) list ->
      'a Ast.obs ->
      'a repr =
   fun name expressions order ast ->
    ignore name;
    let with_group_expr =
      List.find_map ~f:(fun v -> (snd v).with_group) expressions
    and with_group_order =
      List.find_map ~f:(fun v -> (snd v).with_group) order
    in
    match (with_group_expr, with_group_order) with
    | Some _, _ | _, Some _ -> raise ImportErrors.MisplacedWindow
    | None, None ->
        (* The column name used with the cte. The name is fixed here, and used
           as is in [Analysers.Query.build_cte] and
           [Analysers.Query.eval_filters] *)
        let q = "cte.group0" in
        {
          with_group = Some ast;
          repr = Q.Query.funct "expr" [ Q.Query.literal q ];
        }
end

module ASTBuilder =
  Compose.Expression
    (Ast)
    (struct
      let v = ()
    end)

module F :
  Sym.SYM_EXPR
    with type 'a obs = 'a result
     and type 'a path_repr = Format.formatter -> 'a -> unit =
  ASTBuilder.Make (Filter)

module M = Sym.M (F)

let query_of_expression :
    type b.
    b Q.binded_query ->
    Format.formatter ->
    (Format.formatter -> 'a -> unit) ->
    'a T.t ->
    b * 'a T.t option =
 fun parameter formatter printer expr ->
  let repr = M.eval ~path_repr:printer expr in
  match parameter with
  | BindParam ->
      let p = Queue.create () in
      let parameter = Q.QueryParameter.Queue p in
      let value = F.observe repr in
      value.repr ~nested:parameter formatter;
      (p, value.group)
  | NoParam ->
      let value = F.observe repr in
      value.repr ~nested:Literal formatter;
      ((), value.group)