aboutsummaryrefslogtreecommitdiff
path: root/src/odf
diff options
context:
space:
mode:
Diffstat (limited to 'src/odf')
-rwxr-xr-xsrc/odf/odf.ml140
-rwxr-xr-xsrc/odf/odfLoader.ml14
-rwxr-xr-xsrc/odf/odf_ExpressionParser.mly48
3 files changed, 103 insertions, 99 deletions
diff --git a/src/odf/odf.ml b/src/odf/odf.ml
index 048be2e..176e70a 100755
--- a/src/odf/odf.ml
+++ b/src/odf/odf.ml
@@ -5,14 +5,14 @@ let u = UTF8.from_utf8string
type t
-let load_xml input = begin
+let load_xml catalog input = begin
let source = Xmlm.make_input ~enc:(Some `UTF_8) (`Channel input) in
- let sheet = OdfLoader.load source in
+ let sheet = OdfLoader.load catalog source in
sheet
end
-let load file =
+let load catalog file =
let tmp_file = Filename.temp_file "content" ".xml" in
Unix.unlink tmp_file;
@@ -22,14 +22,13 @@ let load file =
let input = open_in_bin tmp_file in
Tools.try_finally
- (fun () -> load_xml input)
+ (fun () -> load_xml catalog input)
(fun () ->
close_in input;
Unix.unlink tmp_file;
Zip.close_in zip
)
-
let write_type ovalue_type cvalue_type attrs output value = begin
let attrs =
(NS.ovalue_type_attr, ovalue_type)::
@@ -50,87 +49,86 @@ let write_bool = write_type "bool" "bool"
let write_error = write_type "string" "error"
let write_date = write_type "date" "date"
-let write_basic: type a. 'b list -> Xmlm.output -> a ScTypes.types -> unit = fun attrs output types -> begin match types with
- | ScTypes.Str s -> write_str attrs output (UTF8.to_utf8string s)
- | ScTypes.Bool b -> write_bool attrs output (string_of_bool b)
- | ScTypes.Num (data_type, d) ->
- begin match ScTypes.get_numeric_type data_type with
- | ScTypes.Number ->
- let f = DataType.Num.to_float d in
- let value = string_of_float f in
- write_num ((NS.value_attr, value)::attrs) output value
- | ScTypes.Date ->
- let value = DataType.Date.to_string d in
- write_date ((NS.date_value_attr, value)::attrs) output value
- end
-end
+module BasicWriter = ScTypes.Type.Eval(struct
+
+ type 'a t = (Xmlm.attribute list -> Xmlm.output -> unit)
+ type 'a obs = 'a t
+
+ let str s attrs output = write_str attrs output (UTF8.to_utf8string s)
+
+ let bool b attrs output = write_bool attrs output (string_of_bool b)
+
+ let num n attrs output =
+ let f = DataType.Num.to_float n in
+ let value = string_of_float f in
+ write_num ((NS.value_attr, value)::attrs) output value
+
+ let date d attrs output =
+ let value = DataType.Date.to_string d in
+ write_date ((NS.date_value_attr, value)::attrs) output value
+
+ let observe value attrs output = value attrs output
+
+end)
+
+let write_basic: type a. 'b list -> Xmlm.output -> a ScTypes.Type.t -> unit = fun attrs output types ->
+ BasicWriter.eval types attrs output
let write_formula output attrs f = begin function
- | ScTypes.Result x -> write_basic attrs output x
- | ScTypes.Error exn -> write_str attrs output "#NAME?"
+ | ScTypes.Result.Ok x -> write_basic attrs output x
+ | ScTypes.Result.Error exn -> write_str attrs output "#NAME?"
end
-let print_ref buffer c =
- UTF8.Buffer.add_string buffer @@ u"[.";
- begin match c with
- | ScTypes.Cell c -> UTF8.Buffer.add_string buffer @@ Cell.to_string c;
- | ScTypes.Range (c1, c2) ->
+(** Print a reference *)
+module Show_ref = struct
+ type 'a t = UTF8.Buffer.buffer -> unit
+
+ type 'a obs = UTF8.Buffer.buffer -> unit
+
+ let cell t buffer =
+ UTF8.Buffer.add_string buffer @@ u"[.";
+ UTF8.Buffer.add_string buffer @@ Cell.to_string t;
+ UTF8.Buffer.add_string buffer @@ u"]"
+
+ let range c1 c2 buffer =
+ UTF8.Buffer.add_string buffer @@ u"[.";
UTF8.Buffer.add_string buffer @@ Cell.to_string c1;
UTF8.Buffer.add_string buffer @@ u":.";
UTF8.Buffer.add_string buffer @@ Cell.to_string c2;
- end;
- UTF8.Buffer.add_string buffer @@ u"]"
-
-let rec print_expr : UTF8.Buffer.buffer -> ScTypes.expression -> unit = fun buffer -> begin function
- | ScTypes.Value (ScTypes.Str s) ->
- UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string s)
- | ScTypes.Value (ScTypes.Bool b) ->
- u(string_of_bool b)
+ UTF8.Buffer.add_string buffer @@ u"]"
+
+ let observe elem buffer = elem buffer
+end
+
+module Show_type = struct
+ type 'a t = UTF8.Buffer.buffer -> unit
+ type 'a obs = UTF8.Buffer.buffer -> unit
+
+ let str s buffer =
+ UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string s)
+
+ let num n buffer =
+ let f = DataType.Num.to_float n in
+ UTF8.Buffer.add_string buffer @@ u(string_of_float f)
+
+ let date n buffer = DataType.Date.to_string n
+ |> u
|> UTF8.Buffer.add_string buffer
- | ScTypes.Value (ScTypes.Num (data_type, d)) ->
- begin match ScTypes.get_numeric_type data_type with
- | ScTypes.Number ->
- let f = DataType.Num.to_float d in
- UTF8.Buffer.add_string buffer @@ u(string_of_float f)
- | ScTypes.Date ->
- DataType.Date.to_string d
- |> u
- |> UTF8.Buffer.add_string buffer
- end
- | ScTypes.Ref r -> print_ref buffer r
- | ScTypes.Expression x ->
- UTF8.Buffer.add_char buffer '(';
- print_expr buffer x;
- UTF8.Buffer.add_char buffer ')';
- | ScTypes.Call (ident, params) ->
- 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
- (UTF8.to_utf8string ident)
- print_expr v2
- | _ ->
- UTF8.Buffer.add_string buffer ident;
- Tools.List.printb ~sep:(u";") print_expr buffer params
- end
- | _ ->
- UTF8.Buffer.add_string buffer ident;
- Tools.List.printb ~sep:(u";") print_expr buffer params
- end
+
+ let bool b buffer =
+ UTF8.Buffer.add_string buffer @@ u(string_of_bool b)
+
+ let observe elem buffer = elem buffer
end
+module ExpressionPrinter = ScTypes.Expr.Eval(Show_expr.Show_Expr(Show_ref)(Show_type))
+
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
- print_expr buffer f;
+ ExpressionPrinter.eval f () buffer;
let formula = UTF8.Buffer.contents buffer
|> UTF8.to_utf8string in
write_formula output [(NS.formula_attr, ("of:=" ^formula))] f value
diff --git a/src/odf/odfLoader.ml b/src/odf/odfLoader.ml
index 9420fdd..93a6c62 100755
--- a/src/odf/odfLoader.ml
+++ b/src/odf/odfLoader.ml
@@ -16,18 +16,18 @@ end
let load_content cache content = begin function
| "float" -> Expression.Basic (
- ScTypes.number (
+ ScTypes.Type.number (
DataType.Num.of_float (float_of_string content)
))
| "date" -> Expression.Basic (
- ScTypes.date (
+ ScTypes.Type.date (
DataType.Num.of_float (float_of_string content)
))
| _ ->
(* If the same text is present many times, use the same string instead of creating a new one *)
memoization cache content (fun content ->
Expression.Basic (
- ScTypes.string (
+ ScTypes.Type.string (
UTF8.from_utf8string content)))
end
@@ -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) (attributes:Xmlm.attribute list) (childs:tree list) = begin
+let build_row (sheet:Sheet.Raw.t ref) (row_num:int ref) catalog (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) (attributes:Xmlm.attribu
List.iter (function
| Cell cell ->
for i = 1 to cell.repetition do
- sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) cell.expression !sheet;
+ sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) cell.expression catalog !sheet;
cell_num := !cell_num + cell.cell_width
done;
| _ -> ()
@@ -106,7 +106,7 @@ end
let data str = Data str
-let load source = begin
+let load catalog source = begin
(* Mutable datas *)
let sheet = ref Sheet.Raw.empty in
@@ -115,7 +115,7 @@ let load source = begin
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))
+ ((NS.table ^ "table-row"), build_row sheet (ref 1) catalog)
] in
let el (((ns, name), attributes):Xmlm.tag) childs = begin
diff --git a/src/odf/odf_ExpressionParser.mly b/src/odf/odf_ExpressionParser.mly
index 54836cd..2acd1b8 100755
--- a/src/odf/odf_ExpressionParser.mly
+++ b/src/odf/odf_ExpressionParser.mly
@@ -6,6 +6,13 @@
let extractColumnNameFromNum (fixed, str) = (fixed, int_of_string str)
+ let build_call ident = function
+ | [] -> Expr.call0 ident
+ | [p1] -> Expr.call1 ident p1
+ | [p1;p2] -> Expr.call2 ident p1 p2
+ | [p1;p2;p3] -> Expr.call3 ident p1 p2 p3
+ | n -> Expr.callN ident n
+
%}
%token <string> REAL
@@ -35,7 +42,7 @@
%left TIMES DIVIDE
%left POW
-%start<ScTypes.expression> value
+%start<ScTypes.Expr.t> value
%%
@@ -43,37 +50,36 @@ value:
| LETTERS COLON EQ expr EOF {$4}
expr:
- | num {Value (number ($1))}
- | MINUS expr {Call (S.sub, [$2])}
- | PLUS expr {Call (S.add, [$2])}
+ | num {Expr.value (Type.number ($1))}
+ | MINUS expr {Expr.call1 S.sub $2}
+ | PLUS expr {Expr.call1 S.add $2}
| L_SQ_BRACKET ref R_SQ_BRACKET {$2}
- | LPAREN expr RPAREN {Expression $2}
- | STR {Value (string (u $1))}
+ | LPAREN expr RPAREN {Expr.expression $2}
+ | STR {Expr.value (Type.string (u $1))}
(* Mathematical operators *)
- | expr MINUS expr {Call (S.sub, [$1; $3])}
- | expr DIVIDE expr {Call (S.div, [$1; $3])}
- | expr TIMES expr {Call (S.mul, [$1; $3])}
- | expr PLUS expr {Call (S.add, [$1; $3])}
- | expr POW expr {Call (S.pow, [$1; $3])}
+ | expr MINUS expr {Expr.call2 S.sub $1 $3}
+ | expr DIVIDE expr {Expr.call2 S.div $1 $3}
+ | expr TIMES expr {Expr.call2 S.mul $1 $3}
+ | expr PLUS expr {Expr.call2 S.add $1 $3}
+ | expr POW expr {Expr.call2 S.pow $1 $3}
(* Comparaison *)
- | expr EQ expr {Call (S.eq, [$1; $3])}
- | expr NEQ expr {Call (S.neq, [$1; $3])}
- | expr LT expr {Call (S.lt, [$1; $3])}
- | expr GT expr {Call (S.gt, [$1; $3])}
- | expr LE expr {Call (S.le, [$1; $3])}
- | expr GE expr {Call (S.ge, [$1; $3])}
-
- | ident LPAREN separated_list(SEMICOLON, expr) RPAREN { Call (u $1, $3) }
+ | expr EQ expr {Expr.call2 S.eq $1 $3}
+ | expr NEQ expr {Expr.call2 S.neq $1 $3}
+ | expr LT expr {Expr.call2 S.lt $1 $3}
+ | expr GT expr {Expr.call2 S.gt $1 $3}
+ | expr LE expr {Expr.call2 S.le $1 $3}
+ | expr GE expr {Expr.call2 S.ge $1 $3}
+ | ident LPAREN separated_list(SEMICOLON, expr) RPAREN { build_call (u $1) $3 }
ref:
- | cell {Ref (Cell $1)}
- | cell COLON cell {Ref (Range ($1, $3))}
+ | cell {Expr.ref (Refs.cell $1)}
+ | cell COLON cell {Expr.ref (Refs.range $1 $3)}
cell:
| DOT fixed(LETTERS) fixed(NUM){Cell.from_string $2 (extractColumnNameFromNum $3)}
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 03:54:02 +0000