Message queue: improve eoq-backoff design (atomic, single-tcp req, pttl sleep)

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -23,15 +23,14 @@
 ;;;; Public utils

 (defn exp-backoff "Returns binary exponential backoff value."
-  [attempt & [{:keys [factor min max]
-               :or   {factor 2000}}]]
+  [attempt & [{:keys [factor min max] :or {factor 2200}}]]
   (let [binary-exp (Math/pow 2 (dec attempt))
         time (* (+ binary-exp (rand binary-exp)) 0.5 factor)]
     (long (let [time (if min (clojure.core/max min time) time)
                 time (if max (clojure.core/min max time) time)]
             time))))

-(comment (map #(exp-backoff % {}) (range 10)))
+(comment (mapv #(exp-backoff % {}) (range 5)))

 ;;;; Admin

@@ -54,7 +53,7 @@
        (car/hgetall*      (qk :nattempts))
        (car/lrange        (qk :mid-circle) 0 -1)
        (->> (car/smembers (qk :gc))            (car/parse set))
-       (->> (car/get      (qk :eoq-backoff?))  (car/parse-bool))
+       (->> (car/get      (qk :eoq-backoff?))  (car/parse-bool)) ; Give TTL?
        (->> (car/get      (qk :ndry-runs))     (car/parse-long))))))

 ;;;; Implementation
@@ -145,9 +144,6 @@
      :mcontent      (car/freeze message)})
    (car/parse #(if (vector? %) (first %) {:carmine.mq/error (keyword %)}))))

-(comment (wcar {} (enqueue "myq" "msg"))
-         (wcar {} (enqueue "myq" "msg" "myid")))
-
 (defn dequeue
   "IMPLEMENTATION DETAIL: Use `worker` instead.
   Rotates queue's mid-circle and processes next mid. Returns:
@@ -155,76 +151,92 @@
     \"eoq-backoff\" - If circle uninitialized or end-of-circle marker reached.
     [<mid> <mcontent> <attempt-count>] - If message should be (re)handled now."
   [qname & [{:keys [lock-ms eoq-backoff-ms]
-             :or   {lock-ms (* 1000 60 60)
-                    eoq-backoff-ms 2000}}]]
-  (car/lua
-   "if redis.call('exists', _:qk-eoq-backoff) == 1 then return 'eoq-backoff' end
-
-    -- TODO Waiting for Lua brpoplpush support to get us long polling
-    local mid = redis.call('rpoplpush', _:qk-mid-circle, _:qk-mid-circle)
-    local now = tonumber(_:now)
-
-    if (not mid) or (mid == 'end-of-circle') then
-      -- Set queue-wide polling backoff flag
-      redis.call('psetex', _:qk-eoq-backoff, _:eoq-backoff-ms, 'true')
-      redis.call('incr',   _:qk-ndry-runs)
-
-      -- Prune expired backoffs. We have to do this manually if we want to keep
-      -- backoffs in a hash as we do for efficiency & Cluster support. This hash
-      -- is usu. quite small since it consists only of active retry and dedupe
-      -- backoffs.
-      for i,k in pairs(redis.call('hkeys', _:qk-backoffs)) do
-        if (now >= tonumber(redis.call('hget', _:qk-backoffs, k))) then
-          redis.call('hdel', _:qk-backoffs, k)
-        end
-      end
-
-      return 'eoq-backoff'
-    end
-
-    if redis.call('sismember', _:qk-gc, mid) == 1 then -- GC
-      redis.call('lrem', _:qk-mid-circle, 1, mid) -- Efficient here
-      redis.call('srem', _:qk-gc,            mid)
-      redis.call('hdel', _:qk-msgs,          mid)
-      redis.call('hdel', _:qk-locks,         mid)
-      --redis.call('hdel', _:qk-backoffs,    mid) -- No! Will use as dedupe backoff
-      redis.call('hdel', _:qk-nattempts,     mid)
-      redis.call('set',  _:qk-ndry-runs, 0) -- Did work
-      return nil
-    end
-
-    local lock_exp    = tonumber(redis.call('hget', _:qk-locks,    mid) or 0)
-    local backoff_exp = tonumber(redis.call('hget', _:qk-backoffs, mid) or 0)
-
-    -- Active lock/backoff
-    if (now < lock_exp) or (now < backoff_exp) then return nil end
-
-    redis.call('hset', _:qk-locks,    mid, now + tonumber(_:lock-ms)) -- Acquire
-    redis.call('hdel', _:qk-backoffs, mid) -- Expired, so prune (keep gc-prune fast)
-    redis.call('set',  _:qk-ndry-runs, 0) -- Did work
-
-    local mcontent  = redis.call('hget',    _:qk-msgs,      mid)
-    local nattempts = redis.call('hincrby', _:qk-nattempts, mid, 1)
-    return {mid, mcontent, nattempts}"
-   {:qk-msgs        (qkey qname :msgs)
-    :qk-locks       (qkey qname :locks)
-    :qk-backoffs    (qkey qname :backoffs)
-    :qk-nattempts   (qkey qname :nattempts)
-    :qk-mid-circle  (qkey qname :mid-circle)
-    :qk-gc          (qkey qname :gc)
-    :qk-eoq-backoff (qkey qname :eoq-backoff?)
-    :qk-ndry-runs   (qkey qname :ndry-runs)}
-   {:now            (System/currentTimeMillis)
-    :lock-ms        lock-ms
-    :eoq-backoff-ms eoq-backoff-ms}))
+             :or   {lock-ms (* 1000 60 60) eoq-backoff-ms exp-backoff}}]]
+  (let [;; Precomp 5 backoffs so that `dequeue` can init the backoff
+        ;; atomically. This is hackish, but a decent tradeoff.
+        eoq-backoff-ms-vec
+        (cond (fn?      eoq-backoff-ms) (mapv eoq-backoff-ms              (range 5))
+              (integer? eoq-backoff-ms) (mapv (constantly eoq-backoff-ms) (range 5))
+              :else (throw (Exception. (str "Bad eoq-backoff-ms: " eoq-backoff-ms))))]
+    (car/lua
+     "if redis.call('exists', _:qk-eoq-backoff) == 1 then return 'eoq-backoff' end
+
+     -- TODO Waiting for Lua brpoplpush support to get us long polling
+     local mid = redis.call('rpoplpush', _:qk-mid-circle, _:qk-mid-circle)
+     local now = tonumber(_:now)
+
+     if (not mid) or (mid == 'end-of-circle') then -- Uninit'd or eoq
+
+       -- Calculate eoq_backoff_ms
+       local ndry_runs = tonumber(redis.call('get', _:qk-ndry-runs) or 0)
+       local eoq_ms_tab = {_:eoq-ms0, _:eoq-ms1, _:eoq-ms2, _:eoq-ms3, _:eoq-ms4}
+       local eoq_backoff_ms = tonumber(eoq_ms_tab[math.min(5, (ndry_runs + 1))])
+
+       -- Set queue-wide polling backoff flag
+       redis.call('psetex', _:qk-eoq-backoff, eoq_backoff_ms, 'true')
+       redis.call('incr',   _:qk-ndry-runs)
+
+       -- Prune expired backoffs. We have to do this manually if we want to keep
+       -- backoffs in a hash as we do for efficiency & Cluster support. This hash
+       -- is usu. quite small since it consists only of active retry and dedupe
+       -- backoffs.
+       for i,k in pairs(redis.call('hkeys', _:qk-backoffs)) do
+         if (now >= tonumber(redis.call('hget', _:qk-backoffs, k))) then
+           redis.call('hdel', _:qk-backoffs, k)
+         end
+       end
+
+       return 'eoq-backoff'
+     end
+
+     if redis.call('sismember', _:qk-gc, mid) == 1 then -- GC
+       redis.call('lrem', _:qk-mid-circle, 1, mid) -- Efficient here
+       redis.call('srem', _:qk-gc,            mid)
+       redis.call('hdel', _:qk-msgs,          mid)
+       redis.call('hdel', _:qk-locks,         mid)
+       --redis.call('hdel', _:qk-backoffs,    mid) -- No! Will use as dedupe backoff
+       redis.call('hdel', _:qk-nattempts,     mid)
+       redis.call('set',  _:qk-ndry-runs, 0) -- Did work
+       return nil
+     end
+
+     local lock_exp    = tonumber(redis.call('hget', _:qk-locks,    mid) or 0)
+     local backoff_exp = tonumber(redis.call('hget', _:qk-backoffs, mid) or 0)
+
+     -- Active lock/backoff
+     if (now < lock_exp) or (now < backoff_exp) then return nil end
+
+     redis.call('hset', _:qk-locks,    mid, now + tonumber(_:lock-ms)) -- Acquire
+     redis.call('hdel', _:qk-backoffs, mid) -- Expired, so prune (keep gc-prune fast)
+     redis.call('set',  _:qk-ndry-runs, 0) -- Did work
+
+     local mcontent  = redis.call('hget',    _:qk-msgs,      mid)
+     local nattempts = redis.call('hincrby', _:qk-nattempts, mid, 1)
+     return {mid, mcontent, nattempts}"
+     {:qk-msgs        (qkey qname :msgs)
+      :qk-locks       (qkey qname :locks)
+      :qk-backoffs    (qkey qname :backoffs)
+      :qk-nattempts   (qkey qname :nattempts)
+      :qk-mid-circle  (qkey qname :mid-circle)
+      :qk-gc          (qkey qname :gc)
+      :qk-eoq-backoff (qkey qname :eoq-backoff?)
+      :qk-ndry-runs   (qkey qname :ndry-runs)}
+     {:now            (System/currentTimeMillis)
+      :lock-ms        lock-ms
+      :eoq-ms0        (nth eoq-backoff-ms-vec 0)
+      :eoq-ms1        (nth eoq-backoff-ms-vec 1)
+      :eoq-ms2        (nth eoq-backoff-ms-vec 2)
+      :eoq-ms3        (nth eoq-backoff-ms-vec 3)
+      :eoq-ms4        (nth eoq-backoff-ms-vec 4)})))

 (comment
-  (clear-queues {} "myq")
-  (queue-status {} "myq")
-  (let [mid (wcar {} (enqueue "myq" "msg"))]
-    (wcar {} (message-status "myq" mid)))
-
-  (wcar {} (dequeue "myq")))
+  (clear-queues {} :q1)
+  (queue-status {} :q1)
+  (wcar {} (enqueue :q1 :msg1 :mid1))
+  (wcar {} (message-status :q1 :mid1))
+  (wcar {} (dequeue :q1))
+  ;;(mapv exp-backoff (range 5))
+  (wcar {} (car/pttl (qkey :q1 :eoq-backoff?))))

 (defn handle1 "Implementation detail!"
   [conn qname handler [mid mcontent attempt :as poll-reply]]
@@ -269,25 +281,21 @@
     (when-not @running?
       (reset! running? true)
       (future
-        (let [{:keys [handler monitor throttle-ms eoq-backoff-ms]} opts
+        (let [{:keys [handler monitor throttle-ms _]} opts
               qk (partial qkey qname)]
           (while @running?
             (try
-              (let [[ndruns mid-circle-size] (wcar conn (car/get  (qk :ndry-runs))
-                                                        (car/llen (qk :mid-circle)))
-                    ndruns (or (car/as-long ndruns) 0)
-                    eoq-backoff-ms* (if-not (fn? eoq-backoff-ms) eoq-backoff-ms
-                                      (eoq-backoff-ms (inc ndruns)))
-                    opts* (assoc opts :eoq-backoff-ms eoq-backoff-ms*)
-                    poll-reply (wcar conn (dequeue qname opts*))]
-
-                (when monitor
-                  (monitor {:mid-circle-size mid-circle-size
-                            :ndry-runs       ndruns
-                            :poll-reply      poll-reply}))
+              (let [[poll-reply ndruns mid-circle-size]
+                    (wcar conn (dequeue qname opts)
+                               (car/get  (qk :ndry-runs))
+                               (car/llen (qk :mid-circle)))]
+
+                (when monitor (monitor {:mid-circle-size mid-circle-size
+                                        :ndry-runs       (or ndruns 0)
+                                        :poll-reply      poll-reply}))

                 (if (= poll-reply "eoq-backoff")
-                  (when eoq-backoff-ms* (Thread/sleep eoq-backoff-ms*))
+                  (Thread/sleep (max (wcar conn (car/pttl (qk :eoq-backoff?))) 10))
                   (handle1 conn qname handler poll-reply)))

               (catch Throwable t (timbre/fatalf t "Worker error!") (throw t)))
@@ -323,19 +331,17 @@
                      considered fatally stalled and message re-queued. Must be
                      sufficiently high to prevent double handling.
    :eoq-backoff-ms - Thread sleep period each time end of queue is reached.
-                     Can be a (fn [ndry-runs]) => ms. Sleep synchronized for all
-                     queue workers.
+                     Can be a (fn [ndry-runs]) -> ms (n<=5) will be used.
+                     Sleep synchronized for all queue workers.
    :throttle-ms    - Thread sleep period between each poll."
   [conn qname & [{:keys [handler monitor lock-ms eoq-backoff-ms throttle-ms
                          auto-start?]
-                  :or   {handler (fn [{:keys [message attempt] :as handler-args}]
-                                   (timbre/infof "%s" handler-args)
-                                   {:status :success})
+                  :or   {handler (fn [args] (timbre/infof "%s" args)
+                                           {:status :success})
                          monitor (monitor-fn qname 1000 (* 1000 60 60))
                          lock-ms        (* 1000 60 60)
                          throttle-ms    200
-                         eoq-backoff-ms (fn [ndruns] (exp-backoff ndruns
-                                                       {:max 10000}))
+                         eoq-backoff-ms exp-backoff
                          auto-start?    true}}]]
   (let [w (->Worker conn qname (atom false)
                     {:handler        handler
@@ -344,12 +350,6 @@
                      :eoq-backoff-ms eoq-backoff-ms
                      :throttle-ms    throttle-ms})]
     (when auto-start? (start w)) w))
-
-(comment
-  (def w1 (worker {} "myq"))
-  (wcar {} (enqueue "myq" "msg"))
-  (stop w1)
-  (queue-status {} "myq"))

 ;;;; Renamed/deprecated


Correct fix for paths with a dot in the directory #1755

--- src/lt/objs/files.cljs
+++ src/lt/objs/files.cljs
@@ -88,9 +88,7 @@
         (recur (rest parts) (conj acc (string/join "." parts)))))))

 (defn ext [path]
-  (let [i (.lastIndexOf path ".")]
-    (when (> i 0)
-      (subs path (inc i) (count path)))))
+  (subs (.extname fpath path) 1))

 (defn without-ext [path]
   (let [i (.lastIndexOf path ".")]


ugh, hiccup doesn't escape by default

ugh, hiccup doesn't escape by default

--- src/pc/views/admin.clj
+++ src/pc/views/admin.clj
@@ -111,12 +111,12 @@
                 :let [cust (cust-model/find-by-id db cust-id)
                       req (first (pc.early-access/find-by-cust db cust))]]
             [:tr
-             [:td (:cust/email cust)]
-             [:td (or (:cust/name cust)
-                      (:cust/first-name cust))]
-             [:td (:early-access-request/company-name req)]
-             [:td (:early-access-request/employee-count req)]
-             [:td (:early-access-request/use-case req)]
+             [:td (h/h (:cust/email cust))]
+             [:td (h/h (or (:cust/name cust)
+                           (:cust/first-name cust)))]
+             [:td (h/h (:early-access-request/company-name req))]
+             [:td (h/h (:early-access-request/employee-count req))]
+             [:td (h/h (:early-access-request/use-case req))]
              [:td [:form {:action "/grant-early-access" :method "post"}
                    (anti-forgery/anti-forgery-field)
                    [:input {:type "hidden" :name "cust-uuid" :value (str (:cust/uuid cust))}]
@@ -133,12 +133,12 @@
              :let [cust (cust-model/find-by-id db cust-id)
                    req (first (pc.early-access/find-by-cust db cust))]]
          [:tr
-          [:td (:cust/email cust)]
-          [:td (or (:cust/name cust)
-                   (:cust/first-name cust))]
-          [:td (:early-access-request/company-name req)]
-          [:td (:early-access-request/employee-count req)]
-          [:td (:early-access-request/use-case req)]])]])))
+          [:td (h/h (:cust/email cust))]
+          [:td (h/h (or (:cust/name cust)
+                        (:cust/first-name cust)))]
+          [:td (h/h (:early-access-request/company-name req))]
+          [:td (h/h (:early-access-request/employee-count req))]
+          [:td (h/h (:early-access-request/use-case req))]])]])))

 (defn format-runtime [ms]
   (let [h (int (Math/floor (/ ms (* 1000 60 60))))
@@ -174,25 +174,25 @@
         [:a {:href (urls/doc-svg doc-id)}
          [:img {:style "width:100;height:100;"
                 :src (urls/doc-svg doc-id)}]]]
-       [:td (get-in stats [:cust :cust/email])]
+       [:td (h/h (get-in stats [:cust :cust/email]))]
        [:td [:form {:action "/refresh-client-stats" :method "post"}
              (anti-forgery/anti-forgery-field)
-             [:input {:type "hidden" :name "client-id" :value client-id}]
+             [:input {:type "hidden" :name "client-id" :value (h/h client-id)}]
              [:input {:type "submit" :value "refresh"}]]]
-       [:td (let [v (get-in stats [:stats :code-version])]
+       [:td (let [v (h/h (get-in stats [:stats :code-version]))]
               [:a {:href (str "https://github.com/dwwoelfel/precursor/commit/" v)}
                v])]
-       [:td (get-in stats [:stats :chat-count])]
-       [:td (get-in stats [:stats :unread-chat-count])]
-       [:td (get-in stats [:stats :transaction-count])]
-       [:td (get-in stats [:stats :layer-count])]
-       [:td (get-in stats [:stats :logged-in?])]
-       [:td (some-> (get-in stats [:stats :run-time-millis]) format-runtime)]
+       [:td (h/h (get-in stats [:stats :chat-count]))]
+       [:td (h/h (get-in stats [:stats :unread-chat-count]))]
+       [:td (h/h (get-in stats [:stats :transaction-count]))]
+       [:td (h/h (get-in stats [:stats :layer-count]))]
+       [:td (h/h (get-in stats [:stats :logged-in?]))]
+       [:td (h/h (some-> (get-in stats [:stats :run-time-millis]) format-runtime))]
        [:td (count (get document-subs doc-id))]
-       [:td (let [visibility (get-in stats [:stats :visibility])]
+       [:td (let [visibility (h/h (get-in stats [:stats :visibility]))]
               (list visibility
                     (when (= "hidden" visibility)
                       [:form {:action "/refresh-client-browser" :method "post"}
                        (anti-forgery/anti-forgery-field)
-                       [:input {:type "hidden" :name "client-id" :value client-id}]
+                       [:input {:type "hidden" :name "client-id" :value (h/h client-id)}]
                        [:input {:type "submit" :value "refresh browser"}]])))]])]])


figwheel.main: fix figwheel.main repl-main-opt regression

--- figwheel-main/src/figwheel/main.cljc
+++ figwheel-main/src/figwheel/main.cljc
@@ -505,10 +505,10 @@
          (cond->
              temp-dir (assoc-in [:options :output-dir]
                                 (default-output-dir
-                                 (assoc cfg [::config :target-dir] temp-dir)))
+                                 (assoc-in cfg [::config :target-dir] temp-dir)))
              temp-dir (assoc-in [:options :output-to]
                                 (default-output-to
-                                 (assoc cfg [::config :target-dir] temp-dir)))
+                                 (assoc-in cfg [::config :target-dir] temp-dir)))
              temp-dir (assoc-in [:options :asset-path]  "cljs-out"))
          (assoc :args args)
          (update :options (fn [opt] (merge {:main 'figwheel.repl.preload} opt)))


make click-to-scroll use body

make click-to-scroll use body

--- frontend/components/build_steps.cljs
+++ frontend/components/build_steps.cljs
@@ -110,11 +110,10 @@
                     (common/messages (:messages action))
                     [:i.click-to-scroll.fa.fa-arrow-circle-o-down.pull-right
                      {:on-click #(let [node (om/get-node owner)
-                                       main (sel1 "main.app-main")]
-                                   (set! (.-scrollTop main) (- (+ (.-scrollTop main)
-                                                                  (.-y (goog.style/getRelativePosition node main))
+                                       body (sel1 "body")]
+                                   (set! (.-scrollTop body) (- (+ (.-y (goog.style/getRelativePosition node body))
                                                                   (.-height (goog.style/getSize node)))
-                                                               (goog.dom/getDocumentHeight))))}]
+                                                               (.-height (goog.dom/getViewportSize)))))}]
                     (when (:bash_command action)
                       [:span
                        (when (:exit_code action)


figwheel.main: add disconnect event

figwheel.main: add disconnect event

--- figwheel-repl/src/figwheel/repl.cljc
+++ figwheel-repl/src/figwheel/repl.cljc
@@ -424,6 +424,14 @@
            (doto (js/Event. "figwheel.repl.connected" target)
              (gobj/add "data" {:url url}))))))

