blob: a8f8b4b6dfdc1129f728d1a0d476bacbe0db0523 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
;;; db-schedules.el --- Query DB community api for schedules -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2024 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: June 26, 2024
;; Modified: June 26, 2024
;; Version: 0.0.1
;; Keywords: convenience data
;; Homepage: https://git.oscarnajera.com/
;; Package-Requires: ((emacs "29.1"))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; Query DB community api for schedules
;;
;;; Code:
;;;
(require 'dash)
(require 'request)
(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 (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
(parse-time-string iso-string)
(encode-time)
(format-time-string "%H:%M:%S")))
(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 . ,time-window))
:parser 'json-parse-buffer
:success #'db-schedules--show-departures))
(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))
(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)))
(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
|
