aboutsummaryrefslogtreecommitdiff
path: root/sheet.ml
blob: 67b1ee1cbc8f2dc4a3ffbe879db8d8a8429441c1 (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
325
326
327
328
329
330
331
332
333
334
module Option = Tools.Option

type cell = int * int

type search = [
  | `Pattern of ScTypes.result option
  | `Next
  | `Previous
]

module Raw = struct

  module Map = Map.Make(struct
    type t = cell
    let compare (x1, y1) (x2, y2) = Pervasives.compare (y1, x1) (y2, x2)
  end)

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

  (** 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.
    *)
  and t = content Map.t

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

  let empty = Map.empty

  let get_value id t = begin
    try (Map.find id t).value
    with Not_found ->  None
  end

  let get_expr id t = begin
    try (Map.find id t).expr
    with Not_found -> empty_cell.expr
  end

  (** Extract a value from a reference.
      This function is given to the evaluator for getting the values from a reference.
   *)
  let get_ref from t ref : ScTypes.result option ScTypes.Refs.range = begin

    ScTypes.Refs.collect ref
      |> ScTypes.Refs.map (fun coord -> get_value coord t)

  end

  (** 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 cell content t = begin
    let new_val = Expression.eval content.expr (get_ref cell t) 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

  (** Parse all the successors from an element, apply a function to each of
      them, and return them *)
  let rec traverse (f:(cell -> content -> t -> t option)) source (init, t) = begin

    let exception Cycle of Cell.Set.t * t in

    let rec successors parents 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.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 parents') content.sink (succ', t')
        end
      )
    end in
    try  Cell.Set.fold (successors init) source.sink (init, t)
    with Cycle (succ, t) -> (succ, t)
  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 sources *)
        let sources = Expression.collect_sources c.expr in
        Cell.Set.fold remove_ref sources t in

      (** If there is no references on the cell, remove it *)
      if Cell.Set.is_empty c.sink then (
        Map.remove id t', None)
      else (
        let c = { empty_cell with sink = c.sink } in
        Map.add id c t', (Some c)
      )
    with Not_found -> t, None
    end
  end

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

  let add_element id f 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

    let t', cell = remove_element id t in
    let cell' = match cell with
    | None -> empty_cell
    | Some x -> x in

    let content = f 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 content (Cell.Set.singleton id, updated)
  end

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

  let paste 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 (get_ref id t))
      } in
    add_element id f t
  end

  let search pattern t = begin
    let exception Found of (int * int) in

    let _search key content = if content.value = pattern then raise (Found key) in
    try
      Map.iter _search t;
      None
    with Found key -> Some key
  end

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

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

end

type yank = cell * Raw.content

type t = {
  selected: Selection.t;    (* The selected cell *)
  data: Raw.t;
  history: t list;          (* Unlimited history *)
  yank: (cell * Raw.content) list
}

let undo t = begin match t.history with
  | [] -> None
  | hd::tl -> Some { hd with selected = t.selected }
end

let move direction t =
  let position = Selection.extract t.selected in
  let position' = begin match direction with
  | Actions.Left quant ->  Tools.Tuple2.replace1 (max 1 ((fst position) - quant)) position
  | Actions.Right quant -> Tools.Tuple2.replace1 ((fst position) + quant) position
  | Actions.Up quant ->    Tools.Tuple2.replace2 (max 1 ((snd position) - quant)) position
  | Actions.Down quant ->  Tools.Tuple2.replace2 ((snd position) + quant) position
  | Actions.Absolute (x, y)-> (x, y)
  end in
  if position = position' then
    None
  else
    Some {t with selected = Selection.create position'}

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

let yank t = begin

  let shift = Selection.shift t.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, []) t.selected in
  let t' = { t with yank = List.rev yanked; } in
  t', count
end

let paste t = begin
  (* Origin of first cell *)
  let (shift_x, shift_y) as shift = Selection.extract t.selected in

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

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

let add expression t = begin
  let id = Selection.extract t.selected in
  let cells, data' = Raw.add id expression t.data in
  cells, { t with data = data'; history = t::t.history}
end

let search action t = begin match action with
  | `Pattern pattern ->
    begin match Raw.search pattern t.data with
    | None -> None
    | Some x -> Some {t with selected = Selection.create x}
    end
  | _ -> None
end

let create data = {
  data = data;
  selected = Selection.create (1, 1);
  history = [];
  yank = [];
}