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
|
(*
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/>.
*)
type 'a range =
| Single of 'a
| Array1 of 'a list
| Array2 of 'a list list
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 -> ScTypes.Result.t option range
type 'a obs = mapper -> content
let cell t mapper = begin
Single (mapper (Cell.to_pair t))
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
elms := (mapper (x, y))::!elms
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
elmy := (mapper (x, y))::!elmy
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 b. a ScTypes.DataFormat.t * a list -> ScTypes.Result.t option -> a ScTypes.DataFormat.t * a list =
fun (format, elements) result ->
begin match result with
| None -> format, (ScTypes.DataFormat.default_value_for format)::elements
| Some (ScTypes.Result.Error x) -> raise x
| Some (ScTypes.Result.Ok 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
(** extract the content from a range.
May raise Errors.TypeError if the range cannot be unified.
*)
let get_content = begin function
| Single None -> raise Errors.TypeError
| Single (Some (ScTypes.Result.Error x)) -> raise x
| Single (Some (ScTypes.Result.Ok 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 match (Tools.List.find_map (fun x -> x) l) with
| ScTypes.Result.Error x -> raise x
| ScTypes.Result.Ok r -> 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 match (Tools.List.find_map2 (fun x -> x) l) with
| ScTypes.Result.Error x -> raise x
| ScTypes.Result.Ok r -> 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
let observe t mapper = get_content (t mapper)
|
