(** 
 This module evaluate the type of an expression.

 The type is given with an analysis from all the component involved inside
 the exrpssion. It is used inside the [query] module in order to check if one
 type need conversion before being used.
 *)

open StdLabels

module Lazy_Repr =
  Compose.Expression
    (Lazier.Make
       (Repr.E))
       (struct
         let v _ = ""
       end)

type t = ImportDataTypes.Types.t

(** Fold over the list of parameters and ensure all the elements are typed in
the same way *)
let group' : t list -> t =
 fun elements ->
  List.fold_left elements ~init:None
    ~f:(fun (acc : ImportDataTypes.Types.t option) v ->
      match acc with
      | None -> Some v
      | Some t when t = v -> acc
      | _ -> Some Extern)
  |> Option.value ~default:ImportDataTypes.Types.None

include Lazy_Repr.Make (struct
  type nonrec t = t
  type 'a repr = t
  type 'a obs = ImportDataTypes.Types.t
  type 'a path_repr = 'a -> unit

  let observe : 'a Repr.E.obs Lazy.t * 'a repr -> 'a obs = snd

  let empty : 'a Repr.E.obs Lazy.t -> 'a repr =
   fun _ -> ImportDataTypes.Types.None

  let expr : 'a Repr.E.obs Lazy.t * 'a repr -> 'a Repr.E.obs Lazy.t -> 'a repr =
   fun e _ -> snd e

  let literal : string -> 'a Repr.E.obs Lazy.t -> 'a repr =
   fun _ _ -> ImportDataTypes.Types.String

  let integer : string -> 'a Repr.E.obs Lazy.t -> 'a repr =
   fun _ _ -> ImportDataTypes.Types.Number

  let path : 'b path_repr -> 'b -> 'a Repr.E.obs Lazy.t -> 'a repr =
   fun _ _ _ -> ImportDataTypes.Types.Extern

  let concat :
      ('a Repr.E.obs Lazy.t * 'a repr) list -> 'a Repr.E.obs Lazy.t -> 'a repr =
   fun _ _ -> ImportDataTypes.Types.String

  let window :
      ('a Repr.E.obs Lazy.t * 'a repr) T.window ->
      ('a Repr.E.obs Lazy.t * 'a repr) list ->
      ('a Repr.E.obs Lazy.t * 'a repr) list ->
      'a Repr.E.obs Lazy.t ->
      'a repr =
   fun name expressions order _ ->
    ignore order;
    ignore expressions;
    match name with
    | T.Counter | T.Max _ | T.Min _ | T.Sum _ -> Number
    | T.Previous expr -> snd expr

  let nvl :
      ('a Repr.E.obs Lazy.t * 'a repr) list -> 'a Repr.E.obs Lazy.t -> 'a repr =
   fun v _ -> group' (List.map ~f:snd v)

  let join :
      string ->
      ('a Repr.E.obs Lazy.t * 'a repr) list ->
      'a Repr.E.obs Lazy.t ->
      'a repr =
   fun _ _ _ -> ImportDataTypes.Types.String

  let boperator :
      T.binary_operator ->
      'a Repr.E.obs Lazy.t * 'a repr ->
      'a Repr.E.obs Lazy.t * 'a repr ->
      'a Repr.E.obs Lazy.t ->
      'a repr =
   fun name _ _ _ ->
    match name with
    | T.Equal | T.Different | T.LT | T.GT -> Bool
    | T.Add | T.Minus -> Number
    | T.Division -> Float
    | T.And | T.Or -> Bool

  let gequality :
      T.binary_operator ->
      'a Repr.E.obs Lazy.t * 'a repr ->
      ('a Repr.E.obs Lazy.t * 'a repr) list ->
      'a Repr.E.obs Lazy.t ->
      'a repr =
   fun name _ _ _ ->
    match name with
    | T.Equal | T.Different -> Bool
    | _ -> None

  let function' :
      T.funct ->
      ('a Repr.E.obs Lazy.t * 'a repr) list ->
      'a Repr.E.obs Lazy.t ->
      'a repr =
   fun name expressions _ ->
    ignore expressions;
    match name with
    | Upper | Trim -> String

  let check : expected:t -> actual:t -> string -> 'a Repr.E.obs Lazy.t -> t =
   fun ~expected ~actual subset expr ->
    if actual = expected then actual
    else
      let expression = (Lazy.force expr) ~top:false in
      raise (ImportErrors.TypeError { expression; subset; expected; actual })

  let funct :
      string ->
      ('a Repr.E.obs Lazy.t * 'a repr) list ->
      'a Repr.E.obs Lazy.t ->
      'a repr =
   fun name expressions repr ->
    match name with
    | "if" -> begin
        match expressions with
        | [] -> Extern
        | (_, hd) :: arg1 :: _ when hd = Bool -> snd arg1
        | (_, hd) :: _ ->
            let expected = ImportDataTypes.Types.Bool and actual = hd in
            check ~expected ~actual "the predicate" repr
      end
    | _ -> Extern
end)

let group :
    ('a Lazier.Make(Repr.E).repr * t) list -> 'a Lazier.Make(Repr.E).repr * t =
 fun v ->
  let v' = group' (List.map v ~f:snd) in
  let l = lazy (Repr.E.empty ()) in
  (l, v')

let arguments = group