dimitri/sncf-bot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add styling to output

Browse source
This commit is contained in:
Dimitri Lozeve 2022-09-10 21:51:02 +02:00
parent f822211000
commit e574ac6251
1 changed files with 11 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

21
sncf.ss
View file

@ -11,6 +11,7 @@
:std/srfi/19 :std/srfi/19
:std/sugar :std/sugar
:std/text/json :std/text/json
:dlozeve/fancy/format
:dlozeve/fancy/table) :dlozeve/fancy/table)
(def +sncf-url+ "https://api.sncf.com/v1/coverage/sncf") (def +sncf-url+ "https://api.sncf.com/v1/coverage/sncf")
@ -39,11 +40,12 @@
(get-station-id sncf-key station) (get-station-id sncf-key station)
(values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604"))) (values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604")))
(let-values (((departures disruptions) (get-departures sncf-key station-id))) (let-values (((departures disruptions) (get-departures sncf-key station-id)))
(displayln (str "Prochains départs de " station-name)) (displayln (parse-markup (format "[bold]Prochains départs de [green]~a[/green] :" station-name)))
(display-departures-table departures) (display-departures-table departures)
(display-disruptions disruptions) (display-disruptions disruptions)
(when mattermost-url (when mattermost-url
(let ((tab-str-md (with-output-to-string (lambda () (let ((tab-str-md (with-output-to-string (lambda ()
(displayln (format "Prochains départs de **~a** :" station-name))
(display-departures-table departures style: 'markdown) (display-departures-table departures style: 'markdown)
(display-disruptions disruptions style: 'markdown))))) (display-disruptions disruptions style: 'markdown)))))
(post-to-mattermost mattermost-url tab-str-md channel: mattermost-channel))))) (post-to-mattermost mattermost-url tab-str-md channel: mattermost-channel)))))
@ -103,9 +105,12 @@
(def (display-departures-table departures style: (style 'unicode)) (def (display-departures-table departures style: (style 'unicode))
(def good-emoji (if (eq? style 'markdown) ":white_check_mark: " "")) (def good-emoji (if (eq? style 'markdown) ":white_check_mark: " ""))
(def bad-emoji (if (eq? style 'markdown) ":warning: " "")) (def bad-emoji (if (eq? style 'markdown) ":warning: " "[yellow]"))
(def widths (compute-table-widths departures)) (def widths (compute-table-widths departures))
(def tab (table '("Réseau" "Direction" "Heure") [(map max '(5 9) widths) ... (if (eq? style 'markdown) 32 13)] style)) (def headers (if (eq? style 'markdown)
'("Réseau" "Direction" "Heure")
'("[bold]Réseau" "[bold]Direction" "[bold]Heure")))
(def tab (table headers [(map max '(5 9) widths) ... (if (eq? style 'markdown) 32 13)] style))
(display (table-header tab)) (display (table-header tab))
(for ((dep departures)) (for ((dep departures))
(with ((departure network direction base-dep-dt dep-dt) dep) (with ((departure network direction base-dep-dt dep-dt) dep)
@ -119,15 +124,11 @@
(def (display-disruptions disruptions style: (style 'unicode)) (def (display-disruptions disruptions style: (style 'unicode))
(unless (null? disruptions) (unless (null? disruptions)
(displayln "Perturbations :")) (displayln (if (eq? style 'markdown) "**Perturbations :**" (parse-markup "[bold]Perturbations :"))))
(for ((dis disruptions)) (for ((dis disruptions))
(let ((messages (hash-ref dis 'messages '()))) (let ((messages (hash-ref dis 'messages '())))
(if (eq? style 'markdown) (display (if (eq? style 'markdown) "* " "• "))
(display "* ") (displayln (if (null? messages) "[Pas de message]" (hash-ref (car messages) 'text))))))
(display "• "))
(if (null? messages)
(displayln "[Pas de message]")
(displayln (hash-ref (car messages) 'text))))))
(def (post-to-mattermost url text channel: (channel #f)) (def (post-to-mattermost url text channel: (channel #f))
(def data (list->hash-table `((text . ,text)))) (def data (list->hash-table `((text . ,text))))