From ef312564ca84a2b49fc291434d8fb2f8501bb618 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Tue, 15 Nov 2016 13:00:01 +0100
Subject: Initial commit

---
 sheet.ml | 300 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 300 insertions(+)
 create mode 100755 sheet.ml

(limited to 'sheet.ml')

diff --git a/sheet.ml b/sheet.ml
new file mode 100755
index 0000000..773c784
--- /dev/null
+++ b/sheet.ml
@@ -0,0 +1,300 @@
+type cell = int * int
+
+type search = [
+  | `Pattern of ScTypes.result
+  | `Next
+  | `Previous
+]
+
+module Raw = struct
+
+  exception Cycle
+
+  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; (** The content evaluated *)
+    sink    : Cell.Set.t;   (** All the cell which references this one *)
+  }
+
+  and t = content Map.t
+
+  (** An empty cell which does contains nothing *)
+  let empty_cell = {
+    expr = Expression.load @@ UTF8.empty;
+    value = ScTypes.Result ScTypes.Undefined;
+    sink = Cell.Set.empty;
+  }
+
+
+  let create = Map.empty
+
+  let get_value (id: cell) t = begin
+    try (Map.find id t).value
+    with Not_found ->  ScTypes.Result ScTypes.Undefined
+  end
+
+  let get_expr (id: cell) t = begin
+    try (Map.find id t).expr
+    with Not_found -> Expression.load @@ UTF8.empty
+  end
+
+  (** Extract a value from a reference. *)
+  let get_ref (from:cell) (t:t) : ScTypes.refs -> ScTypes.types = begin
+
+    let extract_values = begin function
+      | ScTypes.Result v -> v
+      | ScTypes.Error e -> raise e
+    end in
+
+    begin function
+    | ScTypes.Cell c ->
+      let coord = Cell.to_pair c in
+      if coord = from then raise Cycle; extract_values (get_value coord t)
+    | ScTypes.Range _ as r ->
+        ScTypes.Refs.collect r
+        |> List.map (fun x -> if x = from then raise Cycle; extract_values (get_value x t))
+        |> (fun x -> ScTypes.List x)
+    end
+  end
+
+  (** Update the value for the given cell *)
+  let update cell content t = begin
+    let new_val = Expression.eval content.expr (get_ref cell t) in
+    if not (ScTypes.Result.(=) new_val content.value) then
+      Some (Map.add cell { content with value = new_val } t)
+    else
+      (* If there is no changes, do not update the map *)
+      None
+  end
+
+  (** Parse all the successors from [init] and call [f] for each of them.
+      [f] is called only once for each successor.
+      @return all the successors collected
+   *)
+  let successors (f:(cell -> content -> t -> t option)) (init:content) (state:Cell.Set.t * t) = begin
+    let rec fold cell (succ, t) = begin
+      if (Cell.Set.mem cell succ) then
+        (* The element has already been parsed, do not cycle *)
+        (succ, t)
+      else (
+        (* Map.find cannot raise Not_found here *)
+        let content = Map.find cell t in
+        match f cell content t with
+        | None -> (succ, t)
+        | Some x -> Cell.Set.fold fold content.sink (Cell.Set.add cell succ, x)
+      )
+    end in
+    Cell.Set.fold fold init.sink state
+  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 *)
+        successors 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 *)
+    successors 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 = 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 = Expression.eval expr (get_ref id t)
+      } in
+    add_element id f t
+  end
+
+  exception Found of (int * int)
+
+  let search pattern t = begin
+
+    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
+
+  let fold f a t = begin
+    Map.fold (fun key content a -> f a key (content.expr, content.value)) 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 = [];
+}
-- 
cgit v1.2.3