wobsite!

.gitignore

@@ -6,3 +6,11 @@ intertube-scraper
 *#
 *.csv
 trains*/*
+*.dot
+*.png
+*.svg
+*.tar
+*.dat
+*.jpeg
+.#*
+*.txt

trackernet.lisp

@@ -5,6 +5,18 @@
 
 (defparameter *trackernet-base-url* "http://cloud.tfl.gov.uk/TrackerNet")
 
+(defun statsd-inc (&rest args)
+  (ignore-errors
+   (apply #'statsd:inc args)))
+
+(defun statsd-gauge (&rest args)
+  (ignore-errors
+   (apply #'statsd:gauge args)))
+
+(defun statsd-counter (&rest args)
+  (ignore-errors
+   (apply #'statsd:counter args)))
+
 (defun read-all-from (file)
   (with-open-file (source file
                           :element-type '(unsigned-byte 8))
@@ -438,7 +450,12 @@
                   (cl-ansi-text:make-color-string :green :style :background)
                   tid
                   cl-ansi-text:+reset-color-string+
-                  train))
+                  train)
+          ;; make a rescuable thingy
+          (red:setex (format nil "~A-rescue-~A"
+                             line-code tid)
+                     *train-active-expiry-secs*
+                     track-code))
         ;; mark this train as active
         (red:setex (format nil "~A-active-~A"
                            line-code tid)
@@ -465,7 +482,7 @@
                cl-ansi-text:+reset-color-string+
                lcn-train-id
                tid)
-              (statsd:inc "intertube.leading-car-no-change")))
+              (statsd-inc "intertube.leading-car-no-change")))
           ;; reserve the leading car no
           (red:setex (format nil "~A-lcn-~A"
                              line-code leading-car-no)
@@ -493,7 +510,7 @@
                cl-ansi-text:+reset-color-string+
                set-code-train-id
                tid)
-              (statsd:inc "intertube.set-code-change")))
+              (statsd-inc "intertube.set-code-change")))
           ;; reserve the set number
           (red:setex (format nil "~A-set-~A-trip-~A"
                              line-code set-no trip-no)
@@ -539,6 +556,15 @@
     (when score
       (parse-integer score))))
 
+(defun redis-last-cpk (key)
+  "Gets the CONSPACK-decoded value of the last element of the sorted set with the Redis KEY."
+  (let ((data (first
+               (red:zrevrangebyscore key "+inf" "-inf"
+                                     :limit (cons "0" "1")
+                                     :withscores t))))
+    (when data
+      (cpk-unbase64 data))))
+
 (defun redis-cpk-sorted-set-all (key)
   "Gets all elements of the sorted set KEY, alongside their scores, CONSPACK-decoding each element."
   (let ((data
@@ -625,6 +651,8 @@
              "~&archiver: failed to pigz last archive: code ~A~%"
              exit-code))))))
 
+(defparameter *rescue-depth* 3)
+
 (defun archive-trains-tar (keys)
   "Archive trains from KEYS, a list of Redis train sorted set keys."
   (maybe-pigz-last-archive)
@@ -651,7 +679,17 @@
               (cl-ansi-text:make-color-string :red :style :background)
               (second train)
               cl-ansi-text:+reset-color-string+
-              last-data))
+              last-data)
+             (multiple-value-bind (rescue depth)
+                 (find-rescuable-train (track-code last-data) (subseq (second train) 0 1) *rescue-depth*)
+               (when rescue
+                 (format
+                  t
+                  "~&archiver: ~Acould rescue with~A: ~A (depth ~A)~%"
+                  (cl-ansi-text:make-color-string :cyan :style :background)
+                  cl-ansi-text:+reset-color-string+
+                  rescue
+                  depth))))
         do (conspack-encode-to-archive tar
                                        (format nil "~A-~A.trn"
                                                (first train)
@@ -713,7 +751,7 @@
              ;; a reporting gap
              (unless (member last-reported-station *termini*
                              :test #'string=)
-               (statsd:inc "intertube.archived-early")
+               (statsd-inc "intertube.archived-early")
                (format *error-output*
                        "~&archiver: WARNING: train ~A last reported at ~A~%"
                        (second train)
@@ -766,16 +804,16 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
      :start
        (handler-case
            (let ((pred (fetch-trackernet-prediction line-code station-code)))
-             (statsd:inc (format nil "scraper.~A-~A.scraped" line-code station-code))
-             (statsd:inc "intertube.scraped-total")
+             (statsd-inc (format nil "scraper.~A-~A.scraped" line-code station-code))
+             (statsd-inc "intertube.scraped-total")
              (let ((num-trains (maybe-redis-trackernet-prediction pred)))
                (when num-trains
-                 (statsd:gauge (format nil "scraper.~A-~A.trains" line-code station-code) num-trains)
-                 (statsd:inc (format nil "scraper.~A-~A.new" line-code station-code)))))
+                 (statsd-gauge (format nil "scraper.~A-~A.trains" line-code station-code) num-trains)
+                 (statsd-inc (format nil "scraper.~A-~A.new" line-code station-code)))))
 ;;                 (format t "~&scraper(~A-~A): new: ~A (~A trains)~%"
 ;;                        line-code station-code pred num-trains))))
          (error (e)
-           (statsd:inc (format nil "scraper.~A-~A.errors" line-code station-code))
+           (statsd-inc (format nil "scraper.~A-~A.errors" line-code station-code))
            (format *error-output* "~&scraper(~A-~A): error: ~A~%"
                    line-code station-code e)))
        (go :sleep)
@@ -820,7 +858,7 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
   (redis:with-connection ()
     (loop
       while (not *trackernet-kill-switch*)
-      do (statsd:gauge (format nil "line.~A.active-trains" line-code)
+      do (statsd-gauge (format nil "line.~A.active-trains" line-code)
                        (length (trains-active-on-line line-code))) 
       do (sleep 1))))
 
@@ -833,7 +871,7 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
       (handler-case
           (progn
             (archive-trains-tar trains)
-            (statsd:counter "intertube.archived" (length trains))
+            (statsd-counter "intertube.archived" (length trains))
             (mapc #'red:del trains))
         (error (e)
           (format *error-output* "~&archiver: failed: ~A~%" e))))))
@@ -868,6 +906,8 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
               (length codes))))
     (when (> rpm *rude-requests-per-minute*)
       (error "~A requests/min is a bit rude" rpm))
+    (format t "~&~A nodes in rescue table~%"
+            (hash-table-size *track-rescue-graph*))
     (format t "~&starting ~A scrapers, ~A requests/min...~%"
             (length codes) rpm))
   (setf *trackernet-kill-switch* nil)
@@ -1020,22 +1060,28 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
   "Create links between subsequent observed track codes in ARCHIVED-TRAIN's history."
   (destructuring-bind (filename archived-universal-ts train-key history)
       archived-train
+    (declare (ignore filename archived-universal-ts train-key))
     (loop
       with first = (pop history)
       for next = (pop history)
       while next
       do (let ((track-code-1 (track-code (third first)))
                (track-code-2 (track-code (third next))))
-           (unless (gethash (list track-code-1 track-code-2) *track-links-set*)
-             (setf (gethash (list track-code-1 track-code-2) *track-links-set*) 0))
-           (incf (gethash (list track-code-1 track-code-2) *track-links-set*)))
+           (symbol-macrolet
+               ((edge-count (gethash (list track-code-1 track-code-2) *track-links-set*)))
+             (unless edge-count
+               (setf edge-count 0))
+             (incf edge-count)
+             (when (eql (rem edge-count 100) 0)
+               (format t "~&* ~A -> ~A referenced ~A times~%"
+                       track-code-1 track-code-2 edge-count))))
       do (setf first next))))
 
 (defun calculate-exponential-base (max top)
   (expt top
         (/ 1 max)))
 
-(defun track-links-third-quartile (&key (cutoff 0))
+(defun track-links-quartiles (&key (cutoff 0))
   (let ((data (sort (loop
                       for v being the hash-values of *track-links-set*
                       unless (< v cutoff)
@@ -1043,16 +1089,18 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
                     #'<)))
     (values
       (elt data
-           (* 3
+           (* 1
               (floor (length data) 4)))
-      data)))
+      (elt data
+           (* 3
+              (floor (length data) 4))))))
 
 (defun squish-link-length (in max top &optional (base (calculate-exponential-base max top)))
   (cond
    ((> in max) top)
    (t (expt base in))))
 
-(defun write-track-links-graphviz (&optional (out *standard-output*))
+(defun write-track-links-graphviz (&key (out *standard-output*) (cutoff 5))
   "Write the track links out in graphviz format."
   (princ "digraph {" out)
   (format out "node [shape=box margin=\"0.1,0.1\"];
@@ -1068,28 +1116,28 @@ layout = \"neato\";")
                (if (eql (length value) 0)
                    '("???")
                    (bobbin:wrap (list value) 20))))
-  (let* ((q3 (track-links-third-quartile :cutoff 5))
-         (base (calculate-exponential-base q3 3)))
-    (loop
-      for (a b) being the hash-keys of *track-links-set*
-        using (hash-value v)
-      unless (or (< v 5)
-                 (string= a b))
-        do (let* ((score-2 (1- (squish-link-length v q3 3 base)))
-                  (score-perc (floor (* 50 score-2))))
-             (format out "\"~A\" -> \"~A\" [weight=~A len=~F label=\"~A (~A%)\" color=\"0.0 0.0 ~F\" fontcolor=\"0.0 0.0 ~F\" style=\"~A\"];~%"
-                     a
-                     b
-                     score-perc
-                     (- 3.5 score-2)
-                     v
-                     score-perc
-                     (+ 0.2 (/ (- 100 score-perc) 120))
-                     (/ (- 100 score-perc) 100)
-                     (cond
-                       ((> score-perc 80) "bold")
-                       ((< score-perc 20) "dotted")
-                       (t "solid"))))))
+  (multiple-value-bind (q1 q3) (track-links-quartiles :cutoff cutoff)
+    (let* ((base (calculate-exponential-base q3 3)))
+      (loop
+        for (a b) being the hash-keys of *track-links-set*
+          using (hash-value v)
+        unless (or (< v q1)
+                   (string= a b))
+          do (let* ((score-2 (1- (squish-link-length v q3 3 base)))
+                    (score-perc (floor (* 50 score-2))))
+               (format out "\"~A\" -> \"~A\" [weight=~A len=~F label=\"~A (~A%)\" color=\"0.0 0.0 ~F\" fontcolor=\"0.0 0.0 ~F\" style=\"~A\"];~%"
+                       a
+                       b
+                       score-perc
+                       (- 3.5 score-2)
+                       v
+                       score-perc
+                       (+ 0.2 (/ (- 100 score-perc) 120))
+                       (/ (- 100 score-perc) 100)
+                       (cond
+                         ((> score-perc 80) "bold")
+                         ((< score-perc 20) "dotted")
+                         (t "solid")))))))
   (princ "}" out))
 
 
@@ -1103,7 +1151,7 @@ layout = \"neato\";")
   (let ((descs-ht (make-hash-table :test 'equal)))
     (loop
       for key in (get-all "D-track-desc-*")
-      for actual = (subseq key 13)
+      for actual = (subseq key #.(length "D-track-desc-"))
       for value = (red:get key)
       do (when (and
                 (> (length value) 0)
@@ -1134,3 +1182,75 @@ color=lightblue;
                (string= a b))
       do (format out "\"~A\" -> \"~A\" [weight=~A label=\"~A\"];~%" a b v v))
   (princ "}" out))
+
+(defun populate-track-links (train-list)
+  (reset-track-links-set)
+  (loop
+    for train in train-list
+    do (format t "~&*** Processing train ~A...~%" train)
+    do (unarchive-trains-tar train #'populate-track-links-set))
+  (format t "~&*** Done; ~A links~%" (hash-table-size *track-links-set*)))
+
+(defun write-track-links-graphviz-to-file (outfile)
+  (with-open-file (out outfile
+                       :direction :output)
+    (write-track-links-graphviz :out out)))
+
+(defparameter *track-rescue-graph*
+  (or
+   (ignore-errors
+    (alexandria:alist-hash-table (uiop:read-file-form "./rescue-table.dat")
+                                 :test 'equal))
+   (make-hash-table :test 'equal)))
+
+(defun make-rescue-graph ()
+  (setf *track-rescue-graph* (make-hash-table :test 'equal))
+  (multiple-value-bind (q1 q3) (track-links-quartiles :cutoff 5)
+    (let* ((base (calculate-exponential-base q3 3)))
+      (loop
+        for (a b) being the hash-keys of *track-links-set*
+          using (hash-value v)
+        do (symbol-macrolet ((rescue-val (gethash a *track-rescue-graph*)))
+             (let* ((score-2 (1- (squish-link-length v q3 3 base)))
+                    (score-perc (floor (* 50 score-2))))
+               (when (and
+                      (not (string= b a))
+                      (> v q1)
+                      (>= score-perc 20))
+                 (unless rescue-val
+                   (setf rescue-val nil))
+                 (pushnew b rescue-val))))))))
+
+(defun get-rescuable-trains (line-code)
+  (mapcar
+   (lambda (x)
+     (cons
+      (format nil "~A-train-~A" line-code (subseq x #.(length "D-rescue-")))
+      (red:get x)))
+   (get-all (format nil "~A-rescue-*" line-code))))
+
+(defun %find-rescuable-train (start rescuable bfs-depth)
+  (when (>= (decf bfs-depth) 0)
+    (loop
+      for neighbor in (gethash start *track-rescue-graph*)
+      with pos
+      when (setf pos (position neighbor rescuable :key #'cdr :test #'string=))
+        do (throw 'found (values bfs-depth pos))
+      unless (string= neighbor start)
+        do (%find-rescuable-train neighbor rescuable bfs-depth))))
+
+(defun find-rescuable-train (start line-code max-depth)
+  (let ((rescuable (get-rescuable-trains line-code))
+        (real-x nil))
+    (multiple-value-bind (depth pos)
+        (catch 'found
+          (loop
+            ;; this is a curse against computer science
+            ;; I'm implementing BFS with DFS because I wrote DFS
+            ;; and then I realised I made a mistake
+            ;; so
+            for x from 1 upto max-depth
+            do (setf real-x x)
+            do (%find-rescuable-train start rescuable x)))
+      (when depth
+        (values (elt rescuable pos) real-x)))))

wobsite.lisp

@@ -0,0 +1,382 @@
+(defpackage :intertube-web
+  (:use :cl))
+
+(in-package :intertube-web)
+
+(setf (cl-who:html-mode) :html5)
+
+(defparameter *title* "intertube")
+(defvar *accent-colour* "#1d70b8")
+
+(defun with-rendering-context (func)
+  (who:with-html-output-to-string (*standard-output* nil
+                                   :prologue t)
+    (:html
+     :lang "en"
+     (:head
+      (:meta
+       :charset "utf-8")
+      (:title
+       (who:esc *title*))
+      (:meta
+       :name "viewport"
+       :content "width=device-width, initial-scale=1, viewport-fit=cover")
+      (:link
+       :href "/styles.css"
+       :rel "stylesheet"))
+     (:body
+      :class "govuk-template__body"
+      (:a
+       :href "#main-content"
+       :class "govuk-skip-link"
+       "Skip to main content")
+      (:header
+       :class "govuk-header"
+       :role "banner"
+       (:div
+        :class "govuk-header__container govuk-width-container"
+        :style (format nil "border-bottom: 10px solid ~A;"
+                       *accent-colour*)
+        (:div
+         :class "govuk-header__logo"
+         (:a
+          :href "/"
+          :class "govuk-header__link govuk-header__link--homepage"
+          (:span
+           :class "govuk-header__logotype-text"
+           "intertube")))))
+      (:div
+       :class "govuk-width-container"
+       (:main
+        :class "govuk-main-wrapper"
+        :id "main-content"
+        :role "main"
+        (who:str (funcall func))))
+      (:footer
+       :class "govuk-footer"
+       :role "contentinfo"
+       (:div
+        :class "govuk-width-container"
+        (:div
+         :class "govuk-footer__meta"
+         (:div
+          :class "govuk-footer__meta-item govuk-footer__meta-item--grow"
+          (:span
+           :class "govuk-footer__licence-description"
+           "This webpage may contain wiggly donkers.")))))))))
+
+(defmacro render (() &body body)
+  `(with-rendering-context
+     (lambda ()
+       (who:with-html-output-to-string (*standard-output* nil
+                                        :prologue nil)
+         ,@body))))
+
+(hunchentoot:define-easy-handler (css :uri "/styles.css") ()
+  (hunchentoot:handle-static-file "./govuk.css"))
+
+(defun html-rgb-colour (r g b)
+  (format nil "#~2,'0x~2,'0x~2,'0x" r g b))
+
+(defparameter *tube-line-data*
+  '(("Bakerloo" "B" (178 99 0))
+    ("Central" "C" (220 36 31))
+    ("Circle" "H" (255 211 41))
+    ("District" "D" (0 125 50))
+    ("Hammersmith & City" "H" (244 169 190))
+    ("Jubilee" "J" (161 165 167))
+    ("Metropolitan" "M" (155 0 88))
+    ("Northern" "N" (0 0 0))
+    ("Piccadilly" "P" (0 25 168))
+    ("Victoria" "V" (0 152 216))
+    ("Waterloo & City" "W" (147 206 186)))
+  "A list of Tube line data, in the format (NAME TRACKERNET-CODE RGB-COLOUR)")
+
+(defun tube-line-by-code (code)
+  (find-if (lambda (d) (string= (second d) code))
+           *tube-line-data*))
+
+(defparameter *govuk-go-arrow-svg*
+  "<svg class=\"govuk-button__start-icon\" xmlns=\"http://www.w3.org/2000/svg\" width=\"17.5\" height=\"19\" viewBox=\"0 0 33 40\" aria-hidden=\"true\" focusable=\"false\">)
+<path fill=\"currentColor\" d=\"M0 0h13l20 20-20 20H0l20-20z\" />
+</svg>")
+
+(defun train-objects-on-line (code)
+  (let ((active (trackernet::trains-active-on-line code)))
+    (mapcan (lambda (active-key)
+              (let* ((train-id (subseq active-key #.(length "X-active-")))
+                     (whole-key (format nil "~A-train-~A" code train-id))
+                     (data (trackernet::redis-last-cpk whole-key)))
+                (when data
+                  (list data))))
+            active)))
+
+(defun group-trains-by-destination (train-list)
+  (let ((dests (make-hash-table :test 'equal)))
+    (loop
+      for (observer train-obj) in train-list
+      do (let ((dest (or (trackernet::destination-desc train-obj)
+                         "???")))
+           (unless (gethash dest dests)
+             (setf (gethash dest dests) nil))
+           (push (list observer train-obj) (gethash dest dests))))
+    (sort
+     (alexandria:hash-table-alist dests)
+     (lambda (a b)
+       (string< (car a) (car b))))))
+
+(defun string-base64 (str)
+  (qbase64:encode-bytes
+   (flexi-streams:string-to-octets
+    str)))
+
+(defun display-trackernet-train (train)
+  (who:with-html-output-to-string (*standard-output* nil
+                                   :prologue nil)
+    (:tr
+     :class "train-desc govuk-table__row"
+     (:td ; Train ID
+      :class "govuk-table__cell id-field no-phones"
+      (who:esc (trackernet::train-id train)))
+     (:td ; Set/trip number
+      :class "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 ; Destination
+      :class "govuk-table__cell govuk-!-width-two-thirds"
+      (:span
+       (who:esc (or
+                 (trackernet::location-desc train)
+                 "<somewhere>"))
+       (who:str " ")
+       (:strong
+        :class "govuk-tag govuk-tag--grey train-track-code"
+        (who:esc (trackernet::track-code train))))))))
+
+(hunchentoot:define-easy-handler (line :uri "/line") (code)
+  (let ((line-data (tube-line-by-code code)))
+    (unless line-data
+      (setf (hunchentoot:return-code*) 404)
+      (hunchentoot:abort-request-handler "not found lol"))
+    (let* ((*accent-colour* (apply #'html-rgb-colour (third line-data)))
+           (active-trains (train-objects-on-line code))
+           (grouped (group-trains-by-destination active-trains)))
+      (render ()
+        (:a
+         :class "govuk-back-link"
+         :href "/"
+         "All Tube lines")
+        (:span
+         :class "govuk-caption-xl"
+         "Line overview")
+        (:h1
+         :class "govuk-heading-xl"
+         (who:fmt "~A line"
+                  (first line-data)))
+        (:p
+         :class "govuk-body-l"
+         (:strong
+          (who:str (length active-trains)))
+         " trains on the line as of "
+         (:span
+          :class "id-field"
+          (who:esc
+           (local-time:format-timestring
+            nil
+            (local-time:now)
+            :format
+            '((:year 4) #\- (:month 2) #\- (:day 2) #\Space
+              (:hour 2) #\: (:min 2) #\: (:sec 2)))))
+         ".")
+        (:p
+         :class "govuk-body"
+         "Jump to: "
+         (loop
+           with len = (length grouped)
+           for (group . trains) in grouped
+           for i from 1
+           do (who:htm
+               (:a
+                :class "govuk-link"
+                :href (format nil "#~A"
+                              (string-base64 group))
+                (who:esc group)))
+           unless (eql len i)
+             do (who:str " &middot; ")))
+        (:details
+         :class "govuk-details"
+         (:summary
+          :class "govuk-details__summary"
+          (:span
+           :class "govuk-details__summary-text"
+           "What do the columns mean?"))
+         (:div
+          :class "govuk-details__text"
+          (:ul
+           (:li
+            (:p
+             :class "govuk-body"
+             (:strong "TrainID")
+             (who:esc
+              " is a unique identifier given in the open data feeds. It's not entirely clear what, if anything, it correlates to in real life.")))
+           (:li
+            (:p
+             :class "govuk-body"
+             (:strong "LCID")
+             (who:esc
+              " (Leading Car ID) ostensibly identifies the leading car of the train in some way. We use this as our primary means of tracking trains.")))
+           (:li
+            (:p
+             :class "govuk-body"
+             (:strong "Track codes")
+             " "
+             (:strong
+              :class "govuk-tag govuk-tag--grey"
+              "ABCDEF")
+             (who:esc
+              " are arbitrary pieces of text describing a piece of track on the line. ")))
+           (:li
+            (:p
+             :class "govuk-body"
+             (:strong "WTT")
+             (who:esc
+              " gives the Train Number as found in the TfL ")
+             (:a
+              :href "https://tfl.gov.uk/corporate/publications-and-reports/working-timetables"
+              "Working Timetables (WTT)")
+             (who:esc
+              ". These are keyed in by train operators at the start of their journey, and can be moved around by Line Controllers if necessary.")
+             (:ul
+              (:li
+               (:p
+                :class "govuk-body"
+                (:strong
+                 :class "govuk-tag govuk-tag--pink"
+                 "NNN ×R")
+                (who:esc
+                 " denotes a train with WTT number NNN, on its Rth trip of the day.")))
+              (:li
+               (:p
+                :class "govuk-body"
+                (:strong
+                 :class "govuk-tag govuk-tag--green"
+                 "NNN")
+                (who:esc
+                 " denotes a train with WTT number NNN, on its first run of the day (or where no trip number info is available).")))))))))
+        (loop
+          for (group . trains) in grouped
+          do (who:htm
+              (:h2
+               :class "govuk-heading-l"
+               :id (string-base64 group)
+               (who:esc group))
+              (:table
+               :class "tube-line-list govuk-table"
+               (:thead
+                :class "govuk-table__head"
+                (:tr
+                 :class "govuk-table__row"
+                 (:th
+                  :class "govuk-table__header no-phones"
+                  (:abbr
+                   :title "TrackerNet unique identifier"
+                   "TrainID"))
+                 (:th
+                  :class "govuk-table__header"
+                  (: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"
+                  "Current location")))
+               (:tbody
+                :class "govuk-table__body"
+                (loop
+                  for (reporter train) in (sort trains #'string<
+                                                :key (lambda (trn)
+                                                       (trackernet::train-id (second trn))))
+                  do (who:str (display-trackernet-train train)))))))))))
+
+(hunchentoot:define-easy-handler (root :uri "/") ()
+  (render ()
+    (:h1
+     :class "govuk-heading-xl"
+     "Explore the London Underground")
+    (:p
+     :class "govuk-body-l"
+     "Get real-time, second-by-second updates on the movements of Tube trains. ")
+    (:table
+     :class "tube-line-list govuk-table"
+     (:thead
+      :class "govuk-table__head"
+      (:tr
+       :class "govuk-table__row"
+       (:th
+        :class "govuk-table__header"
+        "Line")
+       (:th
+        :class "govuk-table__header"
+        "Data status")
+       (:th
+        :class "govuk-table__header"
+        "Go")))
+     (:tbody
+      :class "govuk-table__body"
+      (loop
+        for (name code rgb) in *tube-line-data*
+        do (let ((ntrains (length (trackernet::trains-active-on-line code))))
+             (who:htm
+              (:tr
+               :class "tube-line govuk-table__row"
+               (:td
+                :class "tube-line-name govuk-table__cell"
+                (who:esc name))
+               (if (> ntrains 0)
+                   (who:htm
+                    (:td
+                     :class "tube-line-status govuk-table__cell"
+                     (:strong
+                      :class "govuk-tag govuk-tag--turquoise"
+                      (who:fmt "~A trains" ntrains))))
+                   (who:htm
+                    (:td
+                     :class "tube-line-status govuk-table__cell"
+                     (:strong
+                      :class "govuk-tag govuk-tag--grey"
+                      "Inactive"))))
+               (:td
+                :class "govuk-table__cell"
+                (:a
+                 :class "govuk-button govuk-button__start tube-line-button"
+                 :style (format nil "background: ~A;"
+                                (apply #'html-rgb-colour rgb))
+                 :role "button"
+                 :draggable "false"
+                 :href (format nil "/line?code=~A" code)
+                 (who:str *govuk-go-arrow-svg*)))))))))))
+
+(push (hunchentoot:create-folder-dispatcher-and-handler "/fonts/" "./fonts/")
+      hunchentoot:*dispatch-table*)
+
+(defun start-webserver ()
+  (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 5000)))