From 041426ccc1b8c46578de38cd5a816a38158a51db Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 1 Nov 2017 20:06:02 +0100
Subject: Moved range extraction function in ScTypes.ml

---
 scTypes.ml | 111 +++++++++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 97 insertions(+), 14 deletions(-)
 mode change 100644 => 100755 scTypes.ml

(limited to 'scTypes.ml')

diff --git a/scTypes.ml b/scTypes.ml
old mode 100644
new mode 100755
index ff0af83..f79b4ef
--- a/scTypes.ml
+++ b/scTypes.ml
@@ -8,8 +8,6 @@ type cell = Cell.t
 
 type ident = UTF8.t
 
-type 'a number_format = (float -> 'a, Format.formatter, unit) format
-
 type _ dataFormat =
   | Date:   DataType.Num.t dataFormat   (* Date *)
   | Number: DataType.Num.t dataFormat   (* Number *)
@@ -53,18 +51,6 @@ let f_number: DataType.Num.t returnType = Num (Some Number)
 let f_string: DataType.String.t returnType = Str
 let f_bool: DataType.Bool.t returnType = Bool
 
-type typeContainer =
-  | Value: 'a types -> typeContainer
-
-let guess_format_result:
-  type a. a returnType -> typeContainer list -> (a -> a types) =
-  fun return params -> begin match return with
-  | Str -> fun value -> Str value
-  | Bool -> fun value -> Bool value
-  | Num (Some x) -> fun value -> Num (x, value)
-  | Num None -> fun value -> Num (Number, value)
-end
-
 type refs =
   | Cell of cell                                      (** A cell *)
   | Range of cell * cell                              (** An area of cells *)
@@ -118,6 +104,32 @@ module Type = struct
         UTF8.Printf.bprintf buffer "%d/%d/%d" y m d
   end
 
+  type t =
+    | Value: 'a dataFormat * 'a -> t
+
+  let get_content : type a. a types -> t = begin function
+    | Num (format, data) -> Value (format, data)
+    | Str s -> Value (String, s)
+    | Bool b -> Value (Bool, b)
+  end
+
+  (*
+  let guess_format_result:
+    type a. a returnType -> t list -> (a -> a types) =
+    fun return params -> begin match return with
+    | Str -> fun value -> Str value
+    | Bool -> fun value -> Bool value
+    | Num (Some x) -> fun value -> Num (x, value)
+    | Num None -> fun value -> Num (Number, value)
+  end
+  *)
+
+  let default_value_for: type a. a dataFormat -> a = function
+    | Date -> DataType.Num.nan
+    | Number -> DataType.Num.nan
+    | Bool -> false
+    | String -> UTF8.empty
+
 end
 
 module Refs = struct
@@ -178,6 +190,77 @@ module Refs = struct
         Tools.Tuple2.printb ~first:"" ~last:"" ~sep:":" Cell.to_buffer Cell.to_buffer buffer (f,t)
   end
 
+  type 'a content =
+    | Value: 'a dataFormat * 'a -> 'a content
+    | List: 'a dataFormat * 'a list -> 'a list content
+    | Matrix: 'a dataFormat * 'a list list -> 'a list list content
+
+  type refContent =
+    | C: 'a content -> refContent
+
+  type ('a, 'b) equality = Eq : ('a, 'a) equality
+
+  let compare_format: type a b. a dataFormat -> b dataFormat -> (a, b) equality =
+    fun a b -> begin match a, b with
+    | Date, Date -> Eq
+    | String, String -> Eq
+    | Number, Number -> Eq
+    | Date, Number -> Eq
+    | Number, Date -> Eq
+    | Bool, Bool -> Eq
+    | _, _ -> raise Errors.TypeError
+    end
+
+  (** Add one element in a typed list.
+
+      The function will raise Error.TypeError if the elements does not match
+      with the list type.
+  *)
+  let add_elem: type a b. a dataFormat * a list -> result option -> a dataFormat * a list =
+  fun (format, elements) result ->
+    begin match result with
+    | None -> format, (Type.default_value_for format)::elements
+    | Some (Error x) -> raise x
+    | Some (Result r) ->
+      let Type.Value (format', element) = Type.get_content r in
+      let Eq = compare_format format format' in
+      let new_format = if (priority format) < (priority format') then
+          format
+        else
+          format' in
+      new_format, element::elements
+    end
+
+  let get_content = begin function
+  | Single None -> raise Errors.TypeError
+  | Single (Some (Error x)) -> raise x
+  | Single (Some (Result r)) ->
+    let Type.Value (format, c) = Type.get_content r in C (Value (format, c))
+  | Array1 l ->
+    (* Get the first element in the list in order to get the format *)
+    let Type.Value (format, _) =
+      begin match (Tools.List.find_map (fun x -> x) l) with
+      | Error x -> raise x
+      | Result r -> Type.get_content r
+      end in
+    (* Then build an unified list (if we can) *)
+    let format, values =  List.fold_left add_elem (format, []) l in
+    C (List(format, List.rev values))
+  | Array2 l ->
+    (* Get the first element in the list *)
+    let Type.Value (format, _) =
+      begin match (Tools.List.find_map2 (fun x -> x) l) with
+      | Error x -> raise x
+      | Result r -> Type.get_content r
+      end in
+    (* Then build an unified list *)
+    let format, values =  List.fold_left (fun (format, result) elems ->
+        let format, elems = List.fold_left add_elem (format, []) elems in
+        (format, List.rev (elems::result))
+      )(format, []) l in
+    C (Matrix(format, List.rev values))
+  end
+
 end
 
 module Result = struct
-- 
cgit v1.2.3