More
author |
Steve Losh <steve@stevelosh.com> |
date |
Mon, 19 Aug 2024 08:55:42 -0400 |
parents |
40c68f5ac898 |
children |
(none) |
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload
'(:adopt :with-user-abort :split-sequence :iterate :losh :drakma :jarl :flexi-streams :local-time)
:silent t))
(defpackage :weather
(:use :cl :iterate :losh)
(:import-from :split-sequence :split-sequence)
(:export :toplevel :*ui*))
(in-package :weather)
;;;; Zip Codes ----------------------------------------------------------------
(defun load-zip-code-coordinates ()
(iterate
;; https://www.census.gov/geographies/reference-files/time-series/geo/gazetteer-files.html
(for line :in-file "data/2019_Gaz_zcta_national.txt" :using #'read-line)
(for fields = (split-sequence #\tab (string-trim " " line)))
(if-first-time
nil
;; GEOID ALAND AWATER ALAND_SQMI AWATER_SQMI INTPTLAT INTPTLONG
(collect-hash ((elt fields 0) (cons (elt fields 5) (elt fields 6)))
:test #'equal))))
(defparameter *zipcodes* (load-zip-code-coordinates))
;;;; Config -------------------------------------------------------------------
(defvar *api-token* nil)
(defun load-config ()
(let* ((token-paths (uiop:xdg-config-pathnames "weather/api-token"))
(config-paths (uiop:xdg-config-pathnames "weather/config"))
(token-path (find-if #'probe-file token-paths))
(config-paths (reverse (remove-if-not #'probe-file config-paths))))
(declare (ignore config-paths)) ; TODO
(if (null token-path)
(error "Cannot find API token file at any of the following paths:~2%~
~{ ~A~%~}~%~
Visit https://home.openweathermap.org/api_keys to get one."
token-paths)
(setf *api-token* (string-trim '(#\space #\newline)
(alexandria:read-file-into-string token-path))))))
;;;; OpenWeatherMap -----------------------------------------------------------
;;; TODO Switch to weather.gov some day to get my taxes' worth, e.g.
;;; https://forecast.weather.gov/MapClick.php?lat=43.1577&lon=-77.6066&FcstType=digitalDWML
;;; Sadly this is XML.
(defclass* response ()
((hourly :json (vector hour)))
(:metaclass jarl:json-class))
(defclass* hour ()
((timestamp :json number :json/name "dt" :json/after-read local-time:unix-to-timestamp)
(temperature :json number :json/name "temp")
(feels-like :json number)
(humidity :json number)
(precipitation :json number :json/name "pop")
(weather :json (vector weather)))
(:metaclass jarl:json-class))
(defclass* weather ()
((description :json string))
(:metaclass jarl:json-class))
(defmethod print-object ((o hour) s)
(print-unreadable-object (o s :type t)
(local-time:format-timestring
s (timestamp o) :format
'(:year #\- (:month 2) #\- (:day 2) #\space (:hour 2) #\: (:min 2)))))
(defmethod print-object ((o weather) s)
(print-unreadable-object (o s :type t)
(format s "~A" (description o))))
(defun ensure-response-string (response)
(etypecase response
(string response)
(stream (alexandria:read-stream-content-into-string response))
(vector (flexi-streams:octets-to-string response))))
(defun query-weather (latitude longitude)
(multiple-value-bind (body status headers uri stream needs-close reason)
(drakma:http-request (format nil "https://api.openweathermap.org/data/2.5/onecall")
:redirect t
:parameters `(("lat" . ,latitude)
("lon" . ,longitude)
("appid" . ,*api-token*)
("exclude" . "current,minutely,daily")
("units" . "imperial")))
(declare (ignore headers needs-close stream))
(setf body (ensure-response-string body))
(if (<= 200 status 299)
(jarl:read 'response body)
(error "Received ~D ~A from ~A: ~A" status reason uri body))))
;;;; Display ------------------------------------------------------------------
(defun ymd (timestamp)
(local-time:format-timestring nil timestamp :format '(:year #\- (:month 2) #\- (:day 2))))
(defun display-hour (hour &optional force-date)
(let* ((ts (timestamp hour))
(h (local-time:timestamp-hour ts)))
(format t "~12A ~2,'0D:00 ~4D°F ~4D% ~{~A~^, ~}~%"
(if (or force-date (zerop h))
(ymd ts)
"")
h
(round (temperature hour))
(round (* 100 (precipitation hour)))
(map 'list #'description (weather hour)))))
(defun display-weather (data &key hours)
(loop :for i :below hours
:for hour :across (hourly data)
:do (display-hour hour (zerop i))))
;;;; Run ----------------------------------------------------------------------
(defun run (location &key (hours 12))
(destructuring-bind (latitude . longitude) (gethash location *zipcodes*)
(display-weather (query-weather latitude longitude)
:hours hours)))
;;;; User Interface -----------------------------------------------------------
(defparameter *option-help*
(adopt:make-option 'help
:help "Display help and exit."
:long "help"
:short #\h
:reduce (constantly t)))
(defparameter *option-hours*
(adopt:make-option 'hours
:help "Show N upcoming hours (default 16)."
:parameter "N"
:long "hours"
:short #\H
:reduce #'adopt:last
:key #'parse-integer
:initial-value 16))
(adopt:define-string *help-text*
"weather takes a location and dumps a useful view of the upcoming weather to ~
standard output.")
(defparameter *examples*
'(("Show the weather at your default location:" . "weather")
("Show the weather at a particular zip code:" . "weather 14604")))
(defparameter *ui*
(adopt:make-interface
:name "weather"
:usage "[OPTIONS] [LOCATION]"
:summary "show the upcoming weather"
:help *help-text*
:examples *examples*
:contents (list *option-hours*
*option-help*)))
(defmacro exit-on-ctrl-c (&body body)
`(handler-case
(with-user-abort:with-user-abort (progn ,@body))
(with-user-abort:user-abort () (adopt:exit 130))))
(defun toplevel ()
(exit-on-ctrl-c
(multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*)
(handler-case
(if (gethash 'help options)
(adopt:print-help-and-exit *ui*)
(progn
(load-config)
(run (or (first arguments) "48105")
:hours (gethash 'hours options))))
(error (e) (adopt:print-error-and-exit e))))))