API refactoring : made the GADT abstract, provide contructor for each case, and deported the

expression with evaluation with module functors

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)}