(** This module extract the type for an expression.

    The module does not check anything, but is intended to be composed in
    another one check. *)

open StdLabels
module S = Qsp_syntax.S
module T = Qsp_syntax.T
module Report = Qsp_syntax.Report

type type_of =
  | Integer  (** A numeric value *)
  | Bool  (** A boolean, not a real type *)
  | String  (** String value *)
  | NumericString
      [@printer fun fmt _ -> Format.pp_print_string fmt "Integer as String"]
      (** String containing a numeric value *)
[@@deriving show { with_path = false }, eq]

module Expression = struct
  type t = Variable of type_of | Raw of type_of [@@deriving show, eq]
  type t' = t

  let v = Fun.id
  let get_type : t -> type_of = function Raw r -> r | Variable r -> r

  let map : t -> type_of -> t =
   fun t type_of ->
    match t with Raw _ -> Raw type_of | Variable _ -> Variable type_of

  let get_nature : t -> t -> type_of -> t =
   fun t1 t2 type_of ->
    match (t1, t2) with
    | Variable _, _ -> Variable type_of
    | _, Variable _ -> Variable type_of
    | Raw _, Raw _ -> Raw type_of

  let integer : ctx:Qsp_syntax.S.extract_context -> S.pos -> string -> t =
   fun ~ctx _ _ ->
    ignore ctx;
    Raw Integer

  let ident : ctx:Qsp_syntax.S.extract_context -> (S.pos, 'any) S.variable -> t
      =
   fun ~ctx var ->
    ignore ctx;
    match var.name.[0] with '$' -> Variable String | _ -> Variable Integer

  let literal :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> t T.literal list -> t =
   fun ~ctx pos values ->
    ignore ctx;
    ignore pos;
    let init = None in
    let typed =
      List.fold_left values ~init ~f:(fun state -> function
        | T.Text t -> (
            (* Tranform the type, but keep the information is it’s a raw data
             or a variable one *)
            let nature = Option.value ~default:(Raw Integer) state in
            match (Option.map get_type state, int_of_string_opt t) with
            | None, Some _
            | Some Integer, Some _
            | Some NumericString, Some _
            | Some Bool, Some _ ->
                Some (map nature NumericString)
            | _, _ ->
                if String.equal "" t then
                  (* If the text is empty, ignore it *)
                  state
                else Some (map nature String))
        | T.Expression t -> (
            let nature = Option.value ~default:(Raw Integer) state in
            match (Option.map get_type state, get_type t) with
            | None, Integer | Some NumericString, Integer ->
                Some (get_nature nature t NumericString)
            | _ -> Some (map nature String)))
    in
    let result = Option.value ~default:(Raw String) typed in
    result

  let uoperator :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> T.uoperator -> t -> t =
   fun ~ctx pos operator t ->
    ignore ctx;
    ignore pos;
    match operator with Add -> t | Neg | No -> Raw Integer

  let boperator :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> T.boperator -> t -> t -> t =
   fun ~ctx pos operator t1 t2 ->
    ignore ctx;
    ignore pos;
    match operator with
    | T.Plus -> (
        match (get_type t1, get_type t2) with
        | Integer, Integer -> get_nature t1 t2 Integer
        | String, _ -> get_nature t1 t2 String
        | _, String -> get_nature t1 t2 String
        | (_ as t), Bool -> get_nature t1 t2 t
        | Bool, (_ as t) -> get_nature t1 t2 t
        | (_ as t), NumericString -> get_nature t1 t2 t
        | NumericString, (_ as t) -> get_nature t1 t2 t)
    | T.Eq | T.Neq -> get_nature t1 t2 Bool
    | T.Mod | T.Minus | T.Product | T.Div -> get_nature t1 t2 Integer
    | T.And | T.Or -> get_nature t1 t2 Bool
    | Lt | Gte | Lte | Gt -> get_nature t1 t2 Bool

  let function_ :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> T.function_ -> t list -> t =
   fun ~ctx pos function_ params ->
    ignore ctx;
    ignore pos;
    match function_ with
    | Dyneval | Dyneval' -> Variable NumericString
    | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Getobj | Instr | Isplay ->
        Variable Integer
    | Desc' | Getobj' -> Variable String
    | Func | Func' -> Variable NumericString
    | Iif | Iif' -> ( match params with _ :: t :: _ -> t | _ -> Raw Bool)
    | Input | Input' -> Variable NumericString
    | Isnum -> Raw Bool
    | Lcase | Lcase' | Ucase | Ucase' -> Raw String
    | Len -> Variable Integer
    | Loc -> Variable Bool
    | Max | Max' | Min | Min' -> (
        match params with
        | [] -> Raw Bool
        | Raw String :: [] | Variable String :: [] -> Variable NumericString
        | hd :: _ -> hd)
    | Mid | Mid' -> Variable String
    | Msecscount -> Variable Integer
    | Rand -> Variable Integer
    | Replace -> Variable String
    | Replace' -> Variable String
    | Rgb -> Variable Integer
    | Rnd -> Variable Integer
    | Selact -> Variable String
    | Str | Str' -> Raw String
    | Strcomp -> Raw Bool
    | Strfind -> Variable String
    | Strfind' -> Variable String
    | Strpos -> Variable Integer
    | Trim -> Variable String
    | Trim' -> Variable String
    | Val -> Variable Integer
end

module A = struct
  let identifier = "get_types"
  let description = "Identify the type for an expression"
  let is_global = true
  let active = ref false
  let depends = []

  type ex = Qsp_syntax.Identifier.t
  type context = unit

  let initialize () = ()

  module Expression = Expression

  module Instruction = struct
    type t = unit
    type t' = unit

    include
      Default.Instruction
        (Expression)
        (struct
          type t = unit

          let default = ()
          let fold seq = Seq.iter (fun _ -> ()) seq
        end)

    let v = Fun.id
  end

  module Location = struct
    type t = unit
    type instruction = Instruction.t'

    let location : context -> S.pos -> instruction list -> t =
     fun context pos instr ->
      ignore context;
      ignore pos;
      List.iter instr ~f:(fun _ -> ())

    let v : t -> Report.t list = fun _ -> []
  end

  let finalize context =
    ignore context;
    []
end

let expression_id = Type.Id.make ()
let ex = Qsp_syntax.Identifier.build ~expression_id (module A)