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


(** Contain a valid value from the sheet. This value can be empty if it is not
yet defined *)
type value =
  | V : 'a ScTypes.Type.t -> value
  | Empty : value

(** This is a snapshot from all the cells in the sheet, the values may be
defined or not, and are not yet unified *)
type range =
  | Single : 'a ScTypes.Type.t -> range
  | Array1 : value list -> range
  | Array2 : value list list -> range

(** Result from the computation, the list is unified and the type is now
identified. The empty elements are defined with a default value. *)
type content =
  | Value:  'a ScTypes.DataFormat.t * 'a -> content
  | List:   'a ScTypes.DataFormat.t * 'a list -> content
  | Matrix: 'a ScTypes.DataFormat.t * 'a list list -> content

(** Type for the mapper function.

  This function should be able to read the cell from the spreadsheet from
  it coordinates, and return the associated value.

*)
type mapper = (int * int -> ScTypes.Result.t option)

type 'a t = mapper -> range

type 'a obs = mapper -> content

let cell t mapper = begin
  begin match mapper (Cell.to_pair t) with
  | None -> raise Errors.TypeError
  | Some (ScTypes.Result.Ok r) -> Single r
  | Some (ScTypes.Result.Error x) -> raise x
  end
end

let range fst snd mapper = begin
  let (x1, y1) = Cell.to_pair fst
  and (x2, y2) = Cell.to_pair 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
        begin match mapper (x, y) with
        | None -> elms := Empty::!elms
        | Some (ScTypes.Result.Error x) -> raise x
        | Some (ScTypes.Result.Ok r) -> elms := (V r)::!elms
        end
      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
        begin match mapper (x, y) with
        | None -> elmy := Empty::!elmy
        | Some (ScTypes.Result.Error x) -> raise x
        | Some (ScTypes.Result.Ok r) -> elmy := (V r)::!elmy
        end
      done;
      elmx := !elmy::!elmx
    done;
    Array2 (!elmx)
  )
end

module TypeContent = struct

  type 'a t = 'a ScTypes.DataFormat.t * 'a

  type value  = Value: ('a ScTypes.DataFormat.t * 'a) -> value [@@unboxed]

  type 'a obs = value

  let str s = (ScTypes.DataFormat.String, s)

  let bool b = (ScTypes.DataFormat.Bool, b)

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

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

  let observe (f, t) = Value (f, t)

end

module M = ScTypes.Type.Eval(TypeContent)

(** Add one element in a typed list.

    The function will raise Error.TypeError if the elements does not match
    with the list type.
*)
let add_elem: type a. a ScTypes.DataFormat.t * a list -> value -> a ScTypes.DataFormat.t * a list =
fun (format, elements) result ->
  begin match result with
  | Empty -> format, (ScTypes.DataFormat.default_value_for format)::elements
  | V r ->
    let TypeContent.Value (format', element) = M.eval r in
    let ScTypes.DataFormat.Eq = ScTypes.DataFormat.compare_format format format' in
    let new_format = if (ScTypes.DataFormat.priority format) > (ScTypes.DataFormat.priority format') then
        format
      else
        format' in
    new_format, element::elements
  end

(** Auxiliary type which does not handle Empty constructor *)
type value' = V' : 'a ScTypes.Type.t -> value'

let option_of_value v = begin match v with
  | Empty -> None
  | V x -> Some (V' x)
end

(** extract the content from a range.

      May raise Errors.TypeError if the range cannot be unified.
  *)
let get_content = begin function
  | Single r ->
    let TypeContent.Value (format, element) = M.eval r in
    Value (format, element)
  | Array1 l ->
    (* Get the first element in the list in order to get the format *)
    let TypeContent.Value (format, _) = begin
      let V' r = Tools.List.find_map option_of_value l in
      M.eval r
    end in
    (* Then build an unified list (if we can) *)
    let format, values =  List.fold_left add_elem (format, []) l in
    List(format, List.rev values)
  | Array2 l ->
    (* Get the first element in the list *)
    let TypeContent.Value (format, _) = begin
      let V' r = Tools.List.find_map2 option_of_value l in
      M.eval r
    end in
    (* Then build an unified list *)
    let format, values =  List.fold_left (fun (format, result) elems ->
        let format, elems = List.fold_left add_elem (format, []) elems in
        (format, List.rev (elems::result))
      )(format, []) l in
    Matrix(format, List.rev values)
  end

(** Collect the data from the references.

If one of the values is an error, the error is thrown as an exception *)
let observe t mapper = get_content (t mapper)