From e029a031050e08599f9d6d5fa654c17d985039c1 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 26 May 2023 21:07:48 +0200
Subject: expose sequence length of trip to onboard unit

---
 lib/Server.hs        |  1 +
 tools/obu-config     | 20 +++++++++++++-------
 tools/obu-guess-trip |  5 ++++-
 tools/obu-ping       | 38 +++++++++++++++++++++++---------------
 4 files changed, 41 insertions(+), 23 deletions(-)

diff --git a/lib/Server.hs b/lib/Server.hs
index d6e9955..7ebaca5 100644
--- a/lib/Server.hs
+++ b/lib/Server.hs
@@ -107,6 +107,7 @@ server gtfs@GTFS{..} Metrics{..} subscribers dbpool settings = handleDebugAPI
           where mkJson :: Trip Deep Deep -> A.Value
                 mkJson Trip {..} = A.object
                   [ "trip" .= tripTripID
+                  , "sequencelength" .= (stopSequence . V.last) tripStops
                   , "stops" .= fmap (\Stop{..} -> A.object
                     [ "departure" .= stopDeparture
                     , "station" .= stationId stopStation
diff --git a/tools/obu-config b/tools/obu-config
index 0cce2ee..d635834 100755
--- a/tools/obu-config
+++ b/tools/obu-config
@@ -16,14 +16,16 @@ give just the key to look something up
 
 Options:
  -s --statefile: state file
+ -d --delete: explicitly delete an entry
  -h --help: display this help
-" progname))
+" progname progname))
   (exit 0))
 
 (define (main args)
   (let-args
    (cdr args)
    ((statefile "s|state=s")
+    (delete "d|delete")
     (help "h|help" => (cut show-help (car args)))
    . restargs)
 
@@ -32,28 +34,32 @@ Options:
         "./obu-state.edn"
         statefile))
 
-  (if (= (length restargs) 2)
+  (if (or delete (= (length restargs) 2))
       (set file
            (list-ref restargs 0)
-           (list-ref restargs 1))
+           (if delete #f (list-ref restargs 1))
+           delete)
       (display
        (get file
             (list-ref restargs 0))))
   (exit 0)))
 
-(define (set file key value)
+(define (set file key value delete)
   (define data
     (if (file-exists? file)
         (call-with-input-file file parse-edn)
         (edn-map)))
   (define data2
-    (hashmap-set data (string->symbol key) value))
+    (if delete
+        (hashmap-delete data (string->symbol key))
+        (hashmap-set data (string->symbol key) value)))
   (call-with-output-file file
     (cut construct-edn data2 <>)))
 
 (define (get file key)
   (if (file-exists? file)
-      (hashmap-ref
+      (guard (e [else #f])
+        (hashmap-ref
        (call-with-input-file file parse-edn)
-       (string->symbol key))
+       (string->symbol key)))
       #f))
diff --git a/tools/obu-guess-trip b/tools/obu-guess-trip
index 305ec8d..b9264f6 100755
--- a/tools/obu-guess-trip
+++ b/tools/obu-guess-trip
@@ -43,7 +43,10 @@ Arguments:
   (define stops (fetch-stations url))
   (define pos
     (with-input-from-process `(obu-ping -s ,statefile -n 1 -d) read))
-  (define trip (assoc-ref (closest-stop-to stops pos) 'trip))
+  (define guessed
+    (closest-stop-to stops pos))
+  (define trip (assoc-ref guessed 'trip))
+  (do-process `(obu-config -s ,statefile sequencelength ,(assoc-ref guessed 'sequencelength)))
   (display trip))
 
 (define (closest-stop-to stops pos)
diff --git a/tools/obu-ping b/tools/obu-ping
index 2897e23..8d0a84a 100755
--- a/tools/obu-ping
+++ b/tools/obu-ping
@@ -78,11 +78,11 @@ Arguments:
     (while #t
       (ping-pos statefile url token))))
 
-(define (ping-pos dir url token)
+(define (ping-pos statefile url token)
   (let ([pos (try-get-current-pos)])
     (display (format "~a\n" pos))
     (if (not (equal? token #f))
-        (display (format "server: ~a\n" (ping url token pos))))))
+        (display (format "server: ~a\n" (ping url token pos statefile))))))
 
 (define (get-token url trip statefile)
   (define cached?
@@ -109,18 +109,26 @@ Arguments:
                   :secure tls)
                  2))))
 
-(define (ping url token pos)
+(define (ping url token pos statefile)
   (define tls
     (equal? (uri-ref url 'scheme) "https"))
-  (parameterize ([json-object-handler json-symbol-key])
-    (parse-json-string
-     (values-ref (http-post
-                  (uri-ref url 'host+port)
-                  "/api/train/ping"
-                  (construct-json-string `((token . ,token)
-                                           (lat . ,(assoc-ref pos 'lat))
-                                           (long . ,(assoc-ref pos 'lon))
-                                           (timestamp . ,(assoc-ref pos 'time))))
-                  :content-type "application/json"
-                  :secure tls)
-                 2))))
+  (define anchor
+    (parameterize ([json-object-handler json-symbol-key])
+      (parse-json-string
+       (values-ref (http-post
+                    (uri-ref url 'host+port)
+                    "/api/train/ping"
+                    (construct-json-string `((token . ,token)
+                                             (lat . ,(assoc-ref pos 'lat))
+                                             (long . ,(assoc-ref pos 'lon))
+                                             (timestamp . ,(assoc-ref pos 'time))))
+                    :content-type "application/json"
+                    :secure tls)
+                   2))))
+  (define sequencelength
+    (guard [e (else 100000)]
+      (with-input-from-process `(obu-config -s ,statefile sequencelength) read)))
+  (if (> (assoc-ref anchor 'sequence) (sequencelength - 0.2))
+      (do-process `(obu-config -s ,statefile -d token))
+      #f)
+  anchor)
-- 
cgit v1.2.3