(module problem03 ()

(import scheme)
(import (chicken base))
(import (chicken format))
(import (chicken io))
(import (chicken irregex))
(import (chicken port))
(import (chicken process signal))
(import (chicken string))
(import (chicken time))
(import (srfi 18))
(import (srfi 69))
(import socket)

(define stderr (current-error-port))
(set-buffering-mode! stderr #:line)

(define str string-append)

(define (string-trim-right string)
  (irregex-replace "[[:space:]]+$" string ""))

(define (elog fmt #!rest args)
  (apply fprintf stderr (str "[~s] " fmt) (current-process-milliseconds) args))

(define host "0.0.0.0")
(define port 10000)

(define backlog 10)
(socket-receive-timeout #f)

(define listener (socket af/inet sock/stream))
(set! (so-reuse-address? listener) #t)
(socket-bind listener (inet-address host port))
(socket-listen listener backlog)

(define (nickname? string)
  (and (not (zero? (string-length string)))
       (not (irregex-search "[^a-zA-Z0-9]" string))))

(define clients (make-hash-table))

(define (handle-client conn-socket)
  (elog "Incoming connection (~s)\n" conn-socket)
  (receive (in out) (socket-i/o-ports conn-socket)
    (display "Welcome to budgetchat! What's your name?\n" out)
    (let loop ((client-state 'connecting))
      (let ((line (read-line in)))
        (if (eof-object? line)
            (begin
              (let ((nick (hash-table-ref/default clients conn-socket #f)))
                (when nick
                  (elog "Processing disconnect from ~a\n" nick)
                  (hash-table-delete! clients conn-socket)
                  (for-each (lambda (client-socket)
                              (receive (in out) (socket-i/o-ports client-socket)
                                (fprintf out "* ~a left the room\n" nick)))
                            (hash-table-keys clients)))))
            (let ((line (string-trim-right line)))
              (case client-state
                ((connecting)
                 (elog "Processing connect from ~s\n" line)
                 (if (nickname? line)
                     (let ((other-nicks (hash-table-values clients)))
                       (elog "Informing other clients about join\n")
                       (for-each (lambda (client-socket)
                                   (receive (in out) (socket-i/o-ports client-socket)
                                     (fprintf out "* ~a joined the room\n" line)))
                                 (hash-table-keys clients))
                       (fprintf out "* names: ~a\n" (string-intersperse other-nicks ", "))
                       (hash-table-set! clients conn-socket line)
                       (loop 'chatting))
                     (begin
                       (close-input-port in)
                       (close-output-port out))))
                ((chatting)
                 (let ((nick (hash-table-ref clients conn-socket)))
                   (elog "Processing chat line (~a): ~a\n" nick line)
                   (hash-table-walk clients (lambda (client-socket client-nick)
                                              (when (not (equal? nick client-nick))
                                                (receive (in out) (socket-i/o-ports client-socket)
                                                  (fprintf out "[~a] ~a\n" nick line))))))
                 (loop client-state)))))))))

(let loop ()
  (let ((conn-socket (socket-accept listener)))
    (thread-start!
     (make-thread
      (lambda ()
        (handle-client conn-socket))))
    (loop)))

(set-signal-handler! signal/int (lambda (_) (socket-close listener) (exit 0)))

)