fix stupid archiving / rescue behaviours, use log4cl, reorg code

deploy.sh

@@ -1,3 +1,2 @@
 #!/bin/sh
-echo '*** NB: press Enter after the text stops scrolling past!'
-sbcl < deploy.txt
+sbcl --noinform --load deploy.txt

deploy.txt

@@ -1,5 +1,6 @@
-(ql:quickload '(drakma cl-conspack cxml cl-statsd cl-redis qbase64 archive cl-ansi-text gzip-stream bobbin cl-heap local-time))
+(ql:quickload '(drakma cl-conspack cxml cl-statsd cl-redis qbase64 archive cl-ansi-text gzip-stream bobbin cl-heap local-time log4cl) :silent t)
 (load "trackernet.lisp")
+(require :sb-sprof)
 (format t "** Loaded ~A track links **~%" (hash-table-size trackernet::*normalized-track-links*))
 (sb-ext:save-lisp-and-die "./intertube-scraper" :toplevel #'trackernet::main :executable t) 
 

wobsite.lisp

@@ -129,6 +129,11 @@
 <path fill=\"currentColor\" d=\"M0 0h13l20 20-20 20H0l20-20z\" />
 </svg>")
 
+(defparameter *govuk-go-arrow-small-svg*
+  "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"8.75\" height=\"9.5\" 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)
@@ -224,7 +229,7 @@
              do (write-byte byte out))
         (close in)))))
 
-(defun display-trackernet-train (train &key code ts reporter distance)
+(defun display-trackernet-train (train &key code ts reporter distance show-dest maybe-hide-codes)
   (who:with-html-output-to-string (*standard-output* nil
                                    :prologue nil)
     (:tr
@@ -266,13 +271,26 @@
       :class "govuk-table__cell id-field no-phones"
       (unless (string= (trackernet::lcid train) "0")
         (who:esc (trackernet::lcid train))))
-     (:td ; Destination
+     (:td ; Location / destination
       :class "govuk-table__cell govuk-!-width-two-thirds"
       (:span
        (who:esc (or
+                 (cdr (assoc (trackernet::track-code train)
+                             (cached-track-suggestions "D")
+                             :test #'string=))
                  (trackernet::location-desc train)
                  "<somewhere>"))
        (who:str " ")
+       (when show-dest
+         (who:htm
+          (:span
+           :style "color: darkgray;"
+           (who:str *govuk-go-arrow-small-svg*)
+           " "
+           (who:esc (or
+                     (trackernet::destination-desc train)
+                     "<somewhere>")))
+          (who:str " ")))
        (when code
          (who:htm
           (:a
@@ -284,7 +302,8 @@
        (when reporter
          (who:htm
           (:strong
-           :class "govuk-tag govuk-tag--yellow train-reporter"
+           :class "govuk-tag govuk-tag--yellow train-reporter no-phones"
+           :style "float: right; margin-left: 10px;"
            (who:esc reporter))
           (who:str " ")))
        (when (and code
@@ -294,8 +313,17 @@
           (:strong
            :class "govuk-tag govuk-tag--red train-stale"
            "Stale")))
-       (:strong
-        :class "govuk-tag govuk-tag--grey train-track-code"
+       (:a
+        :href (multiple-value-bind (around hmac)
+                  (trusted-serialize (list (trackernet::track-code train)))
+                (format nil "/miniviz?around=~A&hmac=~A"
+                        (hunchentoot:url-encode
+                         around)
+                        (hunchentoot:url-encode
+                         hmac)))
+        :class (if maybe-hide-codes
+                   "govuk-tag govuk-tag--grey train-track-code no-phones"
+                   "govuk-tag govuk-tag--grey train-track-code")
         (who:esc (trackernet::track-code train))))))))
 
 (defparameter *max-train-lines* 100)
@@ -443,6 +471,7 @@
         :class "govuk-table__body"
         (loop
           with last = nil
+          with last-dest = nil
           for (ts reporter train) in train-data
           for i from 0
           unless (or
@@ -450,7 +479,9 @@
                   (>= i max-to-show))
             do (who:str (display-trackernet-train train
                                                   :ts ts
+                                                  :show-dest (not (string= (trackernet::destination-desc train) last-dest))
                                                   :reporter reporter))
+               (setf last-dest (trackernet::destination-desc train))
                (setf last (trackernet::track-code train))))
        (unless (>= max-to-show train-data-len)
          (who:htm
@@ -511,7 +542,8 @@
                         (cdr match))))
           `((:name . ,name)
             (:code . ,(car match)))))
-      matches))))
+      (delete-if (lambda (match) (string= (cdr match) "At Platform"))
+                 matches)))))
 
 (defun now-london-time-str ()
   (local-time:format-timestring
@@ -587,6 +619,8 @@
             for (distance key train) in train-list
             do (who:str (display-trackernet-train train
                                                   :distance distance
+                                                  :maybe-hide-codes t
+                                                  :show-dest t
                                                   :code key)))))))))
 
 (hunchentoot:define-easy-handler (line :uri "/line") (code)
@@ -641,7 +675,7 @@
           (:div
            :id "trackcode-hint"
            :class "govuk-hint"
-           "Start typing the name of a station, platform, or track code.")
+           "Start typing the name of a station to show a list of options.")
           (:div
            :id "trackcode-autocomplete-container"
            (:input
@@ -830,7 +864,7 @@
 (push (hunchentoot:create-folder-dispatcher-and-handler "/fonts/" "./fonts/")
       hunchentoot:*dispatch-table*)
 
-(defparameter *redis-port* 3000)
+(defparameter *redis-port* 6379)
 
 (defmethod hunchentoot:acceptor-dispatch-request :around (acceptor request)
   (redis:with-connection (:port *redis-port*)