From 824f2987d47e87d58ee2a4a96d7be417aad6aeab Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 31 Jan 2018 13:20:20 +0100 Subject: API refactoring : made the GADT abstract, provide contructor for each case, and deported the expression with evaluation with module functors --- src/odf/odf.ml | 140 +++++++++++++++++++-------------------- src/odf/odfLoader.ml | 14 ++-- src/odf/odf_ExpressionParser.mly | 48 ++++++++------ 3 files changed, 103 insertions(+), 99 deletions(-) (limited to 'src/odf') 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 REAL @@ -35,7 +42,7 @@ %left TIMES DIVIDE %left POW -%start value +%start 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)} -- cgit v1.2.3