;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;; Trivial Job tracker
(in-package :philip-jose)

;;; Simple worker...
(defparameter *job-handlers* (make-hash-table :test #'equal))

(def*fun register-job-handler (x func)
  (setf (gethash x *job-handlers*) func))

(def*macro defun-job (name formals &body body)
  `(progn
     (defun ,name ,formals ,@body)
     (register-job-handler ,(conc-keyword name) #',name)))

(def*fun call-job-handler (f &rest args)
  (let ((fun (gethash f *job-handlers*)))
    (if fun
      (apply fun args)
      (error "Not a registered response type ~S" f))))

(defun worker-step (&key completed results error (server "localhost") (port *port*))
  (flet ((result-keys ()
           (when completed
             (list* :completed completed
                    (append
                     (when results (list :results results))
                     (when error (list :error error)))))))
    (let ((work
           (flet ((handle-error (x)
                    (logger "~&Error while talking to server: ~A" x)
                    #+sbcl (sb-impl::backtrace 20 t)
                    (throw 'wemh nil)))
             (catch 'wemh
               (with-error-message-handler (handle-error)
                 (simple-client
                  (list* :worker-request (get-id) (result-keys))
                  server port))))))
      (setf completed nil results nil error nil)
      (cond
        ((null work)
         (logger "~&No work to do")
         (fsleep *sleep-delay*))
        (t         
         (logger "~&Work to do: ~S" work)
         ((lambda (x) (apply x (rest work)))
          (ecase (first work)
            (:sleep  #'fsleep)
            (:die #'exit)
            (:job (lambda (&key id description)
                    (setf completed id results
                          (flet ((handle-error (x)
                                   (logger "~&Error while processing ~S: ~A" description x)
                                   (setf error x)
                                   (throw 'wemh nil)))
                            (catch 'wemh
                              (with-error-message-handler (handle-error)
                                (multiple-value-list
                                 (apply #'call-job-handler description))))))))))))
      (result-keys))))

(defun worker-loop (&key (server "localhost") (port *port*))
  (let ((keys nil))
    (loop
      (setf keys
            (handler-case
                (apply #'worker-step :server server :port port keys))))))