aboutsummaryrefslogtreecommitdiff
path: root/src/sheet.ml
blob: cfe299d53a7aa98c95af3132a6ebb31a8620794b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
(*
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 Map = PageMap.SplayMap(struct type t = content let default = empty_cell end)

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

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

  (** Update the value for the given cell.
      Evaluate the new expression and compare it with the previous value.
      @return Some map if the map has been updated
   *)
  let update catalog cell content t = begin
    let new_val = Expression.eval content.expr catalog (fun id -> (Map.find id t).value) in
    match content.value with
    | None ->
      (* If the previous value wasn't defined, update the map *)
      Some (Map.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 (Map.add cell { content with value = Some new_val } t)
      else
        (* If there is no changes, do not update the map *)
        None
  end

  exception Cycle of Cell.Set.t * t

  (** Parse all the successors from an element, apply a function to each of
      them, and return them.

      The function is too long and should be rewriten… *)
  let rec traverse (f:(cell -> content -> t -> t option)) source (init, t) = begin
    try  Cell.Set.fold (successors init f init source) source.sink (init, t)
    with Cycle (succ, t) -> (succ, t)
  end

  and successors init f parents source element (succ, t) = begin

    let content = Map.find element t in

    if Cell.Set.mem element parents then (

      (* if the cell has already been visited, mark it in error, and all the
         descendant *)
      let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in

      if content.value = cycle_error then (
        (* The content has already been updated, do not process it again *)
        (succ, t)
      ) else (
        let t = Map.add element { content with value = cycle_error } t
        and set_error cell content t =
          if content.value = cycle_error then
            None
          else
            Some (Map.add cell { content with value = cycle_error } t) in
        let succ, t = traverse set_error source (init, t) in
        raise (Cycle (succ, t))
      )
    ) else (
      begin match f element content t with
      | None ->
        (* The content does not change, we do not update the successors *)
        (succ, t)
      | Some t' ->
        let parents' = Cell.Set.add element parents
        and succ' = Cell.Set.add element succ in
        if (Cell.Set.is_empty content.sink) then
          (succ', t')
        else
          Cell.Set.fold (successors init f parents' source) content.sink (succ', t')
      end
    )
  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 = Map.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 (
          Map.remove cell t )
        else
          Map.add cell {c with sink = sink'} t
      with Not_found -> t
    end in

    begin try
      let c = Map.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
        Map.remove id t', None
      else (
        let c = { empty_cell with sink = sink' } in
        Map.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 (Cell.Set.singleton 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 Map.find cell t
        with Not_found -> empty_cell in
      let c' = { c with sink = Cell.Set.add id c.sink} in
      Map.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 = Map.add id content t'
    |> Cell.Set.fold add_ref sources
    in

    (** Update the value for each sink already evaluated *)
    traverse (update catalog) content (Cell.Set.singleton 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 -> (Map.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
    let f cell t =
      { cell with
        expr = expr ;
        value = Some (Expression.eval expr catalog (fun id -> (Map.find id t).value))
      } in
    add_element catalog id f t
  end

  let get_sink id t =
    try (Map.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.Map.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.Map.empty;
  history = [];
  yank = [];
  catalog = catalog
}

(** Fold over each defined value *)
let fold f a t = begin
  Raw.Map.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.Map.find id (!t).data in
  cell.expr, cell.value, cell.sink
end