Source file rendering_config.ml
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
181
182
183
184
185
186
187
188
189
open UtilsLib
type engine = STRINGS | LOGIC | DERIVED_TREES | TREES | DEFAULT
let get_engine s =
match String.lowercase_ascii s with
| "strings" -> STRINGS
| "logic" -> LOGIC
| "unranked trees" -> DERIVED_TREES
| "trees" -> TREES
| _ -> DEFAULT
type config = {
bg : int * int * int;
node : int * int * int;
engines : engine Utils.StringMap.t;
}
let default_map =
List.fold_left
(fun acc (lst, engine) ->
List.fold_left (fun acc n -> Utils.StringMap.add n engine acc) acc lst)
Utils.StringMap.empty
[
([ "Strings"; "strings"; "anglais"; "francais" ], STRINGS);
( [ "labelled_logic"; "logic"; "logique"; "HybridLogic"; "semantics" ],
LOGIC );
([ "Trees"; "Derived_trees"; "trees"; "derived_trees" ], DERIVED_TREES);
( [
"discourse_grammar";
"Derivations";
"derivations";
"Derivation_trees";
"derivation_trees";
"TAG";
"DSTAG";
],
TREES );
]
let default =
{ bg = (255, 255, 255); node = (239, 239, 239); engines = default_map }
let get_color key colors default_col =
match Yojson.Basic.Util.([ colors ] |> filter_member key |> flatten) with
| `Int r :: `Int g :: `Int b :: _ -> (r, g, b)
| _ -> default_col
let get_config filename includes =
try
let fullname = Utils.find_file filename includes Error.dummy_pos in
let json_val =
Yojson.Safe.(to_basic (from_channel ~fname:fullname (open_in fullname)))
in
try
let conf = Yojson.Basic.Util.to_assoc json_val in
let signatures = List.assoc_opt "signatures" conf in
let engines =
match signatures with
| None ->
let () =
Warnings.(
issue_warning
(Config (Missing_key (fullname, [], "signatures"))))
in
let () = Warnings.(issue_warning (Config Default_engines)) in
default_map
| Some signatures ->
List.fold_left
(fun acc json ->
try
let _json_acc = Yojson.Basic.Util.member "name" json in
let _json_acc = Yojson.Basic.Util.member "engine" json in
let sig_name =
try
Yojson.Basic.Util.(to_string_option (member "name" json))
with Yojson.Basic.Util.Type_error (s, j) ->
let () =
Warnings.(
issue_warning
(Config
(Bad_group
( fullname,
[ "signatures"; "name" ],
s,
j,
"A json object string was expected",
"Skipping this signature name" ))))
in
None
in
let sig_engine =
try
Yojson.Basic.Util.(
to_string_option (member "engine" json))
with Yojson.Basic.Util.Type_error (s, j) ->
let () =
Warnings.(
issue_warning
(Config
(Bad_group
( fullname,
[ "signatures"; "engine" ],
s,
j,
"A json object string was expected",
"Skipping this engine" ))))
in
None
in
match (sig_name, sig_engine) with
| Some n, Some e -> Utils.StringMap.add n (get_engine e) acc
| None, Some e ->
let () =
Warnings.(
issue_warning
(Config
(Missing_name
(fullname, [ "signatures" ], "name", e))))
in
acc
| Some n, None ->
let () =
Warnings.(
issue_warning
(Config
(Missing_engine
(fullname, [ "signatures" ], "engine", n))))
in
acc
| _, _ -> acc
with Yojson.Basic.Util.Type_error (s, j) ->
let () =
Warnings.(
issue_warning
(Config
(Bad_group
( fullname,
[ "signatures" ],
s,
j,
"A json object with fields \"name\" and \
\"engine\" was expected",
"Skipping this signature name/engine \
association" ))))
in
acc)
Utils.StringMap.empty
(Yojson.Basic.Util.to_list signatures)
in
let colors = List.assoc_opt "colors" conf in
let bg, node_color =
match colors with
| None ->
let () =
Warnings.(
issue_warning (Config (Missing_key (fullname, [], "colors"))))
in
let () = Warnings.(issue_warning (Config Default_colors)) in
(default.bg, default.node)
| Some colors ->
let bg = get_color "background" colors (255, 255, 255) in
let node = get_color "node-background" colors (239, 239, 239) in
(bg, node)
in
{ bg; node = node_color; engines }
with Yojson.Basic.Util.Type_error (s, j) ->
let () =
Warnings.(
issue_warning
(Config
(Bad_group
( fullname,
[],
s,
j,
"A json object with fields \"signatures\" and \"colors\" \
was expected",
"Using default signature to engine mapping" ))))
in
default
with
| Yojson.Json_error s ->
let () = Warnings.(issue_warning (Config (Json_error s))) in
default
let background_color { bg; _ } = bg
let node_color { node; _ } = node
let engines { engines; _ } = engines