(in-package :slacker)
 

 (defclass queue-pair ()
   ((%work-queue :initarg :work-queue :reader work-queue :initform (make-instance 'chanl:unbounded-channel))
    (%result-queue :initarg :result-queue :reader result-queue :initform (make-instance 'chanl:unbounded-channel))))
 

 (defclass event-pump ()

   ((%tick-pause :initform 0.01)
    (%running :accessor running :initform nil)

    (%finish-cb :accessor fwoar.event-loop:finish-cb :initform nil)

    (%ws-client :accessor ws-client :initarg :ws-client :initform nil)

    (%waiting-pings :accessor waiting-pings :initform 0)
    (%modules :accessor modules :initform (make-hash-table))

    (%client-factory :reader client-factory :initarg :client-factory :initform (error "must provide a client factory"))

    (%latest-id :accessor latest-id :initform 0)

    (%queue-pair :accessor queue-pair :initarg :queue-pair :initform (make-instance 'queue-pair))))
 

 (defgeneric start-module (client module)
   (:documentation "start a module"))
 (defgeneric stop-module (client module)
   (:documentation "stop a module"))
 

 (defmethod result-queue ((obj event-pump))
   (result-queue (queue-pair obj)))
 
 (defmethod work-queue ((obj event-pump))
   (work-queue (queue-pair obj)))

 (defun clear-waiting-pings (event-pump)
   (setf (waiting-pings event-pump) 0))

 
 (defmethod fwoar.event-loop:prepare-loop ((event-pump event-pump))

   (funcall (client-factory event-pump)
            event-pump))

 
 (defmethod fwoar.event-loop:cleanup ((event-pump event-pump))

   (format t "~&cleaning up...~&")

   (setf (running event-pump) nil)
   (do-hash-table (_ v (modules event-pump))
     (declare (ignore _))
     (stop-module event-pump v))
   (when (ws-client event-pump)
     (wsd:close-connection (ws-client event-pump))))
 
 (let ((last-ping nil))
   (defun maybe-ping (event-pump)
     (let ((current-time  (get-universal-time)))
       (when (or (null last-ping)
                 (< 15 (- current-time last-ping)))
         (setf last-ping current-time)
         (websocket-driver:send-ping (ws-client event-pump))))))
 
 
 (defun handle-work-queue (event-pump)
   (multiple-value-bind (message message-p)
       (chanl:recv (work-queue event-pump)
                   :blockp nil)
     (when message-p
       (funcall message
                event-pump))))
 
 (defmethod fwoar.event-loop:tick ((task event-pump))
   (handle-work-queue task)
   (maybe-ping task)
   (sleep (slot-value task '%tick-pause)))
 
 (defmethod attach-module ((event-pump event-pump) module &rest args &key)
   (setf (gethash (make-keyword module)
                  (modules event-pump))
         (apply #'make-instance
                module
                args)))
 
 (defgeneric get-module (module event-pump)
   (:documentation "Get one of the activated modules")
   (:method (module (event-pump event-pump))
     (gethash (make-keyword module)
              (modules event-pump))))
 
 (defun stop-slacker (event-pump)

   (funcall (fwoar.event-loop:finish-cb event-pump)))

 
 (defun throttle-continue (num)
   (let ((continue-count 0)
         (now (local-time:now)))
     (lambda (&optional condition)
       (format t "~&~s ~s~%" now continue-count)
       (when (< continue-count num)
         (let ((new-now (local-time:now)))
           (if (< (* 1000 (local-time:timestamp-difference new-now now))
                  5)
               (incf continue-count)
               (setf now new-now
                     continue-count 0))
           (continue condition))))))
 
 (defun test-event-pump ()
   (let ((the-event-pump (make-instance 'event-pump :client-factory 'identity)))
     (chanl:send (work-queue the-event-pump)
                 (lambda (a)
                   (error "test")))
     (chanl:send (work-queue the-event-pump)
                 (lambda (a)
                   (format t "This should happen ~s~%" a)))
     (bt:make-thread (lambda ()
                       (sleep 5)
                       (funcall (finish-cb the-event-pump))))
     (handler-bind ((serious-condition #'continue))
       (fwoar.event-loop:run-loop the-event-pump))))