-
Notifications
You must be signed in to change notification settings - Fork 4
/
biome-multi.el
395 lines (350 loc) · 16.3 KB
/
biome-multi.el
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
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
;;; biome-multi.el --- Do multiple queries to Open Meteo -*- lexical-binding: t -*-
;; Copyright (C) 2024 Korytov Pavel
;; Author: Korytov Pavel <thexcloud@gmail.com>
;; Maintainer: Korytov Pavel <thexcloud@gmail.com>
;; This file is NOT part of GNU Emacs.
;; This program 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.
;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tools for doing multiple queries to Open Meteo.
;;; Code:
(require 'font-lock)
(require 'transient)
(require 'biome-query)
(require 'biome-api-parse)
;; XXX Recursive imports T_T
(declare-function biome-preset "biome")
(defvar biome-multi-query-current nil
"Current query.
This is a list of forms as defined by `biome-query-current'.")
(defvar biome-multi--callback nil
"Call this with the selected query.")
(defclass biome-multi--transient-report (transient-suffix)
((transient :initform t))
"A class to display the current report for `biome-multi'.")
(cl-defmethod transient-init-value ((_ biome-multi--transient-report))
"A dummy method for `biome-multi--transient-report'."
nil)
(cl-defmethod transient-format ((_ biome-multi--transient-report))
"Format the current report for `biome-multi'."
(if (seq-empty-p biome-multi-query-current)
(propertize "Add at least one query" 'face 'error)
(cl-loop for i from 0
for query in biome-multi-query-current
concat (propertize (format "Query #%d: %s\n" i
(alist-get :name query))
'face 'font-lock-keyword-face)
concat (biome-query--format query)
if (not (eq i (1- (length biome-multi-query-current))))
concat "\n")))
(transient-define-infix biome-multi--transient-report-infix ()
:class 'biome-multi--transient-report
:key "~~1")
(defun biome-multi-add-query ()
"Add new query to `biome-multi'."
(interactive)
(funcall-interactively
#'biome-query
(lambda (query)
(if (seq-empty-p biome-multi-query-current)
(setq biome-multi-query-current (list (copy-tree query)))
(nconc biome-multi-query-current (list (copy-tree query))))
(biome-multi-query biome-multi--callback))))
(defun biome-multi-reset ()
"Reset `biome-multi'."
(interactive)
(setq biome-multi-query-current nil))
(defun biome-multi-edit (idx)
"Edit query number IDX in `biome-multi'."
(interactive "nQuery number: ")
(when (or (< idx 0)
(>= idx (length biome-multi-query-current)))
(user-error "Invalid query number"))
(setq biome-query-current (nth idx biome-multi-query-current))
(setq biome-query--callback
(lambda (query)
(setf (nth idx biome-multi-query-current) query)
(biome-multi-query biome-multi--callback)))
(biome-query--section-open (alist-get :name biome-query-current)))
(defun biome-multi-remove (idx)
"Remove query number IDX from `biome-multi'."
(interactive "nQuery number: ")
(when (or (< idx 0)
(>= idx (length biome-multi-query-current)))
(user-error "Invalid query number"))
(setq biome-multi-query-current
(cl-loop for query in biome-multi-query-current
for i from 0
unless (eq i idx)
collect query)))
(defun biome-multi-exec ()
"Process the query made by `biome-multi-query'."
(interactive)
(when (seq-empty-p biome-multi-query-current)
(user-error "No queries to execute"))
(funcall biome-multi--callback biome-multi-query-current))
(defun biome-multi--generate-preset ()
"Generate a preset for the current multi-query."
(interactive)
(let ((buf (generate-new-buffer "*biome-preset*"))
(preset-symbol (gensym "biome-query-preset-")))
(with-current-buffer buf
(emacs-lisp-mode)
(insert ";; Add this to your config\n")
(insert (pp-to-string `(biome-def-multi-preset ,preset-symbol
,biome-multi-query-current)))
(insert ";; invoke with M-x " (symbol-name preset-symbol))
(insert "\n\n;; Or:\n")
(insert (pp-to-string `(add-to-list 'biome-presets-alist
'(,(symbol-name preset-symbol)
:multi
,biome-multi-query-current))))
(insert ";; invoke with M-x biome-preset"))
(switch-to-buffer buf)))
(transient-define-prefix biome-multi-query (callback)
["Open Meteo Multi Query"
(biome-multi--transient-report-infix)]
["Queries"
:class transient-row
("a" "Add query" biome-multi-add-query :transient transient--do-stack)
("e" "Edit query" biome-multi-edit :transient transient--do-stack)
("d" "Delete query" biome-multi-remove :transient t)]
["Actions"
:class transient-row
("RET" "Run" biome-multi-exec)
("p" "Preset" biome-preset :transient transient--do-replace)
("P" "Generate preset definition" biome-multi--generate-preset)
("R" "Reset" biome-multi-reset :transient t)
("q" "Quit" transient-quit-one)]
(interactive (list nil))
(unless callback
(error "Callback is not set. Run M-x `biome-multi' instead"))
(setq biome-multi--callback callback)
(transient-setup 'biome-multi-query))
(defun biome-multi--unique-names-grouped (names-by-group group-names)
"Make names unique in accordance with GROUP-NAMES.
NAMES-BY-GROUP is a list of lists of names. GROUP-NAMES is a list
of group names. The function returns a hash table mapping
original names to unique names."
(let ((name-occurences (make-hash-table :test #'equal))
(names-mapping (make-hash-table :test #'equal)))
(cl-loop for names in names-by-group
do (cl-loop for name in names
do (puthash name
(1+ (gethash name name-occurences 0))
name-occurences)))
(cl-loop for names in names-by-group
for group-name in group-names
do (cl-loop
for name in names
for occurences = (gethash name name-occurences)
do (puthash (format "%s--%s" group-name name)
(if (= occurences 1)
name
(format "%s_%s" name
(replace-regexp-in-string
(rx space) "_" (downcase group-name))))
names-mapping)))
names-mapping))
(defun biome-multi--unique-names (names)
"Make NAMES unique.
NAMES is a list of strings. The return value is a list of
strings as well."
(let ((name-occurences (make-hash-table :test #'equal))
(added-occurences (make-hash-table :test #'equal)))
(cl-loop for name in names
do (puthash name
(1+ (gethash name name-occurences 0))
name-occurences))
(cl-loop for name in names
for occurences = (gethash name name-occurences)
for added = (gethash name added-occurences)
collect (if (= occurences 1)
name
(format "%s_%d" name
(puthash
name
(1+ (or added 0))
added-occurences))))))
(defun biome-multi--join-results (queries query-names vars-mapping results)
"Join RESULTS of QUERIES by time.
Time has be in a string format, comparable by `string-lessp'.
QUERIES is a list of forms as defined by `biome-query-current'.
QUERY-NAMES is a list of query names, made unique. VARS-MAPPING is
the result of `biome-multi--unique-names-grouped' on the list of
variables. RESULTS is a list of responses from Open Meteo.
This function returns the results field mimicking the one returned
by Open Meteo."
(let ((times (make-hash-table :test #'equal))
(var-values-per-time (make-hash-table :test #'equal)))
(cl-loop for result in results
for query in queries
for query-name in query-names
for group-name = (alist-get :group query)
for vars-field = (intern group-name)
for times-vector = (thread-last
result (alist-get vars-field) (alist-get 'time))
do (cl-loop for time across times-vector
do (puthash time t times))
do (cl-loop for (var-name . values) in (seq-filter
(lambda (v) (not (eq 'time (car v))))
(alist-get vars-field result))
for mapped-var-name =
(gethash (format "%s--%s" query-name var-name) vars-mapping)
for var-values = (make-hash-table :test #'equal)
do (cl-loop for time across times-vector
for value across values
do (puthash time value var-values))
do (puthash mapped-var-name var-values var-values-per-time)))
(let ((times-sorted (seq-sort #'string-lessp (hash-table-keys times))))
`((time . ,(vconcat times-sorted))
,@(cl-loop for var-name being the hash-keys of var-values-per-time
using (hash-values var-values)
collect
(cons (intern var-name)
(vconcat
(cl-loop for time in times-sorted
collect (gethash time var-values)))))))))
(defun biome-multi--merge (queries results)
"Merge QUERIES into one query.
QUERIES is a list of forms as defined by `biome-query-current'. RESULTS
is a list of responses from Open Meteo.
The function mimicks the response of Open Meteo, but only insofar
as it is necessary for `biome-grid'."
(let* ((vars-by-group
(cl-loop for query in queries
for group = (alist-get :group query)
collect (alist-get group (alist-get :params query)
nil nil #'string-equal)))
(query-names
(biome-multi--unique-names
(cl-loop for query in queries
collect (alist-get :name query))))
(vars-mapping (biome-multi--unique-names-grouped vars-by-group query-names)))
`(((:name . "Multi Query")
(:group . "multi")
(:params . (("multi" .
,(cl-loop for var-name being the hash-values of vars-mapping
collect var-name)))))
((multi_units
. ,(cons
(cons 'time "iso8601")
(cl-loop
for result in results
for query in queries
for query-name in query-names
for group-name = (alist-get :group query)
for units-field = (intern (format "%s_units" group-name))
append (cl-loop
for (var-name . unit) in (alist-get units-field result)
unless (equal var-name 'time)
collect (cons (intern
(gethash (format "%s--%s" query-name var-name)
vars-mapping))
unit)))))
(multi . ,(biome-multi--join-results queries query-names vars-mapping results))))))
(defun biome-multi--history-section ()
"Create a section for `biome-multi-history'.
This is based on the Historical Weather section."
(let* ((history-params
(copy-tree (alist-get "Historical Weather" biome-api-data
nil nil #'equal)))
(time-section (biome-api-parse--postprocess-extract-section
(alist-get :sections history-params)
"coordinates and time"))
(current-year (decoded-time-year (decode-time))))
(push '("day_of_year" . ((:name . "Day of Year")
(:type . date)))
(alist-get :fields time-section))
(push
`("end_year" . ((:name . "End year")
(:type . number)
(:min . 1940)
(:max . ,current-year)))
(alist-get :fields time-section))
(push
`("start_year" . ((:name . "Start year")
(:type . number)
(:min . 1940)
(:max . ,current-year)))
(alist-get :fields time-section))
(setf (alist-get :name history-params)
"Historical Weather (on this day)")
(setf (alist-get :fields time-section)
(seq-filter
(lambda (elem)
(not (member (car elem) '("start_date" "end_date"))))
(alist-get :fields time-section)))
history-params))
(defun biome-multi-history--prepare-queries (query)
"Create queries for `biome-multi-history'.
QUERY is a query as defined by `biome-query-current', prepared like
for the normal Historical Weather section but with the following
added fields:
- start_year (number from 1940 to current)
- end_year (number from 1940 to current)
- day_of_year (timestamp)."
(let ((start-year (alist-get "start_year"
(alist-get :params query)
nil nil #'equal))
(end-year (alist-get "end_year"
(alist-get :params query)
nil nil #'equal))
(day-of-year (alist-get "day_of_year"
(alist-get :params query)
nil nil #'equal)))
(unless (and start-year end-year day-of-year)
(user-error "Set Start Year, End Year and Day of Year"))
(cl-loop with current-date = (decode-time (seconds-to-time day-of-year))
for year from start-year to end-year
for date = (copy-tree current-date)
do (setf (decoded-time-year date) year)
for time = (time-convert (encode-time date) 'integer)
for year-query = (copy-tree query)
do (setf (alist-get :params year-query)
(seq-filter (lambda (elem)
(not
(member
(car elem)
'("day_of_year" "end_year" "start_year"))))
(alist-get :params year-query)))
do (push (cons "start_date" (- time (% time (* 60 60 24))))
(alist-get :params year-query))
do (push (cons "end_date" (- time (% time (* 60 60 24))))
(alist-get :params year-query))
collect year-query)))
(defun biome-multi--history-query (callback)
"Get historical weather data on a particular day.
CALLBACK is called with a list of queries, one per day."
(interactive (list nil))
(let ((params (biome-multi--history-section)))
(setq biome-query--callback
(lambda (query)
(let ((queries (biome-multi-history--prepare-queries query)))
(when (y-or-n-p (format "Send %s requests to the API?"
(length queries)))
(funcall callback queries)))))
(biome-query--section-open-params params)))
(defun biome-multi--concat-results (queries results)
"Concat RESULTS from multiple Open Meteo responses.
QUERIES is a list of forms as defined by `biome-query-current'. Each
query is assumed to have the same variables. RESULTS is a list of
responses from Open Meteo."
(let ((group (intern (alist-get :group (car queries)))))
(cl-loop for result in (cdr results)
do (cl-loop
for (var . values) in (alist-get group result)
do (setf (alist-get var (alist-get group (car results)))
(vconcat (alist-get var (alist-get group (car results)))
values))))
(car results)))
(provide 'biome-multi)
;;; biome-multi.el ends here