+(defn connection-closed! [url]
+  (when (= host-env :html)
+    (let [target (.. goog.global -document -body)]
+      (.dispatchEvent
+       target
+       (doto (js/Event. "figwheel.repl.disconnected" target)
+         (gobj/add "data" {:url url}))))))
+
 (defn get-websocket-class []
   (or
    (gobj/get goog.global "WebSocket")
@@ -471,6 +479,8 @@
                                (connection-established! url)
                                (swap! state assoc :connection {:websocket websocket})
                                (hook-repl-printing-output! {:websocket websocket})))
+          (.addEventListener goog.net.WebSocket.EventType.CLOSED
+                             (fn [e] (connection-closed! url)))
           (.open url))))))

 ;; -----------------------------------------------------------
@@ -514,6 +524,7 @@
            (msg-fn msg)
            (js/setTimeout #(poll msg-fn connect-url') 500))
          (fn [e] ;; lost connection
+           (connection-closed! connect-url')
            (http-connect connect-url'))))

 (defn long-poll [msg-fn connect-url']
@@ -522,6 +533,7 @@
            (msg-fn msg)
            (long-poll msg-fn connect-url'))
          (fn [e] ;; lost connection
+           (connection-closed! connect-url')
            (http-connect connect-url'))))

 (defn http-connect* [attempt connect-url']


Demonstrate what aleph UDP packets look like

And how the basic idea behind a client works

--- test/com/frereth/common/aleph_test.clj
+++ test/com/frereth/common/aleph_test.clj
@@ -1,8 +1,12 @@
 (ns com.frereth.common.aleph-test
-  (:require [clojure.edn :as edn]
+  (:require [aleph.udp :as udp]
+            [byte-streams :as b-s]
+            [clojure.edn :as edn]
             [clojure.test :refer (deftest is testing)]
             [com.frereth.common.aleph :as aleph]
-            [clojure.core.async :as async]))
+            [clojure.core.async :as async]
+            [manifold.deferred :as dfrd]
+            [manifold.stream :as strm]))

 (deftest count-messages
   (testing "Count minimalist requests/responses"
@@ -31,6 +35,7 @@
   (count-messages))

 (deftest test-routing
+  ;; This approach no longer makes any real sense, assuming it ever did
   (testing "Router"
     (let [connections (atom {})
           port 12081
@@ -56,7 +61,7 @@
           ;; But it was finicky
           (testing "Sending"
             (let [cxns @connections
-                  out-fn (@connections "127.0.0.1")]
+                  out-fn (get cxns "127.0.0.1")]
               (assert out-fn (str "Missing localhost client in " cxns))
               (let [msg '{:a 1
                           :b [2 3 4 5]
@@ -75,3 +80,56 @@
           (.close server))))))
 (comment
   (test-routing))
+
+(deftest udp-basics
+  (let [port 17718
+        server-future (udp/socket {:port port})
+        server (deref server-future 20 ::timed-out)]
+    (println "Server future:" server-future)
+    (if-not (= server ::timed-out)
+      (try
+        ;; Note that this approach is highly likely to have firewall issues.
+        ;; Although so will pretty much any/every other.
+        (let [client @(udp/socket {})]
+          (try
+            (let [initial-pull-future (strm/try-take! server ::drained 50 ::timed-out)
+                  msg-1 {:host "localhost"
+                         :port port
+                         :message (byte-array (range 256))}
+                  initial-put-future (strm/try-put! client msg-1 50 ::timed-out)]
+              (dfrd/on-realized initial-pull-future
+                                (fn success [{:keys [message]
+                                              :as packet}]
+                                  (println "Initial message received by server:" message
+                                           "\ncontained in" packet)
+                                  (is (b-s/bytes= message (:message msg-1)))
+                                  (let [pull-2-future (strm/try-take! client ::drained 50 ::timed-out)
+                                        msg-2 (byte-array (range 256 1024))
+                                        put-2-future (strm/try-put! server (assoc packet :message msg-2) 50 ::timed-out)]
+                                    (dfrd/on-realized put-2-future
+                                                      (fn [success]
+                                                        (is (not= success ::timed-out)))
+                                                      (fn [failure]
+                                                        (is (not failure))))
+                                    (dfrd/on-realized pull-2-future
+                                                      (fn [{:keys [:host :message]
+                                                            in-port :port}]
+                                                        (println "Incoming message:" message)
+                                                        (is (b-s/bytes= message msg-2))
+                                                        (println "Incoming port:" in-port)
+                                                        (is (= port in-port)))
+                                                      (fn [fail]
+                                                        (is false fail)))
+                                    (let [round-tripped (deref pull-2-future 50 ::timed-out)]
+                                      (is (not= round-tripped ::timed-out)))))
+                                (fn fail [x]
+                                  (is (not x))))
+              (dfrd/on-realized initial-put-future
+                                (fn success [x]
+                                  (is (not= x ::timed-out)))
+                                (fn fail [x]
+                                  (is (not x))))
+              (is (not= (deref initial-pull-future 50 ::timed-out) ::timed-out)))
+            (finally (strm/close! client))))
+        (finally (strm/close! server)))
+      (is (not= server ::timed-out)))))


added test

added test

--- test/dynamodb_expression/core_test.clj
+++ test/dynamodb_expression/core_test.clj
@@ -1,7 +1,24 @@
 (ns dynamodb-expression.core-test
   (:require [clojure.test :refer :all]
-            [dynamodb-expression.core :refer :all]))
+            [dynamodb-expression.core :as dx]))

 (deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))
+  (testing "A basic integration test"
+    (let [cnt (atom 0)]
+      (with-redefs [gensym (fn [& [prefix]]
+                             (str prefix "G__" (swap! cnt inc)))]
+        (let [x 4
+              {:keys [update-expression expression-attribute-names expression-attribute-values]
+               :as ex} (-> (dx/update-expr)
+                           (dx/add "foo.bar" x)
+                           (dx/add :bar.baz 8)
+                           (dx/add "-goof-" 76)
+                           dx/expr)]
+          (is (= expression-attribute-names {"#foo_bar_G__1" "foo.bar",
+                                             "#bar_baz_G__2" "bar.baz",
+                                             "#_goof__G__3" "-goof-"}))
+          (is (= expression-attribute-values {":foo_bar_G__1" 4,
+                                              ":bar_baz_G__2" 8,
+                                              ":_goof__G__3" 76}))
+          (is (= update-expression "ADD #foo_bar_G__1 :foo_bar_G__1, #bar_baz_G__2 :bar_baz_G__2, #_goof__G__3 :_goof__G__3")))))))
+


Test test-job-already-exist-response

Test test-job-already-exist-response

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -291,6 +291,15 @@
             {:status "error" :jobName nil       :command "create_job" :message "Job does not exist"} (job-does-not-exist-response nil :create-job)
             {:status "error" :jobName nil       :command nil          :message "Job does not exist"} (job-does-not-exist-response nil nil))))

+(deftest test-job-already-exist-response
+    "Check the function emender-jenkins.rest-api/job-already-exist-response."
+    (testing "the function emender-jenkins.rest-api/job-already-exist-response."
+        (are [x y] (= x y)
+            {:status "error" :jobName "jobName" :command "create_job" :message "Job already exist"} (job-already-exist-response "jobName" :create-job)
+            {:status "error" :jobName "jobName" :command nil          :message "Job already exist"} (job-already-exist-response "jobName" nil)
+            {:status "error" :jobName nil       :command "create_job" :message "Job already exist"} (job-already-exist-response nil :create-job)
+            {:status "error" :jobName nil       :command nil          :message "Job already exist"} (job-already-exist-response nil nil))))
+
 (deftest test-wrong-job-name
     "Check the function emender-jenkins.rest-api/wrong-job-name."
     (testing "the function emender-jenkins.rest-api/wrong-job-name."


Made probability threshold an arg; simplified end-training function

--- test/forma/postprocess/select_test.clj
+++ test/forma/postprocess/select_test.clj
@@ -59,17 +59,16 @@

 (defn end-training
   [res]
-  (cond (= res "32") (datetime->period "32" "2005-12-01")
-        (= res "16") (datetime->period "16" "2005-12-19")))
+  (datetime->period res "2005-12-31"))

 (defmapcatop grab-sig-pixels
   "return a vector of three-tuples, with the country iso code, the
   index of the period with the alert (> 0.5), and the probability of
   the alert.  If the probability of clearing never exceeds the
   threshold, then a stand-in three-tuple is returned."
-  [res out-m]
+  [res out-m thresh]
   (let [series (:prob-series out-m)
-        idx (positions #(> % 0.5) series)
+        idx (positions #(> % thresh) series)
         offset (end-training res)]
     (if (empty? idx)
       [["nil" 0 0]]
@@ -80,7 +79,7 @@

 (def agg-tap (<- [?cntry ?pd ?tot-prob]
                  (sample-output-map ?m)
-                 (grab-sig-pixels "16" ?m :> ?cntry ?pd ?prob)
+                 (grab-sig-pixels "16" ?m 0.5 :> ?cntry ?pd ?prob)
                  (c/sum ?prob :> ?tot-prob)))

 (deftest agg-probs


Fixed handling of missing LOC counts

Fixed handling of missing LOC counts

--- src/alfresco_technical_validation/validation.clj
+++ src/alfresco_technical_validation/validation.clj
@@ -46,10 +46,11 @@

 (defn- build-loc-bookmarks
   [locs type]
-  (let [[files loc] (get locs type)]
-    { (str type "Files") (str files)
-      (str type "LOC")   (str loc)
-    }))
+  (let [[f l] (get locs type)
+        files (str f)
+        loc   (str l)]
+    { (str type "Files") (if (s/blank? files) "0" files)
+      (str type "LOC")   (if (s/blank? loc)   "0" loc) }))

 (defn- count-locs
   [source source-index]


Database code refactoring.

Database code refactoring.

--- src/com/lemondronor/orbital_detector/reports.clj
+++ src/com/lemondronor/orbital_detector/reports.clj
@@ -3,6 +3,7 @@
   (:require [clj-time.coerce :as timecoerce]
             [clojure.java.jdbc :as jdbc]
             [clojure.string :as string]
+            [com.lemondronor.orbital-detector.db :as b]
             [com.lemondronor.orbital-detector.planeplotter :as orbdet]))

 (set! *warn-on-reflection* true)
@@ -43,5 +44,5 @@
 (defn -main [& args]
   (let [db-path (first args)
         log-path (second args)]
-    (create-db! (db-spec db-path) db-schema)
+    (db/create-db! (db/db-spec db-path) db-schema)
     (add-records! db-path (orbdet/read-log log-path))))


runTaskLater Async

runTaskLater Async

--- src/bukkure/bukkit.clj
+++ src/bukkure/bukkit.clj
@@ -67,7 +67,7 @@
   "Execute a given function on the main UI thread after a delay in server ticks (1 tick = 1/20 second), will return a task id you can use to cancel the task - if you specify async?, take care not to directly call any Bukkit API and, by extension, and clj-minecraft functions that use the Bukkit API within this function"
   [plugin fn delay & [async?]]
   (if async?
-    (.runTaskAsynchronously (scheduler) plugin fn (long delay))
+    (.runTaskLaterAsynchronously (scheduler) plugin fn (long delay))
     (.runTaskLater (scheduler) plugin fn (long delay))))

 (defn repeated-task


update cake bin to create windows batch executables too

--- src/cake/tasks/jar.clj
+++ src/cake/tasks/jar.clj
@@ -150,9 +150,11 @@
       (when (newer? uberjar binfile)
         (log "Creating standalone executable:" (.getPath binfile))
         (with-open [bin (FileOutputStream. binfile)]
-          (let [shebang (format "#!/usr/bin/env sh\nexec java %s -jar $0 \"$@\"\n"
-                                (or (*config* "project.java_opts") ""))]
-            (.write bin (.getBytes shebang)))
+          (let [opts (or (*config* "project.java_opts") "")
+                unix (format ":;exec java %s -jar $0 \"$@\"\n" opts)
+                dos  (format "@echo off\r\njava %s -jar %%1 \"%%~f0\" %%*\r\ngoto :eof\r\n" opts)]
+            (.write bin (.getBytes unix))
+            (.write bin (.getBytes dos)))
           (copy uberjar bin))
         (ant Chmod {:file binfile :perm "+x"})))
     (println "Cannot create bin without :main namespace in project.clj")))


Make sure indexes have keys compressed as well

--- src/cfpb/qu/loader.clj
+++ src/cfpb/qu/loader.clj
@@ -252,9 +252,10 @@
   (log/info "Indexing slice" slice)
   (let [sdef (get-in definition [:slices (keyword slice)])
         indexes (or (:index_only sdef)
-                    (:dimensions sdef))]
+                    (:dimensions sdef))
+        zipfn (field-zip-fn sdef)]
     (doseq [index indexes]
-      (coll/ensure-index slice {(keyword index) 1}))))
+      (coll/ensure-index slice {(zipfn index) 1}))))

 (defn load-slices
   [definition]


Fix Shipment from SanSan, Shipment from Kaguya, AstroScript Pilot Program so they cannot place tokens on cards that can only be advanced while rezzed (Tyrant, Woodcutter, Salvage).

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -97,7 +97,9 @@
    {:data {:counter 1}
     :abilities [{:counter-cost 1 :msg (msg "place 1 advancement token on "
                                            (if (:rezzed target) (:title target) "a card"))
-                 :choices {:req #(or (= (:type %) "Agenda") (:advanceable %))}
+                 :choices {:req #(or (= (:advanceable %) "always")
+                                     (and (= (:advanceable %) "while-rezzed") (:rezzed %))
+                                     (= (:type %) "Agenda"))}
                  :effect (effect (add-prop target :advance-counter 1))}]}

    "Argus Security: Protection Guaranteed"
@@ -1677,7 +1679,9 @@
                               card targets))}}

    "Shipment from Kaguya"
-   {:choices {:max 2 :req #(or (= (:type %) "Agenda") (:advanceable %))}
+   {:choices {:max 2 :req #(or (= (:advanceable %) "always")
+                               (and (= (:advanceable %) "while-rezzed") (:rezzed %))
+                               (= (:type %) "Agenda"))}
     :msg (msg "1 advancement tokens on " (count targets) " cards")
     :effect (req (doseq [t targets] (add-prop state :corp t :advance-counter 1)))}

@@ -1685,7 +1689,9 @@
    {:choices ["0", "1", "2"] :prompt "How many advancement tokens?"
     :effect (req (let [c (Integer/parseInt target)]
                    (resolve-ability state side
-                    {:choices {:req #(or (= (:type %) "Agenda") (:advanceable %))}
+                    {:choices {:req #(or (= (:advanceable %) "always")
+                                         (and (= (:advanceable %) "while-rezzed") (:rezzed %))
+                                         (= (:type %) "Agenda"))}
                      :msg (msg "add " c " advancement tokens on a card")
                      :effect (effect (add-prop :corp target :advance-counter c))} card nil)))}


Fix Noise's ability not firing when installing Parasite onto an ice that it immediately trashes.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -1831,7 +1831,11 @@

    "Parasite"
    {:hosting {:req #(and (= (:type %) "ICE") (:rezzed %))}
-    :effect (req (when-let [h (:host card)] (update-ice-strength state side h)))
+    :effect (req (when-let [h (:host card)]
+                   (update! state side (assoc-in card [:special :installing] true))
+                   (update-ice-strength state side h)
+                   (when-let [card (get-card state card)]
+                     (update! state side (update-in card [:special] dissoc :installing)))))
     :events {:runner-turn-begins
              {:effect (req (add-prop state side card :counter 1))}
              :counter-added
@@ -1842,7 +1846,10 @@
               :effect (effect (ice-strength-bonus (- (get-virus-counters state side card))))}
              :ice-strength-changed
              {:req (req (and (= (:cid target) (:cid (:host card))) (<= (:current-strength target) 0)))
-              :effect (effect (trash target))
+              :effect (req (when (get-in card [:special :installing])
+                             (trigger-event state side :runner-install card)
+                             (update! state side (update-in card [:special] dissoc :installing)))
+                           (trash state side target))
               :msg (msg "trash " (:title target))}}}

    "Paricia"


Hide gist id if private

Hide gist id if private

--- src/clj/inky/entry.clj
+++ src/clj/inky/entry.clj
@@ -196,7 +196,7 @@
    [:h3 "Work Queue"]
    (if (> (count jobs) 0)
      [:ul
-      (for [{:keys [gist-id] :as job} jobs]
+      (for [{:keys [gist-id public-gist] :as job} jobs]
         (cond
           (compiling-job? job)
           [:li.compiling
@@ -207,20 +207,29 @@
           (succeeded-job? job)
           [:li.succeeded
            [:i.icon-ok]
-           "Compiled " ($link-gist gist-id gist-id)
-           " "(util/timeago (:started job)) " ago."
+           "Compiled "
+           (if public-gist
+             ($link-gist gist-id gist-id)
+             "a private gist")
+           " " (util/timeago (:started job)) " ago."
            " Took " (compile-duration job) " s."]

           (failed-job? job)
           [:li.failed
            [:i.icon-remove]
-           "Failed compiling " ($link-gist gist-id gist-id)
+           "Failed compiling "
+           (if public-gist
+             ($link-gist gist-id gist-id)
+             "a private gist")
            " "(util/timeago (:started job)) " ago."]

           :else
           [:li.waiting
            [:i.icon-time]
-           "Gist " ($link-gist gist-id gist-id)
+           "Gist "
+           (if public-gist
+             ($link-gist gist-id gist-id)
+             "a private gist")
            ", enqueued " (util/timeago (:created job)) " ago."]))]
      [:div.null-state
       "No jobs."])])


fixed ns comment

fixed ns comment

--- src/clj_camel/core.clj
+++ src/clj_camel/core.clj
@@ -46,7 +46,7 @@
 (defn start-camel-context []
   (let [r (SimpleRegistry.)
         ctx (doto (DefaultCamelContext. r))]
-    (.put r "test-bean" test-bean)
+    (.put r \"test-bean\" test-bean)
     (c/add-routes ctx (cons (make-error-handler) (make-test-routes)))
     (.start ctx)
     ctx))"


Wrap in deftest.

Wrap in deftest.

--- test/onyx/log/generative_peer_join.clj
+++ test/onyx/log/generative_peer_join.clj
@@ -182,32 +182,32 @@
    (is (= (map count (vals (get (:allocations replica) job-1-id))) [1 1 1]))
    (is (= (map count (vals (get (:allocations replica) job-2-id))) [1 1 1]))))

-(deftest balanced-allocations-uneven)
-(checking
- "Checking Balanced allocation causes peers to be evenly over tasks when the spread is uneven"
- 1000
- [{:keys [replica log peer-choices]}
-  (log-gen/apply-entries-gen
-   (gen/return
-    {:replica {:job-scheduler :onyx.job-scheduler/balanced
-               :messaging {:onyx.messaging/impl :dummy-messenger}}
-     :message-id 0
-     :entries (assoc (generate-join-entries (generate-peer-ids 7))
-                :job-1 [(api/create-submit-job-entry job-1-id
-                                                     peer-config
-                                                     job-1
-                                                     (planning/discover-tasks (:catalog job-1) (:workflow job-1)))]
-                :job-2 [(api/create-submit-job-entry job-2-id
-                                                     peer-config
-                                                     job-2
-                                                     (planning/discover-tasks (:catalog job-2) (:workflow job-2)))])
-     :log []
-     :peer-choices []}))]
- (let [j1-allocations (map (fn [t] (get-in replica [:allocations job-1-id t])) (get-in replica [:tasks job-1-id]))
-       j2-allocations (map (fn [t] (get-in replica [:allocations job-2-id t])) (get-in replica [:tasks job-2-id]))]
-   ;; Since job IDs are reused, we can't know which order they'll be in.
-   (is (= (set [(map count j1-allocations) (map count j2-allocations)])
-          #{[2 1 1] [1 1 1]}))))
+(deftest balanced-allocations-uneven
+  (checking
+   "Checking Balanced allocation causes peers to be evenly over tasks when the spread is uneven"
+   1000
+   [{:keys [replica log peer-choices]}
+    (log-gen/apply-entries-gen
+     (gen/return
+      {:replica {:job-scheduler :onyx.job-scheduler/balanced
+                 :messaging {:onyx.messaging/impl :dummy-messenger}}
+       :message-id 0
+       :entries (assoc (generate-join-entries (generate-peer-ids 7))
+                  :job-1 [(api/create-submit-job-entry job-1-id
+                                                       peer-config
+                                                       job-1
+                                                       (planning/discover-tasks (:catalog job-1) (:workflow job-1)))]
+                  :job-2 [(api/create-submit-job-entry job-2-id
+                                                       peer-config
+                                                       job-2
+                                                       (planning/discover-tasks (:catalog job-2) (:workflow job-2)))])
+       :log []
+       :peer-choices []}))]
+   (let [j1-allocations (map (fn [t] (get-in replica [:allocations job-1-id t])) (get-in replica [:tasks job-1-id]))
+         j2-allocations (map (fn [t] (get-in replica [:allocations job-2-id t])) (get-in replica [:tasks job-2-id]))]
+     ;; Since job IDs are reused, we can't know which order they'll be in.
+     (is (= (set [(map count j1-allocations) (map count j2-allocations)])
+            #{[2 1 1] [1 1 1]})))))

 (deftest balanced-allocations
   (checking


Put strips action instantiations in delay

--- src/edu/berkeley/ai/domains/strips/instances.clj
+++ src/edu/berkeley/ai/domains/strips/instances.clj
@@ -172,7 +172,7 @@

 (defmethod envs/get-action-space  ::StripsPlanningInstance [instance]
-  (let [instantiations (map #'strips-action->action (util/safe-get instance :all-actions))]
+  (let [instantiations (map #'strips-action->action (force (util/safe-get instance :all-actions)))]
     (envs/make-enumerated-action-space
      instantiations
      (make-successor-generator instantiations)
@@ -255,8 +255,9 @@
        reg-init
        (seq fluent-goal-atoms)
        fluent-atoms
-       (get-cps-strips-action-instantiations (util/safe-get-in instance [:domain :action-schemata])
-					     trans-objects fluent-atoms always-true-atoms instance)
+       (delay
+        (get-cps-strips-action-instantiations (util/safe-get-in instance [:domain :action-schemata])
+ 					     trans-objects fluent-atoms always-true-atoms instance))
        (util/safe-get instance :state-str-fn))
       :always-true-atoms always-true-atoms
 ;      :always-false-atoms always-false-atoms
@@ -304,7 +305,7 @@
        (flattener (util/safe-get instance :init-atoms))
        (flattener (util/safe-get instance :goal-atoms))
        (flattener (util/safe-get instance :all-atoms))
-       (map #(flatten-action % flattener) (util/safe-get instance :all-actions))
+       (map #(flatten-action % flattener) (force (util/safe-get instance :all-actions)))
        (util/safe-get instance :state-str-fn))
       :unflatten-map (into {} backward-map))))


allow longer words. separate by dash

allow longer words. separate by dash

--- src/ontrail/search.clj
+++ src/ontrail/search.clj
@@ -33,7 +33,7 @@
 (def timestamps (atom {}))

 (def min-term-length 2)
-(def max-term-length 15)
+(def max-term-length 30)

 (def search-per-page 20)

@@ -49,7 +49,7 @@
 (defn tags-to-string [tags]
   (apply str (interpose " " tags)))

-(def re-term #"[a-zåäæö#:0-9\-_]+")
+(def re-term #"[a-zåäæö#:0-9_]+")

 (defn stem-word [term]
   (when term
@@ -72,7 +72,8 @@

 (defn exercise-to-terms [exercise]
   (concat
-    [(:sport exercise) (month-str (:creationDate exercise)) (year-str (:creationDate exercise))]
+    [ (month-str (:creationDate exercise)) (year-str (:creationDate exercise))]
+    (to-term-seq (:sport exercise))
      (to-term-seq (tags-to-string (:tags exercise)))
      (to-term-seq (str (:user exercise) " u:" (:user exercise)))
      (to-term-seq (:body exercise))
@@ -142,7 +143,7 @@

 (defn try-get-one [id]
   (try
-    (mc/find-one-as-map *db* EXERCISE {:_id id})
+    (dissoc (mc/find-one-as-map *db* EXERCISE {:_id id}) :comments)
     (catch Exception exception
       (.error logger (str "Unable to get ex " id " " exception)))))


cache a handler's arity upon adding it rather than calculating it every time the handler is called and constantly incurring java reflection performance penalties.

--- src/overtone/event.clj
+++ src/overtone/event.clj
@@ -22,7 +22,7 @@
   (log/debug "adding-handler for " event-type)
   (dosync
     (let [handlers (get @handler-ref* event-type {})]
-      (alter handler-ref* assoc event-type (assoc handlers key handler))
+      (alter handler-ref* assoc event-type (assoc handlers key [handler (arg-count handler)]))
       true)))

 (defn on-event
@@ -69,6 +69,13 @@
     (alter sync-event-handlers* dissoc event-type))
   nil)

+(defn- run-handler-with-known-arity [[f arity] & args]
+  (try
+    (apply f (take arity args))
+    (catch Exception e
+      (log/debug "Handler Exception - got args:" args"\n"
+                 (with-out-str (.printStackTrace e))))))
+
 (defn- handle-event
   "Runs the event handlers for the given event, and removes any handler that returns :done."
   [handlers* event]
@@ -78,7 +85,7 @@
         _ (log/debug "handlers: " handlers)
         drop-keys (doall (map first
                               (filter (fn [[k handler]]
-                                        (= :done (run-handler handler event)))
+                                        (= :done (run-handler-with-known-arity handler event)))
                                       handlers)))]
     (dosync
       (alter handlers* assoc event-type


Tidy compojure.core ns declaration

Tidy compojure.core ns declaration

--- src/compojure/core.clj
+++ src/compojure/core.clj
@@ -6,11 +6,11 @@

   This namespace provides functions and macros for concisely constructing
   routes and combining them together to form more complex functions."
-  (:require [clojure.string :as str]
-            [ring.util.codec :as codec])
-  (:use clout.core
-        compojure.response
-        [clojure.tools.macro :only (name-with-attributes)]))
+  (:require [compojure.response :as response]
+            [clojure.string :as str]
+            [clojure.tools.macro :as macro]
+            [clout.core :as clout]
+            [ring.util.codec :as codec]))

 (defn- method-matches?
   "True if this request matches the supplied request method."
@@ -46,7 +46,7 @@
   "Evaluate the handler if the route matches the request."
   [route handler]
   (fn [request]
-    (if-let [params (route-matches route request)]
+    (if-let [params (clout/route-matches route request)]
       (handler (assoc-route-params request (decode-route-params params))))))

 (defn- prepare-route
@@ -54,14 +54,14 @@
   [route]
   (cond
     (string? route)
-      `(route-compile ~route)
+      `(clout/route-compile ~route)
     (vector? route)
-      `(route-compile
+      `(clout/route-compile
         ~(first route)
         ~(apply hash-map (rest route)))
     :else
       `(if (string? ~route)
-         (route-compile ~route)
+         (clout/route-compile ~route)
          ~route)))

 (defn- assoc-&-binding [binds req sym]
@@ -101,7 +101,7 @@
   (if-method method
     (if-route route
       (fn [request]
-        (render (handler request) request)))))
+        (response/render (handler request) request)))))

 (defn compile-route
   "Compile a route in the form (method path & body) into a function."
@@ -125,7 +125,7 @@
   "Define a Ring handler function from a sequence of routes. The name may
   optionally be followed by a doc-string and metadata map."
   [name & routes]
-  (let [[name routes] (name-with-attributes name routes)]
+  (let [[name routes] (macro/name-with-attributes name routes)]
    `(def ~name (routes ~@routes))))

 (defmacro GET "Generate a GET route."
@@ -165,7 +165,7 @@

 (defn- if-context [route handler]
   (fn [request]
-    (if-let [params (route-matches route request)]
+    (if-let [params (clout/route-matches route request)]
       (let [uri     (:uri request)
             path    (:path-info request uri)
             context (or (:context request) "")
@@ -181,13 +181,13 @@
   (let [re-context {:__path-info #"|/.*"}]
     (cond
       (string? route)
-       `(route-compile ~(str route ":__path-info") ~re-context)
+       `(clout/route-compile ~(str route ":__path-info") ~re-context)
       (vector? route)
-       `(route-compile
+       `(clout/route-compile
          ~(str (first route) ":__path-info")
          ~(merge (apply hash-map (rest route)) re-context))
       :else
-       `(route-compile (str ~route ":__path-info") ~re-context))))
+       `(clout/route-compile (str ~route ":__path-info") ~re-context))))

 (defmacro context
   "Give all routes in the form a common path prefix and set of bindings.


Add new API    - a noop middleware    - a comp-middleware

--- src/re_frame/core.cljs
+++ src/re_frame/core.cljs
@@ -16,6 +16,7 @@

+(def noop        middleware/noop)
 (def pure        middleware/pure)
 (def debug       middleware/debug)
 (def undoable    middleware/undoable)
@@ -34,3 +35,21 @@
     (register-handler id pure handler))
   ([id middleware handler]
     (register-handler id [pure middleware] handler)))
+
+
+(defn comp-middleware
+  "Given a vector of middleware, filter out any nils, and use comp to compose.
+  v can  be vectors of vectors and will be flattended before use.
+  For convienience, if v turns out to already be a function, just return it."
+  [v]
+  (if (ifn? v)     ;; noop if v is a fucntion
+    v
+    (do
+      (assert  (or (vector? v) (list v))
+               (str "re-frame:  compose expects a vector, got: " v))
+      (let [v (remove nil? (flatten v))]
+        (cond
+          (empty? v)       noop
+          (= 1 (count v))  (first v)
+          :else            (apply comp v))))))
+


Remove unused import

Remove unused import

--- src/pot/core/hand.cljs
+++ src/pot/core/hand.cljs
@@ -1,6 +1,5 @@
 (ns pot.core.hand
-  (:require [pot.core.bl :refer [move-left move-right move-up move-down
-                                 can-take-step? add-random-cell]]
+  (:require [pot.core.bl :refer [move-left move-right move-up move-down add-random-cell]]
             [pot.core.comp :refer [init-state init-history]]))

 (defn state-watcher


More faffing with demunging of type names & descriptors.

--- src/depends/reader.clj
+++ src/depends/reader.clj
@@ -16,27 +16,26 @@
 (def ^:private version-name-map
   "Map of class version numbers to human readable equivalent."
   {
-    45 "1.0 or 1.1",
-    46 "1.2",
-    47 "1.3",
-    48 "1.4",
-    49 "1.5",
-    50 "1.6",
-    51 "1.7",
-    52 "1.8"   ; Speculative!
+    (org.objectweb.asm.Opcodes/V1_1) "1.1",
+    (org.objectweb.asm.Opcodes/V1_2) "1.2",
+    (org.objectweb.asm.Opcodes/V1_3) "1.3",
+    (org.objectweb.asm.Opcodes/V1_4) "1.4",
+    (org.objectweb.asm.Opcodes/V1_5) "1.5",
+    (org.objectweb.asm.Opcodes/V1_6) "1.6",
+    (org.objectweb.asm.Opcodes/V1_7) "1.7"
   })

 (def ^:private type-codes-to-names
   {
-    \B "boolean"
-    \C "char"
-    \D "double"
-    \F "float"
-    \I "int"
-    \J "long"
-    \S "short"
-    \V "void"
-    \Z "boolean"
+    \B (.getClassName org.objectweb.asm.Type/BYTE_TYPE)
+    \C (.getClassName org.objectweb.asm.Type/CHAR_TYPE)
+    \D (.getClassName org.objectweb.asm.Type/DOUBLE_TYPE)
+    \F (.getClassName org.objectweb.asm.Type/FLOAT_TYPE)
+    \I (.getClassName org.objectweb.asm.Type/INT_TYPE)
+    \J (.getClassName org.objectweb.asm.Type/LONG_TYPE)
+    \S (.getClassName org.objectweb.asm.Type/SHORT_TYPE)
+    \V (.getClassName org.objectweb.asm.Type/VOID_TYPE)
+    \Z (.getClassName org.objectweb.asm.Type/BOOLEAN_TYPE)
   })

 (def ^:private primitive-type-names (vals type-codes-to-names))
@@ -60,7 +59,7 @@
     (if-let [matches (re-matches type-name-regex (s/trim s))]
       (let [[_ ^String descriptor ^String type-name] matches]
         (if (or (= 0 (.length (s/trim descriptor))) (= "L" (s/trim descriptor)))
-          (s/replace (s/replace (s/trim type-name) \/ \.) "[]" "")       ; type (class, interface, enum, annotation, etc.)
+          (s/replace (s/replace (s/trim type-name) \/ \.) "[]" "")       ; type
           (get type-codes-to-names (first (seq (s/trim descriptor))))))  ; primitive
       (throw (Exception. (str "Invalid type name or descriptor: " s))))))

@@ -156,8 +155,8 @@
         class-name            (:name info)
         dependencies          (second class-info)
         fixed-exception-names (map determine-type-name exceptions)
-        argument-types        (map #(.getClassName ^org.objectweb.asm.Type %) (org.objectweb.asm.Type/getArgumentTypes desc))
-        return-type           (.getClassName (org.objectweb.asm.Type/getReturnType desc))]
+        argument-types        (map #(determine-type-name (.getClassName ^org.objectweb.asm.Type %)) (org.objectweb.asm.Type/getArgumentTypes desc))
+        return-type           (determine-type-name (.getClassName (org.objectweb.asm.Type/getReturnType desc)))]
     (assert (not (xor desc return-type)) (str "desc=" desc ", return-type=" return-type))  ; Check that ASM doesn't f up the return type descriptor
     [
       info
@@ -194,8 +193,8 @@
         class-name        (:name info)
         dependencies      (second class-info)
         fixed-method-type (determine-type-name owner)
-        argument-types    (map #(.getClassName ^org.objectweb.asm.Type %) (org.objectweb.asm.Type/getArgumentTypes desc))
-        return-type       (.getClassName (org.objectweb.asm.Type/getReturnType desc))]
+        argument-types    (map #(determine-type-name (.getClassName ^org.objectweb.asm.Type %)) (org.objectweb.asm.Type/getArgumentTypes desc))
+        return-type       (determine-type-name (.getClassName (org.objectweb.asm.Type/getReturnType desc)))]
     (assert (not (xor owner fixed-method-type)) (str "owner=" owner ", fixed-method-type=" fixed-method-type))  ; Check that ASM doesn't f up the method type descriptor
     (assert (not (xor desc return-type)) (str "desc=" desc ", return-type=" return-type))  ; Check that ASM doesn't f up the return type descriptor
     [


added currency-format and number-format filters

--- src/selmer/filters.clj
+++ src/selmer/filters.clj
@@ -7,7 +7,8 @@
             [selmer.util :refer [exception]])
   (:import [org.joda.time DateTime]
            [org.joda.time.format DateTimeFormat DateTimeFormatter]
-           [org.apache.commons.codec.digest DigestUtils]))
+           [org.apache.commons.codec.digest DigestUtils]
+           [java.text NumberFormat]))

 (def valid-date-formats
   {"shortDate"       (DateTimeFormat/shortDate)
@@ -23,6 +24,9 @@
    "fullTime"        (DateTimeFormat/fullTime)
    "fullDateTime"    (DateTimeFormat/fullDateTime)
    })
+
+(def currency-format
+  (NumberFormat/getCurrencyInstance))

 (defn ^DateTime fix-date
   [d]
@@ -98,6 +102,17 @@
            (apply str (repeat l \space))
            s
            (apply str (repeat r \space)))))
+
+     :currency-format
+     (fn [n]
+       (throw-when-expecting-number n)
+       (let [n (double n)]
+         (.format ^NumberFormat currency-format n)))
+
+     :number-format
+     (fn [n fmt]
+       (throw-when-expecting-number n)
+       (format fmt n))

      ;;; Format a date, expects an instance of DateTime (Joda Time) or Date.
      ;;; The format can be a key from valid-date-formats or a manually defined format


removed loader

removed loader

--- src/stencil/loader.clj
+++ src/stencil/loader.clj
@@ -1,198 +0,0 @@
-(ns stencil.loader
-  (:refer-clojure :exclude [load])
-  (:use [clojure.java.io :only [resource]]
-        [stencil.parser :exclude [partial]]
-        [stencil.ast :exclude [partial]]
-        stencil.utils)
-  (:import java.util.Date))
-
-;; The dynamic template store just maps a template name to its source code.
-(def ^{:private true} dynamic-template-store (atom {}))
-
-;; The parsed template cache maps template names to its parsed versions.
-(def ^{:private true} parsed-template-cache (atom {}))
-
-;;
-;; Cache policies
-;;
-
-(defn cache-forever
-  "This cache policy will let entries live on forever (until explicitly
-   invalidated). Could be useful in production if mustache templates can't be
-   changed in that environment."
-  [cache-entry]
-  true)
-
-(defn cache-never
-  "This cache policy will consider cache entries to never be valid, essentially
-   disabling caching. Could be useful for development."
-  [cache-entry]
-  false)
-
-(defn cache-timeout
-  "This is a cache policy generator. Takes a timeout in milliseconds as an
-   argument and returns a cache policy that considers cache entries valid for
-   only that long."
-  [timeout-ms]
-  (fn [cache-entry]
-    (let [now (Date.)]
-      (< (.getTime now)
-         (+ (.getTime ^Date (:entry-date cache-entry))
-            timeout-ms)))))
-
-;; Cache policy dictates when a given cache entry is valid. It should be a
-;; function that takes an entry and returns true if it is still valid.
-;; By default, caches templates for 5 seconds.
-(def ^{:private true} cache-policy (atom (cache-timeout 5000)))
-
-;; Holds a cache entry
-(defrecord TemplateCacheEntry [src          ;; The source code of the template
-                               parsed       ;; Parsed ASTNode structure.
-                               entry-date]) ;; Date when we cached this.
-
-(defn template-cache-entry
-  "Given template source, parsed ASTNodes, and timestamp, creates a cache entry.
-   If only source is given, parsed and timestamp are calculated automatically."
-  ([src]
-     (template-cache-entry src (parse src)))
-  ([src parsed]
-     (template-cache-entry src parsed (Date.)))
-  ([src parsed timestamp]
-     (TemplateCacheEntry. src parsed timestamp)))
-
-(declare invalidate-cache-entry invalidate-cache)
-
-(defn register-template
-  "Allows one to register a template in the dynamic template store. Give the
-   template a name and provide its content as a string."
-  [template-name content-string]
-  (swap! dynamic-template-store assoc-fuzzy template-name content-string)
-  (invalidate-cache-entry template-name))
-
-(defn unregister-template
-  "Removes the template with the given name from the dynamic template store."
-  [template-name]
-  (swap! dynamic-template-store dissoc-fuzzy template-name)
-  (invalidate-cache-entry template-name))
-
-(defn unregister-all-templates
-  "Clears the dynamic template store. Also necessarily clears the template
-   cache."
-  []
-  (reset! dynamic-template-store {})
-  (invalidate-cache))
-
-(defn find-file
-  "Given a name of a mustache template, attempts to find the corresponding
-   file. Returns a URL if found, nil if not. First tries to find
-   filename.mustache on the classpath. Failing that, looks for filename on the
-   classpath. Note that you can use slashes as path separators to find a file
-   in a subdirectory."
-  [template-name]
-  (if-let [file-url (resource (str template-name ".mustache"))]
-    file-url
-    (if-let [file-url (resource template-name)]
-      file-url)))
-
-;;
-;; Cache mechanics
-;;
-;; The template cache has two keys, the template name, and a secondary key that
-;; is called the variant. The default variant is set/fetched with nil as the
-;; variant key. Invalidating an entry invalidates all variants. The variants
-;; do NOT work with "fuzzy" map logic for getting/setting.
-;;
-
-(defn cache-assoc
-  "Function used to make atomic updates to the cache. Inserts val at the
-   hierarchical position in the map given by the pair of keys template-name and
-   template-variant. The first key (template-name) is fuzzy, the variant is
-   not."
-  [map [template-name template-variant] val]
-  (let [template-variants (get-fuzzy map template-name)]
-    (assoc-fuzzy map template-name (assoc template-variants
-                                     template-variant val))))
-
-(defn cache
-  "Given a template name, variant key, template source, and parsed AST,
-   stores that entry in the template cache. Returns the parsed template"
-  ([template-name template-variant template-src]
-     (cache template-name template-variant template-src (parse template-src)))
-  ([template-name template-variant template-src parsed-template]
-     (swap! parsed-template-cache
-            cache-assoc [template-name template-variant]
-            (template-cache-entry template-src
-                                  parsed-template))
-     parsed-template))
-
-(defn invalidate-cache-entry
-  "Given a template name, invalidates the cache entry for that name, if there
-   is one."
-  [template-name]
-  (swap! parsed-template-cache dissoc-fuzzy template-name))
-
-(defn invalidate-cache
-  "Clears all entries out of the cache."
-  []
-  (reset! parsed-template-cache {}))
-
-(defn cache-get
-  "Given a template name, attempts to fetch the template with that name from
-   the template cache. Will apply the cache policy, so if the cache policy says
-   the entry is too old, it will return nil. Otherwise, returns the
-   cache-entry. Single argument version gets the default (nil) variant."
-  ([template-name]
-     (cache-get template-name nil))
-  ([template-name template-variant]
-     (let [cache-entry (get (get-fuzzy @parsed-template-cache template-name)
-                            template-variant)]
-       (when (and (not (nil? cache-entry))
-                  (@cache-policy cache-entry))
-         cache-entry))))
-
-(defn set-cache-policy
-  "Sets the function given as an argument to be the cache policy function (takes
-   a cache-entry as argument, returns true if it is still valid)."
-  [new-cache-policy-fn]
-  (reset! cache-policy new-cache-policy-fn))
-
-;;
-;; Loader API
-;;
-
-(defn load
-  "Attempts to load a mustache template by name. When given something like
-   \"myfile\", it attempts to load the mustache template called myfile. First it
-   will look in the dynamic template store, then look in the classpath for
-   a file called myfile.mustache or just myfile.
-
-   With addition arguments template-variant and variant-fn, supports the load
-   and caching of template variants. The template-variant arg is a variant key,
-   while the variant-fn arg is a single argument function that will be called
-   with the template source as argument before it is cached or returned."
-  ([template-name]
-     (load template-name nil identity))
-  ([template-name template-variant variant-fn]
-     (if-let [cached (cache-get template-name template-variant)]
-       (:parsed cached)
-       ;; It wasn't cached, so we have to load it. Try dynamic store first.
-       (if-let [dynamic-src (get-fuzzy @dynamic-template-store template-name)]
-         ;; If found, parse and cache it, then return it.
-         (cache template-name template-variant (variant-fn dynamic-src))
-         ;; Otherwise, try to load it from disk.
-         (if-let [file-url (find-file template-name)]
-           (let [template-src (slurp file-url)]
-             (cache template-name
-                    template-variant
-                    (variant-fn template-src))))))))
-
-(extend-protocol ASTNode
-  stencil.ast.Partial
-  (render [this sb context-stack]
-    (let [padding (:padding this)
-          template (if padding
-                     (load (:name this) padding #(indent-string % padding))
-                     (load (:name this)))]
-      (when template
-        (render template sb context-stack)))))
-


using altsgit add src/fowles/fetcher.clj

--- src/fowles/fetcher.clj
+++ src/fowles/fetcher.clj
@@ -4,7 +4,7 @@
             [clojure.string :as str]
             [org.httpkit.client :as http]
             [clojure.core.async
-             :refer [chan go partition map< split >! <!]
+             :refer [chan go partition map< split >! <! take! alts!!]
              :as async]))

 ;;-------------------------------------------
@@ -31,20 +31,13 @@
          (hmap->query-string args))))

-;; Use `partition` to to create a channel
-;; which will create collections of items from another channel.
-;; Push individual video-ids onto A, partition them onto B.
+(def IDS_PER_QUERY 2)

 ;; Channels
 ;;   1. video-id   -> [video-id]                 (`partition`)
 ;;   2. [video-id] -> uri                        (`map<`)
 ;;   3. uri        -> response-promise
 ;;   4. response-promise -> good-response | bad-response   (`split`)
-
-
-(def IDS_PER_QUERY 2)
-(defn query-count [seq]
-  (/ (count seq) IDS_PER_QUERY))

 (defn mk-pipeline-chan
   [api-key video-ids parts]
@@ -54,17 +47,22 @@
        ;; http://http-kit.org/client.html
        (async/map< #(deref (http/get %)))))

-;; this doesn't work
-;; async/close!))
-
-;; (doseq [vid-id video-ids]
-;; (go (async/>! ch vid-id)))
+(defn query-count [seq]
+  (/ (count seq) IDS_PER_QUERY))

 (defn -main []
   (let [video-ids ["7lCDEYXw3mM" "MjtOzLfebgY" "6QIw1BQIvT4" "2xJWQPdG7jE"]
         parts     ["snippet" "contentDetails" "statistics" "status"]
         ch        (mk-pipeline-chan api-key video-ids parts)]
-    (go (dotimes [_ (query-count video-ids)]
-          (println (async/<! ch))))
-    (Thread/sleep 10000)
+
+    ;; (go (dotimes [_ (query-count video-ids)]
+    ;;      (println (async/<! ch))))
+    ;;      ;; (async/take! ch println))
+    ;; (Thread/sleep 10000)
+
+    (dotimes [_ (query-count video-ids)]
+      (let [[v c] (async/alts!! [ch])]
+        (println v)))
+
+    (async/close! ch)
 ))


Add missing docstrings to core ns

Add missing docstrings to core ns

Fixes #588

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -20,22 +20,6 @@
 ;; -- API ---------------------------------------------------------------------
 ;;
 ;; This namespace represents the re-frame API
-;;
-;; Below, you'll see we've used this technique:
-;;   (def  api-name-for-fn    deeper.namespace/where-the-defn-is)
-;;
-;; So, we promote a `defn` in a deeper namespace "up" to the API
-;; via a `def` in this namespace.
-;;
-;; Turns out, this approach makes it hard:
-;;   - to auto-generate API docs
-;;   - for IDEs to provide code completion on functions in the API
-;;
-;; Which is annoying. But there are pros and cons and we haven't
-;; yet revisited the decision.  To compensate, we've added more nudity
-;; to the docs.
-;;
-

 ;; -- dispatch ----------------------------------------------------------------
 (defn dispatch
@@ -243,7 +227,8 @@
   De-duplication
   --------------

-  XXX
+  Two, or more, concurrent subscriptions for the same query will source reactive
+  updates from the one executing handler.
   "
   ([query]
    (subs/subscribe query))
@@ -251,10 +236,16 @@
    (subs/subscribe query dynv)))

 (defn clear-sub ;; think unreg-sub
+  "When called with no args, unregisters all subscription handlers. When given
+   one arg, assumed to be a `query-id` of a registered subscription handler,
+   unregisters the associated handler.
+
+   NOTE: Depending on the usecase it may also be necessary to call
+         `clear-subscription-cache!`."
   ([]
    (registrar/clear-handlers subs/kind))
-  ([id]
-   (registrar/clear-handlers subs/kind id)))
+  ([query-id]
+   (registrar/clear-handlers subs/kind query-id)))

 (defn clear-subscription-cache!
   "Causes all subscriptions to be removed from the cache.
@@ -305,7 +296,14 @@
   [id handler]
   (fx/reg-fx id handler))

-(def clear-fx    (partial registrar/clear-handlers fx/kind))  ;; think unreg-fx
+(defn clear-fx ;; think unreg-fx
+  "When called with no args, unregisters all effect handlers. When given one arg,
+   assumed to be the `id` of a registered effect handler, unregisters the
+   associated handler."
+  ([]
+   (registrar/clear-handlers fx/kind))
+  ([id]
+   (registrar/clear-handlers fx/kind id)))

 ;; -- coeffects ---------------------------------------------------------------
 (defn reg-cofx
@@ -377,8 +375,14 @@
   ([id value]
    (cofx/inject-cofx id value)))

-(def clear-cofx (partial registrar/clear-handlers cofx/kind)) ;; think unreg-cofx
-
+(defn clear-cofx ;; think unreg-cofx
+  "When called with no args, unregisters all coeffect handlers. When given one arg,
+   assumed to be the `id` of a registered coeffect handler, unregisters the
+   associated handler."
+  ([]
+   (registrar/clear-handlers cofx/kind))
+  ([id]
+   (registrar/clear-handlers cofx/kind id)))

 ;; -- Events ------------------------------------------------------------------

@@ -428,6 +432,9 @@
    (events/register id [cofx/inject-db fx/do-fx interceptors (ctx-handler->interceptor handler)])))

 (defn clear-event ;; think unreg-event-*
+  "When called with no args, unregisters all event handlers. When given one arg,
+   assumed to be the `id` of a registered event handler, unregisters the
+   associated handler."
   ([]
    (registrar/clear-handlers events/kind))
   ([id]
@@ -607,6 +614,10 @@
   (utils/apply-kw interceptor/->interceptor m))

 (defn get-coeffect
+  "When called with one arg, returns the coeffects map from the `context`.
+   When called with two or three args, behaves like `clojure.core/get`,
+   returns the value mapped to `key` in the coeffects map, `not-found` or
+   `nil` if `key` is not present."
   ([context]
    (interceptor/get-coeffect context))
   ([context key]
@@ -615,10 +626,16 @@
    (interceptor/get-coeffect context key not-found)))

 (defn assoc-coeffect
-  [context key f & args]
-  (apply interceptor/assoc-coeffect (into [context key f] args)))
+  "Returns a new `context` with a new coeffects map that contains `key`
+   mapped to the `value`."
+  [context key value]
+  (interceptor/assoc-coeffect context key value))

 (defn get-effect
+  "When called with one arg, returns the effects map from the `context`.
+   When called with two or three args, behaves like `clojure.core/get`,
+   returns the value mapped to `key` in the effects map, `not-found` or
+   `nil` if `key` is not present."
   ([context]
    (interceptor/get-effect context))
   ([context key]
@@ -627,6 +644,8 @@
    (interceptor/get-effect context key not-found)))

 (defn assoc-effect
+  "Returns a new `context` with a new effects map that contains `key`
+   mapped to the `value`."
   [context key value]
   (interceptor/assoc-effect context key value))

@@ -653,13 +672,15 @@
   [new-loggers]
   (loggers/set-loggers! new-loggers))

-;; If you are writing an extension to re-frame, like perhaps
-;; an effects handler, you may want to use re-frame logging.
-;;
-;; usage: (console :error "Oh, dear God, it happened: " a-var " and " another)
-;;        (console :warn "Possible breach of containment wall at: " dt)
-
 (defn console
+  "Logs `args` to the console at `level`.
+   Level can be one of `:log` `:error` `:warn` `:debug` `:group` `:groupEnd`.
+   If you are writing an extension to re-frame, like prehaps an effect handler,
+   you may want to use re-frame logging so that users can configure logging
+   from a central location.
+
+   usage: (console :error \"Oh, dear God, it happened:\" a-var \"and\" another)
+          (console :warn \"Possible breach of containment wall at:\" dt)"
   [level & args]
   (apply loggers/console (into [level] args)))

@@ -719,6 +740,8 @@

 (defn remove-post-event-callback
+  "Unregisters the function identified by `id` to be called after each event is
+   processed."
   [id]
   (router/remove-post-event-callback re-frame.router/event-queue id))

@@ -726,12 +749,14 @@
 ;; --  Deprecation ------------------------------------------------------------
 ;; Assisting the v0.7.x ->  v0.8.x transition.
 (defn register-handler
+  "Deprecated. Use `reg-event-db` instead."
   {:deprecated "0.8.0"}
   [& args]
   (console :warn  "re-frame:  \"register-handler\" has been renamed \"reg-event-db\" (look for registration of" (str (first args)) ")")
   (apply reg-event-db args))

 (defn register-sub
+  "Deprecated. Use `reg-sub-raw` instead."
   {:deprecated "0.8.0"}
   [& args]
   (console :warn  "re-frame:  \"register-sub\" is deprecated. Use \"reg-sub-raw\" (look for registration of" (str (first args)) ")")


File selection

File selection

--- src/reagent2/core.cljs
+++ src/reagent2/core.cljs
@@ -60,8 +60,22 @@
   [:input {:type "button" :value "Reset"
            :on-click #(reset-board)}])

+(defn atom-input [value]
+  [:input {:field :file :type :file
+           :value @value
+           :on-change #(reset! value (-> % .-target .-value))}])
+
+(defn shared-state []
+  (let [val (reagent/atom "foo")]
+    (fn []
+      [:div
+       [:p "The value is now: " @val]
+       [:p "Change it here: " [atom-input val]]])))
+
 (defn home-page []
-  [:div [reset-button]])
+  [:div
+   [shared-state]
+   [reset-button]])

 ;; -------------------------


Sends images to a splunk request

Sends images to a splunk request

--- src/images/handler.clj
+++ src/images/handler.clj
@@ -13,7 +13,9 @@
   (GET "/" [] {:status 200 :body "Dat image search ya'll"})
   (GET "/image" [path filename]
        {:status 200
-        :headers {"Content-Type" (str "image/" (content-subtype filename))}
+        :headers {"Content-Type" (str "image/" (content-subtype filename))
+                  "Access-Control-Allow-Headers" "x-splunk-form-key, accept, origin"
+                  "Access-Control-Allow-Methods" "GET"}
         :body (reader/get-image path filename)})
   (route/resources "/")
   (route/not-found "Not Found"))


Minor correction to db.

Minor correction to db.

--- src/kosha/db/kriti.clj
+++ src/kosha/db/kriti.clj
@@ -19,3 +19,7 @@
             WHERE kriti_id = ?; "
            kriti-id]]
     (vec (db-util/run-query q))))
+
+(defn all-kritis []
+  (let [q ["SELECT k.* FROM kritis k"]]
+    (db-util/run-query q)))


Remove eval-without-project

Remove eval-without-project

--- src/leiningen/repl.clj
+++ src/leiningen/repl.clj
@@ -1,6 +1,6 @@
 (ns leiningen.repl
   (:require [clojure.main])
-  (:use [leiningen.compile :only [eval-in-project eval-without-project]]
+  (:use [leiningen.compile :only [eval-in-project]]
         [clojure.java.io :only [copy]])
   (:import [java.net Socket]
            [java.io OutputStreamWriter InputStreamReader File]))


New way of mapping

New way of mapping

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -290,6 +290,10 @@
 (defn map-quneo
   []
   (cues/add-midi-control-to-cue-mapping "quneo" 0 :note 36 0 7)
+  (show/add-midi-control-to-var-mapping
+    "quneo" 0 24 :sparkle-chance :min 0.01 :max 0.2)
+  (show/add-midi-control-to-var-mapping
+    "quneo" 0 25 :sparkle-fade :min 1 :max 500)
 )
 (afterglow.midi/watch-for "quneo" map-quneo)


Better option unwrap.

Better option unwrap.

--- core/src/main/clojure/stone/core.clj
+++ core/src/main/clojure/stone/core.clj
@@ -74,7 +74,7 @@
   (.publish ts timestamp value))

 (defn readers [^Database db id]
-  (.get (.getReaders db id)))
+  (.orNull (.getReaders db id)))

 (defn close
   ([^Closeable cl] (.close cl))


Allow restart on buggy actions

Allow restart on buggy actions

--- src/obb_demo/core.cljs
+++ src/obb_demo/core.cljs
@@ -47,11 +47,12 @@
               result (turn/simulate-actions game player [action])
               new-game (result/result-board result)]
           #_(println player action)
-          (when-not (result/succeeded? result)
-            (println result))
-          (-> (assoc game-data :game new-game)
-              (dissoc :action)
-              (assoc :actions (rest actions))))
+          (if-not (result/succeeded? result)
+            (do (println result)
+                game-data)
+            (-> (assoc game-data :game new-game)
+                (dissoc :action)
+                (assoc :actions (rest actions)))))
         (-> (assoc game-data :action (first actions))
             #_(boardground/with-selected-element (nth (first actions) 1))
             #_())))))


Added year condition to search.

Added year condition to search.

--- src/ontrail/search.clj
+++ src/ontrail/search.clj
@@ -64,20 +64,24 @@

 (defn month-str [date]
   (when date
-    (.toString date "yyyy-M")))
+    (.toString date "'m:'yyyy-M")))
+
+(defn year-str [date]
+  (when date
+    (.toString date "'y:'yyyy")))

 (defn exercise-to-terms [exercise]
-  (concat
-   (to-term-seq (tags-to-string (:tags exercise)))
-   (to-term-seq (str (:user exercise) " u:" (:user exercise)))
-   (to-term-seq (:body exercise))
-   (to-term-seq (:title exercise))
-   (to-term-seq (str (:sport exercise) " m:" (month-str (:creationDate exercise))))
-   (to-term-seq
-    (reduce
-     (fn [result comment]
-       (str result " " (:body comment) " c:"(:user comment)))
-     "" (:comments exercise)))))
+  (concat
+    [(:sport exercise) (month-str (:creationDate exercise)) (year-str (:creationDate exercise))]
+     (to-term-seq (tags-to-string (:tags exercise)))
+     (to-term-seq (str (:user exercise) " u:" (:user exercise)))
+     (to-term-seq (:body exercise))
+     (to-term-seq (:title exercise))
+     (to-term-seq
+      (reduce
+       (fn [result comment]
+         (str result " " (:body comment) " c:"(:user comment)))
+       "" (:comments exercise)))))

 (defn insert-term [assoc-fn ex-id index term]
   (if-let [postings (index term)]


test cases

test cases

--- cloc-web/test/cloc_web/core_test.clj
+++ cloc-web/test/cloc_web/core_test.clj
@@ -96,4 +96,21 @@
           (cheshire/parse-string true)
           count
           (= 2)
-          is))))+          is))))
+
+(deftest patch-display-lang-with-unauthorized-user
+ (testing "no session"
+    (is (= 401 (:status (client/patch (str url "/user/target/display_lang") {:accept :json
+                                                                             :body ""
+                                                                             :content-type :json
+                                                                             :throw-exceptions false}))))
+
+  (testing "invalid session id"
+    (let [client-get clj-http.client/get]
+      (with-redefs [clj-http.client/get (fn [& param] {:status 400
+                                                       :body {:error ""}})]
+        (is (= 401 (:status (client/patch (str url "/user/target/display_lang") {:accept :json
+                                                                                :body ""
+                                                                                :content-type :json
+                                                                                :throw-exceptions false
+                                                                                :cookies {"session_id" {:discard true :value (jwt-token "debug_token" {:expires (-> 28 days)})}}})))))))))


dsets.clj: results are no longer made canonical.

--- clojure/org/gavrog/clojure/dsets.clj
+++ clojure/org/gavrog/clojure/dsets.clj
@@ -45,7 +45,7 @@
               #{}]
        :extract (fn [[ds free alt-starts]]
                   (when (and (empty? free) (first (best? ds alt-starts)))
-                    (canonical ds)))
+                    ds))
        :children (fn [[ds free alt-starts]]
                    (when (seq free)
                      (let [[i D] (first free)


- lists: cleanup and minimalise demo

- lists: cleanup and minimalise demo

--- src/re_demo/lists.cljs
+++ src/re_demo/lists.cljs
@@ -1,17 +1,17 @@
 (ns re-demo.lists
   (:require [reagent.core          :as     r]
             [re-com.core           :refer  [label checkbox]]
-            [re-com.box            :refer  [h-box v-box gap]]
-            [re-com.dropdown       :refer  [single-dropdown]]
+            [re-com.box            :refer  [h-box v-box]]
             [re-com.selection-list :refer  [selection-list]]
             [re-com.util           :refer  [golden-ratio-a golden-ratio-b]]))

-(defn- parameters-with
-  [content multi-select? disabled? required? as-exclusions?]
+(defn- options-with
+  [width content multi-select? disabled? required? as-exclusions?]
   (fn []
     (let [check-style {:font-size "small" :margin-top "1px"}]
       [v-box
+       :width (str width "px")
        :gap      "20px"
        :align    :start
        :children [[label :style {:font-style "italic"} :label "boolean parameters:"]
@@ -42,8 +42,8 @@

-(defn- show-variant
-  [variation]
+(defn- list-with-options
+  [width]
   (let [disabled?     (r/atom false)
         multi-select? (r/atom true)
         required?     (r/atom true)
@@ -56,32 +56,28 @@
                                {:id "6" :label "6 Donec id elit non mi porta gravida at eget metus. Maecenas sed diam eget risus varius blandit" :short "Short label 6"}
                                {:id "7" :label "7 Donec id elit non mi porta gravida at eget metus. Maecenas sed diam eget risus varius blandit" :short "Short label 7"}])
         selections    (r/atom (set [(second @items)]))]
-    (case variation
-      "1" [(fn
-             []
-             [parameters-with
-               [v-box
-                :gap      "20px"
-                :align    :start
-                :children [[selection-list
-                            :width         "391px"      ;; manual hack for width of variation panel A+B 1024px
-                            :max-height    "95px"       ;; based on compact style @ 19px x 5 rows
-                            :model         selections
-                            :choices       items
-                            :label-fn      :label
-                            :as-exclusions as-exlcusion?
-                            :multi-select  multi-select?
-                            :disabled      disabled?
-                            :required      required?
-                            :on-change     #(do (println %) (reset! selections %))]]]
-               multi-select?
-               disabled?
-               required?
-               as-exlcusion?])])))
+    [options-with
+     width
+     [v-box ;; TODO: v-box required to constrain height of internal border.
+      :children [[selection-list
+                  :width         "391px"      ;; manual hack for width of variation panel A+B 1024px
+                  :max-height    "95px"       ;; based on compact style @ 19px x 5 rows
+                  :model         selections
+                  :choices       items
+                  :label-fn      :label
+                  :as-exclusions as-exlcusion?
+                  :multi-select  multi-select?
+                  :disabled      disabled?
+                  :required      required?
+                  :on-change     #(do (println %) (reset! selections %))]]]
+     multi-select?
+     disabled?
+     required?
+     as-exlcusion?]))

 (defn- notes
-  [_ width]
+  [width]
   [v-box
    :width (str width "px")
    :children [[:div.h4 "Parameters:"]
@@ -125,33 +121,16 @@
                  " - IFn to call on each element to get label string, default #(str %)"]]]]])

-(def variations ^:private [{:id "1" :label "Toggle single/multiple selection"}])
-
 (defn panel
   []
-  (let [selected-variation (r/atom "1")]
-    (fn []
-      (let [panel-width 1024
-            h-gap         70
-            a-width     (- (golden-ratio-a panel-width) h-gap)
-            b-width     (golden-ratio-b panel-width)]
-        [v-box
-         :width    (str panel-width "px")
-         :children [[:h3.page-header "Multiple & Single Selection List"]
-                    [h-box
-                     :gap      (str h-gap "px")
-                     :children [[notes selected-variation a-width]
-                                [v-box
-                                 :gap       "15px"
-                                 :width     (str b-width "px")
-                                 :children  [[h-box
-                                              :align    :center
-                                              :justify  :between
-                                              :children [[label :label "Choose variation"]
-                                                         [single-dropdown
-                                                          :width     "auto"
-                                                          :choices   variations
-                                                          :model     selected-variation
-                                                          :on-change #(reset! selected-variation %)]]]
-                                             [gap :size "0px"] ;; Force a bit more space here
-                                             [show-variant @selected-variation]]]]]]]))))+  (let [panel-width 1024
+        h-gap       70
+        a-width     (- (golden-ratio-a panel-width) h-gap)
+        b-width     (golden-ratio-b panel-width)]
+    [v-box
+     :width    (str panel-width "px")
+     :children [[:h3.page-header "Multiple & Single Selection List"]
+                [h-box
+                 :gap      (str h-gap "px")
+                 :children [[notes a-width]
+                            [list-with-options b-width]]]]]))


require reagent.ratom macros in cljs namespace

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -1,6 +1,7 @@
 (ns reagent.ratom
   (:refer-clojure :exclude [atom])
-  (:require-macros [reagent.debug :refer (dbg log warn dev?)])
+  (:require-macros [reagent.debug :refer (dbg log warn dev?)]
+                   reagent.ratom)
   (:require [reagent.impl.util :as util]))

 (declare ^:dynamic *ratom-context*)


Update the old get-or-create-session schema.

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -399,11 +399,13 @@
                                  defaulted-reqs)))))))

 (def OldGetOrCreateArg
-  {(s/optional-key :browser-name)  s/Str
-   (s/optional-key :reserved)      s/Bool
+  {(s/optional-key :browser-name)   s/Str
+   (s/optional-key :reserved)       s/Bool
    (s/optional-key :tags)          [s/Str]
-   (s/optional-key :node)          {:url s/Str}
-   (s/optional-key :current-url)   s/Str
+   (s/optional-key :node)          {(s/optional-key :url)   s/Str
+                                    (s/optional-key :id)    s/Str
+                                    (s/optional-key :tags) [s/Str]}
+   (s/optional-key :current-url)    s/Str
    (s/optional-key :reserve-after-create)       s/Bool
    (s/optional-key :extra-desired-capabilities) Capabilities
    (s/optional-key :force-create)               s/Bool})


Fix grammar

Fix grammar

--- webapp/src/org/teamweek/webapp/endpoint/team.clj
+++ webapp/src/org/teamweek/webapp/endpoint/team.clj
@@ -44,7 +44,7 @@
                                   :member/email email})
                  :team/questions [{:question/text "What have you accomplished this week?"
                                    :question/order 1}
-                                  {:question/text "What you commit to do next week?"
+                                  {:question/text "What do you commit to do next week?"
                                    :question/order 2}]}]
     @(d/transact conn [team-tx])))


ugh clojure

ugh clojure

--- src/advent/core.clj
+++ src/advent/core.clj
@@ -210,6 +210,7 @@
     circuit-input)
   )

+
 (defn build-circuit
   "returns a map of input's data
   Usage: (build-circuit \"day-7-data.txt\")
@@ -217,18 +218,20 @@
   [circuit-input]
   (map-values (parse-circuit-data-into-map (str/split (slurp circuit-input) #"\n")) single-values-to-keywords))

-
+(defn parse-int [i]
+  (try
+    (Integer. i)
+    (catch Exception e i)))

 (defn find-signal
-  "returns the value of signal (keyword) within a circuit (map)"
+  "returns the value of signal (keyword) within a circuit (map)
+  Usage: (find-signal :i sample-built-circuit)"
   [signal circuit]
   (if (integer? (signal circuit))
     (signal circuit)
     (case (count (signal circuit))
-      2 ((let [value-as-string (last (signal circuit))
-               value (read-string (value-as-string))
-               is-value-number (number? value)]
-           (if is-value-number
-             (bit-not-unsigned value)
-             (find-signal (keyword value) circuit))))
+      2 ((let [value (parse-int (last (signal circuit)))]
+           (if (number? value)
+             (println "is a number")
+             (println "is not a number") )))
       3 (println "got three here"))))


Remove debug print.

Remove debug print.

--- src/app/screen.cljs
+++ src/app/screen.cljs
@@ -41,7 +41,6 @@

 (defn gen-noncollide-attrs []
   (loop [trials 100]
-    (println trials)
     (let [div2 (gen-div-attrs)]
       (if (and (divs-collision? div2 @divs)
                (> trials 0))


comments and cleanup dead code

comments and cleanup dead code

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -16,30 +16,6 @@

 ;; use map or pmap.
 (def ^:const mapfn pmap)
-
-;; tree-building functions: useful for developing grammars.
-(defn into-list-of-maps [arg]
-  (cond
-
-   (seq? arg)
-   arg
-
-   (set? arg)
-   (seq arg)
-
-   (map? arg)
-   (list arg)
-
-   (nil? arg)
-   (list :top)
-
-   (keyword? arg)
-   (list arg)
-
-   true (throw (exception (str "into-map: don't know what to do with a " (type arg) ".")))))
-
-(declare overh)
-(declare overc)

 (def ^:dynamic *extra-diagnostics* false)

@@ -139,11 +115,11 @@
                               (get-in child fail-path)))
               (if (and (not (= (get-in parent [:synsem :cat])
                                (get-in child [:synsem :cat]))))
-                (log/warn (str "moreover-head: CHILD CAT DIFFERS FROM HEAD CAT!")))
+                (log/warn (str "moreover-head: parent's :cat != head child's cat.")))
               (if (fail? (unify (get-in parent [:head :synsem :subcat :1 :cat])
                                 (get-in child [:synsem :subcat :1 :cat])))
-                (log/trace (str "moreover-head: SUBCAT parent head subcat 1:" (get-in parent [:head :synsem :subcat :1 :cat]) ";"
-                                "moreover-head: SUBCAT        head subcat 1:" (get-in child [:synsem :subcat :1 :cat]))))
+                (log/trace (str "moreover-head: parent specifies: [:head :synsem :subcat :1]: " (get-in parent [:head :synsem :subcat :1 :cat]) ";"
+                                "moreover-head: head child specifies: [:synsem subcat :1]   : " (get-in child [:synsem :subcat :1 :cat]))))
               (if (and false ;; TODO (if no-pre-checks-have-caught-this ..)
                        (get-in parent [:head :synsem :infl])
                        (get-in comp [:synsem :infl]))
@@ -161,7 +137,8 @@
       (log/trace (str "overh: head: " (get-in head [:rule] (str "head is a lexeme with pred: " (strip-refs (get-in head [:synsem :sem :pred]))))))
       (log/trace (str "overh: parent: " (strip-refs (dissoc parent :serialized))))
       (log/trace (str "overh: head: " (strip-refs (dissoc head :serialized))))))
-
+  ;; TODO: get rid of all this type-checking and use
+  ;; whatever the smart people use for Clojure argument type-checking.
   (cond

    (nil? head)


Re-factor source code formating.

Re-factor source code formating.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -148,10 +148,11 @@

 (defn merge-options
   [defaults user-options mandatory-defaults]
-  (merge-with (fn [a b] (if (and (map? a) (map? b))
-                          (merge a b)
-                          b))
-              defaults user-options mandatory-defaults))
+  (merge-with
+    (fn [a b] (if (and (map? a) (map? b))
+                (merge a b)
+                b))
+    defaults user-options mandatory-defaults))

 (defn get-cli-opts
   [user-options]


Add quit function

Add quit function

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/main.clj
+++ src/conexp/main.clj
@@ -79,6 +79,11 @@
        (do (require 'conexp.tests)
            (clojure.test/run-tests 'conexp.tests)))))

+(defn quit
+  "Quits conexp-clj."
+  []
+  (System/exit 0))
+
 ;;;


Add HTTPS support to ALB

Add HTTPS support to ALB

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -244,16 +244,16 @@
 ;; health_check https://www.terraform.io/docs/providers/aws/r/alb_target_group.html# sensible defaults

 (defn alb-listener
-  [name-fn {:keys [account-number protocol lb-port port alb-name name ssl-policy cert]}]
+  [name-fn {:keys [account-number lb-protocol protocol lb-port port alb-name name ssl-policy cert]}]
   (let [cluster-resource (partial resource name-fn)
         cluster-output-of (fn [type name output] (output-of type (name-fn name) output))
-        ssl-cert-arn (str "arn:aws:iam::" account-number ":server-certificate/" cert)
-        add-cert-if-present #(if cert (assoc % :certificate_arn ssl-cert-arn) %)
+        ssl-cert-arn cert
+        add-cert-if-present #(if cert (assoc % :certificate_arn ssl-cert-arn :ssl_policy ssl-policy) %)
         alb-arn (cluster-output-of "aws_alb" alb-name "arn")]
     (cluster-resource "aws_alb_listener" name
                       (add-cert-if-present {:load_balancer_arn alb-arn
                                             :port (or lb-port port) ;; lb-port is optional
-                                            :protocol protocol
+                                            :protocol (or lb-protocol protocol)
                                             :default_action {:target_group_arn (cluster-output-of "aws_alb_target_group" name "arn")
                                                              :type "forward"}}))))

@@ -282,7 +282,7 @@
                     name-fn
                     (merge {:account-number account-number
                             :alb-name name}
-                           (select-keys % [:name :port :lb-port :protocol :ssl-policy :cert]))) listeners)))))
+                           (select-keys % [:name :port :lb-port :lb-protocol :protocol :ssl-policy :cert]))) listeners)))))

 (defn asg [name
            name-fn


should also get default security groups!

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -196,7 +196,7 @@
                                                :ssl_certificate_id (str "arn:aws:iam::" account-id ":server-certificate/" cert_name)}]
                             [default-listener])
         listeners (concat default-listeners (:listeners spec))
