1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
(*
This file is part of licht.
licht is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
licht is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with licht. If not, see <http://www.gnu.org/licenses/>.
*)
(** Contain a valid value from the sheet. This value can be empty if it is not
yet defined *)
type value =
| V : 'a ScTypes.Type.t -> value
| Empty : value
(** This is a snapshot from all the cells in the sheet, the values may be
defined or not, and are not yet unified *)
type range =
| Single : 'a ScTypes.Type.t -> range
| Array1 : value list -> range
| Array2 : value list list -> range
(** Result from the computation, the list is unified and the type is now
identified. The empty elements are defined with a default value. *)
type content =
| Value: 'a ScTypes.DataFormat.t * 'a -> content
| List: 'a ScTypes.DataFormat.t * 'a list -> content
| Matrix: 'a ScTypes.DataFormat.t * 'a list list -> content
(** Type for the mapper function.
This function should be able to read the cell from the spreadsheet from
it coordinates, and return the associated value.
*)
type mapper = (int * int -> ScTypes.Result.t option)
type 'a t = mapper -> range
type 'a obs = mapper -> content
let cell t mapper = begin
begin match mapper (Cell.to_pair t) with
| None -> raise Errors.TypeError
| Some (ScTypes.Result.Ok r) -> Single r
| Some (ScTypes.Result.Error x) -> raise x
end
end
let range fst snd mapper = begin
let (x1, y1) = Cell.to_pair fst
and (x2, y2) = Cell.to_pair snd in
let min_x = min x1 x2
and max_x = max x1 x2
and min_y = min y1 y2
and max_y = max y1 y2 in
if (min_x = max_x) || (min_y = max_y) then (
(* There is only a one dimension array *)
let elms = ref [] in
for x = min_x to max_x do
for y = min_y to max_y do
begin match mapper (x, y) with
| None -> elms := Empty::!elms
| Some (ScTypes.Result.Error x) -> raise x
| Some (ScTypes.Result.Ok r) -> elms := (V r)::!elms
end
done
done;
Array1 (!elms)
) else (
(* This a two-dimension array *)
let elmx = ref [] in
for x = min_x to max_x do
let elmy = ref [] in
for y = min_y to max_y do
begin match mapper (x, y) with
| None -> elmy := Empty::!elmy
| Some (ScTypes.Result.Error x) -> raise x
| Some (ScTypes.Result.Ok r) -> elmy := (V r)::!elmy
end
done;
elmx := !elmy::!elmx
done;
Array2 (!elmx)
)
end
module TypeContent = struct
type 'a t = 'a ScTypes.DataFormat.t * 'a
type value = Value: ('a ScTypes.DataFormat.t * 'a) -> value [@@unboxed]
type 'a obs = value
let str s = (ScTypes.DataFormat.String, s)
let bool b = (ScTypes.DataFormat.Bool, b)
let num n : DataType.Num.t t = (ScTypes.DataFormat.Number, n)
let date d : DataType.Num.t t = (ScTypes.DataFormat.Date, d)
let observe (f, t) = Value (f, t)
end
module M = ScTypes.Type.Eval(TypeContent)
(** 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. a ScTypes.DataFormat.t * a list -> value -> a ScTypes.DataFormat.t * a list =
fun (format, elements) result ->
begin match result with
| Empty -> format, (ScTypes.DataFormat.default_value_for format)::elements
| V r ->
let TypeContent.Value (format', element) = M.eval r in
let ScTypes.DataFormat.Eq = ScTypes.DataFormat.compare_format format format' in
let new_format = if (ScTypes.DataFormat.priority format) > (ScTypes.DataFormat.priority format') then
format
else
format' in
new_format, element::elements
end
(** Auxiliary type which does not handle Empty constructor *)
type value' = V' : 'a ScTypes.Type.t -> value'
let option_of_value v = begin match v with
| Empty -> None
| V x -> Some (V' x)
end
(** extract the content from a range.
May raise Errors.TypeError if the range cannot be unified.
*)
let get_content = begin function
| Single r ->
let TypeContent.Value (format, element) = M.eval r in
Value (format, element)
| Array1 l ->
(* Get the first element in the list in order to get the format *)
let TypeContent.Value (format, _) = begin
let V' r = Tools.List.find_map option_of_value l in
M.eval r
end in
(* Then build an unified list (if we can) *)
let format, values = List.fold_left add_elem (format, []) l in
List(format, List.rev values)
| Array2 l ->
(* Get the first element in the list *)
let TypeContent.Value (format, _) = begin
let V' r = Tools.List.find_map2 option_of_value l in
M.eval 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
Matrix(format, List.rev values)
end
(** Collect the data from the references.
If one of the values is an error, the error is thrown as an exception *)
let observe t mapper = get_content (t mapper)
|
