Skip to content
Commits on Source (2)
Hide whitespace changes
Inline Side-by-side
trackernet.lisp
View file @ beaee055
......@@ -4464,6 +4464,12 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping.
(subseq train #.(length "X-train-")))
(redis-train (+ ts 1) "X" "X-DEL" fake-train)))))
(defparameter *xrcos-handover-berths*
'("0091" "0099" "095S" ; GWML end
"0233" "0243" ; GEML end
"COUT" ; not used but here just for safety
))
(defun stomp-td-message-handler (message-type body)
"Handles a STOMP message."
(unless (member message-type '(:+CA-MSG+ :+CB-MSG+ :+CC-MSG+ :+CT-MSG+))
......@@ -4557,7 +4563,15 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping.
berth rescue-headcode headcode)
(rescue-train (format nil "X-train-~A" rescue-headcode)
(format nil "X-train-~A" headcode))
(red:del (format nil "X-train-~A" rescue-headcode))))))
(red:del (format nil "X-train-~A" rescue-headcode)))
;; FIXME(eta): actually handle GWML/GEML transitions
;; the Q0 TD doesn't send deletes or steps to COUT for handover
;; berths, but we only use that TD, so just delete trains to
;; keep them from sticking
(when (member berth *xrcos-handover-berths*
:test #'string=)
(log:info "train ~A in handover berth, deleting" headcode)
(enqueue-td-deletion headcode)))))
(defvar *current-stomp-td-backoff* 1)
......
wobsite.lisp
View file @ beaee055
......@@ -2463,29 +2463,32 @@
(:td ; Train ID
:class "govuk-table__cell id-field no-phones"
(who:esc (trackernet::train-id train))))))
(:td ; Set/trip number
:class (if ts
"govuk-table__cell no-phones"
"govuk-table__cell")
(let* ((trip-no (trackernet::trip-no train))
(set-no (trackernet::set-no train))
(class (if (string= trip-no "0")
"govuk-tag govuk-tag--green"
"govuk-tag govuk-tag--pink")))
(unless (string= set-no "000")
(who:htm
(:strong
:class class
(who:esc set-no)
(unless (string= trip-no "0")
(who:str " ×")
(who:esc trip-no)))))))
(:td ; LCID
:class "govuk-table__cell id-field no-phones"
(unless (string= (trackernet::lcid train) "0")
(who:esc (trackernet::lcid train))))
(unless (string= line-code "X")
(who:htm
(:td ; Set/trip number
:class (if ts
"govuk-table__cell no-phones"
"govuk-table__cell")
(let* ((trip-no (trackernet::trip-no train))
(set-no (trackernet::set-no train))
(class (if (string= trip-no "0")
"govuk-tag govuk-tag--green"
"govuk-tag govuk-tag--pink")))
(unless (string= set-no "000")
(who:htm
(:strong
:class class
(who:esc set-no)
(unless (string= trip-no "0")
(who:str " ×")
(who:esc trip-no)))))))
(:td ; LCID
:class "govuk-table__cell id-field no-phones"
(unless (string= (trackernet::lcid train) "0")
(who:esc (trackernet::lcid train))))))
(:td ; Location / destination
:class "govuk-table__cell govuk-!-width-two-thirds"
:class (format nil "govuk-table__cell ~A"
(if (string= line-code "X") "" "govuk-!-width-two-thirds"))
(:span
(who:esc (or
(cdr (assoc (trackernet::track-code train)
......@@ -3369,7 +3372,10 @@ Returns the number of requests counted, including this one."
(:a
:class "govuk-link"
:href (format nil "/train?train=~A-train-~A" line-code trackernet-id)
"the raw Trackernet data")
(who:str
(if (string= line-code "X")
"the raw Network Rail data"
"the raw Trackernet data")))
" for more granular information.")))
(:h3
:class "govuk-heading-m train-history-heading"
......@@ -3565,7 +3571,8 @@ Returns the number of requests counted, including this one."
(:span
:class "govuk-caption-xl"
(who:fmt
"Trackernet raw data for ~A"
"~A raw data for ~A"
(if (string= line-code "X") "Network Rail" "Trackernet")
train))
(:h1
:class "govuk-heading-xl"
......@@ -3576,27 +3583,28 @@ Returns the number of requests counted, including this one."
"nowhere")))
(:p
:class "govuk-body-l"
(cond
((> secs-old 90)
(who:htm
(:strong
:class "govuk-tag govuk-tag--red"
(who:fmt "Very Stale"))))
((> secs-old 30)
(who:htm
(:strong
:class "govuk-tag govuk-tag--red"
(who:fmt "Stale"))))
((> secs-old 15)
(who:htm
(:strong
:class "govuk-tag govuk-tag--orange"
"Intermittent")))
(t
(who:htm
(:strong
:class "govuk-tag govuk-tag--turquoise"
"Active"))))
(unless (string= line-code "X")
(cond
((> secs-old 90)
(who:htm
(:strong
:class "govuk-tag govuk-tag--red"
(who:fmt "Very Stale"))))
((> secs-old 30)
(who:htm
(:strong
:class "govuk-tag govuk-tag--red"
(who:fmt "Stale"))))
((> secs-old 15)
(who:htm
(:strong
:class "govuk-tag govuk-tag--orange"
"Intermittent")))
(t
(who:htm
(:strong
:class "govuk-tag govuk-tag--turquoise"
"Active")))))
" Showing "
(:strong
(who:fmt "~A" max-to-show))
......@@ -3607,12 +3615,14 @@ Returns the number of requests counted, including this one."
(:strong
(who:esc start-ts))
".")
(:p
:class "govuk-body"
(who:fmt "Leading car IDs: ~{~A~^, ~} · WTT IDs: ~{~A~^, ~} · Destinations: ~{~A~^, ~}"
(nreverse lcids)
(nreverse wtts)
(nreverse dests)))
(unless (string= line-code "X")
(who:htm
(:p
:class "govuk-body"
(who:fmt "Leading car IDs: ~{~A~^, ~} · WTT IDs: ~{~A~^, ~} · Destinations: ~{~A~^, ~}"
(nreverse lcids)
(nreverse wtts)
(nreverse dests)))))
(:table
:class "govuk-table"
(:thead
......@@ -3622,18 +3632,21 @@ Returns the number of requests counted, including this one."
(:th
:class "govuk-table__header"
"Time")
(unless (string= line-code "X")
(who:htm
(:th
:class "govuk-table__header no-phones"
(:abbr
:title "Working Timetable train number"
"WTT"))
(:th
:class "govuk-table__header no-phones"
(:abbr
:title "Leading Car ID (LCID)"
"LCID"))))
(:th
:class "govuk-table__header no-phones"
(:abbr
:title "Working Timetable train number"
"WTT"))
(:th
:class "govuk-table__header no-phones"
(:abbr
:title "Leading Car ID (LCID)"
"LCID"))
(:th
:class "govuk-table__header govuk-!-width-two-thirds"
:class (format nil "govuk-table__header ~A"
(if (string= line-code "X") "" "govuk-!-width-two-thirds"))
"Location")))
(:tbody
:class "govuk-table__body"
......