(*
This file is part of licht.

licht is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

licht is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with licht.  If not, see <http://www.gnu.org/licenses/>.
*)

(** Internal representation for each type *)
type 'a value =
    | Bool:   DataType.Bool.t                       -> DataType.Bool.t value
    | Num:    DataType.Num.t ScTypes.DataFormat.t * DataType.Num.t  -> DataType.Num.t value
    | String: DataType.String.t                     -> DataType.String.t value
    | List:   'a ScTypes.DataFormat.t * 'a list       -> 'a list value
    | Matrix: 'a ScTypes.DataFormat.t * 'a list list  -> 'a list list value

type existencialResult =
  | Result : 'a value -> existencialResult [@@unboxed]

module T:Sym_type.SYM_TYPE with type 'a obs = existencialResult = struct

  type 'a t = 'a value

  type 'a obs = existencialResult

  let str s = String s

  let num n = Num (ScTypes.DataFormat.Number, n)

  let date d = Num (ScTypes.DataFormat.Date, d)

  let bool b = Bool b

  let observe x = Result x

end

type dic = (Functions.C.t * (int * int -> ScTypes.Result.t option))

type t = dic -> existencialResult

type obs = dic -> ScTypes.Result.t

module R = Eval_ref

(** Extract the type and the content from a value *)
let get_argument: type a. a value -> a Functions.typ * a = function
  | Bool b        -> Functions.t_bool, b
  | Num (_, n)    -> Functions.t_int, n
  | String s      -> Functions.t_string, s
  | List (t, l)   -> Functions.t_list (Functions.typ_of_format t), l
  | Matrix (t, l) -> Functions.t_list (Functions.t_list (Functions.typ_of_format t)), l

(** Convert the evaluation result in a type depending of the function parameters *)
let wrap_call (Functions.C.R(ret, res)) type_builder = begin
  let returnType = ScTypes.ReturnType.guess_format_result ret type_builder in
  begin match returnType with
  | ScTypes.DataFormat.Bool    -> T.observe (T.bool res)
  | ScTypes.DataFormat.String  -> T.observe (T.str res)
  | ScTypes.DataFormat.Number  -> T.observe (T.num res)
  | ScTypes.DataFormat.Date    -> T.observe (T.date res)
  end
end

(** Extract the format from a list of results *)
let build_format_list ll =

  List.map (fun (Result x) ->
    begin match x with
      | Bool _         -> ScTypes.DataFormat.F (ScTypes.DataFormat.Bool)
      | Num (x, _)     -> ScTypes.DataFormat.F x
      | String _       -> ScTypes.DataFormat.F (ScTypes.DataFormat.String)
      | List (f, _)    -> ScTypes.DataFormat.F f
      | Matrix (f, _)  -> ScTypes.DataFormat.F f
    end
  ) ll

let value v _ = T.observe v

let ref r (_, mapper) = begin
  match R.observe r mapper with
  | R.Value (f, res) -> begin match f with
    | ScTypes.DataFormat.Bool    -> T.observe (T.bool res)
    | ScTypes.DataFormat.String  -> T.observe (T.str res)
    | ScTypes.DataFormat.Number  -> T.observe (T.num res)
    | ScTypes.DataFormat.Date    -> T.observe (T.date res)
  end
  | R.List (t, l) -> Result (List(t, l))
  | R.Matrix (t, l) -> Result (Matrix(t, l))
end

let observe repr catalog = begin
  let Result r = repr catalog in match r with
  | Bool b ->  ScTypes.Result.Ok (ScTypes.Type.boolean b)
  | String s -> ScTypes.Result.Ok (ScTypes.Type.string s)
  | Num (format, n)  ->
    begin match format with
      (* We can only match numeric formats here *)
      | ScTypes.DataFormat.Date -> ScTypes.Result.Ok (ScTypes.Type.date n)
      | ScTypes.DataFormat.Number -> ScTypes.Result.Ok (ScTypes.Type.number n)
      | _ -> raise Errors.TypeError
    end
  | _ -> raise Errors.TypeError
end

let expression e = e

let call0 ident (catalog, _) =
  let name' = UTF8.to_utf8string ident in
  let (arg1:(unit Functions.C.argument * unit)) = (Functions.t_unit, ()) in
  wrap_call
    (Functions.C.eval1 catalog name' arg1)
    (fun () -> raise Errors.TypeError)

let call1 ident p1 ((catalog, _) as c) =
  let name' = UTF8.to_utf8string ident in
  (* Evaluate here p1 expression *)
  let (Result r1) = p1 c in
  let arg1 = get_argument r1 in
  wrap_call
    (Functions.C.eval1 catalog name' arg1)
    (fun () -> build_format_list [Result r1])

let call2 ident p1 p2 ((catalog, _) as c) =
  let name' = UTF8.to_utf8string ident in
  let (Result r1) = p1 c in
  let (Result r2) = p2 c in
  let arg1 = get_argument r1
  and arg2 = get_argument r2 in
  wrap_call
    (Functions.C.eval2 catalog name' arg1 arg2)
    (fun () -> build_format_list [Result r1; Result r2])

let call3 ident p1 p2 p3 ((catalog, _) as c) =
  let name' = UTF8.to_utf8string ident in
  let (Result r1) = p1 c in
  let (Result r2) = p2 c in
  let (Result r3) = p3 c in
  let arg1 = get_argument r1
  and arg2 = get_argument r2
  and arg3 = get_argument r3 in
  wrap_call
    (Functions.C.eval3 catalog name' arg1 arg2 arg3)
    (fun () -> build_format_list [Result r1; Result r2; Result r3])

let callN ident params ((catalog, _) as c) =

  let map_params expression = begin
    let (Result r) = expression c in
    let formatter = Format.str_formatter in
    Functions.repr formatter (fst @@ get_argument r);
    Format.flush_str_formatter ()
  end in
  let signature = List.map map_params params in
  raise (Errors.Undefined (ident, signature))