From 850d7f66ae0a042114a4fbac27e16bbf96f0a275 Mon Sep 17 00:00:00 2001 From: Oscar Najera Date: Thu, 27 Jun 2024 13:59:05 +0200 Subject: Better interface to query german public transport --- public_transport/db-schedules.el | 150 ++++++++++++++++++++++++++------------- 1 file changed, 100 insertions(+), 50 deletions(-) diff --git a/public_transport/db-schedules.el b/public_transport/db-schedules.el index b4b7370..a8f8b4b 100644 --- a/public_transport/db-schedules.el +++ b/public_transport/db-schedules.el @@ -7,8 +7,8 @@ ;; Created: June 26, 2024 ;; Modified: June 26, 2024 ;; Version: 0.0.1 -;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp -;; Homepage: https://github.com/titan/db-schedules +;; Keywords: convenience data +;; Homepage: https://git.oscarnajera.com/ ;; Package-Requires: ((emacs "29.1")) ;; ;; This file is not part of GNU Emacs. @@ -20,72 +20,122 @@ ;;; Code: ;;; - -(require 'request) (require 'dash) +(require 'request) -(defun db-schedules-locations (query-string) - "Look for a station." - (interactive "sFuzzy search for a stop: ") +(cl-defun db-schedules--parse-locations (data) + "Parse response DATA to simple name id pair." + (seq-keep + (lambda (res) + (-let (((&hash "id" "name" "type") res)) + (when (string= type "stop") + (cons name id)))) + data)) + +(cl-defun db-schedules--locations-show (&key data &allow-other-keys) + "Show tabulated list buffer with location DATA results." + (with-current-buffer (get-buffer-create "*Result locations*") + (tabulated-list-mode) + (setq tabulated-list-entries + (mapcar (-lambda ((name . id)) + (list id (vector id name))) data)) + (setq tabulated-list-format + [("ID" 8 t) + ("Name" 40 t)]) + (tabulated-list-init-header) + (tabulated-list-print t) + (display-buffer (current-buffer)) )) + +(defun db-schedules--locations (query-string success-callback) + "Look for a stop matching QUERY-STRING then process with SUCCESS-CALLBACK." (request "https://v6.db.transport.rest/locations" :params `((query . ,query-string) (stops . true) (poi . false)) - :parser 'json-parse-buffer - :success (cl-function - (lambda (&key data &allow-other-keys) - (let* ((output - (seq-keep (lambda (res) - (-let (((&hash "id" "name" "type") res)) - (when (string= type "stop") - (list name id)))) - data)) - (selected (completing-read "Which one first best? " (mapcar #'car output)))) - (assoc selected output #'string=)))))) + :parser (lambda () (db-schedules--parse-locations (json-parse-buffer))) + :success success-callback)) (defun db-schedules--time (iso-string) "From ISO-STRING time go only todays time." (thread-last - (iso8601-parse iso-string) + (parse-time-string iso-string) (encode-time) (format-time-string "%H:%M:%S"))) -(defun db-schedules--departures (stop-id future-window) +(defun db-schedules-buffer (stop-id) + "Return buffer with name for STOP-ID." + (get-buffer-create + (format "*Departures: %s*" stop-id))) + +(defun db-schedules--prepare-row (row) + "Return tabulated entry vector for ROW." + (-let* (((&hash "stop" "when" "plannedWhen" "delay" "direction" "line") row) + ((&hash "name") stop) + ((&hash "name" line-name) line) + extra) + (when (integerp delay) + (thread-first + (format "Planned: %s" (db-schedules--time plannedWhen)) + (propertize 'face 'font-lock-comment-face) + (push extra)) + (thread-first + (format "Delayed: %s" (seconds-to-string delay)) + (propertize 'face 'font-lock-keyword-face) + (push extra))) + (vector name + (thread-first + (if (eq when :null) plannedWhen when) + (db-schedules--time) + (propertize 'face (if (integerp delay) 'font-lock-keyword-face 'font-lock-doc-face))) + (thread-first + (propertize line-name 'face 'font-lock-string-face) + (list direction) + (string-join " ")) + (string-join extra " ")))) + +(cl-defun db-schedules--show-departures (&key data &allow-other-keys) + "Show tabulated list buffer with departures DATA results." + (let ((rows (thread-last + (gethash "departures" data) + (seq-map #'db-schedules--prepare-row)))) + (with-current-buffer (db-schedules-buffer (elt (car rows) 0)) + (tabulated-list-mode) + (setq tabulated-list-entries + (seq-map-indexed (lambda (row idx) (list idx row)) rows)) + (setq tabulated-list-format + [("Stop" 25 nil) + ("time" 10 nil ) + ("direction" 38 nil) + ("extra" 25 nil)]) + (tabulated-list-init-header) + (tabulated-list-print t) + (display-buffer (current-buffer)) ))) + +(defun db-schedules--departures (stop-id time-window) + "Query and show departures for STOP-ID within the TIME-WINDOW." (request (format "https://v6.db.transport.rest/stops/%s/departures" stop-id) - :params `((duration . ,future-window)) + :params `((duration . ,time-window)) :parser 'json-parse-buffer - :success (cl-function - (lambda (&key data &allow-other-keys) - (thread-last - (gethash "departures" data) - (seq-map-indexed - (lambda (row idx) - (-let* (((&hash "stop" "plannedWhen" "delay" "direction" "line") row) - ((&hash "name" "products") stop) - ((&hash "name" line-name) line) - type) - (maphash (lambda (k v) (when (eq v t) (push k type))) products) - (if (integerp delay) (push (format "Delayed %s" (seconds-to-string delay)) type)) - (list idx - (vector name - (db-schedules--time plannedWhen) - (string-join (list line-name direction) " ") - (string-join type " ")))))) - (setq tabulated-list-entries)) - (tabulated-list-print t))))) + :success #'db-schedules--show-departures)) -(with-current-buffer (get-buffer-create "*time schedule") - (tabulated-list-mode) - (setq tabulated-list-format - [("Stop" 25 nil) - ("time" 10 nil ) - ("direction" 25 nil) - ("extra" 25 nil)]) +(defun db-schedules-search-location (query) + "QUERY for locations and show result list." + (interactive "sFuzzy search for a stop: ") + (db-schedules--locations query #'db-schedules--locations-show)) - (tabulated-list-init-header) +(cl-defun db-schedules--pick-location-query-departures (&key data &allow-other-keys) + "Pick from location DATA, then query for departures at stop location." + (let* ((stop-name (completing-read "Which stop fits best? " + (mapcar #'car data))) + (stop-id (cdr (assoc stop-name data #'string=))) + (time-window (completing-read "time in futre: " + (mapcar #'number-to-string '(5 10 20 40))))) + (db-schedules--departures stop-id time-window))) - (db-schedules--departures "683258" 1000) - (display-buffer (current-buffer))) +(defun db-schedules-location-departures (query) + "QUERY for locations and show it departures list." + (interactive "sFuzzy search for a stop: ") + (db-schedules--locations query #'db-schedules--pick-location-query-departures)) (provide 'db-schedules) ;;; db-schedules.el ends here -- cgit v1.2.3