SimpleQ

core.clj

(ns simpleq.core)

(defn- start-simpleq-thread-loop [q thread-active exception]
  (.start (Thread.
           #((comment println "Thread started")
             
             (loop [expr (first @q)]
               (comment println "Sleeping for 2 sec")
               (comment Thread/sleep 2000)
               (comment println (str "Executing " expr))
               (try
                 (eval expr)
                 (catch Exception e
                   (dosync
                    (ref-set thread-active false)
                    (ref-set exception [expr e]))))
               (dosync (alter q (comp vec rest)))
               (dosync (when-not (first @q)
                         (ref-set thread-active false)))
               (when @thread-active
                 (recur (first @q)))))))
  )

(defn new-simpleq []
  (let [q (ref [])
        thread-active (ref false)
        exception (ref nil)]
    (fn [expr]
      (condp = expr
        :exception @exception
        :continue (when @exception
                    (dosync
                     (alter q (comp vec rest))
                     (ref-set thread-active true)
                     (ref-set exception nil))
                    (start-simpleq-thread-loop q thread-active exception))
        (do
          (when @exception
            (throw (Exception. "Simple Q had an exception")))
          (comment println (str "Q:" @q))
          (dosync (alter q conj expr))
          (comment println (str "T-A:" @thread-active))
          (dosync
           (when-not @thread-active
             (ref-set thread-active true)
             (start-simpleq-thread-loop q thread-active exception))))))))

(defn test-simpleq-fn [sq expr]
  (try
    (sq expr)
    (catch Exception e
      (let [exc (sq :exception)]
        (println e)
        (println (str "Caused by:" exc))
        (sq :continue)
        (when-not (= (first exc) expr)
          (sq expr))))))

(defn test-simpleq-pr [sq msg] 
  (test-simpleq-fn sq `(do (Thread/sleep 2000) (println ~msg))))

(defn test-simpleq-thread [sq]
  (test-simpleq-pr sq "**** 1")
  (test-simpleq-fn sq '(do (Thread/sleep 2000) (println "**** 2")))
  (test-simpleq-fn sq '(do (Thread/sleep 2000) (println "**** 3")))
  (println (str "EXC: "(sq :exception)))
  (test-simpleq-fn sq '(/ 1 0))
  (test-simpleq-fn sq '(do (Thread/sleep 2000) (println "**** 4")))
  (test-simpleq-fn sq '(do (Thread/sleep 2000) (println "**** 5")))
  (Thread/sleep 10000)
  (test-simpleq-fn sq '(do (Thread/sleep 2000) (println "**** 6"))))

(defn test-simpleq []
  (let [sq (new-simpleq)]
    (test-simpleq-thread sq)))