diff options
-rwxr-xr-x | Makefile | 2 | ||||
-rwxr-xr-x | UTF8.ml | 6 | ||||
-rwxr-xr-x | UTF8.mli | 7 | ||||
-rwxr-xr-x | dataType.ml | 4 | ||||
-rwxr-xr-x | dataType.mli | 2 | ||||
-rwxr-xr-x | evaluator.ml | 74 | ||||
-rwxr-xr-x | evaluator.mli | 2 | ||||
-rwxr-xr-x | expression.ml | 7 | ||||
-rwxr-xr-x | expression.mli | 3 | ||||
-rwxr-xr-x | expressionParser.mly | 4 | ||||
-rwxr-xr-x | main.ml | 11 | ||||
-rwxr-xr-x | odf/odf.ml | 113 | ||||
-rwxr-xr-x | odf/odf_ExpressionLexer.mll | 11 | ||||
-rwxr-xr-x | odf/odf_ExpressionParser.mly | 5 | ||||
-rwxr-xr-x | odf/odf_ns.ml | 3 | ||||
-rwxr-xr-x | scTypes.ml | 7 | ||||
-rwxr-xr-x | scTypes.mli | 2 | ||||
-rwxr-xr-x | screen.ml | 112 | ||||
-rwxr-xr-x | screen.mli | 24 | ||||
-rwxr-xr-x | sheet.ml | 44 | ||||
-rwxr-xr-x | sheet.mli | 10 | ||||
-rwxr-xr-x | tests/expressionParser_test.ml | 4 | ||||
-rwxr-xr-x | tests/expression_test.ml | 9 | ||||
-rwxr-xr-x | tests/odf/odf_ExpressionParser_test.ml | 74 | ||||
-rwxr-xr-x | tests/sheet_test.ml | 29 | ||||
-rwxr-xr-x | tests/test.ml | 1 | ||||
-rwxr-xr-x | tools.ml | 39 |
27 files changed, 398 insertions, 211 deletions
@@ -31,7 +31,7 @@ doc: $(OCAMLBUILD) -pkgs $(PACKAGES) -menhir -Is $(PATHS) licht.docdir/index.html
test: stub
- $(OCAMLBUILD) -pkgs $(PACKAGES),oUnit -cflag -g -lflag -g $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS),tests test.byte --
+ $(OCAMLBUILD) -pkgs $(PACKAGES),oUnit -cflag -g -lflag -g $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS),tests,tests/odf test.byte --
relink: stub
rm -f _build/main.native
@@ -4,7 +4,11 @@ let empty = "" let decode x = Text.decode x
-let encode x = Text.encode x
+let encode x =
+ try Some (Text.encode x)
+ with Text.Invalid (_, _) -> None
+
+let raw_encode x = Text.encode x
let from_utf8string x = x
@@ -16,7 +16,12 @@ val decode: string -> t val from_utf8string: string -> t
(** Encode to the string to the user locale *)
-val encode: t -> string
+val encode: t -> string option
+
+(** Encode the string.
+ This function may raise Text.Invalid if the string cannot be encoded in current locale
+*)
+val raw_encode: t -> string
val to_utf8string: t -> string
diff --git a/dataType.ml b/dataType.ml index 3937465..2fcbd0d 100755 --- a/dataType.ml +++ b/dataType.ml @@ -109,6 +109,10 @@ module Num = struct | NAN -> NAN
| N n1 -> N (Num.abs_num n1)
+ let neg = function
+ | NAN -> NAN
+ | N n1 -> N (Num.minus_num n1)
+
end
module Bool = struct
diff --git a/dataType.mli b/dataType.mli index 09b0082..901346c 100755 --- a/dataType.mli +++ b/dataType.mli @@ -17,6 +17,8 @@ module Num: sig val to_num: t -> Num.num
+ val neg: t -> t
+
val eq: t -> t -> bool
val neq: t -> t -> bool
val lt: t -> t -> bool
diff --git a/evaluator.ml b/evaluator.ml index 3adf7fa..490ab43 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -1,8 +1,6 @@ module D = DataType
module T = Tools
-let u = UTF8.from_utf8string
-
exception RegisteredFunction
(** Data format *)
@@ -392,32 +390,25 @@ let repr mapper value = begin | ScTypes.Bool b -> Result (Bool b)
| ScTypes.Date d -> Result (Num (Date, (D.Num.of_num d)))
| ScTypes.Str s -> Result (String s)
- | ScTypes.Undefined -> raise Errors.TypeError
end in
- (** Extract the value from a raw type.
- If the value is Undefined, provide a default result.
- *)
- let guess_value: type a. a typ -> ScTypes.types -> existencialResult = fun typ value -> begin
- try extract_value value with Errors.TypeError ->
- match typ with
+ let add_elem: type a. a typ -> a list * a dataFormat -> ScTypes.types option -> a list * a dataFormat =
+ begin fun type_of (result, format_of) next ->
+ let Result r = match next with
+ | Some x -> extract_value x
+ | None -> begin match type_of with
| Num -> Result (Num (Number, (D.Num.nan)))
| Bool -> Result (Bool false)
- | String -> Result (String (u""))
+ | String -> Result (String (UTF8.empty))
| List x -> Result (List ((default_format_for_type x), []))
| Unit -> raise Errors.TypeError
- end in
-
-
- let add_elem: type a. a typ -> a list * a dataFormat -> ScTypes.types -> a list * a dataFormat =
- begin fun type_of (result, format_of) next ->
- let Result r = guess_value type_of next in
- begin match compare_typ type_of (type_of_value r) with
- | T.Eq ->
- let l' = (get_value_content r)::result in
- l' , (most_generic_format (format_of_value r) format_of)
- | _ -> raise Errors.TypeError
- end
+ end in
+ begin match compare_typ type_of (type_of_value r) with
+ | T.Eq ->
+ let l' = (get_value_content r)::result in
+ l' , (most_generic_format (format_of_value r) format_of)
+ | _ -> raise Errors.TypeError
+ end
end in
(* Return the result for any expression as an ScTypes.types result *)
@@ -449,11 +440,14 @@ let repr mapper value = begin (* For a reference to an external we first extract the value pointed *)
| ScTypes.Ref r ->
begin match mapper r with
- | ScTypes.Refs.Single v -> extract_value v
+ | ScTypes.Refs.Single v ->
+ begin match v with
+ | None -> raise Errors.TypeError
+ | Some v -> extract_value v
+ end
| ScTypes.Refs.Array1 l ->
-
(* Guess the list type from it's first defined element *)
- let Result r = extract_value (List.find ((!=) ScTypes.Undefined) l) in
+ let Result r = extract_value (Tools.List.find_map (fun x -> x) l) in
let format_of = format_of_value r in
let type_of = type_of_value r in
(* Build the list with all the elements *)
@@ -461,7 +455,8 @@ let repr mapper value = begin Result (List (format, elems))
| ScTypes.Refs.Array2 l ->
(* Guess the list type from it's first defined element *)
- let Result r = extract_value (Tools.List.find2 ((!=) ScTypes.Undefined) l) in
+ let Result r = extract_value (Tools.List.find_map2 (fun x -> x) l) in
+
let format_of = format_of_value r in
let type_of = type_of_value r in
(* Build the list with all the elements *)
@@ -526,14 +521,17 @@ let () = begin let module CompareNum = MAKE(D.Num) in
CompareNum.register t_int;
- register0 "rand" f_number D.Num.rnd;
- register2 "+" (t_int, t_int) f_num D.Num.add;
- register2 "-" (t_int, t_int) f_num D.Num.sub;
- register2 "*" (t_int, t_int) f_number D.Num.mult;
- register2 "/" (t_int, t_int) f_number D.Num.div;
- register2 "^" (t_int, t_int) f_number D.Num.pow;
+ register0 "rand" f_number D.Num.rnd;
- register1 "abs" t_int f_number D.Num.abs;
+ register1 "+" t_int f_num (fun x -> x);
+ register1 "-" t_int f_num D.Num.neg; (* Unary negation *)
+ register2 "+" (t_int, t_int) f_num D.Num.add;
+ register2 "-" (t_int, t_int) f_num D.Num.sub;
+ register2 "*" (t_int, t_int) f_number D.Num.mult;
+ register2 "/" (t_int, t_int) f_number D.Num.div;
+ register2 "^" (t_int, t_int) f_number D.Num.pow;
+
+ register1 "abs" t_int f_number D.Num.abs;
fold "sum" t_int f_number D.Num.add (D.Num.of_num (Num.num_of_int 0));
fold "product" t_int f_number D.Num.mult (D.Num.of_num (Num.num_of_int 1));
@@ -553,4 +551,14 @@ let () = begin let module CompareString = MAKE(D.String) in
CompareString.register t_string;
+ (* Build a date *)
+ register3 "date" (t_int, t_int, t_int) f_date (
+ fun year month day ->
+ Tools.Date.get_julian_day
+ (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num year)
+ (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num month)
+ (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num day)
+ |> D.Num.of_num
+ )
+
end
diff --git a/evaluator.mli b/evaluator.mli index 9fa280b..d69bba6 100755 --- a/evaluator.mli +++ b/evaluator.mli @@ -1,4 +1,4 @@ -val repr: (ScTypes.refs -> ScTypes.types ScTypes.Refs.range) -> ScTypes.expression -> ScTypes.types
+val repr: (ScTypes.refs -> ScTypes.types option ScTypes.Refs.range) -> ScTypes.expression -> ScTypes.types
(** Type definitions *)
diff --git a/expression.ml b/expression.ml index 1feb62e..155e1b9 100755 --- a/expression.ml +++ b/expression.ml @@ -6,6 +6,7 @@ let u = UTF8.from_utf8string type t =
| Basic of ScTypes.types (** A direct type *)
| Formula of formula (** A formula *)
+ | Undefined (** The content is not defined *)
and formula =
| Expression of ScTypes.expression (** A valid expression *)
@@ -13,7 +14,7 @@ and formula = let is_defined = function
- | Basic ScTypes.Undefined -> false
+ | Undefined -> false
| _ -> true
let load content = begin
@@ -41,7 +42,7 @@ let load content = begin )
) else (
(* If the string in empty, build an undefined value *)
- Basic ScTypes.Undefined
+ Undefined
)
end
@@ -60,6 +61,7 @@ let eval expr sources = begin | Basic value -> ScTypes.Result value
| Formula (Expression f) -> ScTypes.Result (eval_exp f)
| Formula (Error (i, s)) -> ScTypes.Error ScTypes.Error
+ | Undefined -> ScTypes.Error Not_found
with ex -> ScTypes.Error ex
end
@@ -91,6 +93,7 @@ let show e = ScTypes.show_expr buffer f
| Basic b -> ScTypes.Type.show buffer b
| Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s
+ | Undefined -> ()
end;
UTF8.Buffer.contents buffer
diff --git a/expression.mli b/expression.mli index f7f0ece..e54d2a0 100755 --- a/expression.mli +++ b/expression.mli @@ -1,6 +1,7 @@ type t =
| Basic of ScTypes.types (** A direct type *)
| Formula of formula (** A formula *)
+ | Undefined (** The content is not defined *)
and formula =
| Expression of ScTypes.expression (** A valid expression *)
@@ -15,7 +16,7 @@ val load_expr: t -> t val is_defined: t -> bool
(** Evaluate the expression *)
-val eval: t -> (ScTypes.refs -> ScTypes.types ScTypes.Refs.range) -> ScTypes.result
+val eval: t -> (ScTypes.refs -> ScTypes.types option ScTypes.Refs.range) -> ScTypes.result
(** Collect all the cell referenced in the expression *)
val collect_sources: t -> Cell.Set.t
diff --git a/expressionParser.mly b/expressionParser.mly index a4d0716..ac3f71d 100755 --- a/expressionParser.mly +++ b/expressionParser.mly @@ -48,6 +48,7 @@ content: basic: | num {Num ((snd $1), Some (u(fst $1)))} | MINUS num {Num (Num.minus_num (snd $2), Some (u("-" ^(fst $2)) ))} + | PLUS num {Num ((snd $2), Some (u(fst $2)))} | NUM DIVIDE NUM DIVIDE NUM { Date (Tools.Date.get_julian_day (Num.int_of_num @@ snd $1) @@ -57,7 +58,8 @@ basic: expr: | num {Value (Num ((snd $1), Some (u(fst $1))))} - | MINUS num {Value (Num (Num.minus_num (snd $2), Some (u("-" ^(fst $2)) )))} + | MINUS expr {Call (F.sub, [$2])} + | PLUS expr {Call (F.add, [$2])} | LETTERS ident LPAREN separated_list(SEMICOLON, expr) RPAREN { Call (u($1 ^ $2), $4) } @@ -127,8 +127,8 @@ let rec normal_mode (t, screen) = begin | Actions.Search -> let expr = Screen.search screen |> Expression.load in - let pattern = Expression.eval expr (fun _ -> ScTypes.Refs.Single ScTypes.Undefined) in - begin match Sheet.search (`Pattern pattern) t with + let pattern = Expression.eval expr (fun _ -> ScTypes.Refs.Single None) in + begin match Sheet.search (`Pattern (Some pattern)) t with | Some t' -> normal_mode @@ redraw t' screen | None -> normal_mode (t, screen) end @@ -231,11 +231,6 @@ let () = begin else Odf.load Sys.argv.(1) in - let window = Screen.init () in - begin Tools.try_finally - (fun () -> + Screen.run (fun window -> ignore @@ normal_mode @@ redraw (Sheet.create sheet) window) - (fun () -> - ignore @@ Screen.close window; ) - end end @@ -6,25 +6,27 @@ let u = UTF8.from_utf8string type t
-let load_attrs attrs =
-
- let _load t = function
- | (("urn:oasis:names:tc:opendocument:xmlns:table:1.0", "formula"), x) ->
- T.Tuple3.replace1 (Some x) t
- | (("urn:oasis:names:tc:opendocument:xmlns:office:1.0", "value"), x) ->
- T.Tuple3.replace2 (Some x) t
- | (("urn:oasis:names:tc:opendocument:xmlns:office:1.0", "date-value"), x) ->
- T.Tuple3.replace2 (Some x) t
- | (("urn:oasis:names:tc:opendocument:xmlns:table:1.0", "number-columns-repeated"), x) ->
- T.Tuple3.replace3 (Some x) t
- | _ -> t
- in List.fold_left _load (None, None, None) attrs
+(** Map for storing all the attributes *)
+module AttributesMap = Map.Make (struct
+ type t = string * string
+ let compare = Pervasives.compare
+end)
+
+let get_attr map key = begin
+ try Some (AttributesMap.find key map) with
+ Not_found -> None
+end
let load_formula formula =
let lineBuffer = Lexing.from_string formula in
- Expression.Formula (
- Expression.Expression (
- Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer))
+ try
+ Expression.Formula (
+ Expression.Expression (
+ Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer))
+ with e ->
+ print_endline formula;
+ raise e
+
let load_content content = begin function
| "float" -> Expression.Basic (
@@ -38,38 +40,52 @@ let load_content content = begin function UTF8.from_utf8string content))
end
+(** Load the content from a cell *)
let load_cell sheet cell_num row_num changed (attrs, cell) = begin
- let attributes = load_attrs attrs in
- let repetition = match T.Tuple3.thd attributes with
+ (* Load all the attributes from the xml element *)
+ let add_attr map (key, value) = AttributesMap.add key value map in
+ let attributes = List.fold_left add_attr AttributesMap.empty attrs in
+
+ (* Check if the content is repeated *)
+ let repetition = match get_attr attributes NS.number_columns_repeat_attr with
+ | None -> 1
+ | Some x -> int_of_string x
+
+ (* cell width *)
+ and cell_width = match get_attr attributes NS.number_columns_spanned_attr with
| None -> 1
| Some x -> int_of_string x in
let vtype =
try List.assoc NS.ovalue_type_attr attrs
with Not_found -> "" in
- let expression, new_change = begin match attributes with
- | Some x, _, _ -> load_formula x, true
- | _, Some x, _ ->
+
+ let formula = get_attr attributes NS.formula_attr
+ and value = get_attr attributes NS.value_attr in
+
+ let expression, update = begin match formula, value with
+ | Some x, _ -> load_formula x, true
+ | _, Some x ->
(load_content x vtype) , true
| _ ->
begin try
Xml.member "p" cell
|> Xml.data_to_string
|> fun x -> (load_content x vtype, true)
- with Xml.Tag_not_found _ -> Expression.Basic ScTypes.Undefined, false
+ with Xml.Tag_not_found _ -> Expression.Undefined, false
end
end in
- if new_change then (
+ if update then (
for i = 1 to repetition do
- incr cell_num;
+ cell_num := !cell_num + cell_width;
sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) (Expression.load_expr expression) !sheet
done
) else (
- cell_num := !cell_num + repetition
+ cell_num := !cell_num + (repetition * cell_width )
);
- changed || new_change
+ changed || update
end
let load_row sheet row_num (attrs, row) = begin
@@ -119,13 +135,13 @@ let load file = Zip.copy_entry_to_file zip content tmp_file;
let input = open_in_bin tmp_file in
- Tools.try_finally (fun () ->
- load_xml input
- )( fun () ->
- close_in input;
- Unix.unlink tmp_file;
- Zip.close_in zip
- )
+ Tools.try_finally
+ (fun () -> load_xml input)
+ (fun () ->
+ close_in input;
+ Unix.unlink tmp_file;
+ Zip.close_in zip
+ )
let write_type ovalue_type cvalue_type attrs output value = begin
@@ -157,7 +173,6 @@ let write_basic attrs output = begin function | ScTypes.Date d ->
let value = Tools.Date.to_string d in
write_date ((NS.date_value_attr, value)::attrs) output value
- | _ -> ()
end
let write_formula output attrs f = begin function
@@ -180,11 +195,13 @@ let rec print_expr buffer = begin function | ScTypes.Value (ScTypes.Num (n, _)) ->
UTF8.Buffer.add_string buffer @@ u(string_of_float @@ Num.float_of_num n)
| ScTypes.Value (ScTypes.Str s) ->
- UTF8.Buffer.add_string buffer @@ u"\"";
- UTF8.Buffer.add_string buffer s;
- UTF8.Buffer.add_string buffer @@ u"\""
- | ScTypes.Value (ScTypes.Bool b) -> UTF8.Buffer.add_string buffer @@ u(string_of_bool b)
- | ScTypes.Value x -> ()
+ UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string s)
+ | ScTypes.Value (ScTypes.Bool b) ->
+ u(string_of_bool b)
+ |> UTF8.Buffer.add_string buffer
+ | ScTypes.Value (ScTypes.Date d) ->
+ u(Tools.Date.to_string d)
+ |> UTF8.Buffer.add_string buffer
| ScTypes.Ref r -> print_ref buffer r
| ScTypes.Expression x ->
UTF8.Buffer.add_char buffer '(';
@@ -194,6 +211,10 @@ let rec print_expr buffer = begin function begin match (UTF8.to_utf8string ident) with
| "+" | "*" | "-" | "/" | "^" | "="
| "<>" | "<=" | ">=" | "<" | ">" -> begin match params with
+ | v1::[] ->
+ UTF8.Printf.bprintf buffer "%s%a"
+ (UTF8.to_utf8string ident)
+ print_expr v1
| v1::v2::[] ->
UTF8.Printf.bprintf buffer "%a%s%a"
print_expr v1
@@ -210,6 +231,7 @@ let rec print_expr buffer = begin function end
let write_cell output value = begin function
+ | Expression.Undefined -> ()
| Expression.Basic b -> write_basic [] output b
| Expression.Formula (Expression.Expression f) ->
let buffer = UTF8.Buffer.create 10 in
@@ -222,8 +244,9 @@ let write_cell output value = begin function end
(** Jump to the wanted position *)
-let goto output (from_x, from_y) (to_x, to_y) = begin
+let goto output (from_x, from_y) (to_x, to_y) :unit = begin
+ (** Insert as many rows than required *)
let insert_rows count = begin
(* Close the previous openend rows *)
Xmlm.output output `El_end;
@@ -240,6 +263,7 @@ let goto output (from_x, from_y) (to_x, to_y) = begin 1
end
+ (** Insert as many cells as required *)
and insert_cells count = begin
Xmlm.output output (
`El_start (
@@ -255,11 +279,11 @@ let goto output (from_x, from_y) (to_x, to_y) = begin else
from_x in
let jump_cell = to_x - from_x' in
- if jump_cell > 0 then insert_cells jump_cell;
-
-
+ if jump_cell > 0 then
+ insert_cells jump_cell
end
+(** Write the cell content and return the updated position *)
let f output cursor position (expr, value) = begin
goto output cursor position;
@@ -271,7 +295,7 @@ let f output cursor position (expr, value) = begin Tools.Tuple2.map1 ((+) 1) position
end
-let save sheet file =
+let save sheet file = begin
let tmp_file = Filename.temp_file "content" ".xml" in
Unix.unlink tmp_file;
let out_channel = open_out_bin tmp_file in
@@ -308,3 +332,4 @@ let save sheet file = Zip.close_out zip;
Unix.unlink tmp_file
)
+end
diff --git a/odf/odf_ExpressionLexer.mll b/odf/odf_ExpressionLexer.mll index 28fce22..1db73c3 100755 --- a/odf/odf_ExpressionLexer.mll +++ b/odf/odf_ExpressionLexer.mll @@ -13,9 +13,13 @@ let newline = "\r\n" | '\n' | '\r' let space = ['\t' ' '] | newline let letters = ['A'-'Z' 'a'-'z'] -let identifier = letters (letters | digit | ['-' '_' '.'])* (letters | digit)+ -let text = letters | digit +(* Function identifier. + Valid identifiers are : + ORG.OPENOFFICE.DAYSINMONTH + it cannot end with a digit. + *) +let identifier = letters (letters | digit | ['-' '_' '.'])* letters+ let cell = letters+ digit+ @@ -36,7 +40,7 @@ rule read = parse | '+' { PLUS } | '-' { MINUS } | '/' { DIVIDE } - | '"' { read_string (Buffer.create 17) lexbuf } + | '"' { read_string (Buffer.create 16) lexbuf } | ';' { SEMICOLON } | ':' { COLON } | '[' { L_SQ_BRACKET } @@ -47,6 +51,7 @@ rule read = parse | '.' { DOT } | letters+ as _1 { LETTERS _1} + | identifier as _1 { IDENT _1} | '\000' { EOF } | eof { EOF } diff --git a/odf/odf_ExpressionParser.mly b/odf/odf_ExpressionParser.mly index 6c34c1d..9731699 100755 --- a/odf/odf_ExpressionParser.mly +++ b/odf/odf_ExpressionParser.mly @@ -13,6 +13,7 @@ %token <string> STR %token <string> LETTERS +%token <string> IDENT %token DOLLAR %token DOT @@ -43,7 +44,8 @@ value: expr: | num {Value (Num ((snd $1), Some (u(fst $1))))} - | MINUS num {Value (Num (Num.minus_num (snd $2), Some (u("-" ^(fst $2)) )))} + | MINUS expr {Call (F.sub, [$2])} + | PLUS expr {Call (F.add, [$2])} | L_SQ_BRACKET ref R_SQ_BRACKET {$2} @@ -85,6 +87,7 @@ num: | NUM {$1} ident: + | IDENT { $1 } | text+ { String.concat "" $1 } text: diff --git a/odf/odf_ns.ml b/odf/odf_ns.ml index c22ae7e..5a501da 100755 --- a/odf/odf_ns.ml +++ b/odf/odf_ns.ml @@ -52,7 +52,8 @@ let table_cell_node = (table, "table-cell") let ovalue_type_attr = (office, "value-type")
let value_attr = (office, "value")
let formula_attr = (table, "formula")
- let date_value_attr = (office, "date-value")
+ let date_value_attr = (office, "date-value")
+ let number_columns_spanned_attr = (table, "number-columns-spanned")
let text_node = (text, "p")
@@ -12,8 +12,6 @@ type types = | Num of Num.num * (UTF8.t option) (** A number *) | Str of UTF8.t (** A string *) | Date of Num.num (** A date in julian day *) - - | Undefined (** The content is not defined *) | Bool of bool (** A boolean *) type refs = @@ -55,7 +53,6 @@ module Type = struct end and show buffer = begin function - | Undefined -> () | Num (n,x) -> begin match x with | Some value -> UTF8.Buffer.add_string buffer value @@ -171,6 +168,10 @@ let rec show_expr buffer : expression -> unit = begin function begin match utf8ident with | "+" | "*" | "-" | "/" | "^" | "=" | "<>" | "<=" | ">=" | "<" | ">" -> begin match params with + | v1::[] -> + UTF8.Printf.bprintf buffer "%s%a" + utf8ident + show_expr v1 | v1::v2::[] -> UTF8.Printf.bprintf buffer "%a%s%a" show_expr v1 diff --git a/scTypes.mli b/scTypes.mli index deef1a0..1d8fe54 100755 --- a/scTypes.mli +++ b/scTypes.mli @@ -10,8 +10,6 @@ type types = | Num of Num.num * (UTF8.t option) (** A number *)
| Str of UTF8.t (** A string *)
| Date of Num.num (** A date in julian day *)
-
- | Undefined (** The content is not defined *)
| Bool of bool (** A boolean *)
type refs =
@@ -4,13 +4,13 @@ module Color = Curses.Color module T2 = Tools.Tuple2 +module Option = Tools.Option + let cell_size = 10 let u = UTF8.from_utf8string -type t = Sheet.t - -type screen = { +type t = { window: Curses.window; (* the main window *) sheet: Curses.window; (* the spreadsheet *) input: Curses.window; (* the input window *) @@ -52,15 +52,16 @@ end let status screen msg = begin let height, width = screen.size in - let encoded = UTF8.encode msg in - let status = Bytes.make (width -1) ' ' in - Bytes.blit encoded 0 status 0 (String.length encoded); - Curses.werase screen.status; - if not ( - Curses.mvwaddstr screen.status 0 0 encoded - && Curses.wrefresh screen.status - ) then + UTF8.encode msg |> Option.iter (fun encoded -> + let status = Bytes.make (width -1) ' ' in + Bytes.blit encoded 0 status 0 (String.length encoded); + Curses.werase screen.status; + if not ( + Curses.mvwaddstr screen.status 0 0 encoded + && Curses.wrefresh screen.status + ) then raise (Failure "Status update") + ) end (** Draw the spreadsheet *) @@ -99,10 +100,13 @@ let draw data screen = begin else Curses.wattrset screen.sheet (Attrs.color_pair 1 ) end; + ignore @@ Curses.mvwaddstr screen.sheet 0 (x * cell_size + screen.left_margin) - @@ Printf.sprintf "%-*s" cell_size (UTF8.encode @@ Cell.to_hname pos_x); + @@ Printf.sprintf "%-*s" cell_size (UTF8.raw_encode @@ Cell.to_hname pos_x); + Curses.wattrset screen.sheet Attrs.normal; + for y = 1 to (height-2) do let pos_y = y + (snd screen.start) - 1 in @@ -118,22 +122,25 @@ let draw data screen = begin Curses.wattrset screen.sheet Attrs.normal; end; + + (* Get the content from the cell *) let content = Sheet.Raw.get_value (pos_x, pos_y) data.Sheet.data - |> ScTypes.Result.show - |> UTF8.split ~sep:(u"\n") in - - let value = UTF8.encode content - and length = UTF8.length content in - let strlength = String.length value in - let blank = cell_size - length in - let padding = if blank > 0 - then String.make blank ' ' - else "" in - - ignore - @@ Curses.mvwaddnstr screen.sheet y (x * cell_size + screen.left_margin) - (Printf.sprintf "%s%s" value padding) - 0 (blank + strlength) + |> Option.map (fun x -> UTF8.split ~sep:(u"\n") (ScTypes.Result.show x)) + |> Option.default UTF8.empty in + + (* If the content is defined, try to encode it and print it*) + UTF8.encode content |> Tools.Option.iter (fun value -> + let length = UTF8.length content in + let strlength = String.length value in + let blank = cell_size - length in + let padding = if blank > 0 + then String.make blank ' ' + else "" in + ignore + @@ Curses.mvwaddnstr screen.sheet y (x * cell_size + screen.left_margin) + (Printf.sprintf "%s%s" value padding) + 0 (blank + strlength) + ) done done; ignore @@ Curses.wrefresh screen.sheet; @@ -190,20 +197,23 @@ let draw_input t screen = begin let expr = Sheet.Raw.get_expr (Selection.extract t.Sheet.selected) t.Sheet.data |> Expression.show in - (* Compute the difference between number of bytes in the string, and the - number of character printed : Printf.sprintf format use the bytes number - in the string, while Curses print the characters in the user encoding *) let result = Sheet.Raw.get_value (Selection.extract t.Sheet.selected) t.Sheet.data - |> ScTypes.Result.show in - let encoded_result = UTF8.encode result in - let result_length_delta = (UTF8.length result) - (String.length encoded_result) in + |> Option.map ScTypes.Result.show + |> Option.default UTF8.empty in - ignore ( - encoded_result - |> Printf.sprintf "%-*s" (width - 11 - result_length_delta) - |> Curses.mvwaddstr screen.input 0 10 + UTF8.encode result |> Option.iter (fun encoded_result -> + (* Compute the difference between number of bytes in the string, and the + number of character printed : Printf.sprintf format use the bytes number + in the string, while Curses print the characters in the user encoding *) + let result_length_delta = (UTF8.length result) - (String.length encoded_result) in + + ignore ( + encoded_result + |> Printf.sprintf "%-*s" (width - 11 - result_length_delta) + |> Curses.mvwaddstr screen.input 0 10 - && Curses.wrefresh screen.input); + && Curses.wrefresh screen.input) + ); status screen expr; screen end @@ -248,8 +258,8 @@ let resize data t = begin end let editor ?position ?(prefix=UTF8.empty) ?(init=UTF8.empty) t = begin - let encodedPrefix = UTF8.encode prefix - and encodedInit = UTF8.encode init in + let encodedPrefix = UTF8.raw_encode prefix + and encodedInit = UTF8.raw_encode init in let with_refs, position = match position with | None -> false, (1, 1) | Some x -> true, x in @@ -262,7 +272,7 @@ let editor ?position ?(prefix=UTF8.empty) ?(init=UTF8.empty) t = begin | [] -> () | elems -> ( (* Rewrite each char after the cursor *) let y, x = Curses.getyx t.status in - List.iter (fun x -> ignore @@ Curses.waddstr t.status (UTF8.encode x)) elems; + List.iter (fun x -> ignore @@ Curses.waddstr t.status (UTF8.raw_encode x)) elems; ignore @@ Curses.wmove t.status y x ) end @@ -285,6 +295,10 @@ let editor ?position ?(prefix=UTF8.empty) ?(init=UTF8.empty) t = begin | "\027" -> (* Escape, cancel the modifications *) None | "\010" -> (* Enter, validate the input *) + + (* We concatenate all the characters. This can create an invalid string in + * the current locale (if there are copy/paste, or other events). + *) Some (UTF8.implode @@ (UTF8.rev_implode before)::after) | "\001\004" -> (* Left *) @@ -414,7 +428,7 @@ let editor ?position ?(prefix=UTF8.empty) ?(init=UTF8.empty) t = begin and insert_cell_name position name before after = begin let cell_name = Cell.to_string @@ (position, (false, false)) in ignore @@ delete_previous name; - ignore @@ Curses.waddstr t.status (UTF8.encode cell_name); + ignore @@ Curses.waddstr t.status (UTF8.raw_encode cell_name); rewrite_after after; ignore @@ Curses.wrefresh t.status; select_content position cell_name before after @@ read_key t @@ -438,12 +452,8 @@ let search screen = begin end end -(* -let read_input position screen = begin - let result = editor ~position ~init:(u"=") screen in - begin match result with - | Some content -> content - | None -> UTF8.empty - end -end -*) +let run f = + let window = init () in + Tools.try_finally + (fun () -> f window) + (fun () -> ignore @@ close window ) @@ -1,31 +1,29 @@ (** Represent the {!module:Sheet} *)
-type screen
+type t
-(** Initialise thee screen *)
-val init: unit -> screen
-
-val close: screen -> unit
+(** Run the screen *)
+val run: (t -> 'a) -> 'a
(** {2 Screen updates} *)
-val draw: Sheet.t -> screen -> screen
+val draw: Sheet.t -> t -> t
-val draw_input: Sheet.t -> screen -> screen
+val draw_input: Sheet.t -> t -> t
-val resize: Sheet.t -> screen -> screen
+val resize: Sheet.t -> t -> t
(** Display a message in the status bar. *)
-val status: screen -> UTF8.t -> unit
+val status: t -> UTF8.t -> unit
(** {2 User inputs} *)
(** Wait for a keycode *)
-val read_key : screen -> string
+val read_key : t -> string
(** The keycode is always NULL terminated *)
-val search: screen -> UTF8.t
+val search: t -> UTF8.t
-val get_cell: screen -> int * int -> (int * int) option
+val get_cell: t -> int * int -> (int * int) option
-val editor: ?position: int * int -> ?prefix:UTF8.t -> ?init:UTF8.t -> screen -> UTF8.t option
+val editor: ?position: int * int -> ?prefix:UTF8.t -> ?init:UTF8.t -> t -> UTF8.t option
@@ -1,7 +1,9 @@ +module Option = Tools.Option
+
type cell = int * int
type search = [
- | `Pattern of ScTypes.result
+ | `Pattern of ScTypes.result option
| `Next
| `Previous
]
@@ -17,7 +19,7 @@ module Raw = struct type content = {
expr : Expression.t; (** The expression *)
- value : ScTypes.result; (** The content evaluated *)
+ value : ScTypes.result option; (** The content evaluated *)
sink : Cell.Set.t; (** All the cell which references this one *)
}
@@ -29,7 +31,7 @@ module Raw = struct (** An empty cell which does contains nothing *)
let empty_cell = {
expr = Expression.load @@ UTF8.empty;
- value = ScTypes.Result ScTypes.Undefined;
+ value = None;
sink = Cell.Set.empty;
}
@@ -37,7 +39,7 @@ module Raw = struct let get_value id t = begin
try (Map.find id t).value
- with Not_found -> ScTypes.Result ScTypes.Undefined
+ with Not_found -> None
end
let get_expr id t = begin
@@ -48,7 +50,7 @@ module Raw = struct (** 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 = begin
+ let get_ref from t ref : ScTypes.types option ScTypes.Refs.range = begin
let extract_values = begin function
| ScTypes.Result v -> v
@@ -56,21 +58,27 @@ module Raw = struct end in
ScTypes.Refs.collect ref
- |> ScTypes.Refs.map (fun coord -> extract_values (get_value coord t))
+ |> ScTypes.Refs.map (fun coord -> Option.map extract_values (get_value coord t))
end
(** Update the value for the given cell.
Evaluate the new expression and compare it with the previous value.
- @return the map updated if the result differ.
+ @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
- 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
+ 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 both 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 [init] and call [f] for each of them.
@@ -176,7 +184,7 @@ module Raw = struct else
let f cell t = { cell with
expr = expression ;
- value = Expression.eval expression (get_ref id t)
+ value = Some (Expression.eval expression (get_ref id t))
} in
add_element id f t
end
@@ -186,7 +194,7 @@ module Raw = struct let f cell t =
{ cell with
expr = expr ;
- value = Expression.eval expr (get_ref id t)
+ value = Some (Expression.eval expr (get_ref id t))
} in
add_element id f t
end
@@ -206,8 +214,14 @@ module Raw = struct 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 -> f a key (content.expr, content.value)) t a
+ Map.fold (fun key content a ->
+ match content.value with
+ | None -> a
+ | Some x ->
+ f a key (content.expr, x)
+ ) t a
end
end
@@ -17,13 +17,17 @@ module Raw: sig val add: cell -> Expression.t -> t -> Cell.Set.t * t val remove: cell -> t -> Cell.Set.t * t - - val get_value: cell -> t -> ScTypes.result + + (** Get the value content. + @return None if the cell is not defined + *) + val get_value: cell -> t -> ScTypes.result option val get_expr: cell -> t -> Expression.t val get_sink: cell -> t -> Cell.Set.t + (** Fold over all the defined values *) val fold: ('a -> cell -> (Expression.t * ScTypes.result ) -> 'a) -> 'a -> t -> 'a end @@ -38,7 +42,7 @@ type t = { } type search = [ - | `Pattern of ScTypes.result + | `Pattern of ScTypes.result option | `Next | `Previous ] diff --git a/tests/expressionParser_test.ml b/tests/expressionParser_test.ml index 7c16233..25d9d00 100755 --- a/tests/expressionParser_test.ml +++ b/tests/expressionParser_test.ml @@ -4,8 +4,8 @@ let u = UTF8.from_utf8string let _msg ~(expected:Expression.t) ~(result:Expression.t) = Printf.sprintf "Expected %s but got %s" - (UTF8.encode @@ Expression.show @@ Expression.load_expr expected) - (UTF8.encode @@ Expression.show @@ Expression.load_expr result) + (UTF8.raw_encode @@ Expression.show @@ Expression.load_expr expected) + (UTF8.raw_encode @@ Expression.show @@ Expression.load_expr result) let load_expr str = Expression.Formula ( diff --git a/tests/expression_test.ml b/tests/expression_test.ml index d1ac2ba..3f00e67 100755 --- a/tests/expression_test.ml +++ b/tests/expression_test.ml @@ -9,14 +9,13 @@ let _msg ~expected ~result = | Expression.Basic ScTypes.Num _ -> "N" | Expression.Basic ScTypes.Str _ -> "S" | Expression.Basic ScTypes.Date _ -> "D" - | Expression.Basic ScTypes.Undefined -> "U" | Expression.Basic ScTypes.Bool _ -> "B" | Expression.Formula _ -> "F" in Printf.sprintf "Expected %s:%s but got %s:%s" - (UTF8.encode @@ Expression.show expected) + (UTF8.raw_encode @@ Expression.show expected) (get_type expected) - (UTF8.encode @@ Expression.show result) + (UTF8.raw_encode @@ Expression.show result) (get_type result) let assert_equal expected result = @@ -86,8 +85,8 @@ let test_sources ctx = begin let expected = Cell.Set.singleton (1, 1) in let msg = Printf.sprintf "Expected %s but got %s" - (UTF8.encode @@ Tools.String.print_buffer Cell.Set.printb expected) - (UTF8.encode @@ Tools.String.print_buffer Cell.Set.printb result) in + (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb expected) + (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb result) in OUnit2.assert_equal ~msg expected result diff --git a/tests/odf/odf_ExpressionParser_test.ml b/tests/odf/odf_ExpressionParser_test.ml new file mode 100755 index 0000000..2cdb3bb --- /dev/null +++ b/tests/odf/odf_ExpressionParser_test.ml @@ -0,0 +1,74 @@ +open OUnit2
+
+let u = UTF8.from_utf8string
+
+let _msg ~(expected:ScTypes.expression) ~(result:ScTypes.expression) =
+ let b1 = UTF8.Buffer.create 16
+ and b2 = UTF8.Buffer.create 16 in
+ ScTypes.show_expr b1 expected;
+ ScTypes.show_expr b2 result;
+
+ Printf.sprintf "Expected \n\t%s but got \n\t%s"
+ (UTF8.raw_encode @@ UTF8.Buffer.contents b1)
+ (UTF8.raw_encode @@ UTF8.Buffer.contents b2)
+
+
+let test_formula ctx = begin
+
+ let test1 = "of:=CONCATENATE(SUM([.F16:.AJ16]);\"/\";8*NETWORKDAYS([.F6]; [.F6]+(ORG.OPENOFFICE.DAYSINMONTH([.F6])-1)))" in
+
+ let line = Lexing.from_string test1 in
+ let result = Odf_ExpressionParser.value Odf_ExpressionLexer.read line in
+
+ let expected = ScTypes.(
+
+ Call(u"CONCATENATE", [
+ Call (u"SUM", [
+ Ref (Range (((6, 16), (false, false)), (((36, 16), (false, false)))))]);
+ Value (Str (u"/"));
+ Call(u"*", [
+ Value (Num ((Num.num_of_int 8, Some (u"8"))));
+ Call(u"NETWORKDAYS", [
+ Ref (Cell ((6, 6), (false, false)));
+ Call(u"+", [
+ Ref (Cell ((6, 6), (false, false)));
+ Expression (
+ Call( u"-", [
+ Call(u"ORG.OPENOFFICE.DAYSINMONTH", [
+ Ref (Cell ((6, 6), (false, false)))]);
+ Value (Num ((Num.num_of_int 1, Some (u"1"))));
+ ]))])])])])) in
+
+ assert_equal
+ ~msg:(_msg ~expected ~result)
+ expected
+ result
+
+end
+
+let test_formula2 ctx = begin
+ let value = "of:=+[.H51]*[.G52]" in
+ let line = Lexing.from_string value in
+ let result = Odf_ExpressionParser.value Odf_ExpressionLexer.read line in
+
+ let expected = ScTypes.(
+
+ Call (u"+", [
+ Call(u"*", [
+ Ref (Cell ((8, 51), (false, false)));
+ Ref (Cell ((7, 52), (false, false)))
+ ])])) in
+
+ assert_equal
+ ~msg:(_msg ~expected ~result)
+ expected
+ result
+
+end
+
+let tests = "odf_ExpressionParser_test">::: [
+
+ "test_formula" >:: test_formula;
+ "test_formula2" >:: test_formula2;
+
+ ]
diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml index de42730..1a1bef3 100755 --- a/tests/sheet_test.ml +++ b/tests/sheet_test.ml @@ -1,11 +1,20 @@ open OUnit2 +module Option = Tools.Option + let u = UTF8.from_utf8string -let _msg ~expected ~result = +let _msg ~expected ~result = begin + + let get_string v = match v with + | None -> "Undefined" + | Some x -> UTF8.raw_encode @@ ScTypes.Result.show x + in + Printf.sprintf "Expected %s but got %s" - (UTF8.encode @@ ScTypes.Result.show expected) - (UTF8.encode @@ ScTypes.Result.show result) + (get_string expected) + (get_string result) +end (** Test a simple references between two cells *) let test_create_ref_1 ctx = begin @@ -15,7 +24,7 @@ let test_create_ref_1 ctx = begin |> snd |> Sheet.Raw.add (0,0) @@ Expression.load @@ u"=C3" |> snd in let result = (Sheet.Raw.get_value (0, 0) s) in - let expected = (ScTypes.Result (ScTypes.Num (Num.num_of_int (-1), None))) in + let expected = Some (ScTypes.Result (ScTypes.Num (Num.num_of_int (-1), None))) in assert_equal ~msg:(_msg ~expected ~result) @@ -33,7 +42,7 @@ let test_create_ref_2 ctx = begin let result = (Sheet.Raw.get_value (2, 2) s) in - let expected = ScTypes.Result (ScTypes.Num (Num.num_of_int 123, None)) in + let expected = Some (ScTypes.Result (ScTypes.Num (Num.num_of_int 123, None))) in assert_equal ~msg:(_msg ~expected ~result) @@ -47,7 +56,7 @@ let test_create_direct_cycle ctx = begin |> Sheet.Raw.add (2,2) @@ Expression.load @@ u"=B2" |> snd in let result = (Sheet.Raw.get_value (2, 2) s) in - let expected = ScTypes.Error Errors.TypeError in + let expected = Some (ScTypes.Error Errors.TypeError) in assert_equal ~msg:(_msg ~expected ~result) @@ -63,7 +72,7 @@ let test_create_indirect_cycle ctx = begin |> snd |> Sheet.Raw.add (0,0) @@ Expression.load @@ u"=A1" |> snd in let result = (Sheet.Raw.get_value (0, 0) s) in - let expected = ScTypes.Error Errors.TypeError in + let expected = Some (ScTypes.Error Errors.TypeError) in assert_equal ~msg:(_msg ~expected ~result) @@ -80,7 +89,7 @@ let test_delete ctx = begin |> snd |> Sheet.Raw.remove (3,3) |> snd in let result = (Sheet.Raw.get_value (3, 3) s) in - let expected = ScTypes.Result ScTypes.Undefined in + let expected = None in assert_equal ~msg:(_msg ~expected ~result) @@ -101,8 +110,8 @@ let test_update_succs1 ctx = begin let expected = Cell.Set.of_list [(1,1); (1, 2); (2,2)] in let msg = Printf.sprintf "Expected %s but got %s" - (UTF8.encode @@ Tools.String.print_buffer Cell.Set.printb expected) - (UTF8.encode @@ Tools.String.print_buffer Cell.Set.printb result) in + (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb expected) + (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb result) in assert_equal ~msg expected diff --git a/tests/test.ml b/tests/test.ml index 8a24cd5..b9672ab 100755 --- a/tests/test.ml +++ b/tests/test.ml @@ -5,6 +5,7 @@ let () = ExpressionParser_test.tests; Expression_test.tests; Sheet_test.tests; + Odf_ExpressionParser_test.tests; ] in OUnit2.run_test_tt_main tests @@ -5,6 +5,20 @@ module Option = struct let map f = function | Some x -> Some (f x) | None -> None + + let iter f = function + | Some x -> f x + | None -> () + + let bind f = function + | None -> None + | Some x -> f x + + let default v = function + | None -> v + | Some x -> x + + end module String = struct @@ -125,22 +139,29 @@ module List = struct UTF8.Buffer.add_string buffer last end + let rec find_map f = begin function + | [] -> raise Not_found + | hd::tl -> begin match f hd with + | Some x -> x + | None -> find_map f tl + end + end + let rec findOpt p = begin function | [] -> None | x::l -> - if p x then - Some(x) - else - findOpt p l + if p x then + Some(x) + else + findOpt p l end - and find2 p = begin function + and find_map2 p = begin function | [] -> raise Not_found | x::l -> - begin match findOpt p x with - | None -> find2 p l - | Some x -> x - end + begin try find_map p x with + Not_found -> find_map2 p l + end end (** Convert the list [l] as an array *) |