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

(defun parse-request (line)
  (string-trim-right line))

(defun nicknamep (string)
  (and (not (zerop (length string)))
       (not (string-match-p "[^a-zA-Z0-9]" string))))

(defvar-local client-state nil)
(defvar clients (make-hash-table :test #'equal))

(defun server-filter (process string)
  ;; (message "Received string (%s): %S" process string)
  (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)))
        ;; (message "Appended string (%s): %S" process string)
        (while (looking-at ".*\n")
          (let* ((line (buffer-substring (line-beginning-position)
                                         (line-end-position)))
                 (line (string-trim-right line)))
            (cond
             ((eq client-state 'connecting)
              (message "Processing connect from %S" line)
              (if (nicknamep line)
                  (let (other-users)
                    (maphash (lambda (client-proc nick)
                               (push nick other-users)
                               (message "Informing other client about join: %s (%s)" nick client-proc)
                               (process-send-string client-proc
                                                    (format "* %s joined the room\n" line)))
                             clients)
                    (process-send-string process
                                         (format "* names: %s\n"
                                                 (string-join other-users ", ")))
                    (puthash process line clients)
                    (setq client-state 'chatting))
                (process-send-string process "Invalid nickname\n")
                (delete-process process)
                (kill-buffer)))
             ((eq client-state 'chatting)
              (let ((nick (gethash process clients)))
                (message "Processing chat line (%s): %S" nick line)
                (maphash (lambda (client-proc client-nick)
                           (when (not (equal nick client-nick))
                             (process-send-string client-proc
                                                  (format "[%s] %s\n" nick line))))
                         clients)))))
          (forward-line 1))))))

(defun server-sentinel (process event)
  ;; (message "Event (%s): %S" process event)
  (when (not (process-buffer process))
    (set-process-buffer process (generate-new-buffer "budget-chat")))
  (cond
   ((string-match-p "^open from" event)
    (process-send-string process "Welcome to budgetchat! What's your name?\n")
    (with-current-buffer (process-buffer process)
      (setq client-state 'connecting)))
   ((eq (process-status process) 'closed)
    (let ((nick (gethash process clients)))
      (when nick
        (message "Processing disconnect from %s" nick)
        (remhash process clients)
        (maphash (lambda (client-proc _nick)
                   (ignore-errors
                     (process-send-string client-proc
                                          (format "* %s left the room\n" nick))))
                 clients)))
    (delete-process process)
    (kill-buffer (process-buffer process)))))

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

(defvar server
  (make-network-process
   :name "budget-chat"
   :server t
   :host "0.0.0.0"
   :service 10000
   :family 'ipv4
   :coding 'utf-8
   :filter #'server-filter
   :sentinel #'server-sentinel
   ;; :log #'server-log
   ))

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