;; -*- lexical-binding: t; -*-
(require 'bindat)
(require 'subr-x)

(defvar-local asset-prices nil)

(defconst message-length 9)

(defvar message-bindat-spec
  (bindat-type
   (type u8)
   (arg uint 32)
   (arg2 uint 32)))

(defvar uint32-bindat-spec
  (bindat-type
    (arg uint 32)))

(bindat-pack uint32-bindat-spec '((arg . 0)))

(defconst sint32-max (ash 1 (1- 32)))
(defconst uint32-max (* sint32-max 2))

(defun uint32-to-sint32 (n)
  (if (>= n sint32-max)
      (- n uint32-max)
    n))

(defun sint32-to-uint32 (n)
  (if (< n 0)
      (+ uint32-max n)
    n))

(defun parse-request (message)
  (let ((parsed (bindat-unpack message-bindat-spec message)))
    `( :type ,(bindat-get-field parsed 'type)
       :arg ,(uint32-to-sint32 (bindat-get-field parsed 'arg))
       :arg2 ,(uint32-to-sint32 (bindat-get-field parsed 'arg2)))))

(parse-request "\x49\x00\x00\x30\x39\x00\x00\x00\x65")
(parse-request "\x51\x00\x00\x03\xe8\x00\x01\x86\xa0")

(defun process-request (request)
  (let ((type (plist-get request :type))
        (arg (plist-get request :arg))
        (arg2 (plist-get request :arg2)))
    (cond
     ((char-equal type ?I)
      (message "Insertion request (%d, %d)" arg arg2)
      (puthash arg arg2 asset-prices)
      nil)
     ((char-equal type ?Q)
      (message "Query request (%d, %d)" arg arg2)
      (let ((keys (sort (hash-table-keys asset-prices) #'<=))
            (sum 0)
            (n 0))
        (dolist (key keys)
          (when (and (>= key arg) (<= key arg2))
            (setq sum (+ sum (gethash key asset-prices)))
            (setq n (1+ n))))
        (cond
         ((zerop n)
          (message "Query response: 0 (no entries)")
          (bindat-pack uint32-bindat-spec '((arg . 0))))
         ((> arg arg2)
          (message "Query response: 0 (invalid range)")
          (bindat-pack uint32-bindat-spec '((arg . 0))))
         (t
          (let ((mean (round (/ sum n))))
            (message "Query response: %d (%d, %d)" mean sum n)
            (bindat-pack uint32-bindat-spec `((arg . ,mean))))))))
     (t
      "\xde\xad\xbe\xef"))))

(defun server-filter (process string)
  (when (not (process-buffer process))
    (let ((buf (generate-new-buffer "prime-time")))
      (set-process-buffer process buf)
      (with-current-buffer buf
        (set-buffer-multibyte nil))))
  (let ((buf (process-buffer process)))
    (when (buffer-live-p buf)
      (with-current-buffer buf
        (save-excursion
          (goto-char (process-mark process))
          (insert string)
          (set-marker (process-mark process) (point)))
        (when (not asset-prices)
          (setq asset-prices (make-hash-table :test #'equal)))
        (while (>= (- (point-max) (point)) message-length)
          (let* ((message (buffer-substring (point) (+ (point) message-length)))
                 (request (parse-request message))
                 (response (process-request request)))
            (when response
              (process-send-string process response))
            (goto-char (+ (point) message-length))))))))

(defun server-sentinel (process event)
  (when (eq (process-status process) 'closed)
    (kill-buffer (process-buffer process))
    (delete-process process)))

;; (defun server-log (server connection message)
;;   (message "%s (%s): %s" server connection message))

(defvar server
  (make-network-process
   :name "means-to-an-end"
   :server t
   :host "0.0.0.0"
   :service 10000
   :family 'ipv4
   :coding 'binary
   :filter #'server-filter
   :sentinel #'server-sentinel
   ;; :log #'server-log
   ))

(while t
  (accept-process-output nil 0.01))