;;;  see next comments on how to start this

;; boat service:
(use matchable medea spiffy uri-common intarweb comparse intarweb)
;; (server-port 8888)
(match (command-line-arguments)
  ((port)
   (server-port (string->number port)))
  (else (print "usage: <port>\n
- send geojson (boats) on stdin.
- /arp-boats REST interface")
        (exit 1)))

;; workaround for blocking on i/o when reading json from stdin
(include "nonblocking-input-ports.scm")
(current-input-port (open-input-file*/nonblock 0))

;; ==================== debug

(thread-start! (lambda () (use nrepl) (nrepl 1234)))


;; ==================== utils

;; ==================== reser ====================
;; TODO: release reser egg and make don't embed it here
(define (request-string!)
  ;; TODO: what to do is we have more than 16MB? we can't just ignore it all.
  (read-string (min (* 16 1024 1024) ;; <- max 16MB
                    (or (header-value 'content-length (request-headers (current-request))) 0))
               (request-port (current-request))))

(define (reser-handler handler)

  (define request `((body    . ,(request-string!))
                    (uri     . ,(request-uri (current-request)))
                    (headers . ,(request-headers (current-request)))
                    (method  . ,(request-method (current-request)))))

  (define resp (handler request))

  (send-response body:    (or (alist-ref 'body resp) "")
                 status:  (alist-ref 'status resp)
                 code:    (alist-ref 'code resp)
                 reason:  (alist-ref 'reason resp)
                 headers: (or (alist-ref 'headers resp) '())))
;; construct a response object
(define (response #!key body status code reason headers)
  `((body    . ,body)
    (status  . ,status)
    (code    . ,code)
    (reason  . ,reason)
    (headers . ,headers)))

;; call handler with an exception handler, and log error to request
;; response instead of stderr.
(define ((wrap-errors handler) r)
  (handle-exceptions
   exn
   (response body: (conc (get-condition-property exn 'exn 'message) ": "
                         (get-condition-property exn 'exn 'arguments) "\n"
                         (with-output-to-string (lambda () (pp (condition->list exn)))))
             status: 'bad-request)
   (handler r)))

;; append \n at end of server response. makes it terminal friendly
(define ((wrap-trailing-newline handler) r)
  (let ((resp (handler r)))
    (alist-update 'body (string-append (or (alist-ref 'body resp) "") "\n") resp)))

;; access domain-name string, use "*" to give everybody access
;; ((wrap-cors-headers "*" (lambda _ (response headers: (headers `((abd "klm")))))) '())
;; ((wrap-cors-headers "*" (lambda _ (response body: "hi"))) '())
(define ((wrap-cors-headers access handler) r)
  (let ((response (handler r)))
    (alist-update 'headers
                  (alist-update 'Access-Control-Allow-Origin
                                (list access)
                                (or (alist-ref 'headers response) '()))
                  response)))

;; ==================== globals

(define state '())

(define (limit lst num)
  (take lst (min (length lst) num)))

;; ==================== boat utils

(define (geojson-mmsi geojson)
  (alist-ref 'mmsi (or (alist-ref 'properties geojson) '())))

;; (pp (extract (include "./boat.data.scm")))

;; input: alist ((pos . (lat . lon)) (mmsi . mmsi))
;; state is a map of <mmsi>:<properties>
(define (prj-geojson geojson state)
  ;; set properties for mmsi key:
  (alist-update (geojson-mmsi geojson) ;; key (mmsi)
                geojson ;; value (geojson feature)
                state))

;; (rect-inside? 0 0  1 -1 -1 1)
(define (rect-inside? x y top left bottom right)
  (and (>= x left)   (<= x right)
       (>= y bottom) (<= y top)))

;; (length (filter (lambda (pair) (geojson-inside? (cdr pair) 61 5 60 6)) _state))

(define (geojson-inside? geojson top left bottom right)
  (and-let* ((gm (alist-ref 'geometry geojson))
             (pos (alist-ref 'coordinates gm))
             (lon (vector-ref pos 0))
             (lat (vector-ref pos 1)))
            (and lon lat (rect-inside? lon lat top left bottom right))))

;; query boats based on region (bounding box). typical json is "[60,
;; 5, 61, 5.5]"
(define (bb-query state bbox)
  ;; bad naming here, sorry. need a rect abstraction
  (define (corner x) (vector-ref bbox x))
  (define result
    (filter (lambda (pair)
              (geojson-inside? (cdr pair)
                               (corner 0) (corner 1)
                               (corner 2) (corner 3)))
            state))

  (print ", found " (length result) "/" (length state) " boats")


  (json->string
   `((type . "FeatureCollection")
     (features . ,(list->vector (limit (map cdr result) 100))))))


;; (mmsi-query state `((mmsi . #(257999279 257605000))))
(define (mmsi-query state json)

  (define (->vector x) (if (vector? x) x (vector x)))
  (define (->fixnum x) (if (number? x) x (string->number x)))

  (let ((boats (map ->fixnum
                    (vector->list
                     (->vector
                      (or (alist-ref 'mmsi json)
                          (error "request missing mmsi field")))))))
    (define result (filter (lambda (pair) ;; (mmsi . alist)
                             (member (car pair) boats))
                           state))
    (json->string `((type . "FeatureCollection")
                    (features . ,(list->vector (map cdr result)))))))


(define (query-handler json)
  (print "boats: got query " json)
  (if json
      (if (vector? json)
          (response body: (bb-query state json))
          (response body: (mmsi-query state json)))
      (response status: 'bad-request body: "invalid geojson query" json)))

;; uri to bounding-box query. ie:
;; (uri-bbq (uri-reference "?bb=1/2/3/4"))
;; (uri-bbq (uri-reference "?nothing=false"))
(define (uri-bbq uri)
  (and-let* ((bb (alist-ref 'bb (uri-query uri))))
            (list->vector (map string->number (string-split bb "/")))))

(define (top-handler r)
  (match (uri-path (alist-ref 'uri r))
    (('/ "arp-boats")
     ;; - try picking the bb query parameter from GET request
     ;; - try reading the json payload (POST request)
     (query-handler (or (uri-bbq (alist-ref 'uri r))
                        (read-json (alist-ref 'body r)))))
    (else (response status: 'bad-request))))

;; you can test by evaluating this:
;; (app `((uri . ,(uri-reference "/arp-boats?bb=1/2/3/4")) (body . "")))
(define app (wrap-cors-headers
             "*" ;; give everybody "ajax" access
             (wrap-errors
              (wrap-trailing-newline (lambda (r) (top-handler r))))))


(define server-thread
  (thread-start!
   (lambda ()
     (vhost-map `((".*" . ,(lambda (c) (reser-handler (lambda (r) (app r)))))))
     (start-server))))

(define count 0)
(let loop ((input (current-input-port)))
  (receive (json rest) (read-json input)
    (set! count (add1 count))
    (set! state (prj-geojson json state))
    (if (not (parser-input-end? rest))
        (loop rest))))