#!/usr/bin/env gosh

(use rfc.json)
(use rfc.uri)
(use rfc.http)
(use srfi-19)
(use file.util)
(use util.match)
(use gauche.parseopt)
(use gauche.process)
(use text.edn)
(use scheme.mapping.hash)

(define (show-help progname)
  (display (format
"~a: tracktrain's on-board reporting thing. Excepts input to be
piped from gpsd's `gpspipe --json` onto stdin.

Arguments:
 -u --url: base url of the tracktrain server [required]
 -n: number of positions to fetch (default is to loop forever)
 -d --no-ping: just print the positions, don't send anything
 -s --statefile: state file
 -c --config: config file (default is /etc/tracktrain/obu.conf)
 -h --help: display this help
" progname))
  (exit 0))

(define (main args)
  (let-args
   (cdr args)
   ((statefile "s|state=s")
    (baseurl "u|url=s")
    (n "n=i")
    (no-ping "d|no-ping")
    (help "h|help" => (cut show-help (car args)))
    . restargs)
   (if (and (equal? baseurl #f) (equal? no-ping #f))
       (show-help (car args))
       (with-input-from-process
        '(gpspipe --json)
        (cut report-position
             (if (equal? statefile #f) "./obu-state.edn" statefile)
             baseurl
             n
             no-ping)
        :on-abnormal-exit :ignore))
   (exit 0)))


(define (try-get-current-pos)
  (define json
    (parameterize
      ; replace all json keys with symbols; everything else is confusing
      ([json-object-handler
        (cut map (lambda p `(,(string->symbol (car (car p))) . ,(cdr (car p)))) <>)])
      (parse-json)))
  (define class
    (assoc-ref json 'class))
  (match class
    ("TPV" `((lat . ,(assoc-ref json 'lat))
                      (lon . ,(assoc-ref json 'lon))
                      (time . ,(assoc-ref json 'time))))
    (_ (try-get-current-pos))))

(define json-symbol-key
  (cut map (lambda p `(,(string->symbol (car (car p))) . ,(cdr (car p)))) <>))

(define (report-position statefile url n no-ping)
  (define trip
    (if no-ping #f
    (process-output->string `(obu-guess-trip -u ,url))))
  (define token
    (if no-ping #f (get-token url trip statefile)))
  (if n
    (dotimes (i n)
      (ping-pos statefile url token))
    (while #t
      (ping-pos statefile url token))))

(define (ping-pos dir 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))))))

(define (get-token url trip statefile)
  (define cached?
    (with-input-from-process `(obu-config -s ,statefile token) read))
  (if cached?
      (symbol->string cached?)
      (let* ([token (fetch-token url trip)])
        (do-process `(obu-config -s ,statefile token ,token))
        token)))

(define (fetch-token url trip)
  (define tls
    (equal? (uri-ref url 'scheme) 'https))
  (display (format "fetching new token for trip ~a…\n" trip))
  (parameterize
      ; replace all json keys with symbols; everything else is confusing
      ([json-object-handler json-symbol-key])
    (parse-json-string
     (values-ref (http-post
                  (uri-ref url 'host+port)
                  (format "/api/train/register/~a" trip)
                  (construct-json-string '((agent . "onboard-unit")))
                  :content-type "application/json"
                  :secure tls)
                 2))))

(define (ping url token pos)
  (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))))