-        elb-security-groups        (map #(id-of "aws_security_group" %) sgs)]
+        elb-security-groups        (map #(id-of "aws_security_group" %) (concat sgs default-sgs))]
     (cluster-resource "aws_elb" name {:name name
                                       :subnets subnets
                                       :security_groups elb-security-groups


Relax API wrapper for `on` and `at`

Relax API wrapper for `on` and `at`

These functions may be better to allow a protocol so that they work
with, say, intervals.

--- src/tick/alpha/api.clj
+++ src/tick/alpha/api.clj
@@ -102,8 +102,8 @@

 ;; Time

-(defn on [t d] (core/on (time t) (date d)))
-(defn at [d t] (core/at (date d) (time t)))
+(defn on [t d] (core/on t (date d)))
+(defn at [d t] (core/at d (time t)))
 (defn noon [v] (core/noon v))
 (defn midnight [v] (core/midnight v))
 (defn midnight? [v] (core/midnight? v))


simplified to use slide, and slide!

simplified to use slide, and slide!

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -114,14 +114,12 @@
                          (paint [g]
                                 (dorun (for [x (range dim) y (range dim)]
                                          (render-tile g @*board* [x y])))))
-        move! (fn ([piece]
-                    (dosync (alter *board* move piece))
-                    (.repaint panel)))
-        mover! (fn [& moves]
+        slide! (fn [& moves]
                 (send (agent moves)
                       (fn [moves]
-                        (doseq [m moves]
-                          (move! m)
+                        (doseq [piece moves]
+                          (dosync (alter *board* slide piece))
+                          (.repaint panel)
                           (Thread/sleep 300)))))]
     (dosync (ref-set *board* (vec (concat (range 1 (* dim dim)) '(0))))
             (when (> dim 2)
@@ -132,17 +130,16 @@
       (.addKeyListener
        (proxy [KeyAdapter] []
          (keyPressed [#^KeyEvent e]
-                     (let [dir-move (comp move! (partial move-direction @*board*))]
-                       (condp = (.getKeyCode e)
-                           KeyEvent/VK_LEFT  (dir-move :left)
-                           KeyEvent/VK_RIGHT (dir-move :right)
-                           KeyEvent/VK_UP    (dir-move :up)
-                           KeyEvent/VK_DOWN  (dir-move :down)
-                           KeyEvent/VK_Q     (.dispose #^JFrame frame)
-                           KeyEvent/VK_S     (apply mover! (path-to @*board* [0 0]))
-                           true))))))
+                     (condp = (.getKeyCode e)
+                         KeyEvent/VK_LEFT  (slide! :left)
+                         KeyEvent/VK_RIGHT (slide! :right)
+                         KeyEvent/VK_UP    (slide! :up)
+                         KeyEvent/VK_DOWN  (slide! :down)
+                         KeyEvent/VK_Q     (.dispose #^JFrame frame)
+                         KeyEvent/VK_S     (apply slide! (path-to @*board* [0 0]))
+                         true)))))
     (doto frame (.setContentPane panel) .pack .show)
-    mover!))
+    slide!))

 (comment
-  (def move! (main 3)))
+  (def slide! (main 3)))


Change tasks :due-by to :due.

Change tasks :due-by to :due.

--- src/todo_repl/core.clj
+++ src/todo_repl/core.clj
@@ -3,23 +3,23 @@
     (:require [todo-repl.date-parsing :as dp])
     #_(:use todo-repl.date-parsing))

-(defn new-task [name due-by due-after context url]
+(defn new-task [name due due-after context url]
   {:name name
    :due-after due-after
-   :due-by due-by
+   :due due
    :context context
    :url url
    :status :incomplete
    :created (str (java.util.Date.))
    })

-(defn new-task-better [{:keys [name due-after due-by context url]
-                   :or {due-by "never"
+(defn new-task-better [{:keys [name due-after due context url]
+                   :or {due "never"
                         due-after nil
                         context nil
                         url [{:label "" :url ""}] }}]
   (new-task name
-            (dp/nl-to-date due-by)
+            (dp/nl-to-date due)
             (dp/nl-to-date due-after)
             context
             url))