(** All the types used in the spreadsheet. *)

let u = UTF8.from_utf8string

exception Error

type cell = Cell.t

type ident = UTF8.t

type 'a number_format = (float -> 'a, Format.formatter, unit) format

type _ dataFormat =
  | Date:   DataType.Num.t dataFormat   (* Date *)
  | Number: DataType.Num.t dataFormat   (* Number *)
  | String: DataType.String.t dataFormat           (* String result, there is only one representation *)
  | Bool:   DataType.Bool.t dataFormat  (* Boolean result *)

type numericType =
  | Date
  | Number

let get_numeric_type: DataType.Num.t dataFormat -> numericType = function
  | Date -> Date
  | Number -> Number

let priority: type a. a dataFormat -> int = function
  | Date   -> 1
  | Number -> 0
  | String -> 0
  | Bool   -> 0

type 'a types =
  | Num  : DataType.Num.t dataFormat * DataType.Num.t -> DataType.Num.t types    (** A number *)
  | Str  : DataType.String.t -> DataType.String.t types                     (** A string *)
  | Bool : DataType.Bool.t -> DataType.Bool.t types                         (** A boolean *)

type 'a returnType =
  | Num  : DataType.Num.t dataFormat option -> DataType.Num.t returnType    (** A number *)
  | Str  : DataType.String.t returnType                                     (** A string *)
  | Bool : DataType.Bool.t returnType                                       (** A boolean *)

let f_num: DataType.Num.t returnType  = Num None
let f_date: DataType.Num.t returnType = Num (Some Date)
let f_number: DataType.Num.t returnType = Num (Some Number)
let f_string: DataType.String.t returnType = Str
let f_bool: DataType.Bool.t returnType = Bool

type typeContainer =
  | Value: 'a types -> typeContainer

let guess_format_result:
  type a. a returnType -> typeContainer list -> (a -> a types) =
  fun return params -> begin match return with
  | Str -> fun value -> Str value
  | Bool -> fun value -> Bool value
  | Num (Some x) -> fun value -> Num (x, value)
  | Num None -> fun value -> Num (Number, value)
end

type refs =
  | Cell of cell                                      (** A cell *)
  | Range of cell * cell                              (** An area of cells *)

type expression =
  | Value : 'a types -> expression                    (** A direct value *)
  | Ref : refs -> expression                          (** A reference to another cell *)
  | Call : ident * expression list -> expression      (** A call to a function *)
  | Expression : expression -> expression             (** An expression *)

(** Result from a computation *)
type result =
  | Result : 'a types -> result
  | Error : exn -> result

module Type = struct
  (* Required because Num.Big_int cannot be compared with Pervasives.(=) *)
  let (=) : type a b. a types -> b types -> bool = fun t1 t2 ->
    match t1, t2 with
    | Num (_, n1), Num (_, n2) -> DataType.Num.eq n1 n2
    | Bool b1, Bool b2 -> b1 = b2
    | Str s1, Str s2 -> s1 = s2
    | _, _ -> false

  (** Show a list of elements
   *)
  let rec show_list printer buffer = begin function
    | [] -> ()
    | hd::[] ->
        UTF8.Printf.bprintf buffer "%a"
        printer hd
    | hd::tl ->
        UTF8.Printf.bprintf buffer "%a, "
        printer hd;
        show_list printer buffer tl
  end

  and show: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function
    | Str x     -> UTF8.Buffer.add_string buffer x
    | Bool b    -> UTF8.Printf.bprintf buffer "%B" b
    | Num (Number, n)     ->
      let n = DataType.Num.to_num n in
      if Num.is_integer_num n then
        UTF8.Buffer.add_string buffer @@ u(Num.string_of_num n)
      else
        let to_b = UTF8.Format.formatter_of_buffer buffer in
        ignore @@ UTF8.Format.fprintf to_b "%.2f" (Num.float_of_num n);
        Format.pp_print_flush to_b ()
    | Num (Date, n)    ->
        let y, m, d = Date.date_from_julian_day (DataType.Num.to_num n) in
        UTF8.Printf.bprintf buffer "%d/%d/%d" y m d
  end

