Better interface to query german public transport

1 files 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