(*
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/>.
*)

module Tuple2 = Tools.Tuple2

let u = UTF8.from_utf8string

type t =
  | Basic: 'a ScTypes.Type.t -> t (** A direct type *)
  | Formula: formula -> t         (** A formula *)
  | Undefined: t                  (** The content is not defined *)

and formula =
  | Expression of ScTypes.Expr.t  (** A valid expression *)
  | Error of int * UTF8.t         (** When the expression cannot be parsed *)


let is_defined = function
  | Undefined -> false
  | _ -> true

let load content = begin
  let content = UTF8.to_utf8string content in
  if String.length content > 0 then (
    if content.[0] = '=' then (
      (* If the string start with a '=', load it as a formula *)
      Formula (
        try
          Expression (
               Lexing.from_string content
            |> ExpressionParser.value ExpressionLexer.read)
        with _ -> Error (1, UTF8.from_utf8string content)
      )
    ) else (
      (* First try to load the data with basic types, and fallback with string *)
      let content' =
        try String.sub content 0 (String.index content '\000')
        with Not_found -> content in
        try
          let ScTypes.Result.Ok r =
               ExpressionParser.content ExpressionLexer.read
            @@ Lexing.from_string content' in
          Basic r
        with _ -> Basic (ScTypes.Type.string (UTF8.from_utf8string content'))
    )
  ) else (
    (* If the string in empty, build an undefined value *)
    Undefined
  )
end


let load_expr expr = expr

module EvalExpr = ScTypes.Expr.Eval(Evaluate)

(** Extract the parameters to give to a function.
    return an Error if one of them is an error
 *)
let eval expr catalog mapper = begin

  begin try match expr with
    | Basic value -> ScTypes.Result.Ok value
    | Formula (Expression e) -> EvalExpr.eval e (catalog, mapper)
    | Formula (Error (i, s)) -> ScTypes.Result.Error ScTypes.Error
    | Undefined -> ScTypes.Result.Error Not_found
    with ex -> ScTypes.Result.Error ex
  end

end


module EvalSources = ScTypes.Expr.Eval(Collect_sources)

let collect_sources = begin function
  | Formula (Expression f) -> EvalSources.eval f Cell.Set.empty
  | _ -> Cell.Set.empty
end

module Shifter = ScTypes.Expr.Eval(Shift_expr)
module Printer = ScTypes.Expr.Eval(Show_expr.Show_Expr(Show_ref)(Show_type))

(** Inherit the default representation, but print the float with all decimals *)
module LongPrinter = ScTypes.Type.Eval(struct

  include Show_type

  let num n buffer =
    if DataType.Num.is_integer n then
      DataType.Num.to_int n
        |> string_of_int
        |> UTF8.from_utf8string
        |> UTF8.Buffer.add_string buffer
    else
      let f = DataType.Num.to_float n
      and to_b = UTF8.Format.formatter_of_buffer buffer in
      ignore @@ UTF8.Format.fprintf to_b "%f" f;
      Format.pp_print_flush to_b ()

end)

let show e =
  let buffer = UTF8.Buffer.create 16 in
  begin match e with
  | Formula (Expression f) ->
      UTF8.Buffer.add_char buffer '=';
      Printer.eval f buffer
  | Basic b -> LongPrinter.eval b buffer
  | Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s
  | Undefined -> ()
  end;
  UTF8.Buffer.contents buffer

let shift vector = function
  | Formula (Expression f) -> Formula (Expression (Shifter.eval f vector))
  | other -> other

let (=) t1 t2 = match t1, t2 with
  | Basic b1, Basic b2 -> ScTypes.Type.(=) b1 b2
  | o1, o2 -> Pervasives.(=) o1 o2