theurgy/userland/weather.el

;;; weather.el --- Fetch and display the weather from bom.gov.au -*- lexical-binding: t -*-


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

;; Reverse-engineered API docs are available here https://trickypr.github.io/bom-weather-docs/
;; This code depends on request.el

;;; Code:

(defcustom theurgy-geohash
  ""
  "The geohash used for fetching forecast data from BOM. You can manually find this by going to https://api.weather.bom.gov.au/v1/locations?search=<suburb-name>, or you can get a nicer interface for it with \\[theurgy-weather-find-geohash]."
  :type 'string
  :group 'theurgy
  :group 'theurgy-weather)

(defvar bom-api "https://api.weather.bom.gov.au/v1/")

(defun theurgy-weather-find-geohash (search-term)
  "Search for SEARCH-TERM and then return possible geohash candidates."
  (interactive "sSearch term (Suburb or Postcode): ")
  (when (> 4 (length search-term))
    (error "Search term must be greater than 3 characters (don't ask me)"))
  (request (concat bom-api "locations?search=" search-term)
    :parser 'json-read
    :success (cl-function
	      (lambda (&key data &allow-other-keys)
		(let* ((res (cdr (assoc 'data data)))
		       (candidates (mapcar (lambda (alst)
					     (cons (concat
						    (cdr (assoc 'name alst)) ", "
						    (cdr (assoc 'state alst)) ", "
						    (cdr (assoc 'postcode alst)))
						   (cdr (assoc 'geohash alst))))
					   res)))
		  (customize-save-variable 'theurgy-geohash (cdr (assoc (completing-read "Select Location: " candidates) candidates))))))))

(defvar forecast-timer nil)
(defvar forecast-location "forecast") ;; The location of the cached forecast, relative to the emacs user directory

(defun theurgy-weather-fetch-forecast ()
  "Fetch and save the weather forecast."
  (interactive)
  (request
    (concat bom-api "locations/" theurgy-geohash "/forecasts/daily")
    :parser 'json-read
    :success (cl-function
	      (lambda (&key data &allow-other-keys)
		(save-excursion
		  (find-file (concat user-emacs-directory forecast-location))
		  (delete-region (point-min) (point-max))
		  (insert (format "%S" (mapcar (lambda (alst)
						 (cons (let ((d (parse-time-string (cdr (assoc 'date alst)))))
							 (list (nth 3 d) (nth 4 d) (nth 5 d)))
						       (assq-delete-all 'date alst)))
					       (cdr (assoc 'data data)))))
		  (save-buffer)
		  (kill-buffer))))))

(defun current-date ()
  "Get the current date as a list."
  (let ((d (decode-time (current-time))))
    (list (nth 3 d) (nth 4 d) (nth 5 d))))

(defun today+ (days)
  "Date list for today + DAYS."
  (let* ((sec (+ (* days 86400) (time-convert (current-time) 'integer)))
	 (d (decode-time sec)))
    (list (nth 3 d) (nth 4 d) (nth 5 d))))

(defun prompt-date ()
  "Prompt the user for a date."
  (let ((d (parse-time-string (org-read-date))))
    (list (nth 3 d) (nth 4 d) (nth 5 d))))

(defun theurgy-weather-get-for-date (date)
  "Get weather for a particular DATE."
  (let* ((forecast-data (read (with-temp-buffer
				(insert-file-contents (concat user-emacs-directory forecast-location))
				(buffer-string))))
	 (day (assoc date
		     forecast-data)))
    day))

(defun theurgy-quick-forecast (date)
  "Quick forecast for DATE."
  (let ((forecast (theurgy-weather-get-for-date date)))
    (message (format "%s - %s degrees. %s"
		     (cdr (assoc 'temp_min forecast))
		     (cdr (assoc 'temp_max forecast))
		     (cdr (assoc 'short_text forecast))))))

(defun theurgy-weather-quick ()
  "Show the forecast as a message."
  (interactive)
  (theurgy-quick-forecast (prompt-date)))

(defun theurgy-start-forecast-timer ()
  "Start the timer for periodically retrieving the weather forecast."
  (interactive)
  (theurgy-weather-fetch-forecast)
  (unless forecast-timer
    (when (timerp forecast-timer)
      (cancel-timer forecast-timer))
    (setq forecast-timer (run-at-time t (* 60 30) #'theurgy-weather-fetch-forecast))))

(theurgy-start-forecast-timer)

(defun theurgy-weather-insert-forecast (fc)
  "Insert provided forecast FC in the current buffer, as org markup."
  (let ((date (car fc)))
    (insert (format "* %s/%s/%s - %s\n" (nth 0 date) (nth 1 date) (nth 2 date) (cdr (assoc 'short_text fc))))
    (insert (format "%s\n" (cdr (assoc 'extended_text fc))))
    (insert (format "- %s-%s°C\n"
		    (cdr (assoc 'temp_min fc))
		    (cdr (assoc 'temp_max fc))))
    (insert (format "- %s%% Chance of Rain (%s-%smm)\n"
		    (cdr (assoc 'chance (assoc 'rain fc)))
		    (cdr (assoc 'lower_range (assoc 'amount (assoc 'rain fc))))
		    (cdr (assoc 'upper_range (assoc 'amount (assoc 'rain fc))))))
    (insert (format "- %s UV\n"
		    (cdr (assoc 'category (assoc 'uv fc)))))
    (insert (format "- %s Fire Danger\n"
		    (cdr (assoc 'fire_danger fc))))
    (insert "\n")))

(defun theurgy-weather ()
  "Show weather information in a new buffer."
  (interactive)
  (let ((buf (generate-new-buffer "*Weather*")))
    (with-current-buffer buf
      (delete-region (point-min) (point-max))
      (org-mode)
      (let* ((today (theurgy-weather-get-for-date (current-date)))
	     (tomorrow (theurgy-weather-get-for-date (today+ 1)))
	     (after-tomorrow (theurgy-weather-get-for-date (today+ 2))))
	(theurgy-weather-insert-forecast today)
	(theurgy-weather-insert-forecast tomorrow)
	(theurgy-weather-insert-forecast after-tomorrow))
      (setq buffer-read-only t))
    (switch-to-buffer buf)))

(provide 'weather)

;;; weather.el ends here