lisp/weather.lisp @ 1fa04416fcdb

(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 -----------------------------------------------------------
(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) "14604")
                   :hours (gethash 'hours options))))
        (error (e) (adopt:print-error-and-exit e))))))