aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xMakefile2
-rwxr-xr-xUTF8.ml6
-rwxr-xr-xUTF8.mli7
-rwxr-xr-xdataType.ml4
-rwxr-xr-xdataType.mli2
-rwxr-xr-xevaluator.ml74
-rwxr-xr-xevaluator.mli2
-rwxr-xr-xexpression.ml7
-rwxr-xr-xexpression.mli3
-rwxr-xr-xexpressionParser.mly4
-rwxr-xr-xmain.ml11
-rwxr-xr-xodf/odf.ml113
-rwxr-xr-xodf/odf_ExpressionLexer.mll11
-rwxr-xr-xodf/odf_ExpressionParser.mly5
-rwxr-xr-xodf/odf_ns.ml3
-rwxr-xr-xscTypes.ml7
-rwxr-xr-xscTypes.mli2
-rwxr-xr-xscreen.ml112
-rwxr-xr-xscreen.mli24
-rwxr-xr-xsheet.ml44
-rwxr-xr-xsheet.mli10
-rwxr-xr-xtests/expressionParser_test.ml4
-rwxr-xr-xtests/expression_test.ml9
-rwxr-xr-xtests/odf/odf_ExpressionParser_test.ml74
-rwxr-xr-xtests/sheet_test.ml29
-rwxr-xr-xtests/test.ml1
-rwxr-xr-xtools.ml39
27 files changed, 398 insertions, 211 deletions
diff --git a/Makefile b/Makefile
index f90a98c..bf896ac 100755
--- a/Makefile
+++ b/Makefile
@@ -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
diff --git a/UTF8.ml b/UTF8.ml
index 33df5b4..4fa5eca 100755
--- a/UTF8.ml
+++ b/UTF8.ml
@@ -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
diff --git a/UTF8.mli b/UTF8.mli
index c1fa400..9e957ac 100755
--- a/UTF8.mli
+++ b/UTF8.mli
@@ -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) }
diff --git a/main.ml b/main.ml
index 393d4fe..e91a9f5 100755
--- a/main.ml
+++ b/main.ml
@@ -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
diff --git a/odf/odf.ml b/odf/odf.ml
index df98adb..da33ba9 100755
--- a/odf/odf.ml
+++ b/odf/odf.ml
@@ -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")
diff --git a/scTypes.ml b/scTypes.ml
index 6ea9f35..869df8b 100755
--- a/scTypes.ml
+++ b/scTypes.ml
@@ -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 =
diff --git a/screen.ml b/screen.ml
index d48381a..a8e2d0c 100755
--- a/screen.ml
+++ b/screen.ml
@@ -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 )
diff --git a/screen.mli b/screen.mli
index a6a33dc..b5f74b2 100755
--- a/screen.mli
+++ b/screen.mli
@@ -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
diff --git a/sheet.ml b/sheet.ml
index b604c03..38a45d7 100755
--- a/sheet.ml
+++ b/sheet.ml
@@ -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
diff --git a/sheet.mli b/sheet.mli
index 59a1fa7..d3c8151 100755
--- a/sheet.mli
+++ b/sheet.mli
@@ -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
diff --git a/tools.ml b/tools.ml
index f4befa5..33185ec 100755
--- a/tools.ml
+++ b/tools.ml
@@ -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 *)