biome-multi.el

;;; 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