path: root/src/sheet.ml

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

type cell = int * int

module Raw = struct

  type content = {
    expr    : Expression.t; (** The expression *)
    value   : ScTypes.Result.t option; (** The content evaluated *)
    sink    : Cell.Set.t;   (** All the cell which references this one *)
  }

  (** An empty cell which does contains nothing *)
  let empty_cell = {
    expr = Expression.Undefined;
    value = None;
    sink = Cell.Set.empty;
  }

  (** Internaly, we use an array to store the data. Each array as a fixed size
  of 8×8 cells, and each array is stored in a tree. *)
  module PageMap = PageMap.SplayMap(struct type t = content let default = empty_cell end)

  (** The sheet is a PageMap which always contains evaluated values. When a cell is
      updated, all the cell which references this value are also updated.
    *)
  type t = PageMap.t

  let get_expr id t = (PageMap.find id t).expr

  (** Update the value for the given cell.
      Evaluate the new expression and compare it with the previous value.
      @return Some PageMap if the PageMap has been updated
   *)
  let update catalog cell content t = begin
    let new_val = Expression.eval content.expr catalog (fun id -> (PageMap.find id t).value) in
    match content.value with
    | None ->
      (* If the previous value wasn't defined, update the PageMap *)
      Some (PageMap.add cell { content with value = Some new_val } t)
    | Some old_value ->
      (* If the previous value was defined, update only if result differs *)
      if not (ScTypes.Result.(=) new_val old_value) then
        Some (PageMap.add cell { content with value = Some new_val } t)
      else
        (* If there is no changes, do not update the PageMap *)
        None
  end

  let traverse (f:(cell -> content -> t -> t option)) content (id, t) = begin

    let module M = Hashtbl.Make(struct
      type t = cell
      let equal c1 c2 = c1 = c2
      let hash (x, y) = (lnot x) + y
    end) in

    (* Create a table with each cell and it evaluation order.
       Detect cycles and return None if there is any.
    *)
    let rec _order cache level next : cell array option =
      begin match (Cell.Set.is_empty next) with
      | true ->
        (* Nothing more to do, store the values in an array, and return it. *)
        let arr = Array.make (M.length cache) (0, (0, 0)) in
        let i = ref 0 in
        M.iter (fun id (idx, _) ->  Array.set arr (!i) (idx, id); incr i ) cache;
        Array.sort (fun ((v1:int), _) ((v2:int), _) -> compare v1 v2) arr;
        Some (Array.map (fun (_, cell) -> cell) arr)

      | false ->
        let id = Cell.Set.choose next in

        let content = PageMap.find id t in

        let update k = function
        | None -> None
        | Some level ->
          let level' = level + 1 in
          begin match M.find_opt cache k with
          | None -> M.add cache k (level', Cell.Set.singleton id);
            Some level'
          | Some (depth, pred) ->
              if (Cell.Set.mem id pred) then
                (* There is a cycle, break the loop *)
                None
              else
                let pred' = Cell.Set.add id pred in
                M.replace cache k (level', pred');
                Some level'
          end
        in

        (* Update the cache for each sink in the cell *)
        match Cell.Set.fold update content.sink level with
        | None -> None (* There is a cylce, juste stop *)
        | level' ->
          (* Then add all the cell to be next set *)
             Cell.Set.remove id next
          |> Cell.Set.union content.sink
          |> _order cache level'

      end in

    let eval (to_update, t) (id) = begin
      if not (Cell.Set.mem id to_update) then
        (to_update, t)
      else
        let content = PageMap.find id t in
        match f id content t with
        | None -> (to_update, t)
        | Some t' -> (Cell.Set.union content.sink to_update, t')
      end in

    (** Traverse all the cells to mark them with an error *)
    let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in
    let rec set_error t next = begin
      if Cell.Set.is_empty next then
        (* Nothing more to do, just return the sheet updated *)
        t
      else
        let id = Cell.Set.choose next in
        let content = PageMap.find id t in
        let next' = Cell.Set.remove id next in
        if content.value = cycle_error then
          set_error t next'
        else
          let t' = PageMap.add id { content with value = cycle_error } t in
          set_error t' (Cell.Set.union next' content.sink)
    end in

    match _order (M.create 16) (Some 0) (Cell.Set.singleton id) with
    | None -> Cell.Set.empty, (set_error t (Cell.Set.singleton id))
    | Some arr -> Array.fold_left eval ((Cell.Set.add id content.sink), t) arr
  end


  (** Remove the cell from the sheet *)
  let remove_element (id:cell) t : t * content option = begin

    (** Remove the references from each sources.
        If the sources is not referenced anywhere, and is Undefined, remove it
    *)
    let remove_ref cell t = begin
      try let c = PageMap.find cell t in
        (* Remove all the refs which points to the removed cell *)
        let sink' = Cell.Set.filter ((<>) id) c.sink in
        if Cell.Set.is_empty sink' && not (Expression.is_defined c.expr) then (
          PageMap.remove cell t )
        else
          PageMap.add cell {c with sink = sink'} t
      with Not_found -> t
    end in

    begin try
      let c = PageMap.find id t in
      let t' =
        (** Remove the references from each cell pointed by the expression *)
        let sources = Expression.collect_sources c.expr in
        Cell.Set.fold remove_ref sources t in

      (* Removing the references to itself, keep all the other references
         pointing to it (they are not affected) *)
      let sink' = Cell.Set.filter ((<>) id) c.sink in
      (** If there is no more references on the cell, remove it *)
      if Cell.Set.is_empty sink' then
        PageMap.remove id t', None
      else (
        let c = { empty_cell with sink = sink' } in
        PageMap.add id c t', (Some c)
      )
    with Not_found -> t, None
    end
  end

  let remove id catalog t = begin
    match remove_element id t with
    | t, None -> Cell.Set.empty, t
    | t, Some content ->
        (** Update all the successors *)
        traverse (update catalog) content (id, t)
  end

  let add_element catalog id content_builder t = begin

    (** Add the references in each sources.
        If the sources does not exists, create it.
    *)
    let add_ref cell t = begin
      let c =
        try PageMap.find cell t
        with Not_found -> empty_cell in
      let c' = { c with sink = Cell.Set.add id c.sink} in
      PageMap.add cell c' t
    end in

    (* Remove the cell and update all the sink. *)
    let t', cell = remove_element id t in
    let cell' = match cell with
    | None -> empty_cell
    | Some x -> x in

    let content = content_builder cell' t' in

    let sources = Expression.collect_sources content.expr in
    let updated = PageMap.add id content t'
    |> Cell.Set.fold add_ref sources
    in

    (** Update the value for each sink already evaluated *)
    traverse (update catalog) content (id, updated)
  end

  let add id expression catalog t = begin
    if not (Expression.is_defined expression) then
      (Cell.Set.empty, t)
    else
      let f cell t = begin
        { cell with
          expr = expression ;
          value = Some (Expression.eval expression catalog (fun id -> (PageMap.find id t).value)) }
      end in
      add_element catalog id f t
  end

  let paste catalog id shift content t = begin
    let expr = Expression.shift shift content.expr in
    add id expr catalog t
  end

  let get_sink id t =
    try (PageMap.find id t).sink
    with Not_found -> Cell.Set.empty

end

type sheet = {
  data: Raw.t;
  history: ((cell * Expression.t) list) list;    (* Unlimited history *)
  yank: (cell * Raw.content) list;
  catalog: Functions.C.t;
}

type t = sheet ref

let undo t = begin
  let catalog = (!t).catalog in
  match (!t).history with
  | [] -> false
  | hd::tl ->
    let data = List.fold_left (
    fun data (id, expression) ->
      if Expression.is_defined expression then
        snd @@ Raw.add id expression catalog data
      else
        snd @@ Raw.remove id catalog data
    ) (!t).data hd in
    t:= { (!t) with data = data; history = tl};
    true
end

let delete selected t = begin
  let catalog = (!t).catalog in
  let history = Selection.fold (fun acc id -> (id, Raw.get_expr id (!t).data)::acc) [] selected in
  let count, data' = Selection.fold (fun (count, data) c ->
    (count + 1, snd @@ Raw.remove c catalog (!t).data)) (0, (!t).data) selected in
  t := { !t with
    data = data';
    history = history::(!t).history
  };
  count
end

let yank selected t = begin

  let shift = Selection.shift selected in
  let origin = shift (0, 0) in
  let _yank (count, extracted) cell = begin
    let content =
    try let content = (Raw.PageMap.find cell (!t).data) in
    { content with Raw.expr = Expression.shift origin content.Raw.expr }
    with Not_found ->  Raw.empty_cell in

    count + 1, (shift cell,content)::extracted
  end in

  let count, yanked = Selection.fold _yank (0, []) selected in
  t := { !t with yank = List.rev yanked; };
  count
end

let paste shift t = begin
  let catalog = (!t).catalog in
  (* Origin of first cell *)
  let (shift_x, shift_y) as shift = shift in

  let history' = List.map (fun ((x, y), content) ->
    let id = shift_x + x, shift_y + y in
    id, Raw.get_expr id (!t).data) (!t).yank in

  let _paste (count, t) ((x, y), content) = begin
    count + 1, snd @@ Raw.paste catalog (shift_x + x, shift_y + y) shift content t
  end in

  let count, data' = List.fold_left _paste (0, (!t).data) (!t).yank in
  t := { !t with data = data'; history = history'::(!t).history };
  count
end

let add ~history expression id t = begin
  let prev_expression = Raw.get_expr id (!t).data in
  let cells, data' = Raw.add id expression (!t).catalog (!t).data in

  let () = if history then
    t:= { !t with data = data'; history = [id, prev_expression]::(!t).history }
  else
    t:= { !t with data = data' } in

  cells
end

let create catalog = ref {
  data = Raw.PageMap.empty;
  history = [];
  yank = [];
  catalog = catalog
}

(** Fold over each defined value *)
let fold f a t = begin
  Raw.PageMap.fold (fun key content a ->
    match content.Raw.value with
    | None -> a
    | Some x ->
      f a key (content.Raw.expr, x)
  ) (!t).data a
end

let get_cell id t = begin
  let cell = Raw.PageMap.find id (!t).data in
  cell.expr, cell.value, cell.sink
end