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

Display unicode and markdown tables with a single function

Browse source
This commit is contained in:
Dimitri Lozeve 2022-09-09 22:30:03 +02:00
parent d6d18ba43f
commit efb0c4d1fe
1 changed files with 15 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

41
sncf.ss
View file

@ -5,6 +5,7 @@
(import :std/format (import :std/format
:std/getopt :std/getopt
:std/iter :std/iter
:std/misc/string
:std/net/request :std/net/request
:std/srfi/19 :std/srfi/19
:std/sugar :std/sugar
@ -27,8 +28,8 @@
(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 ()
(display-departures-table-md departures) (display-departures-table departures style: 'markdown)
(display-disruptions disruptions))))) (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)))))
(catch (getopt-error? exn) (catch (getopt-error? exn)
(getopt-display-help exn "sncf" (current-error-port)) (getopt-display-help exn "sncf" (current-error-port))
@ -47,8 +48,10 @@
(request-status req) (request-status-text req))) (request-status req) (request-status-text req)))
(exit 1)))) (exit 1))))
(def (display-departures-table departures) (def (display-departures-table departures style: (style 'unicode))
(def tab (table '("Réseau" "Direction" "Heure") [10 30 13])) (def good-emoji (if (eq? style 'markdown) ":white_check_mark: " ""))
(def bad-emoji (if (eq? style 'markdown) ":warning: " ""))
(def tab (table '("Réseau" "Direction" "Heure") [10 30 (if (eq? style 'markdown) 32 13)] style))
(display (table-header tab)) (display (table-header tab))
(for ((dep departures)) (for ((dep departures))
(let* ((info (hash-ref dep (string->symbol "display_informations"))) (let* ((info (hash-ref dep (string->symbol "display_informations")))
@ -58,40 +61,22 @@
(dep-dt-str (hash-ref stop-dt (string->symbol "departure_date_time"))) (dep-dt-str (hash-ref stop-dt (string->symbol "departure_date_time")))
(dep-dt (string->date dep-dt-str "~Y~m~dT~H~M~S")) (dep-dt (string->date dep-dt-str "~Y~m~dT~H~M~S"))
(hour-str (if (equal? dep-dt base-dep-dt) (hour-str (if (equal? dep-dt base-dep-dt)
(date->string dep-dt "~H:~M") (str good-emoji (date->string dep-dt "~H:~M"))
(format "~a → ~a" (str bad-emoji (format "~a → ~a"
(date->string base-dep-dt "~H:~M") (date->string base-dep-dt "~H:~M")
(date->string dep-dt "~H:~M"))))) (date->string dep-dt "~H:~M"))))))
(display (table-row tab (display (table-row tab
(hash-ref info 'network) (hash-ref info 'network)
(hash-ref info 'direction) (hash-ref info 'direction)
hour-str)))) hour-str))))
(display (table-footer tab))) (display (table-footer tab)))
(def (display-departures-table-md departures) (def (display-disruptions disruptions style: (style 'unicode))
(displayln "| Réseau | Direction | Heure |")
(displayln "|-")
(for ((dep departures))
(let* ((info (hash-ref dep (string->symbol "display_informations")))
(stop-dt (hash-ref dep (string->symbol "stop_date_time")))
(base-dep-dt-str (hash-ref stop-dt (string->symbol "base_departure_date_time")))
(base-dep-dt (string->date base-dep-dt-str "~Y~m~dT~H~M~S"))
(dep-dt-str (hash-ref stop-dt (string->symbol "departure_date_time")))
(dep-dt (string->date dep-dt-str "~Y~m~dT~H~M~S"))
(hour-str (if (equal? dep-dt base-dep-dt)
(date->string dep-dt ":white_check_mark: ~H:~M")
(format ":warning: ~a → ~a"
(date->string base-dep-dt "~H:~M")
(date->string dep-dt "~H:~M")))))
(displayln (format "| ~a | ~a | ~a |"
(hash-ref info 'network)
(hash-ref info 'direction)
hour-str)))))
(def (display-disruptions disruptions)
(displayln "Perturbations :") (displayln "Perturbations :")
(for ((dis disruptions)) (for ((dis disruptions))
(if (eq? style 'markdown)
(display "* ") (display "* ")
(display "• "))
(displayln (hash-ref (car (hash-ref dis 'messages)) 'text)))) (displayln (hash-ref (car (hash-ref dis 'messages)) 'text))))
(def (post-to-mattermost url text channel: (channel #f)) (def (post-to-mattermost url text channel: (channel #f))