end

module Refs = struct

  type 'a range =
    | Single of 'a
    | Array1 of 'a list
    | Array2 of 'a list list

  let collect = function
    | Cell x -> Single (Pervasives.fst x)
    | Range (fst, snd) ->
        let (x1, y1) = Pervasives.fst fst
        and (x2, y2) = Pervasives.fst snd in
        let min_x = min x1 x2
        and max_x = max x1 x2
        and min_y = min y1 y2
        and max_y = max y1 y2 in
        if (min_x = max_x) || (min_y = max_y) then (
          (* There is only a one dimension array *)
          let elms = ref [] in
          for x = min_x to max_x do
            for y = min_y to max_y do
              elms := (x, y)::!elms
            done
          done;
          Array1 (!elms)
        ) else (
          (* This a two-dimension array *)
          let elmx = ref [] in
          for x = min_x to max_x do
            let elmy = ref [] in
            for y = min_y to max_y do
              elmy := (x, y)::!elmy
            done;
            elmx := !elmy::!elmx
          done;
          Array2 (!elmx)
        )

  let map f = function
    | Single coord ->  Single (f coord)
    | Array1 values -> Array1 (List.map f values)
    | Array2 values -> Array2 (List.map (List.map f) values)

  let shift (vector_x, vector_y) ref =
    let _shift ((x, y), (fixed_x, fixed_y)) =
      let x' = if fixed_x then x else x + vector_x
      and y' = if fixed_y then y else y + vector_y in
        (x', y'), (fixed_x, fixed_y)
    in match ref with
    | Cell x -> Cell (_shift x)
    | Range (fst, snd) -> Range (_shift fst, _shift snd)

  let show buffer = begin function
    | Cell r      -> UTF8.Buffer.add_string buffer @@ Cell.to_string r
    | Range (f,t) ->
        Tools.Tuple2.printb ~first:"" ~last:"" ~sep:":" Cell.to_buffer Cell.to_buffer buffer (f,t)
  end

end

module Result = struct
  let (=) t1 t2 =
    match t1, t2 with
    | Result v1, Result v2 -> Type.(=) v1 v2
    | _, _ -> t1 = t2

  let show = begin function
    | Error x ->
        (*
        let buffer = Buffer.create 16 in
        let b = Format.formatter_of_buffer buffer in
        Errors.printf b x;
        Format.pp_print_flush b ();
        u(Buffer.contents buffer)
        *)
        u"#Error"
    | Result v ->
          let buffer = UTF8.Buffer.create 16 in
          Type.show buffer v;
          UTF8.Buffer.contents buffer
  end

end

(** Represent an expression.
 *)
let rec show_expr buffer : expression -> unit = begin function
  | Value (Str x) ->
      (** Print the value with quotes *)
      UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string x)
  | Value v -> Type.show buffer v
  | Ref r -> Refs.show buffer r
  | Call (ident, params) ->
    let utf8ident = UTF8.to_utf8string ident in
    begin match utf8ident with
    | "+" | "*" | "-" | "/" | "^" | "="
    | "<>" | "<=" | ">=" | "<" | ">" -> begin match params with
      | v1::[] ->
        UTF8.Printf.bprintf buffer "%s%a"
        utf8ident
        show_expr v1
      | v1::v2::[] ->
        UTF8.Printf.bprintf buffer "%a%s%a"
        show_expr v1
          utf8ident
        show_expr v2
      | _ ->
        UTF8.Buffer.add_string buffer ident;
        Tools.List.printb ~sep:(u";") show_expr buffer params
    end
    | _ ->
      UTF8.Buffer.add_string buffer ident;
      Tools.List.printb ~sep:(u";") show_expr buffer params
    end
  | Expression expr ->
      UTF8.Printf.bprintf buffer "(%a)" show_expr expr
end