@@ -15,6 +15,11 @@

    (%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)))

@@ -23,3 +28,82 @@

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

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

+

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

+  (declare (optimize (debug 3)))

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

+    #+nil (websocket-driver:start-connection client)))

+

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

+  (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 (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))))

@@ -202,22 +202,22 @@ Return a string with the generated JSON output."

                                              &rest args)

   (format *xxx* "~&~a: ~{~a~^ ~}~%" target args)

   (dbind* (&optional target-name target-id) (find-channel target)

-    (if target-name

-        (progn

-          (with (message (string-join args #\space))

-            (when-let* ((start-link (position #\< message))

-                        (stop-link (position #\> message :start start-link))

-                        (_ (> stop-link (+ 4 start-link))))

-              (setf message (concat (subseq message 0 start-link)

-                                    (subseq message (1+ start-link) stop-link)

-                                    (subseq message (1+ stop-link)))))

-            (queue-message event-pump target-id

-                           message))

-          (queue-message event-pump target-id

-                         (format nil "Notifying channel ~a" target-name)

-                         :thread (ensure-thread message)))

-        (queue-message event-pump target-id (format nil "Can't find channel `~a`" target)

-                       :thread (ensure-thread message)))))

+          (if target-name

+              (progn

+                (with (message (string-join args #\space))

+                  (when-let* ((start-link (position #\< message))

+                              (stop-link (position #\> message :start start-link))

+                              (_ (> stop-link (+ 4 start-link))))

+                    (setf message (concat (subseq message 0 start-link)

+                                          (subseq message (1+ start-link) stop-link)

+                                          (subseq message (1+ stop-link)))))

+                  (queue-message event-pump target-id

+                                 message))

+                (queue-message event-pump target-id

+                               (format nil "Notifying channel ~a" target-name)

+                               :thread (ensure-thread message)))

+              (queue-message event-pump target-id (format nil "Can't find channel `~a`" target)

+                             :thread (ensure-thread message)))))

 (defparameter *reaction-store* (make-hash-table :test 'equalp :synchronized t))

@@ -1,18 +1,5 @@

 (in-package :slacker)

-(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))))

-

 (defvar *api-token*) 

 (defun make-client (event-pump)

@@ -33,10 +20,14 @@

                               message)))

         (wsd:on :close client

                 (lambda (&key code reason)

-                  (format t "~&Closed with code: ~a for reason ~a. Restarting in 2 seconds~%" code reason)

-                  (sleep 2)

-                  (format t "~& ... restarting~%")

-                  (make-client event-pump)))

+                  (if (running event-pump)

+                      (progn

+                        (format t "~&Closed with code: ~a for reason ~a. Restarting in 2 seconds~%"

+                                code reason)

+                        (sleep 2)

+                        (format t "~& ... restarting~%")

+                        (make-client event-pump))

+                      (format t "~&exiting~%"))))

         (wsd:start-connection client)))))

 (defgeneric send-message (client type &key)

@@ -75,11 +66,6 @@

                       :test 'equal)))

-(defgeneric start-module (client module)

-  (:documentation "start a module"))

-(defgeneric stop-module (client module)

-  (:documentation "stop a module"))

-

 (define-condition connection-lost (error)

   ())

@@ -109,29 +95,6 @@

       (send-message event-pump :ping)

       (error 'connection-lost)))

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

-  (declare (optimize (debug 3)))

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

-    (websocket-driver:start-connection client)))

-

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

-  (setf (running event-pump) nil)

-  (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))))))

-

-(defmethod fwoar.event-loop:tick ((task event-pump))

-  (handle-work-queue task)

-  (maybe-ping task)

-  (sleep (slot-value task '%tick-pause)))

-

 (defun network-loop (event-pump modules)

   (declare (optimize (debug 3)))

   (loop for (module . args) in modules