diff options
Diffstat (limited to 'src/odf/odf.ml')
| -rwxr-xr-x | src/odf/odf.ml | 140 |
1 files changed, 69 insertions, 71 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
|