From bb48738c4111f5f4e2faa40fe67ae1b8b9d7c2eb Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 29 Nov 2017 15:51:39 +0100 Subject: Rework on the Sheet.ml API : removed low level functions, made the sheet mutable --- src/actionParser.mly | 4 +- src/actions.mli | 2 +- src/main.ml | 201 +++++++++++++++++++++++++-------------------------- src/odf/odf.ml | 2 +- src/odf/odfLoader.ml | 10 +-- src/screen.ml | 64 +++++++--------- src/screen.mli | 11 ++- src/selection.ml | 14 ++++ src/selection.mli | 2 + src/sheet.ml | 167 +++++++++++++++++------------------------- src/sheet.mli | 81 +++++---------------- tests/sheet_test.ml | 150 ++++++++++++++++++-------------------- 12 files changed, 310 insertions(+), 398 deletions(-) diff --git a/src/actionParser.mly b/src/actionParser.mly index 6318ca6..296467a 100755 --- a/src/actionParser.mly +++ b/src/actionParser.mly @@ -7,7 +7,6 @@ %token EOF %token LEFT RIGHT UP DOWN %token NPAGE PPAGE HOME END -%token RESIZE %token DELETE %token SEARCH %token E U V Y P @@ -16,6 +15,7 @@ %token BUTTON1_CLICKED %token BUTTON1_RELEASED %token COMMAND +%token RESIZE %start normal %% @@ -27,7 +27,6 @@ normal: | RIGHT { Move (Right 1) } | UP { Move (Up 1) } | DOWN { Move (Down 1) } - | RESIZE { Resize } | DELETE { Delete } | E { Edit } | U { Undo } @@ -43,3 +42,4 @@ normal: | BUTTON1_CLICKED { Button1_clicked $1} | BUTTON1_RELEASED{ Button1_released $1} | COMMAND { Command } + | RESIZE { Resize } diff --git a/src/actions.mli b/src/actions.mli index f955538..9a59aa1 100755 --- a/src/actions.mli +++ b/src/actions.mli @@ -13,7 +13,6 @@ type modes = type actions = | Move of direction -| Resize (* Resize event *) | Escape | Delete | Yank @@ -26,3 +25,4 @@ type actions = | Button1_clicked of (int * int) | Button1_released of (int * int) | Command +| Resize diff --git a/src/main.ml b/src/main.ml index 8e557ce..4e49aa3 100755 --- a/src/main.ml +++ b/src/main.ml @@ -2,17 +2,15 @@ module E:Sym_expr.SYM_EXPR = Evaluate let u = UTF8.from_utf8string -let redraw t screen = - let screen' = - Screen.draw t screen - |> Screen.draw_input t in - t, screen' - -let action f msg (t, screen) = begin - let t', count = f t in - let t', screen' = redraw t' screen in - Screen.status screen' @@ UTF8.from_utf8string (Printf.sprintf msg count); - t', screen' +let redraw t screen selection = + Screen.draw t selection screen; + Screen.draw_input t selection screen + +let action f msg (t, screen, selection) = begin + let count = f t in + redraw t screen selection; + Screen.status screen @@ UTF8.from_utf8string (Printf.sprintf msg count); + t, screen, selection end let catalog = Functions.C.compile @@ Functions.built_in Functions.C.empty @@ -67,187 +65,188 @@ let parser screen = begin menhirParser get_value end -let rec normal_mode (t, screen) = begin +let rec normal_mode (t, screen, selection) = begin match (parser screen) with - | exception x -> normal_mode (t, screen) + | exception x -> normal_mode (t, screen, selection) | Actions.Visual -> Screen.status screen @@ u"-- Selection --"; - selection_mode (t, screen) + selection_mode (t, screen, selection) | Actions.Move direction -> - begin match Sheet.move direction t with - | Some t' -> normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) + begin match Selection.move direction selection with + | Some selection -> + redraw t screen selection; + normal_mode (t, screen, selection) + | None -> normal_mode (t, screen, selection) end - | Actions.Resize -> normal_mode (t, Screen.resize t screen) + | Actions.Resize -> normal_mode (t, Screen.resize t selection screen, selection) | Actions.Delete -> - let yank_before_delete = fun x -> Sheet.delete (fst (Sheet.yank x)) in - normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen) + let yank_before_delete = fun x -> + ignore @@ Sheet.yank selection x; + Sheet.delete selection x in + normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen, selection) | Actions.Yank -> - normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen) + normal_mode @@ action (Sheet.yank selection) "Yanked %d cells" (t, screen, selection) | Actions.Paste -> - normal_mode @@ action Sheet.paste "Pasted %d cells" (t, screen) + let paste = Sheet.paste @@ Selection.extract selection in + normal_mode @@ action paste "Pasted %d cells" (t, screen, selection) | Actions.Undo -> begin match Sheet.undo t with - | Some t' -> normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) + | true -> + redraw t screen selection; + normal_mode (t, screen, selection) + | false -> normal_mode (t, screen, selection) end (* Edit a content *) | Actions.Edit -> - let position = Selection.extract t.Sheet.selected in - let expr = Sheet.Raw.get_expr position t.Sheet.data - |> Expression.show in - begin match Screen.editor ~position ~prefix:(u"-> ") ~init:expr screen with + let position = Selection.extract selection in + let expr, _, _ = Sheet.get_cell position t in + let expr_repr = Expression.show expr in + begin match Screen.editor ~position ~prefix:(u"-> ") ~init:expr_repr screen with | None -> (* Restore the previous value *) - Screen.status screen expr; - normal_mode (t, screen) + Screen.status screen expr_repr; + normal_mode (t, screen, selection) | Some content -> let expr' = Expression.load content in - let _, t' = Sheet.add expr' t in - normal_mode @@ redraw t' screen + ignore @@ Sheet.add ~history:true expr' position t; + redraw t screen selection; + normal_mode (t, screen, selection) end (* Insert a new formula, the actual value will be erased *) | Actions.InsertFormula -> - let position = Selection.extract t.Sheet.selected in + let position = Selection.extract selection in begin match Screen.editor ~position ~init:(u"=") screen with | None -> (* Restore the previous value *) - let expr = Sheet.Raw.get_expr position t.Sheet.data - |> Expression.show in - Screen.status screen expr; - normal_mode (t, screen) + let expr, _, _ = Sheet.get_cell position t in + Screen.status screen (Expression.show expr); + normal_mode (t, screen, selection) | Some content -> let expr = Expression.load content in - let _, t' = Sheet.add expr t in - normal_mode @@ redraw t' screen + ignore @@ Sheet.add ~history:true expr position t; + redraw t screen selection; + normal_mode (t, screen, selection) end -(* - | Actions.Search -> - let expr = Screen.search screen - |> Expression.load in - (*let pattern = Expression.eval expr (fun _ -> ScTypes.Refs.Single None) in*) - let pattern = Expression.eval' expr catalog in - begin match Sheet.search (`Pattern (Some pattern)) t with - | Some t' -> normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) - end -*) - | Actions.Button1_clicked coord -> begin match Screen.get_cell screen coord with - | None -> normal_mode (t, screen) - | Some (x,y) -> begin match Sheet.move (Actions.Absolute (x,y)) t with - | Some t' -> normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) + | None -> normal_mode (t, screen, selection) + | Some (x,y) -> begin match Selection.move (Actions.Absolute (x,y)) selection with + | Some selection' -> + redraw t screen selection'; + normal_mode (t, screen, selection') + | None -> normal_mode (t, screen, selection) end end | Actions.Button1_released coord -> begin match Screen.get_cell screen coord with - | Some (x,y) when (x,y) <> (Selection.extract t.Sheet.selected) -> + | Some (x,y) when (x,y) <> (Selection.extract selection) -> Screen.status screen @@ u"-- Selection -- "; - let t' = { t with - Sheet.selected = Selection.extends (Actions.Absolute (x,y)) t.Sheet.selected - } in - let screen' = Screen.draw t' screen in - selection_mode (t', screen') - | _ -> normal_mode (t, screen) + let selection = Selection.extends (Actions.Absolute (x,y)) selection in + Screen.draw t selection screen; + selection_mode (t, screen, selection) + | _ -> normal_mode (t, screen, selection) end | Actions.Command -> begin match Screen.editor ~prefix:(u":") screen with | None -> - normal_mode (t, screen) + normal_mode (t, screen, selection) | Some content -> let args = try UTF8.to_utf8string content |> Tools.String.split ~by:' ' with Not_found -> (UTF8.to_utf8string content, "") in - command (t, screen) args + command (t, screen, selection) args end - | _ -> normal_mode (t, screen) + | _ -> normal_mode (t, screen, selection) end -and selection_mode (t, screen) = begin +and selection_mode (t, screen, selection) = begin match (parser screen) with - | exception x -> selection_mode (t, screen) + | exception x -> selection_mode (t, screen, selection) - | Actions.Resize -> selection_mode (t, Screen.resize t screen) + | Actions.Resize -> selection_mode (t, Screen.resize t selection screen, selection) | Actions.Delete -> - let yank_before_delete = fun x -> Sheet.delete (fst (Sheet.yank x)) in - normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen) + let yank_before_delete = fun x -> + ignore @@ Sheet.yank selection x; + Sheet.delete selection x in + normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen, selection) | Actions.Yank -> - normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen) + normal_mode @@ action (Sheet.yank selection) "Yanked %d cells" (t, screen, selection) | Actions.Escape -> - let t' = { t with Sheet.selected = Selection.create (Selection.extract t.Sheet.selected) } in - let screen' = Screen.draw t' screen - |> Screen.draw_input t' in - Screen.status screen UTF8.empty; - normal_mode (t', screen') + let selection = Selection.create (Selection.extract selection) in + Screen.draw t selection screen; + Screen.draw_input t selection screen; + Screen.status screen UTF8.empty; + normal_mode (t, screen, selection) | Actions.Move m -> - let t' = { t with Sheet.selected = Selection.extends m t.Sheet.selected } in - let screen' = Screen.draw t' screen in - selection_mode (t', screen') + let selection = Selection.extends m selection in + Screen.draw t selection screen; + selection_mode (t, screen, selection) | Actions.Button1_clicked coord -> begin match Screen.get_cell screen coord with - | None -> normal_mode (t, screen) - | Some (x,y) -> begin match Sheet.move (Actions.Absolute (x,y)) t with - | Some t' -> + | None -> normal_mode (t, screen, selection) + | Some (x,y) -> begin match Selection.move (Actions.Absolute (x,y)) selection with + | Some selection -> Screen.status screen UTF8.empty; - normal_mode @@ redraw t' screen - | None -> normal_mode (t, screen) + redraw t screen selection; + normal_mode (t, screen, selection) + | None -> normal_mode (t, screen, selection) end end - | _ -> selection_mode (t, screen) + | _ -> selection_mode (t, screen, selection) end -and command (t, screen) action = begin +and command (t, screen, selection) action = begin match action with | ("w", file) -> (* Save the file *) - Odf.save t.Sheet.data file; - normal_mode @@ redraw t screen -(* - | ("repr", file) -> (* Save the file *) - let out_gv = open_out_bin file in - let form = Format.formatter_of_out_channel out_gv in - Evaluator.repr form (Evaluator.get_catalog ()); - close_out out_gv; - normal_mode @@ redraw t screen -*) + Odf.save t file; + redraw t screen selection; + normal_mode (t, screen, selection) | ("enew", _) -> (* Start a new spreadsheet *) - normal_mode @@ redraw (Sheet.create catalog Sheet.Raw.empty) screen + let selection = Selection.create (1, 1) + and sheet = Sheet.create catalog in + redraw sheet screen selection; + normal_mode (sheet, screen, selection) | ("q", _) -> (* Quit *) t - | _ -> normal_mode @@ redraw t screen + | _ -> + redraw t screen selection; + normal_mode (t, screen, selection) end let () = begin let sheet = if Array.length Sys.argv = 1 then - Sheet.Raw.empty + Sheet.create catalog else - Odf.load catalog Sys.argv.(1) in + Odf.load catalog Sys.argv.(1) + + and selection = Selection.create (1, 1) in Screen.run (fun window -> - ignore @@ normal_mode @@ redraw (Sheet.create catalog sheet) window) + redraw sheet window selection; + ignore @@ normal_mode (sheet, window, selection) + ) end diff --git a/src/odf/odf.ml b/src/odf/odf.ml index 176e70a..1db9d4b 100755 --- a/src/odf/odf.ml +++ b/src/odf/odf.ml @@ -210,7 +210,7 @@ let save sheet file = begin Xmlm.output output (`El_start (NS.table_node, [])); Xmlm.output output (`El_start (NS.table_row_node, [])); - ignore (Sheet.Raw.fold (f output) (1,1) sheet); + ignore (Sheet.fold (f output) (1,1) sheet); Xmlm.output output `El_end; Xmlm.output output `El_end; diff --git a/src/odf/odfLoader.ml b/src/odf/odfLoader.ml index 93a6c62..280e6bd 100755 --- a/src/odf/odfLoader.ml +++ b/src/odf/odfLoader.ml @@ -83,7 +83,7 @@ let build_p (attributes:Xmlm.attribute list) = begin function end -let build_row (sheet:Sheet.Raw.t ref) (row_num:int ref) catalog (attributes:Xmlm.attribute list) (childs:tree list) = begin +let build_row (sheet:Sheet.t) (row_num:int ref) (attributes:Xmlm.attribute list) (childs:tree list) = begin let repetition = try int_of_string @@ List.assoc (NS.table, "number-rows-repeated") attributes @@ -94,7 +94,7 @@ let build_row (sheet:Sheet.Raw.t ref) (row_num:int ref) catalog (attributes:Xmlm List.iter (function | Cell cell -> for i = 1 to cell.repetition do - sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) cell.expression catalog !sheet; + ignore @@ Sheet.add ~history:false cell.expression (!cell_num, !row_num) sheet; cell_num := !cell_num + cell.cell_width done; | _ -> () @@ -109,13 +109,13 @@ let data str = Data str let load catalog source = begin (* Mutable datas *) - let sheet = ref Sheet.Raw.empty in + let sheet = Sheet.create catalog in let cache = Hashtbl.create 10 in let table = Base.String_dict.of_alist_exn [ ((NS.text ^ "p"), build_p); ((NS.table ^ "table-cell"), build_cell cache); - ((NS.table ^ "table-row"), build_row sheet (ref 1) catalog) + ((NS.table ^ "table-row"), build_row sheet (ref 1)) ] in let el (((ns, name), attributes):Xmlm.tag) childs = begin @@ -125,6 +125,6 @@ let load catalog source = begin end in match Xmlm.input_doc_tree ~el ~data source with - | _, Unit -> !sheet + | _, Unit -> sheet | _ -> raise Not_found end diff --git a/src/screen.ml b/src/screen.ml index c61efea..7888ba5 100755 --- a/src/screen.ml +++ b/src/screen.ml @@ -32,16 +32,14 @@ let get_cell screen (x, y) = begin Some (x', y') end -let center data screen height width = begin +let center data position screen height width = begin let height' = height - 3 and width' = (width - screen.left_margin) / cell_size in let end_x = (fst screen.start) + width' -1 in let end_y = (snd screen.start) + height' -2 in - let selected = Selection.extract data.Sheet.selected in - let center_axis f replace max_limit shift screen = begin - let selected_axis = f selected in + let selected_axis = f position in match (selected_axis >= f screen.start), (selected_axis > max_limit) with | true, false -> screen | _ -> { screen with start = replace (max 1 (selected_axis - shift)) screen.start } @@ -65,23 +63,20 @@ let status screen msg = begin end (** Draw the spreadsheet *) -let draw data screen = begin - - let selected = Selection.extract data.Sheet.selected in +let draw data selected screen = begin - let referenced = - Sheet.Raw.get_expr selected data.Sheet.data - |> Expression.collect_sources + let position = Selection.extract selected in - and sink = Sheet.Raw.get_sink selected data.Sheet.data in + let expr, _, sink = Sheet.get_cell position data in + let referenced = Expression.collect_sources expr in let height, width = screen.size in - let screen = center data screen height width in + let screen = center data position screen height width in for y = 1 to (height-2) do let pos_y = (y + (snd screen.start) - 1) in if (Curses.has_colors ()) then begin - if Selection.is_selected (Selection.Vertical pos_y) data.Sheet.selected then + if Selection.is_selected (Selection.Vertical pos_y) selected then Curses.wattrset screen.sheet (Attrs.color_pair 2 ) else Curses.wattrset screen.sheet (Attrs.color_pair 1 ) @@ -95,7 +90,7 @@ let draw data screen = begin for x = 0 to ((width - cell_size - screen.left_margin) / cell_size) do let pos_x = x + (fst screen.start) in if (Curses.has_colors ()) then begin - if Selection.is_selected (Selection.Horizontal pos_x) data.Sheet.selected then + if Selection.is_selected (Selection.Horizontal pos_x) selected then Curses.wattrset screen.sheet (Attrs.color_pair 2 ) else Curses.wattrset screen.sheet (Attrs.color_pair 1 ) @@ -112,7 +107,7 @@ let draw data screen = begin let pos_y = y + (snd screen.start) - 1 in if (Curses.has_colors ()) then begin - if Selection.is_selected (Selection.Cell (pos_x, pos_y)) data.Sheet.selected then + if Selection.is_selected (Selection.Cell (pos_x, pos_y)) selected then Curses.wattrset screen.sheet (Attrs.color_pair 3 ) else if Cell.Set.mem (pos_x, pos_y) referenced then Curses.wattrset screen.sheet (Attrs.color_pair 4 ) @@ -124,8 +119,9 @@ let draw data screen = begin (* Get the content from the cell *) - let content = Sheet.Raw.get_value (pos_x, pos_y) data.Sheet.data - |> Option.map (fun x -> UTF8.split ~sep:(u"\n") (ScTypes.Result.show x)) + + let _, value, _ = Sheet.get_cell (pos_x, pos_y) data in + let content = Option.map (fun x -> UTF8.split ~sep:(u"\n") (ScTypes.Result.show x)) value |> Option.default UTF8.empty in (* If the content is defined, try to encode it and print it*) @@ -143,8 +139,7 @@ let draw data screen = begin ) done done; - ignore @@ Curses.wrefresh screen.sheet; - screen + ignore @@ Curses.wrefresh screen.sheet end @@ -190,15 +185,13 @@ let close {window} = begin Curses.endwin() end -let draw_input t screen = begin +let draw_input t selected screen = begin let height, width = screen.size in - let expr = Sheet.Raw.get_expr (Selection.extract t.Sheet.selected) t.Sheet.data - |> Expression.show in + let expr, value, _ = Sheet.get_cell (Selection.extract selected) t in - let result = Sheet.Raw.get_value (Selection.extract t.Sheet.selected) t.Sheet.data - |> Option.map ScTypes.Result.show + let result = Option.map ScTypes.Result.show value |> Option.default UTF8.empty in UTF8.encode result |> Option.iter (fun encoded_result -> @@ -214,11 +207,14 @@ let draw_input t screen = begin && Curses.wrefresh screen.input) ); - status screen expr; - screen + status screen (Expression.show expr); + () end -(** Wait for an event and return the key pressed +(** Wait for an event and return the key pressed. + + Non blocking for other running Lwt thread. + If the key code contains more than one char, they are both returned *) let read_key {window} = begin @@ -238,7 +234,7 @@ let read_key {window} = begin Buffer.contents buff end -let resize data t = begin +let resize data selection t = begin let size = Curses.getmaxyx t.window in if (size <> t.size) then ( let height, width = size in @@ -253,7 +249,8 @@ let resize data t = begin && Curses.mvwin t.status (height - 1) 0); Curses.wclear t.status; ignore @@ Curses.wrefresh t.status; - draw data t + draw data selection t; + t ) else t end @@ -441,15 +438,6 @@ let editor ?position ?(prefix=UTF8.empty) ?(init=UTF8.empty) t = begin try _edit (UTF8.rev_explode init) [] @@ read_key t with _ -> None) (fun () -> ignore @@ Curses.curs_set 0) - -end - -let search screen = begin - let result = editor ~prefix:(u"/") screen in - begin match result with - | Some content -> content - | None -> UTF8.empty - end end let run f = diff --git a/src/screen.mli b/src/screen.mli index b5f74b2..0d9dc69 100755 --- a/src/screen.mli +++ b/src/screen.mli @@ -7,11 +7,11 @@ val run: (t -> 'a) -> 'a (** {2 Screen updates} *) -val draw: Sheet.t -> t -> t +val draw: Sheet.t -> Selection.t -> t -> unit -val draw_input: Sheet.t -> t -> t +val draw_input: Sheet.t -> Selection.t -> t -> unit -val resize: Sheet.t -> t -> t +val resize: Sheet.t -> Selection.t -> t -> t (** Display a message in the status bar. *) val status: t -> UTF8.t -> unit @@ -22,8 +22,7 @@ val status: t -> UTF8.t -> unit val read_key : t -> string (** The keycode is always NULL terminated *) -val search: t -> UTF8.t - -val get_cell: t -> int * int -> (int * int) option +(** Get the cell matching the terminal coordinates *) +val get_cell: t -> int * int -> Sheet.cell option val editor: ?position: int * int -> ?prefix:UTF8.t -> ?init:UTF8.t -> t -> UTF8.t option diff --git a/src/selection.ml b/src/selection.ml index 2bf41ce..28e11fa 100755 --- a/src/selection.ml +++ b/src/selection.ml @@ -71,3 +71,17 @@ end let shift = function | Single (start_x, start_y) -> fun (x, y) -> (x - start_x, y - start_y) | Multiple ((start_x, start_y), _) -> fun (x, y) -> (x - start_x, y - start_y) + +let move direction t = + let position = extract t 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 (create position') diff --git a/src/selection.mli b/src/selection.mli index fb207e4..aa14e38 100755 --- a/src/selection.mli +++ b/src/selection.mli @@ -18,3 +18,5 @@ val shift: t -> (int * int) -> (int * int) val fold: ('a -> int * int -> 'a) -> 'a -> t -> 'a val extends: Actions.direction -> t -> t + +val move: Actions.direction -> t -> t option diff --git a/src/sheet.ml b/src/sheet.ml index 6d3c34a..881bf58 100755 --- a/src/sheet.ml +++ b/src/sheet.ml @@ -1,11 +1,5 @@ type cell = int * int -type search = [ - | `Pattern of ScTypes.Result.t option - | `Next - | `Previous -] - module Raw = struct type content = { @@ -25,14 +19,10 @@ module Raw = struct 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) - type t = Map.t - (** 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. *) - let empty = Map.empty - - let get_value id t = (Map.find id t).value + type t = Map.t let get_expr id t = (Map.find id t).expr @@ -41,7 +31,7 @@ module Raw = struct @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 -> get_value id t) in + 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 *) @@ -188,7 +178,7 @@ module Raw = struct let f cell t = begin { cell with expr = expression ; - value = Some (Expression.eval expression catalog (fun id -> get_value id t)) } + value = Some (Expression.eval expression catalog (fun id -> (Map.find id t).value)) } end in add_element catalog id f t end @@ -198,147 +188,120 @@ module Raw = struct let f cell t = { cell with expr = expr ; - value = Some (Expression.eval expr catalog (fun id -> get_value id t)) + value = Some (Expression.eval expr catalog (fun id -> (Map.find id t).value)) } in add_element catalog 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 - (* Iteration*) - Map.fold _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 history = ((cell * Expression.t) list) list - -type t = { - selected: Selection.t; (* The selected cell *) +type sheet = { data: Raw.t; - history: history; (* Unlimited history *) - yank: yank list; + 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 - match t.history with - | [] -> None + 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 t.catalog data + snd @@ Raw.add id expression catalog data else - snd @@ Raw.remove id t.catalog data - ) t.data hd in - Some { t with data = data; history = tl} + snd @@ Raw.remove id catalog data + ) (!t).data hd in + t:= { (!t) with data = data; history = tl}; + true 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 catalog = t.catalog in - let history = Selection.fold (fun acc id -> (id, Raw.get_expr id t.data)::acc) [] t.selected in - let count, data' = Selection.fold (fun (count, c) t -> - (count + 1, snd @@ Raw.remove t catalog c)) (0, t.data) t.selected in - let t' = { t with +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 - } in - t', count + history = history::(!t).history + }; + count end -let yank t = begin +let yank selected t = begin - let shift = Selection.shift t.selected in + 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 + 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 + let count, yanked = Selection.fold _yank (0, []) selected in + t := { !t with yank = List.rev yanked; }; + count end -let paste t = begin - let catalog = t.catalog in +let paste shift t = begin + let catalog = (!t).catalog in (* Origin of first cell *) - let (shift_x, shift_y) as shift = Selection.extract t.selected in + 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 + 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 - let t' = { t with data = data'; history = history'::t.history } in - t', count + 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 expression t = begin - let id = Selection.extract t.selected in - let prev_expression = Raw.get_expr id t.data in - let cells, data' = Raw.add id expression t.catalog t.data in - cells, { t with data = data'; history = [id, prev_expression]::t.history } -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 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 + 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 data = { - data = data; - selected = Selection.create (1, 1); +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 diff --git a/src/sheet.mli b/src/sheet.mli index 14856d4..169932e 100755 --- a/src/sheet.mli +++ b/src/sheet.mli @@ -1,80 +1,37 @@ (** This module represent a sheet *) type cell = int * int - -module Raw: sig - type t - - (** An empty sheet *) - val empty: t - - (** Add a new value in the sheet. The previous value is replaced - @return All the successors to update and the new sheet. - *) - val add: cell -> Expression.t -> Functions.C.t -> t -> Cell.Set.t * t - - val remove: cell -> Functions.C.t -> t -> Cell.Set.t * t +type t - (** Get the value content. - @return None if the cell is not defined - *) - val get_value: cell -> t -> ScTypes.Result.t option - - val get_expr: cell -> t -> Expression.t +(** Crate an empty sheet. *) +val create: Functions.C.t -> t - val get_sink: cell -> t -> Cell.Set.t - - (** Fold over all the defined values *) - val fold: ('a -> cell -> (Expression.t * ScTypes.Result.t ) -> 'a) -> 'a -> t -> 'a - -end - -type yank -type history - -type t = { - selected: Selection.t; (* The selected cell *) - data: Raw.t; - history: history; (* Unlimited history *) - yank: yank list; (* All the selected cells *) - catalog: Functions.C.t -} - -type search = [ - | `Pattern of ScTypes.Result.t option - | `Next - | `Previous -] - -(** Undo the last action and return the previous state, if any *) -val undo: t -> t option +(** Add or update the sheet. + The expression is added at given position. + @return A set containing all updated cells. *) +val add: history:bool -> Expression.t -> cell -> t -> Cell.Set.t -(** Move the cursor in one direction, return the state updated if the move is - allowed *) -val move: Actions.direction -> t -> t option +(** Undo the last action and return true if something has been undone *) +val undo: t -> bool (** Delete the content of selected cells. @return The sheet and the number of cells deleted *) -val delete: t -> t * int +val delete: Selection.t -> t -> int (** Copy the selected cells @return The sheet and the number of cells deleted *) -val yank: t -> t * int - -(** Search for a pattern on the sheet - @return The state updated if the pattern has been found. *) -val search: search -> t -> t option +val yank: Selection.t -> t -> int -val paste: t -> t * int +(** Paste all the selection at the given position. *) +val paste: cell -> t -> int -(** Add or update the sheet. - The expression is added at current selection. - @return A set containing all updated cells, and the tree updated. *) -val add: Expression.t -> t -> Cell.Set.t * t - -(** Create an empty sheet *) -val create: Functions.C.t -> Raw.t -> t +(** Fold over all the defined values *) +val fold: ('a -> cell -> (Expression.t * ScTypes.Result.t) -> 'a) -> 'a -> t -> 'a +(** Get the content from a cell. + Also return all the other cell pointing to it. +*) +val get_cell: cell -> t -> Expression.t * ScTypes.Result.t option * Cell.Set.t diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml index dfa8da4..197cf88 100755 --- a/tests/sheet_test.ml +++ b/tests/sheet_test.ml @@ -23,11 +23,11 @@ let build_num value = ScTypes.Type.number @@ DataType.Num.of_int value (** Test a simple references between two cells *) let test_create_ref_1 ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (3,3) (Expression.load @@ u"=-1") catalog - |> snd |> Sheet.Raw.add (0,0) (Expression.load @@ u"=C3") catalog - |> snd in - let result = (Sheet.Raw.get_value (0, 0) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=-1") (3,3) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=C3") (0,0) s; + + let _, result, _ = Sheet.get_cell (0, 0) s in let expected = Some (ScTypes.Result.Ok (build_num (-1))) in assert_equal @@ -38,14 +38,12 @@ end let test_create_ref_2 ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=C3") catalog - |> snd |> Sheet.Raw.add (3,3) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"123") catalog - |> snd in - + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=C3") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (3,3) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"123") (1,1) s; - let result = (Sheet.Raw.get_value (2, 2) s) in + let _, result, _ = Sheet.get_cell (2, 2) s in let expected = Some (ScTypes.Result.Ok (build_num 123)) in assert_equal @@ -56,10 +54,10 @@ end let test_create_direct_cycle ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=B2 + 1") catalog - |> snd in - let result = (Sheet.Raw.get_value (2, 2) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2 + 1") (2,2) s; + + let _, result, _ = Sheet.get_cell (2, 2) s in let expected = Some (ScTypes.Result.Error Errors.TypeError) in assert_equal @@ -71,11 +69,11 @@ end (** Overide the value after a cycle. *) let test_recover_from_cycle ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=B2 + 1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=6") catalog - |> snd in - let result = (Sheet.Raw.get_value (2, 2) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2 + 1") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=6") (2,2) s; + + let _, result, _ = Sheet.get_cell (2, 2) s in let expected = Some (ScTypes.Result.Ok (build_num (6))) in assert_equal @@ -86,13 +84,13 @@ end let test_create_indirect_cycle ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=B2+1") catalog - |> snd |> Sheet.Raw.add (0,0) (Expression.load @@ u"=A1") catalog - |> snd in - let result = (Sheet.Raw.get_value (0, 0) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2+1") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (0,0) s; + + let _, result, _ = Sheet.get_cell (0, 0) s in let expected = Some (ScTypes.Result.Error Errors.Cycle) in assert_equal @@ -103,18 +101,18 @@ end let test_check_cycle3 ctx = begin - let s = Sheet.Raw.empty - (* First set A1 to 3 *) - |> Sheet.Raw.add (1,1) (Expression.load @@ u"=3") catalog - |> snd |> Sheet.Raw.add (1,2) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.add (5,5) (Expression.load @@ u"=B2") catalog - (* A3 = A1 + A1 = 6 *) - |> snd |> Sheet.Raw.add (1,3) (Expression.load @@ u"=A2 + E5") catalog - (* Then set A1 to 2 *) - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> snd in - let result = (Sheet.Raw.get_value (1, 3) s) in + let s = Sheet.create catalog in + (* First set A1 to 3 *) + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=3") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (1,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2") (5,5) s; + (* A3 = A1 + A1 = 6 *) + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A2 + E5") (1,3) s; + (* Then set A1 to 2 *) + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s; + + let _, result, _ = Sheet.get_cell (1, 3) s in (* A3 = A1 + A1 = 4 *) let expected = Some (ScTypes.Result.Ok (build_num 4)) in @@ -126,13 +124,12 @@ end let test_delete ctx = begin - let s = Sheet.Raw.empty - |> Sheet.Raw.add (2,2) (Expression.load @@ u"=C3") catalog - |> snd |> Sheet.Raw.add (3,3) (Expression.load @@ u"=A1") catalog - |> snd |> Sheet.Raw.remove (2,2) catalog - |> snd |> Sheet.Raw.remove (3,3) catalog - |> snd in - let result = (Sheet.Raw.get_value (3, 3) s) in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=C3") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1") (3,3) s; + ignore @@ Sheet.delete (Selection.create (2,2)) s; + ignore @@ Sheet.delete (Selection.create (3,3)) s; + let _, result, _ = Sheet.get_cell (3, 3) s in let expected = None in assert_equal @@ -143,12 +140,12 @@ end let test_update_succs1 ctx = begin - let result = Sheet.Raw.empty - |> Sheet.Raw.add (1,1) (Expression.load @@ u" =1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A2") catalog - |> snd |> Sheet.Raw.add (1,2) (Expression.load @@ u"=A1/1") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> fst in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u" =1") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A2") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1/1") (1,2) s; + + let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in (* All the cells are updated by the change *) let expected = Cell.Set.of_list [(1,1); (1, 2); (2,2)] in @@ -164,12 +161,13 @@ end let test_update_succs2 ctx = begin - let result = Sheet.Raw.empty - |> Sheet.Raw.add (1,1) (Expression.load @@ u"=1") catalog - |> snd |> Sheet.Raw.add (2,2) (Expression.load @@ u"=A2") catalog - |> snd |> Sheet.Raw.add (1,2) (Expression.load @@ u"=A1/0") catalog - |> snd |> Sheet.Raw.add (1,1) (Expression.load @@ u"=2") catalog - |> fst in + let s = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=1") (1,1) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A2") (2,2) s; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=A1/0") (1,2) s; + + let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in + (* Only (1, 1) is updated ; (2, 2) does not change, neither (2, 2) *) let expected = Cell.Set.of_list [(1,1)] in @@ -180,19 +178,14 @@ end let test_paste_undo ctx = begin - let empty = Sheet.create catalog Sheet.Raw.empty in - (* The expected result for the whole test *) let expected = Some (ScTypes.Result.Ok (ScTypes.Type.number (DataType.Num.of_int 6))) in - let sheet = empty - |> Tools.Option.test @@ Sheet.move (Actions.Absolute (2, 1)) - |> Sheet.add (Expression.load @@ u"=6") - |> snd - |> Tools.Option.test @@ Sheet.move (Actions.Absolute (1, 1)) - |> Sheet.add (Expression.load @@ u"=B1") - |> snd in - let result = Sheet.Raw.get_value (1, 1) sheet.Sheet.data in + let sheet = Sheet.create catalog in + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=6") (2, 1) sheet; + ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B1") (1, 1) sheet; + + let _, result, _ = Sheet.get_cell (1, 1) sheet in (* Ensure the value is correctly evaluated *) assert_equal @@ -200,17 +193,14 @@ let test_paste_undo ctx = begin expected result; - let sheet2 = - (* Copy the cell *) - fst @@ Sheet.yank sheet - |> Tools.Option.test @@ Sheet.move (Actions.Absolute (2, 1)) - (* Paste it on another value *) - |> Sheet.paste - |> fst - (* Undo the paste *) - |> Tools.Option.test @@ Sheet.undo in - - let result = Sheet.Raw.get_value (1, 1) sheet2.Sheet.data in + (* Copy the cell *) + ignore @@ Sheet.yank (Selection.create (1, 1)) sheet; + (* Paste it on another value *) + ignore @@ Sheet.paste (2, 1) sheet; + (* Undo the paste *) + assert_equal true (Sheet.undo sheet); + + let _, result, _ = Sheet.get_cell (1, 1) sheet in (* The value should be the same as the first evaluation *) assert_equal -- cgit v1.2.3