diff options
| -rw-r--r-- | lib/Server.hs | 1 | ||||
| -rwxr-xr-x | tools/obu-config | 20 | ||||
| -rwxr-xr-x | tools/obu-guess-trip | 5 | ||||
| -rwxr-xr-x | 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) |