(PDB-4310) Fix intermittent unusual-queue-names test failures

Unmake my mess.  Fix intermittent test failures in
handling-commands-producing-unusual-queue-names-across-restart which
I believe were caused by redef races across the server restart and/or
redefing at too low a level (move the redef to process-cmdref to
bypass all of the processsing, discards, etc.).

Rework the test to use two completely separate instances with a shared
vardir to make the phase separation simpler and hopefully clearer.

--- test/puppetlabs/puppetdb/command_test.clj
+++ test/puppetlabs/puppetdb/command_test.clj
@@ -30,7 +30,7 @@
             [puppetlabs.puppetdb.reports :as reports]
             [puppetlabs.puppetdb.testutils
              :refer [args-supplied call-counter default-timeout-ms dotestseq
-                     times-called]]
+                     temp-dir times-called]]

             [puppetlabs.puppetdb.jdbc :refer [query-to-vec] :as jdbc]
             [puppetlabs.puppetdb.jdbc-test :refer [full-sql-exception-msg]]
@@ -47,8 +47,7 @@
             [slingshot.test]
             [puppetlabs.puppetdb.utils :as utils]
             [puppetlabs.puppetdb.time :as pt]
-            [puppetlabs.trapperkeeper.app  :as tk-app
-             :refer [get-service app-context]]
+            [puppetlabs.trapperkeeper.app :refer [get-service app-context]]
             [clojure.core.async :as async]
             [puppetlabs.kitchensink.core :as ks]
             [clojure.string :as str]
@@ -1656,48 +1655,59 @@

 (deftest handling-commands-producing-unusual-queue-names-across-restart
   ;; Should also apply to a full server stop/start
-  (let [producer-ts (to-string (now))]
-    (svc-utils/with-puppetdb-instance
-      (let [dispatcher (get-service *server* :PuppetDBCommandDispatcher)
-            enqueue-command (partial enqueue-command dispatcher)
-            mod-cert "underscores_must_be_altered_for_the_queue"
-            long-cert (apply str (repeat (inc queue/max-metadata-utf8-bytes) "z"))
-            enqueue #(enqueue-command (command-names :replace-facts) 4 %
-                                      nil
-                                      (tqueue/coerce-to-stream
-                                       {:environment "DEV" :certname %
-                                        :values {:foo "foo"}
-                                        :producer_timestamp producer-ts})
-                                      "")]
-        (with-redefs [process-command-and-respond! (fn [& _]
-                                                     (throw (Exception. "prevent processing")))]
-          (enqueue mod-cert)
-          (enqueue long-cert)))
-      ;; Now start back up with a functional processor and make sure the commands
-      ;; can be found and processed.
-      (let [orig-process process-command-and-respond!
+  (with-test-db
+    (let [producer-ts (to-string (now))
+          shared-vardir (temp-dir)
+          config (-> (svc-utils/create-temp-config)
+                     (assoc :database *db*)
+                     (assoc-in [:global :vardir] shared-vardir))]
+
+      ;; Add unusual messages to the queue without processing them
+      (with-redefs [process-cmdref (fn [& _] :intentionally-did-nothing)]
+        (svc-utils/call-with-single-quiet-pdb-instance
+         config
+         (fn []
+           (let [dispatcher (get-service *server* :PuppetDBCommandDispatcher)
+                 enqueue-command (partial enqueue-command dispatcher)
+                 mod-cert "underscores_must_be_altered_for_the_queue"
+                 long-cert (apply str (repeat (inc queue/max-metadata-utf8-bytes) "z"))
+                 enqueue #(enqueue-command (command-names :replace-facts) 4 %
+                                           nil
+                                           (tqueue/coerce-to-stream
+                                            {:environment "DEV" :certname %
+                                             :values {:foo "foo"}
+                                             :producer_timestamp producer-ts})
+                                           "")]
+             (enqueue mod-cert)
+             (enqueue long-cert)))))
+
+      ;; Now start back up with a functional processor and make sure
+      ;; the commands can be found and processed.
+      (let [orig-process process-cmdref
             continue-processing? (promise)]
-        (with-redefs [process-command-and-respond! #(do
-                                                      @continue-processing?
-                                                      (apply orig-process %&))]
-          (tk-app/restart *server*)  ; have to restart -- stop/start doesn't work
-          (let [dispatcher (get-service *server* :PuppetDBCommandDispatcher)
-                response-mult (response-mult dispatcher)
-                response-watch-ch (async/chan 10)
-                _ (async/tap response-mult response-watch-ch)]
-            (deliver continue-processing? true)
-            (let [[val _] (async/alts!! [(async/into
-                                          #{} (async/take 2 response-watch-ch))
-                                         (async/timeout tu/default-timeout-ms)])]
-              (when-not val
-                (throw (Exception. "timed out waiting for response-chan")))
-              (is (= 2 (count val)))
-              (let [expected #{{:command "replace facts" :version 4
-                                 :producer-timestamp producer-ts :delete? nil}}]
-                (is (= expected
-                       (->> val
-                            (map #(select-keys % [:command :version :producer-timestamp :delete?]))
-                            set)))))))))))
+        (with-redefs [process-cmdref #(do
+                                        @continue-processing?
+                                        (apply orig-process %&))]
+          (svc-utils/call-with-single-quiet-pdb-instance
+           config
+           (fn []
+             (let [dispatcher (get-service *server* :PuppetDBCommandDispatcher)
+                   response-mult (response-mult dispatcher)
+                   response-watch-ch (async/chan 10)
+                   _ (async/tap response-mult response-watch-ch)]
+               (deliver continue-processing? true)
+               (let [[val _] (async/alts!! [(async/into
+                                             #{} (async/take 2 response-watch-ch))
+                                            (async/timeout tu/default-timeout-ms)])]
+                 (when-not val
+                   (throw (Exception. "timed out waiting for response-chan")))
+                 (is (= 2 (count val)))
+                 (let [expected #{{:command "replace facts" :version 4
+                                   :producer-timestamp producer-ts :delete? nil}}]
+                   (is (= expected
+                          (->> val
+                               (map #(select-keys % [:command :version :producer-timestamp :delete?]))
+                               set)))))))))))))

 ;; Test mitigation of
 ;; https://bugs.openjdk.java.net/browse/JDK-8176254 i.e. handling of


Remove splitting for unrefined output sets.

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -199,13 +199,29 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Subproblem Impl  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn add-child-sp! [thing sp]
- #_ (util/assert-is (<= (summary/max-reward (summaries/summary sp))
-                      (summary/max-reward (summaries/summary thing)))
-                  "%s" [thing sp]) ;; Would be nice, but hard to get right before-sum
-  (summaries/summary-changed-local! thing)
-  (add-output! thing sp))
-
+(defn set-stub-output! [stub sp]
+  (summaries/summary-changed-local! stub)
+  (add-output! stub sp))
+
+;; TODO: put a switch here.
+;; Would be nice to assert consistency, but hard to get before-summary...
+;; This version keeps children with same input inside.
+;; Actually makes things worse sometimes (more evaluations?!) -- with first, better with last.
+(defn add-sp-child! [sp child-sp]
+  (assert (not (terminal? sp)))
+  (if (and (= (output-set sp) (output-set child-sp))
+            (not (terminal? child-sp)#_(summary/solved? (summaries/summary (tree-summarizer child-sp))))) ;;no
+    (do (connect-and-watch! sp child-sp #(add-sp-child! sp %))
+        (summaries/summary-changed! sp ))
+    (do (summaries/summary-changed-local! sp)
+        (add-output! sp child-sp))))
+#_
+(defn add-sp-child! [sp child-sp]
+  (assert (not (terminal? sp)))
+  (summaries/summary-changed-local! sp)
+  (add-output! sp child-sp))
+
+;; Note: All nonterminal subproblems use or-summary for ri-fn
 (defn make-simple-subproblem
   [stub subsuming-sp out-set terminal? summary-fn ri-fn init-bound]
   (let [ts-atom (atom nil)
@@ -244,14 +260,14 @@
           (let [ret (make-simple-subproblem stub subsuming-sp out-set false or-summary ri-fn reward)]
             (connect-and-watch! ret subsuming-sp
               (fn [sub-out]
-                (connect-and-watch! ret (refine-input sub-out inp-set) #(add-child-sp! ret %))
+                (connect-and-watch! ret (refine-input sub-out inp-set) #(add-sp-child! ret %))
                 (summaries/summary-changed! ret)))  ;; TODO: needed?
             ret)

           :else
           (let [ret (make-simple-subproblem stub subsuming-sp out-set false or-summary ri-fn reward)]
             (doseq [child (map #(make-fs-seq-stub inp-set %) (fs/child-seqs function-set inp-set))]
-              (connect-and-watch! ret child #(add-child-sp! ret %)))
+              (connect-and-watch! ret child #(add-sp-child! ret %)))
             ret))))

@@ -275,6 +291,7 @@
                                     (min (subsuming-bound s) (second @state)) s)))
          Evaluable
          (evaluate! [s]
+;                    (println "evals" s)
            (assert (not (= :go @state)))
            (let [ready? (= :ready @state)]
              (if-let [[out-set reward :as op] (if ready? (fs/apply-opt function-set inp-set) @state)]
@@ -283,7 +300,7 @@
                  (if (or (not ready?) (not (= status :live)))
                    (do (reset! state :go)
                        (->> (make-atomic-subproblem s function-set subsuming-sp out-set reward status)
-                            (add-child-sp! s)))
+                            (set-stub-output! s)))
                    (do (reset! state op) (summaries/summary-changed! s))))
                (do (reset! state :go) (summaries/summary-changed! s))))))]
     (connect-subsuming! ret subsuming-sp)
@@ -318,7 +335,7 @@
     (add-watcher! watch
       (fn [o] ;        (println ret o)
         (summaries/summary-changed-local! ss)
-        (connect-and-watch! ret (stub-f o) #(add-child-sp! ret %))
+        (connect-and-watch! ret (stub-f o) #(add-sp-child! ret %))
         (summaries/summary-changed! ret))) ;; TODO: efficiency?

     ret))
@@ -343,7 +360,7 @@
     (connect-subsuming! ret subsuming-sp)
     (summaries/connect! ret (tree-summarizer left-sp) false)
     (connect-and-watch! ret right-stub
-      #(add-child-sp! ret (make-pair-subproblem subsuming-sp ret left-sp %)))
+      #(set-stub-output! ret (make-pair-subproblem subsuming-sp ret left-sp %)))
     ret))

 (defn- make-pair-stub1 [subsuming-sp left-stub right-name right-stub-fn]
@@ -355,7 +372,7 @@
       (fn [lo]
         (connect-and-watch! ret
           (make-pair-stub2 subsuming-sp lo (right-stub-fn (output-set lo)))
-          #(add-child-sp! ret %))
+          #(set-stub-output! ret %))
         (summaries/summary-changed! ret))) ;; TODO: wasteful?

     ret))
@@ -400,7 +417,6 @@
         ret       (atom nil)]
     (add-watcher! root-stub (fn [root] (reset! ret root)))
     (evaluate! root-stub)
-    (summaries/summary root-stub) ;; To make asert in add-child-sp! happy
     (evaluate! root-stub)
 ;    (println root-stub (summaries/summary root-stub) ret)
     (assert @ret)


same fix for get-threads-for-group

same fix for get-threads-for-group

--- src/braid/common/state.cljs
+++ src/braid/common/state.cljs
@@ -235,17 +235,27 @@
   (reaction (get-in @state [:tags tag-id :group-id])))

 (defn get-threads-for-group
-  [state [_ group-id]]
-  (let [group-for-tag (fn [tag-id]
-                        (get-in @state [:tags tag-id :group-id]))]
-    (reaction (->> (@state :threads)
+  ([state [_ group-id]] (get-threads-for-group state nil [group-id]))
+  ([state _ [group-id]]
+   (let [group-for-tag (fn [tag-id]
+                         (get-in @state [:tags tag-id :group-id]))
+         group-users (reaction
+                       (into #{}
+                             (comp
+                               (filter (fn [u] (contains? (set (u :group-ids)) group-id)))
+                               (map :id))
+                             (vals (@state :users))))]
+     (reaction (->> (@state :threads)
                     vals
-                   (filter (fn [thread]
-                     (or (empty? (thread :tag-ids))
-                         (contains?
-                           (into #{} (map group-for-tag) (thread :tag-ids))
-                           group-id))))
-                   doall))))
+                    (filter (fn [thread]
+                              (and (or (empty? (thread :tag-ids))
+                                       (contains?
+                                         (into #{} (map group-for-tag) (thread :tag-ids))
+                                         group-id))
+                                (subset?
+                                  (set (thread :mentioned-ids))
+                                  @group-users))))
+                    doall)))))

 (defn get-nickname
   [state [_ user-id]]


replace JS `in` expressions with proper cljs

--- src/chessground/common.cljs
+++ src/chessground/common.cljs
@@ -5,7 +5,7 @@

 (enable-console-print!)

-(def debug false)
+(def debug true)

 (def ground-id
   "Ground unique ID generator (increment)"
@@ -40,23 +40,23 @@
     {:top (+ (.-top rect) (-> js/document .-body .-scrollTop))
      :left (+ (.-left rect) (-> js/document .-body .-scrollLeft))}))

-; is there a better way to do that?
-(def touch-device? (js* "'ontouchstart' in document"))
-
 (defn hidden? [element]
   (nil? (js->clj (.-offsetParent element))))
+
+; mimics the JavaScript `in` operator
+(defn js-in [obj prop]
+  (and obj (or (.hasOwnProperty obj prop)
+               (js-in (.-__proto__ obj) prop))))
+
+(def touch-device? (js-in js/document "ontouchstart"))

 (def transform-prop
   "Fun fact: this won't work if chessground is included in the <head>
    Because the <body> element must exist at the time this code runs."
-  (do
-    (or (.-body js/document) (throw "chessground must be included in the <body> tag!"))
-    (cond
-      (js* "'transform' in document.body.style") "transform"
-      (js* "'webkitTransform' in document.body.style") "webkitTransform"
-      (js* "'mozTransform' in document.body.style") "mozTransform"
-      (js* "'oTransform' in document.body.style") "oTransform"
-      :else "transform")))
+  (do (or (.-body js/document) (throw "chessground must be included in the <body> tag!"))
+      (let [style (-> js/document .-body .-style)
+            props ["transform" "webkitTransform" "mozTransform" "oTransform"]]
+        (first (or (filter #(js-in style %) props) props)))))

 (defn square-element [dom-element]
   "If element is a square, return it. If it's a piece, return its parent"


Convert rest of flow-control to new logging

--- src/clojure/frereth_cp/message/flow_control.clj
+++ src/clojure/frereth_cp/message/flow_control.clj
@@ -1,11 +1,10 @@
 (ns frereth-cp.message.flow-control
   "Cope with flow-control algorithms"
   (:require [clojure.spec.alpha :as s]
-            [clojure.tools.logging :as log]
             [frereth-cp.message.constants :as K]
             [frereth-cp.message.specs :as specs]
             [frereth-cp.shared.crypto :as crypto]
-            [frereth-cp.shared.logging :as log2]
+            [frereth-cp.shared.logging :as log]
             [frereth-cp.util :as utils]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -260,9 +259,6 @@
     :as state}
    {acked-time ::specs/time
     :as acked-block}]
-  (log/debug (utils/pre-log message-loop-name)
-             "Updating flow-control stats due to "
-             acked-block)
   ;; The base-rtt-average calculation really only needs to
   ;; happen the first time around, when the rtt-average
   ;; is 0.
@@ -274,19 +270,26 @@
   ;; of jacobson's-retransmission-timeout.
   ;; Which is just wasteful duplication.
   (try
-    (let [state (calculate-base-rtt-averages state acked-time)
+    (let [state (update state
+                        ::log/state
+                        #(log/debug %
+                                    ::update-statistics
+                                    "Updating flow-control stats"
+                                    {::ackd-block acked-block
+                                     ::specs/message-loop-name message-loop-name}))
+          state (calculate-base-rtt-averages state acked-time)
           state (update state
-                        ::log2/state
-                        #(log2/debug %
+                        ::log/state
+                        #(log/debug %
                                      ::update-statistics
                                      "Recalculating retransmission timeout"
                                      {::specs/message-loop-name message-loop-name}))]
       (jacobson's-retransmission-timeout state acked-block))
     (catch RuntimeException ex
       (update state
-              ::log2/state
-              #(log2/exception %
-                               ex
-                               ::update-statistics
-                               "Updating statistics failed"
-                               (dissoc state ::log2/state))))))
+              ::log/state
+              #(log/exception %
+                              ex
+                              ::update-statistics
+                              "Updating statistics failed"
+                              (dissoc state ::log/state))))))


Remove modal onclose handler. Om component automatically unmount when om/root calling for dom element second time.

--- src/cljs/hatnik/web/client/form/add_action.cljs
+++ src/cljs/hatnik/web/client/form/add_action.cljs
@@ -174,8 +174,6 @@
     om/IDidMount
     (did-mount [this]
       (let [modal-window ($ (:modal-jq-id data))]
-        (.on modal-window
-             "hidden.bs.modal" (fn [_ _] (on-modal-close owner)))
         (.modal modal-window)))))

 (defn show [project-id & {:keys [type action callback]


Added logging

Added logging

--- src/clj/bookmarx/server.clj
+++ src/clj/bookmarx/server.clj
@@ -8,9 +8,9 @@
 (timbre/refer-timbre)

  (defn -main [& args]
-   (timbre/set-config! (dissoc (env :log-config) :filename))
+   (timbre/set-config! (dissoc (env :log-config) :fname))
    (timbre/merge-config!
-     {:appenders {:spit (timbre/spit-appender {:filename (env :log-config)})}})
+     {:appenders {:spit (timbre/spit-appender {:fname (:fname (env :log-config))})}})

    (let [port (Integer/parseInt (or (env :port) "3000"))]
      (run-jetty app {:port port :join? false})))


add ring multipart middleware to be able to handle upload file

--- src/clj/closerve/server.clj
+++ src/clj/closerve/server.clj
@@ -9,6 +9,7 @@
             [ring.adapter.jetty :as jetty]
             [ring.middleware.resource :as resources]
             [ring.middleware.file :as midfile]
+            [ring.middleware.multipart-params :as multi]
             [com.keminglabs.jetty7-websockets-async.core :as ws]
             [clojure.core.async :refer [go close! <! >! <!! sliding-buffer chan timeout]]
             [crypto.random :as random]
@@ -178,6 +179,8 @@
      (recur)))
   )

+(defn upload-tmp-store [upload-key]
+  (println "!!! get uplaod key:" upload-key))

 (defn start-server [host port]
   (if (nil? @session-manager) (reset! session-manager
@@ -191,6 +194,7 @@
                 wrap-flexfile
                 (wrap-resource-add-type "public/")
                 wrap-params
+                (multi/wrap-multipart-params :store upload-tmp-store)
                 wrap-enum-sessions
                 (session/wrap-session {:store (cookie-store {:key (get-cookie-key @session-manager)})})
                 wrap-rule-check


fix bug in select-one! where nil result could not be returned

--- src/clj/com/rpl/specter.clj
+++ src/clj/com/rpl/specter.clj
@@ -37,9 +37,9 @@
 (defn compiled-select-one!
   "Version of select-one! that takes in a selector pre-compiled with comp-paths"
   [selector structure]
-  (let [res (compiled-select-one selector structure)]
-    (when (nil? res) (throw-illegal "No elements found for params: " selector structure))
-    res
+  (let [res (compiled-select selector structure)]
+    (when (not= 1 (count res)) (throw-illegal "Expected exactly one element for params: " selector structure))
+    (first res)
     ))

 (defn select-one!


Wrap the partition-fn with a safe-exec (#93)

Co-authored-by: Jérôme Prudent <69fa021806e13987be610a2b3ab1b00259fb69da@oscaro.com>

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -768,7 +768,7 @@
     (reify
       Partition$PartitionFn
       (partitionFor [this elem num]
-        (f elem num)))))
+        (safe-exec (f elem num))))))

 (defn dpartition-by
   {:doc (with-opts-docstr


fix missing safe-exec in filename policy

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -1854,15 +1854,17 @@
   [{:keys [file-name suffix] :as options
     :or {file-name "file"}}]
   (fn [shard-number shard-count ^BoundedWindow window _ ]
-    (let [timestamp (timf/unparse (:date-hour-minute timf/formatters)
-                                (.start window))]
-      (str timestamp "-" file-name "-" shard-number "-of-" shard-count "." suffix))))
+    (safe-exec
+     (let [timestamp (timf/unparse (:date-hour-minute timf/formatters)
+                                   (.start window))]
+       (str timestamp "-" file-name "-" shard-number "-of-" shard-count "." suffix)))))

 (defn- mk-default-unwindowed-fn
   [{:keys [file-name suffix] :as options
     :or {file-name "file"}}]
   (fn [shard-number shard-count  _]
-    (str file-name "-" shard-number "of" shard-count  "." suffix)))
+    (safe-exec
+     (str file-name "-" shard-number "of" shard-count  "." suffix))))

 (def filename-schema
   {:file-name {:docstr "set the default filename prefix (only used when no custom function is set)"}


removed whitespace.

removed whitespace.

--- src/clj/forma/reproject.clj
+++ src/clj/forma/reproject.clj
@@ -3,7 +3,7 @@
 ;; sinusoidal grid at arbitrary resolution.

 (ns forma.reproject
-  (:use cascalog.api
+  (:use cascalog.api
         [forma.matrix.utils :only (idx->colrow
                                    colrow->idx)])
   (:require [forma.source.modis :as m]))


Fix float reader for specific environments such as IcedTea.

--- src/cljam/io/bcf/reader.clj
+++ src/cljam/io/bcf/reader.clj
@@ -94,8 +94,8 @@
         (case (bit-and 0xFFFF i) 0x8000 nil 0x8001 :eov i))
     3 (let [i (lsb/read-int r)]
         (case (bit-and 0xFFFFFFFF i) 0x80000000 nil 0x80000001 :eov i))
-    5 (let [i (lsb/read-float r)]
-        (case (Float/floatToRawIntBits i) 0x7F800001 nil 0x7F800002 :eov i))
+    5 (let [i (lsb/read-int r)]
+        (case (bit-and 0xFFFFFFFF i) 0x7F800001 nil 0x7F800002 :eov (Float/intBitsToFloat i)))
     7 (lsb/read-byte r)))

 (defn- bytes->strs
@@ -163,7 +163,7 @@
   (let [chrom-id (lsb/read-int shared)
         pos (inc (lsb/read-int shared))
         rlen (lsb/read-int shared)
-        qual (lsb/read-float shared)
+        qual (lsb/read-int shared)
         n-allele-info (lsb/read-int shared)
         n-allele (unsigned-bit-shift-right n-allele-info 16)
         n-info (bit-and n-allele-info 0xFFFF)
@@ -179,7 +179,7 @@
     {:chr chrom-id
      :pos pos
      :ref-length rlen
-     :qual (when-not (= (Float/floatToRawIntBits qual) 0x7F800001) qual)
+     :qual (when-not (= qual 0x7F800001) (Float/intBitsToFloat qual))
      :id id
      :ref (first refseq)
      :alt (seq (map first altseq))


Add `grouped-rpositions` for performance

--- src/cljam/pileup/pileup.clj
+++ src/cljam/pileup/pileup.clj
@@ -39,6 +39,20 @@
      (if (>= end n)
        (cons n (lazy-seq (rpositions start end (inc n)))))))

+(defn grouped-rpositions
+  "Returns a lazy seq of grouped positions. Equivalent of
+  (partition-all n (rpositions start end)). This implementation is faster."
+  [start end n]
+  (lazy-seq
+   (letfn [(rpositions* [s e]
+             (loop [i e xs `()]
+               (if (>= i s)
+                 (recur (dec i) (cons i xs))
+                 xs)))]
+     (when (<= start end)
+       (cons (rpositions* start (min (+ start n -1) end))
+             (grouped-rpositions (+ start n) end n))))))
+
 (defn- read-alignments
   "Reads alignments which have the rname and are included in a range defined by
   the pos and window size, returning the alignments as a lazy seq. Reading
@@ -55,8 +69,7 @@
   "Internal pileup function."
   [rdr rname rlength start end]
   (let [read-alignments-memo (memoize read-alignments)]
-    (->> (rpositions start end)
-         (partition-all step)
+    (->> (grouped-rpositions start end step)
          (map vec)
          (map (fn [positions]
                 (let [pos (if (= (count positions) step)


non-working version that tries to GET /cards from the server

--- src/cljs/dekk/handlers.cljs
+++ src/cljs/dekk/handlers.cljs
@@ -2,7 +2,9 @@
   (:require [ajax.core :refer [GET]]
             [re-frame.core :refer [register-handler, dispatch]]
             [re-frame.utils :as util]
-            [re-frame.middleware :refer [undoable]]))
+            [re-frame.middleware :refer [undoable]]
+            [cljs.reader :refer [read-string, register-tag-parser!]]
+            [dekk.domain :refer [map->Card]]))

 (register-handler
@@ -13,14 +15,17 @@
     (assoc-in app-state [:board-id] board-id)))

 (register-handler
-  :process-phones-response
+  :process-cards-response
   (fn
     ;; store the response of fetching the phones list in the phones attribute of the db
     [app-state [_ response]]
-    (assoc-in app-state [:cards] response)))
+    (register-tag-parser! "dekk.domain/Card" map->Card)
+    (util/log "response" response)
+    (assoc-in app-state [:cards]
+              (read-string {:body response}))))

 (register-handler
-  :process-phones-bad-response
+  :process-cards-bad-response
   (fn
     ;; log a bad response fetching the phones list
     [app-state [_ response]]
@@ -33,6 +38,7 @@
   (fn
     ;; Fetch the list of phones and process the response
     [app-state _]
+    (util/log "load-cards")
     (GET "cards"
          {:handler         #(dispatch [:process-cards-response %1])
           :error-handler   #(dispatch [:process-cards-bad-response %1])


simpify the core loop

simpify the core loop

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -34,6 +34,7 @@
 (def current-turn (reaction (game/current-turn (:game @app-state))))
 (def current-board (reaction (turn/get-board @current-turn)))
 (def current-player (reaction (turn/get-player @current-turn)))
+(def help-toggled? (reaction (:help @app-state)))

 ;; -----------------------------------------
@@ -61,9 +62,8 @@
 (defn start-game-loop
   "Manage transitions between player moves, ai moves, and generic game events"
   []
-  (let [game-on-xf (fn [_] (not (turn/game-over? @current-turn)))
-        is-human-xf (fn [_] (not (is-ai? @current-player)))
-        player-events (chan 1 (comp (filter game-on-xf) (filter is-human-xf)))
+  (let [is-human-xf (fn [_] (not (is-ai? @current-player)))
+        player-events (chan 1 (filter is-human-xf))
         game-events (chan 1)]
     (go
       (while true
@@ -72,7 +72,6 @@
           player-events ([coord] (play-game-turn! coord))
           (async/timeout ai-move-delay) ([_] (if (is-ai? @current-player) (handle-ai!)))
           )))
-
     {:player-events player-events
      :game-events game-events}))

@@ -89,12 +88,12 @@

 ;; -----------------------------------------
-;; DISPLAY
+;; PLUGGING THE BLOCKS
 ;; -----------------------------------------

 (defn get-suggestions
   []
-  (if (and (:help @app-state) (not (is-ai? @current-player)))
+  (if (and @help-toggled? (not (is-ai? @current-player)))
     (turn/get-moves-of @current-turn @current-player)
     {}))


Add one-argument toast function

Add one-argument toast function

--- src/clojure/neko/notify.clj
+++ src/clojure/neko/notify.clj
@@ -15,11 +15,14 @@
 (defn toast
   "Creates a Toast object using a text message and a keyword
   representing how long a toast should be visible (`:short` or
-  `:long`). The application context wiil be used."
-  [^String message, length]
-  {:pre [(contains? toast-length length)]}
-  (.show
-   ^Toast (Toast/makeText context message ^int (toast-length length))))
+  `:long`). The application context wiil be used. One-argument version
+  takes only message and assumes length to be :long."
+  ([message]
+     (toast message :long))
+  ([^String message, length]
+     {:pre [(contains? toast-length length)]}
+     (.show
+      ^Toast (Toast/makeText context message ^int (toast-length length)))))

 ;; ### Notifications


Parse childrens in reply text

Parse childrens in reply text

Fixes #11161

Signed-off-by: andrey <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/chat/components/reply.cljs
+++ src/status_im/ui/screens/chat/components/reply.cljs
@@ -35,6 +35,9 @@

              (= type "mention")
              @(re-frame/subscribe [:contacts/contact-name-by-identity literal])
+
+             (seq children)
+             (get-quoted-text-with-mentions children)

              :else
              literal))


Test for NPE in job-name->book-name

Test for NPE in job-name->book-name

--- test/emender_jenkins/results_test.clj
+++ test/emender_jenkins/results_test.clj
@@ -235,6 +235,13 @@
             "Book Name 1" (job-name->book-name "test-Red_Hat_Enterprise_Linux-6.2-Book_Name_1-en-US (preview)")
             "Book Name 1" (job-name->book-name "test-Red_Hat_Enterprise_Linux-7-Book_Name_1-en-US (preview)"))))

+(deftest test-job-name->book-name-2
+    "Check the emender-jenkins.results/job-name->book-name function."
+    (testing "the emender-jenkins.results/job-name->book-name function."
+        (are [x y] (= x y)
+            "unknown"     (job-name->book-name "test-Product-1 (preview)")
+            "unknown"     (job-name->book-name nil))))
+
 (deftest test-job-name->environment
     "Check the emender-jenkins.results/job-name->environment function."
     (testing "the emender-jenkins.results/job-name->environment function."


removed irrelevant tests

removed irrelevant tests

--- test/forma/classify/logistic_test.clj
+++ test/forma/classify/logistic_test.clj
@@ -126,37 +126,3 @@
          ["500" h v s l 14141 35 (random-eco) (rand-int 2)])))

-(defn grab-forma-output
-  [path]
-  (let [src (hfs-seqfile path)]
-    (?<- (stdout)
-         [?s ?l ?prob-series]
-         (src _ _ _ ?s ?l ?prob-series)
-         (:distinct false))))
-
-(defn look-at-feat
-  "path to partfile that comes from s3://formaresults/prebetatemp;
-  test to make sure that the betas are produced"
-  [path]
-  (let [src (hfs-seqfile path)]
-    (?<- (stdout)
-         [?eco ?beta]
-         (src ?mod-h ?mod-v ?s ?l ?eco ?hansen ?val ?neighbor-val)
-         (logistic-beta-wrap [1e-6 1e-8 250] ?hansen ?val ?neighbor-val :> ?beta)
-         (:distinct false))))
-
-(defbufferop num-distinct [tuples]
-  [(reduce +
-           (map (partial thresh-make-binary -1)
-                (apply concat tuples)))])
-
-(defn examine-data
-  "path to partfile that comes from s3://formaresults/prebetatemp;
-  test to make sure that the betas are produced"
-  [path]
-  (let [src (hfs-seqfile path)]
-    (?<- (stdout)
-         [?eco ?num]
-         (src ?mod-h ?mod-v ?s ?l ?eco ?hansen ?val ?neighbor-val)
-         (num-distinct ?hansen :> ?num))))
-


Multi-class support

Multi-class support

--- src/main/cljc/clojure_club/rpg_spec/mgrimm.cljc
+++ src/main/cljc/clojure_club/rpg_spec/mgrimm.cljc
@@ -1,7 +1,5 @@
 (ns clojure-club.rpg-spec.mgrimm
   (:require
-    [clojure.pprint :as pp]
-    [clojure.string :as string]
     [clojure.core.reducers :as r]
     [clojure.spec.alpha :as s]
     [clojure.spec.gen.alpha :as g]))
@@ -44,7 +42,8 @@

 (s/def ::gender #{:male :female})
 (s/def ::race #{:dwarf :elf :gnome :half-elf :half-orc :halfling :human})
-(s/def ::class #{:barbarian :bard :cleric :druid :fighter :monk :paladin :ranger :rogue :sorcerer :wizard})
+(s/def ::class (s/coll-of #{:barbarian :bard :cleric :druid :fighter :monk :paladin :ranger :rogue :sorcerer :wizard}
+                          :min-count 1 :max-count 2 :distinct true :into #{}))
 (s/def ::level (s/with-gen (s/int-in 1 21) #(s/gen #{1})))

 (s/def ::character (s/keys :req [::name ::gender ::race ::class ::level ::traits]))
@@ -54,4 +53,4 @@
 (defn create-character []
   (first (g/sample (s/gen ::character) 100)))

-#_(pp/pprint (create-character))
+#_(clojure.pprint/pprint (create-character))


implementing find-attr-node-test

implementing find-attr-node-test

--- test/synthesis_crawlers/core_test.clj
+++ test/synthesis_crawlers/core_test.clj
@@ -107,3 +107,7 @@
                                #{}))
            '("http://www.economist.com")))))

+#_(deftest find-attr-nodes-test
+  (testing "finds nodes which contain the specified attributes"
+    )
+  )


fix race condition

fix race condition

:rid needs to be available when the build first starts but it isn't
guaranteed the message that provides it is processed before that

--- src/main/shadow/cljs/devtools/server/worker.clj
+++ src/main/shadow/cljs/devtools/server/worker.clj
@@ -203,6 +203,12 @@
            ::m/worker-id proc-id
            ::m/worker-for build-id})

+        {:keys [op rid] :as welcome-msg}
+        (<!! from-relay)
+
+        _ (when (not= op :welcome)
+            (throw (ex-info "received unexcpected first message from relay" {:msg welcome-msg})))
+
         thread-state
         {::impl/worker-state true
          :resource-update-chan resource-update
@@ -211,6 +217,7 @@
          :classpath classpath
          :cache-root cache-root
          :cli-opts cli-opts
+         :rid rid
          :npm npm
          :babel babel
          :proc-id proc-id


ref hint bugfix

ref hint bugfix

--- src/name_bazaar/ui/pages/manage_names_page.cljs
+++ src/name_bazaar/ui/pages/manage_names_page.cljs
@@ -79,8 +79,9 @@
       (let [{:keys [:ens.record/addr :ens.record/name]} @form-data
             ownership-status @(subscribe [:ens.record/ownership-status (when (seq name)
                                                         (str name constants/registrar-root))])
-            full-name (when (seq name)
-                        (str name constants/registrar-root))
+            full-name-fn #(when (seq %)
+                           (str % constants/registrar-root))
+            full-name (full-name-fn name)
             name-record @(subscribe [:public-resolver/record (namehash full-name)])
             default-resolver? @(subscribe [:ens.record/default-resolver? (namehash full-name)])
             submit-disabled? (not= ownership-status :ens.ownership-status/owner)]
@@ -97,7 +98,7 @@
               {:value name
                :on-change #(do
                              (swap! form-data assoc :ens.record/name (aget %2 "value"))
-                             (load-addr (namehash full-name)))}]]
+                             (load-addr (full-name-fn (aget %2 "value"))))}]]
             [ui/GridColumn
              {:computer 8
               :mobile 16}


store server opts in connection-info*

store server opts in connection-info*

--- src/overtone/sc/machinery/server/connection.clj
+++ src/overtone/sc/machinery/server/connection.clj
@@ -170,11 +170,14 @@

 (defn- internal-booter
   "Fn to actually boot internal server. Typically called within a thread."
-  []
+  [opts]
   (log/info "booting internal audio server")
   (on-deps :internal-server-booted ::connect-internal connect-internal)
-  (let [server (scsynth osc-msg-decoder)]
-    (dosync (ref-set sc-world* server))
+  (let [server    (scsynth osc-msg-decoder opts)
+        full-opts (merge-sc-args opts)]
+    (dosync (ref-set sc-world* server)
+            (alter connection-info* assoc :opts full-opts))
+
     (scsynth-listen-udp server 57110)
     (log/info "The internal scsynth server has booted...")
     (satisfy-deps :internal-server-booted)
@@ -182,8 +185,8 @@

 (defn- boot-internal-server
   "Boots internal server by executing it on a daemon thread."
-  []
-  (let [sc-thread (Thread. internal-booter)]
+  [opts]
+  (let [sc-thread (Thread. #(internal-booter opts))]
     (.setDaemon sc-thread true)
     (println "--> Booting internal SuperCollider server...")
     (log/debug "Booting SuperCollider internal server (scsynth)...")
@@ -271,8 +274,8 @@
 (defn- sc-command
   "Creates a string array representing the sc command to execute in an
   external process (typically with #'external-booter)"
-  [port opts]
-  (into-array String (cons (or (config-get :sc-path) (find-sc-path)) (scsynth-arglist (merge-sc-args opts {:port port})))))
+  [opts]
+  (into-array String (cons (or (config-get :sc-path) (find-sc-path)) (scsynth-arglist opts))))

 (defn- boot-external-server
   "Boot the audio server in an external process and tell it to listen on
@@ -280,7 +283,9 @@
   ([port opts]
      (when-not (= :connected @connection-status*)
        (log/debug "booting external server")
-       (let [cmd       (sc-command port opts)
+       (let [full-opts (merge-sc-args opts {:port port})
+             cmd       (sc-command full-opts)
+
              sc-thread (if (windows-os?)
                          (Thread. #(external-booter cmd (windows-sc-path)))
                          (Thread. #(external-booter cmd)))]
@@ -288,7 +293,8 @@
          (println "--> Booting external SuperCollider server...")
          (log/debug (str "Booting SuperCollider server (scsynth) with cmd: " (apply str (interleave cmd (repeat " ")))))
          (.start sc-thread)
-         (dosync (ref-set server-thread* sc-thread))
+         (dosync (ref-set server-thread* sc-thread)
+                 (alter connection-info* assoc :opts full-opts))
          (connect "127.0.0.1" port)
          :booting))))

@@ -326,7 +332,7 @@

        (let [port (if (nil? port) (+ (rand-int 50000) 2000) port)]
          (case connection-type
-           :internal (boot-internal-server)
+           :internal (boot-internal-server opts)
            :external (boot-external-server port opts))
          (wait-until-deps-satisfied :server-ready)))
      (print-ascii-art-overtone-logo


paragraph rewrite to improve grammar/flow

--- src/pc/views/blog/product_hunt_wake_up_call.clj
+++ src/pc/views/blog/product_hunt_wake_up_call.clj
@@ -40,9 +40,9 @@
          We researched many prototyping tools but we couldn't find one that met our expectations in terms of simple, efficient collaboration.
          Everything was overly complex and made impromptu teamwork a chore.
          Rather than settling, we decided to scratch our own itch."]
-     [:p "Our initial goal was to simply help ourselves share ideas as efficiently and effectively as possible, and then make it insanely easy to share those ideas.
-         We know the pain of losing a good idea; the worst part for me is knowing that it didn't have to happen.
-         I wouldn't have lost that idea if had I sketched it out sooner or if I drew it on something that couldn't get misplaced."]]
+     [:p "Our goal was to express our ideas fast while simultaneously making them dead simple to share.
+         It's frustrating to lose a good idea over something that's easily preventable.
+         We never want to lose another idea because we held it for too long or misplaced a sketch of it."]]

     [:figure
      [:a.img {:href "/" :data-caption-black "It's faster than even we expected."}


Updates to schedule of First Light exhibit

--- spectacles/src/spectacles/scheduler.clj
+++ spectacles/src/spectacles/scheduler.clj
@@ -4,7 +4,8 @@
             [spectacles.bet-you-miss]
             [spectacles.cyberspeed]
             [spectacles.kaleidoscope-logo]
-            [spectacles.kaleidoscope]))
+            [spectacles.kaleidoscope]
+            [spectacles.whalesong]))

 (def sketches {:logo-countdown {:setup  spectacles.present-logo/setup
                                 :update spectacles.present-logo/update
@@ -40,14 +41,26 @@
                                    :update spectacles.kaleidoscope-logo/update
                                    :draw   spectacles.kaleidoscope-logo/draw
                                    :name   "Kaleidoscope Logo"
-                                   :author "Arthur Hall III"}})
+                                   :author "Arthur Hall III"}

-(def installations {:lifeinlights01 :logo-countdown
-                    :lifeinlights02 :starfield
-                    :lifeinlights03 :bet-you-miss
-                    :lifeinlights04 :cyberspeed
-                    :lifeinlights05 :kaleidoscope
-                    :lifeinlights06 :kaleidoscope-logo})
+               :whalesong {:setup  spectacles.whalesong/setup
+                           :update spectacles.whalesong/update
+                           :draw   spectacles.whalesong/draw
+                           :name   "Whalesong"
+                           :author "Aaron Arnett"}})
+
+;; TODO Determine what goes in Kerr A & B
+;; TODO Duplicate/split bet-you-miss
+(def installations {:lifeinlights01 :logo-countdown       ;; Leeds north door
+                    :lifeinlights02 :starfield            ;; Commercial Kitchen (window)
+                    :lifeinlights03 :bet-you-miss         ;; Easy Pickins (Needs to be duplicated/split, black background?)
+                    :lifeinlights04 :cyberspeed           ;; Bridges and Lane
+                    :lifeinlights05 :whalesong            ;; Kerr (C)
+                    :lifeinlights06 :kaleidoscope-logo    ;; Leeds lobby (or entrance?)
+                    :lifeinlights07 :kaleidoscope         ;; Commercial Kitchen (facade) (800x600)
+                    :lifeinlights08 :kaleidoscope         ;; Kerr (A)
+                    :lifeinlights09 :kaleidoscope         ;; Kerr (B)
+                    })

 (defn select-sketch []
   (let [hostname (.getHostName (java.net.InetAddress/getLocalHost))]


Only show container times once the build finishes running

--- src-cljs/frontend/components/build.cljs
+++ src-cljs/frontend/components/build.cljs
@@ -223,7 +223,7 @@
     (:status override-status)
     real-status))

-(defn container-pill [{:keys [container status current-container-id build-running?]} owner]
+(defn container-pill [{:keys [container status current-container-id build-running? build-finished?]} owner]
   (reify
     om/IDisplayName
     (display-name [_] "Container Pill v2")
@@ -241,7 +241,6 @@
     (render-state [_ {:keys [override-status]}]
       (html
        (let [container-id (container-model/id container)
-             duration-ms (container-utilization-duration container)
              status (maybe-override-status status override-status)
              icon-name (case status
                          :failed "Status-Failed"
@@ -258,7 +257,8 @@
            [:span.container-index (str (:index container))]
            [:span.status-icon
             (om/build container-result-icon {:name icon-name})]]
-          (om/build container-duration-label {:actions (:actions container)})])))))
+          (when build-finished?
+            (om/build container-duration-label {:actions (:actions container)}))])))))

 (def paging-width 10)

@@ -351,6 +351,7 @@
                     (om/build container-pill
                               {:container container
                                :build-running? build-running?
+                               :build-finished? (build-model/finished? build)
                                :current-container-id current-container-id
                                :status (container-model/status container build-running?)}
                               {:react-key (:index container)}))


only show discount notice for hunters

only show discount notice for hunters

--- src-cljs/frontend/components/outer.cljs
+++ src-cljs/frontend/components/outer.cljs
@@ -275,10 +275,12 @@
                " have collaboration tools to improve your productivity. "
                "Start your domain to organize team communications with private docs. "]]
              [:div.price-foot
-              [:a.bubble-button {:href "/trial"
-                                 :target "_top"
-                                 :data-bottom "Product Hunt 50% off for 6mo"
-                                 :class " hover ph-pricing-button"}
+              [:a.bubble-button (merge {:href "/trial"
+                                        :target "_top"}
+                                       (when (get-in app state/ph-discount-path)
+                                         {:data-bottom "Product Hunt 50% off for 6mo"
+                                          :class " hover ph-pricing-button"}))
+
                [:span "Start a free trial."]]]]
             [:section.price-divide.right
              [:div.price-divide-line]]
@@ -290,9 +292,9 @@
               [:h4.content-copy
                "Contact sales."]
               [:p.price-copy.content-copy
-                "Looking for a customized solution? "
-                "Precursor was engineered to easily set up and run on your own server. "
-                "Email sales@precursorapp.com and we will respond immediately."]]
+               "Looking for a customized solution? "
+               "Precursor was engineered to easily set up and run on your own server. "
+               "Email sales@precursorapp.com and we will respond immediately."]]
              [:div.price-foot
               [:a.bubble-button {:href "mailto:sales@precursorapp.com?Subject=Enterprise%20Inquiry"}
                [:span "Email a sales rep."]]]]]]])))))


added to the verb can the past participle been able

--- src/babel/english/lexicon-verbcoach.clj
+++ src/babel/english/lexicon-verbcoach.clj
@@ -415,6 +415,7 @@
    "can"
    {:english {:participle "being able to"
               :past "could"
+              :past-participle "been able to"
               :imperfect {:1sing "used to be able to"
                           :2sing "used to be able to"
                           :3sing "used to be able to"


handling of :ko :parser-state

handling of :ko :parser-state

--- ccw.core/src/ccw/editors/antlrbased/PareditAutoEditStrategy.clj
+++ ccw.core/src/ccw/editors/antlrbased/PareditAutoEditStrategy.clj
@@ -27,9 +27,9 @@
                           {:text (.get document)
                            :offset (.offset command)
                            :length 0})]
-      #_(println "result:" result)
-      (set! (.offset command) (-> result :modifs first :offset))
-      (set! (.length command) (-> result :modifs first :length))
-      (set! (.text command) (-> result :modifs first :text))
-      (set! (.shiftsCaret command) false)
-      (set! (.caretOffset command) (:offset result)))))+      (when (not= :ko (-> result :parser-state))
+        (set! (.offset command) (-> result :modifs first :offset))
+        (set! (.length command) (-> result :modifs first :length))
+        (set! (.text command) (-> result :modifs first :text))
+        (set! (.shiftsCaret command) false)
+        (set! (.caretOffset command) (:offset result))))))


added forgotten

added forgotten

--- src/babel/english/lexicon-verbcoach.clj
+++ src/babel/english/lexicon-verbcoach.clj
@@ -745,6 +745,7 @@
    "forget" {:synsem {:cat :verb
                       :sem {:pred :forget}}
              :english {:past "forgot"
+                       :past-participle "forgotten"
                        :participle "forgetting"}}

    "form" {:synsem {:cat :verb


support irregular future stems

support irregular future stems

--- src/babel/francais/morphology/verbs.clj
+++ src/babel/francais/morphology/verbs.clj
@@ -105,6 +105,9 @@
         stem (if re-type
                ;; prendre -> prend
                (string/replace infinitive #"re$" "")
+               stem)
+        stem (if (get-in word [:future-stem])
+               (get-in word [:future-stem])
                stem)
         last-stem-char-is-i (re-find #"ir$" infinitive)
         last-stem-char-is-e (re-find #"er$" infinitive)


Fix copyright year on handlers impl ns.

Fix copyright year on handlers impl ns.

--- src/clojure/catacumba/impl/handlers.clj
+++ src/clojure/catacumba/impl/handlers.clj
@@ -1,4 +1,4 @@
-;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without


Add additional graph checkboxes (no onClick functions yet).

--- src/clojure/my/stuff/fitlogger/main.clj
+++ src/clojure/my/stuff/fitlogger/main.clj
@@ -209,12 +209,18 @@
 (defn graph-layout [activity]
   [:linear-layout {:orientation :vertical}
    [:graphview {:layout-width :fill,
-                :layout-height 700}]
+                :layout-height 1000}]
    [:linear-layout {:orientation :horizontal}
     [:checkbox {:text "Total Weight"}]]
    [:linear-layout {:orientation :horizontal}
     [:checkbox {:text "BF%"}]
-    [:checkbox {:text "Total BF"}]]])
+    [:checkbox {:text "Total BF"}]]
+   [:linear-layout {:orientation :horizontal}
+    [:checkbox {:text "H2O%"}]
+    [:checkbox {:text "Total H2O"}]]
+   [:linear-layout {:orientation :horizontal}
+    [:checkbox {:text "Muscle%"}]
+    [:checkbox {:text "Total Muscle"}]]])

 (defn pager-adapter [activity]


Mouse dragged and moved events do not occur... ?!?

--- src/conexp/contrib/gui/editors/util.clj
+++ src/conexp/contrib/gui/editors/util.clj
@@ -17,9 +17,10 @@
            [java.util Vector]
            [java.awt Toolkit Dimension Point]
            [java.awt.event KeyEvent ActionEvent ActionListener MouseEvent
-                        MouseListener InputEvent]
+                        InputEvent]
            [java.awt.datatransfer DataFlavor StringSelection]
-           [javax.swing.event TreeSelectionListener TableModelListener]
+           [javax.swing.event TreeSelectionListener TableModelListener
+             MouseInputListener ]
            [javax.swing.table DefaultTableModel])
   (:use clojure.contrib.swing-utils
         [clojure.contrib.string :only (join split-lines split)])
@@ -107,8 +108,10 @@
      released  _mouse button up event
      entered   _mouse enters widget
      exited    _mouse exits widget
-     clicked   _mouse button clicked"
-  [pressed released entered exited clicked]
+     clicked   _mouse button clicked
+     moved     _mouse has been moved
+     dragged   _mouse has been dragged"
+  [pressed released entered exited clicked moved dragged]
   (let [translate-button {MouseEvent/NOBUTTON 0
                           MouseEvent/BUTTON1  1
                           MouseEvent/BUTTON2  2
@@ -128,7 +131,7 @@
                            :modifiers (translate-modifier (.getModifiersEx event))
                            :position [(.getX event) (.getY event)]
                            :buttons-down (translate-pressed-btns (.getModifiersEx event))})]
-    (proxy [MouseListener] []
+    (proxy [MouseInputListener] []
       (mousePressed [event]
         (with-swing-threads* (pressed (translate-event event))))
       (mouseReleased [event]
@@ -138,7 +141,13 @@
       (mouseExited [event]
         (with-swing-threads* (exited (translate-event event))))
       (mouseClicked [event]
-        (with-swing-threads* (clicked (translate-event event)))))))
+        (with-swing-threads* (clicked (translate-event event))))
+      (mouseMoved [event]
+        (with-swing-threads* (message-box "MOVED")
+          (moved (translate-event event))))
+      (mouseDragged [event]
+        (with-swing-threads* (dragged (translate-event event)))))))
+

 ;;; managed/unmanaged interop
@@ -424,6 +433,11 @@
                 (.setRowSelectionAllowed false)
                 (.setColumnSelectionAllowed true))
      :cells   (.setCellSelectionEnabled table true))))
+
+(defn-typecheck-swing-threads* select-single-cell ::table-control
+  "Selects a single cell given as view-coordinates in the given table control"
+  [otable row column]
+  (.changeSelection (get-control otable) row column false false))

 (defn-typecheck-swing set-value-at-view ::table-control
   "Sets the value of a cell in the table according to a view position."
@@ -660,14 +674,29 @@
                                 (if (not= start-col end-col)
                                   (move-column widget start-col end-col))
                                 (if (not= start-row end-row)
-                                  (move-row widget start-row end-row))))),
+                                  (move-row widget start-row end-row)))
+                              (dosync (ref-set drag-start nil)))),
+         drag-motion-event (fn [x]
+                             (message-box "X")
+                             (if (and (= (:button x) 1)
+                                   (= (:modifiers x) #{:alt})
+                                   (not= (deref drag-start) nil))
+                               (let [ cell (get-view-coordinates-at-point
+                                             widget (:position x))
+                                      row (first cell)
+                                      column (second cell) ]
+                                 (select-single-cell widget row column))
+                               (message-box "DRAG")
+                               )),

         cell-permutor (proxy-mouse-listener button-down-event
                                             button-up-event
                                             ignore-event
                                             ignore-event
-                                            ignore-event)]
+                                            ignore-event
+                                            drag-motion-event
+                                            drag-motion-event)]
     (add-hook widget "table-changed"
       (fn [c f l t] (table-change-hook widget c f l t))
       "This hook is called whenever a table widget is changed,


Obtain a proper next txid before executing the ops.

--- src/continuo/postgresql/transaction.clj
+++ src/continuo/postgresql/transaction.clj
@@ -107,7 +107,8 @@
   "Given an connection and seq of operation objects,
   execute them in serie."
   [conn operations]
-  (run! #(-execute % conn) operations))
+  (let [txid (get-next-txid conn)]
+    (run! #(-execute % conn txid) operations))

 (defn run-in-tx
   [conn func]
@@ -116,7 +117,6 @@
     (func conn)))

 (defn transact*
-  {:internal true}
   [context partition facts]
   (let [ops (compile-ops context partition facts)
         conn (.-connection context)]


Rename dependent namespace

Rename dependent namespace

--- src/leiningen/highlight.clj
+++ src/leiningen/highlight.clj
@@ -4,7 +4,7 @@
             [clojure.java.io :as io]
             [clojure.java.browse :as browse]
             [genuine-highlighter.core :as hl]
-            [genuine-highlighter.decoration-rules [terminal :as t]]
+            [genuine-highlighter.rendering-rules [terminal :as t]]
             [leiningen.highlight.rendering-rules.html :as html]
             [compojure [core :refer [defroutes GET]]
                        [route :as route]]


Add support for rubocop 0.19

Add support for rubocop 0.19

Detects use of 'offenses' over 'offences'

--- src/lt/plugins/rubocop.cljs
+++ src/lt/plugins/rubocop.cljs
@@ -35,8 +35,12 @@
                  (dom/set-css target {:display :none}))))

 (defn violations-for-file [json-str]
-  (let [parsed (js->clj (JSON/parse json-str))]
-    (-> parsed (get "files") first (get "offences") )))
+  (let [parsed (js->clj (JSON/parse json-str))
+        file-info (first (get parsed "files"))
+        offence-key (if (contains? file-info "offenses")
+                      "offenses"
+                      "offences")]
+    (get file-info offence-key)))

 (defn offence-line-map [violations]
   (map (fn [violation]


(PDB-3611) Reduce batch size for fact value rehashing

5000 felt like it was too big, could OOM with large facts.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1356,7 +1356,7 @@
   (jdbc/call-with-query-rows
    ["select id, value::text from fact_values"]
    (fn [rows]
-     (doseq [batch (partition-all 5000 rows)]
+     (doseq [batch (partition-all 500 rows)]
        (let [ids (map :id rows)
              hashes (map #(-> (:value %)
                               json/parse


Try backing off when creating a connection [IMMUTANT-285]

We'll retry up to a minute currently - this is really a shot in the
dark to see if it fixes the timing issue when clustered.

--- modules/messaging/src/main/clojure/immutant/messaging/core.clj
+++ modules/messaging/src/main/clojure/immutant/messaging/core.clj
@@ -18,7 +18,7 @@
 (ns ^{:no-doc true} immutant.messaging.core
   "Internal utilities used by messaging. You should only need to dip
    into here in advanced cases."
-  (:use [immutant.util :only (at-exit in-immutant?)]
+  (:use [immutant.util :only (at-exit in-immutant? backoff)]
         immutant.messaging.internal)
   (:require [immutant.registry          :as registry]
             [immutant.messaging.hornetq :as hornetq]
@@ -199,9 +199,15 @@
 (defn create-connection
   "Creates a connection and registers it in the *connections* map"
   [opts]
-  (let [conn (if (or (tx/active?) (and (in-immutant?) (:xa opts)))
-               (.createXAConnection (connection-factory opts) (:username opts) (:password opts))
-               (.createConnection (connection-factory opts) (:username opts) (:password opts)))]
+  (let [conn (backoff
+              10 60000
+              (if (or (tx/active?) (and (in-immutant?) (:xa opts)))
+                (.createXAConnection (connection-factory opts)
+                                     (:username opts)
+                                     (:password opts))
+                (.createConnection (connection-factory opts)
+                                   (:username opts)
+                                   (:password opts))))]
     (if (:client-id opts) (.setClientID conn (:client-id opts)))
     (if *connections* (set! *connections* (assoc *connections* (connection-key opts) conn)))
     conn))


Fix a comment.

Fix a comment.

--- test/clojure_the_language/clojure_numerics_test.clj
+++ test/clojure_the_language/clojure_numerics_test.clj
@@ -257,7 +257,7 @@
 (fact (==-and-same-type 2N 2N) => true)

 ;;;; ___________________________________________________________________________
-;;;; ---- Going from longs/Longs to bigger or smaller ----
+;;;; ---- Going from Longs to bigger or smaller ----

 (def max-long-plus-1 9223372036854775808N)


Handle NRPN messages

Handle NRPN messages

--- src/mininova_web_ui/ui.cljs
+++ src/mininova_web_ui/ui.cljs
@@ -16,11 +16,19 @@

 (rf/reg-event-fx ::control
   [rf/debug]
-  (fn [fx [_ cc value midi?]]
-    (-> fx
-        (assoc-in [:db ::control cc] value)
-        ;; FIXME: (if-not midi?)
-        (assoc ::midi/midi [[176 cc value]]))))
+  (fn [fx [_ cc value from-midi?]]
+    (let [fx- (assoc-in fx [:db ::control cc] value)]
+      (if from-midi?
+        fx-
+        ;; If the event doesn't originate from midi, send it
+        (assoc fx- ::midi/midi
+          (if (vector? cc)
+            ;; NRPN
+            [[0xB0 0x63 (first cc)]
+             [0xB0 0x62 (second cc)]
+             [0xB0 0x06 value]]
+            ;; Regular CC
+            [[0xB0 cc value]]))))))

 (rf/reg-sub ::control
   (fn [db [_ cc]]
@@ -34,7 +42,10 @@
         "Osc"]
       [:li {:class (if (= tab :filter) "is-active")
             :on-click #(rf/dispatch [::panel :filter])}
-        "Filter"]]))
+        "Filter"]
+      [:li {:class (if (= tab :env) "is-active")
+            :on-click #(rf/dispatch [::panel :env])}
+        "Env"]]))

 (defn knob [{:keys [cc label min max]}]
   (let [value @(rf/subscribe [::control cc])]
@@ -55,6 +66,11 @@
   [:div.filter-panel
     [:h2 "Filter"]])

+(defn env-panel []
+  [:div.env-panel
+    [:h2 "Envelope"]
+    [knob {:cc [0 1] :label "Attack" :min 0 :max 127}]])
+
 (defn main-panel []
   (let [tab @(rf/subscribe [::panel])]
     [:main.main-panel
@@ -62,4 +78,5 @@
       (condp = tab
         :osc [osc-panel]
         :filter [filter-panel]
+        :env [env-panel]
         [:h2 "Select a panel"])]))


Added test.  ns cleanup.

Added test.  ns cleanup.

--- test/com/lemondronor/turboshrimp/h264j_test.clj
+++ test/com/lemondronor/turboshrimp/h264j_test.clj
@@ -1,11 +1,9 @@
 (ns com.lemondronor.turboshrimp.h264j-test
   (:require [clojure.java.io :as io]
             [clojure.test :refer :all]
-            [com.lemondronor.turboshrimp.pave :as pave]
             [com.lemondronor.turboshrimp.h264j :as decode]
-            [com.lemonodor.xio :as xio])
-  (:import [java.awt.image BufferedImage]
-           [javax.imageio ImageIO]))
+            [com.lemondronor.turboshrimp.pave :as pave])
+  (:import (java.awt.image BufferedImage)))

 (deftest h264-decoder-test
@@ -16,7 +14,8 @@
                     io/input-stream
                     pave/read-frame)
           ^BufferedImage img (decoder frame)]
+      (is (instance? BufferedImage img))
       (is (= 672 (.getWidth img)))
       (is (= 418 (.getHeight img)))
-      ;;(ImageIO/write img "png" (io/file "woo.png"))
+      ;;(ImageIO/write img "png" (io/file "decoded-frame.png"))
       )))


Update everything

Update everything

--- web-app/project.clj
+++ web-app/project.clj
@@ -2,32 +2,32 @@
   :description        "A Potato front-end implemented with OM"
   :url                "http://potato.network"
   :license            {:name "Apache"}
-  :min-lein-version   "2.5.3"
+  :min-lein-version   "2.8.1"

-  :dependencies [[org.clojure/clojure       "1.8.0"]
-                 [http-kit "2.1.19"]
-                 [org.clojure/clojurescript "1.8.51" :scope "provided"]
-                 [org.omcljs/om             "0.9.0"]
-                 [org.clojure/core.async    "0.2.374"]
+  :dependencies [[org.clojure/clojure       "1.9.0"]
+                 [http-kit                  "2.2.0"]
+                 [org.clojure/clojurescript "1.9.946" :scope "provided"]
+                 [org.omcljs/om             "1.0.0-beta1"]
+                 [org.clojure/core.async    "0.3.465"]
                  ;; If cljs-http is upgraded to 0.1.39, the code will fail when compiled with optimisations enabled
-                 [cljs-http                 "0.1.30" :exclusions [org.clojure/core.async]]
-                 [cljsjs/moment             "2.9.0-0"]]
+                 [cljs-http                 "0.1.44" :exclusions [org.clojure/core.async]]
+                 [cljsjs/moment             "2.17.1-1"]]

-  :plugins      [[lein-cljsbuild            "1.1.3"] ; Leiningen plugin to make ClojureScript development easy
+  :plugins      [[lein-cljsbuild            "1.1.7"] ; Leiningen plugin to make ClojureScript development easy
                  ]

   :clean-targets ^{:protect false} ["resources/public/js"]

-  :profiles {:dev {:dependencies [[com.cemerick/piggieback "0.2.1"]
-                                  [figwheel-sidecar "0.5.3-2"]]
+  :profiles {:dev {:dependencies [[com.cemerick/piggieback "0.2.2"]
+                                  [figwheel-sidecar "0.5.4-6"]]
                    :source-paths ["cljs_src"]
-                   :plugins [[lein-figwheel "0.5.3-2" :exclusions [org.clojure/clojure
-                                                                   org.clojure/tools.reader
-                                                                   ring/ring-core
-                                                                   commons-fileupload
-                                                                   clj-time]]
-                             [cider/cider-nrepl "0.16.0-SNAPSHOT" :exclusions [org.clojure/clojure
-                                                                               org.clojure/tools.nrepl]]]}}
+                   :plugins [[lein-figwheel "0.5.14" :exclusions [org.clojure/clojure
+                                                                  org.clojure/tools.reader
+                                                                  ring/ring-core
+                                                                  commons-fileupload
+                                                                  clj-time]]
+                             [cider/cider-nrepl "0.16.0" :exclusions [org.clojure/clojure
+                                                                      org.clojure/tools.nrepl]]]}}

   :cljsbuild {:builds
               [{:id "dev"
@@ -39,7 +39,7 @@

                 :compiler {:main          potato.main
                            :output-to     "resources/public/js/potato.js"
-                           :output-dir    "resources/public/js/out"
+                           :output-dir    "resources/public/js/out/"
                            :asset-path    "/js/out"
                            :optimizations :none
                            :source-map    true
@@ -65,6 +65,7 @@
                 :source-paths ["src/cljs" "env/prod/cljs"]
                 :compiler {:main          potato.main
                            :output-to     "resources/public/js/potato.js"
+                           :output-dir    "resources/public/js/prod/out"
                            :optimizations :advanced
                            :externs       ["externs-input.js"]
                            :elide-asserts false
@@ -89,13 +90,14 @@
                 :source-paths ["admin/cljs" "env/admin-prod/cljs"]
                 :compiler {:main          potato.admin
                            :output-to     "resources/public/js/admin.js"
+                           :output-dir    "resources/public/js/admin-prod/out/"
                            :optimizations :advanced
                            :elide-asserts true
                            :pretty-print  false}}]}

   :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]
                  :welcome (println "Welcome to Potato dev server Clojure REPL.")
-                 :init-ns potato.dev}
+                 :init-ns potato.dev}
   :figwheel {:server-port      10555
              :http-server-root "public"
              :nrepl-port       7888})


Remove now unused tests.

Remove now unused tests.


Add tools.namespace to the dependencies.

--- clstreams/project.clj
+++ clstreams/project.clj
@@ -5,6 +5,8 @@
             :url "http://www.eclipse.org/legal/epl-v10.html"}

   :dependencies [[org.clojure/clojure "1.8.0"]
+                 [org.clojure/tools.namespace "0.3.0-alpha3"]
+
                  [org.apache.kafka/kafka-clients "0.10.1.0"]
                  [org.apache.kafka/kafka-streams "0.10.1.0"]]


Use only ASCII characters in source code


fixed failing test

fixed failing test

--- test/staircase/test/steps.clj
+++ test/staircase/test/steps.clj
@@ -21,7 +21,7 @@
 (def db (atom (data/new-pooled-db db-spec)))

 ;; We set up and tear down by deleting everything in the database.
-(defn drop-tables []
+(defn drop-tables []
   (debug "Dropping tables...")
   (staircase.sql/drop-all-tables db-spec))

@@ -63,6 +63,7 @@
           doc-1 {:history_id my-history
                  :title "step 1"
                  :tool "quicksearch"
+                 :description "created slave1 with boba fett"
                  :stamp "testing"
                  :data {"foo" "bar" "quuxibility" 1.23}
                  }
@@ -75,7 +76,7 @@
         (is (instance? java.util.Date (:created_at got))
             (str (pr-str (:created_at got)) " should be a date"))
         (is (instance? java.util.UUID id-1)))
-      (testing "retrieved record"
+      (testing "retrieved record"
         (is (=
              (dissoc got :created_at) ;; Ignore created at in this comparison.
              (-> doc-1 ;; We expect the following transformations on the document:
@@ -102,4 +103,3 @@
           (is (= "changed the title" (:title retrieved))))
         (testing "Changed, and did not add a step"
           (is (= 2 (count all))))))))
-


sleep?

sleep?

--- test/tabby/local_net_test.clj
+++ test/tabby/local_net_test.clj
@@ -92,6 +92,7 @@
 (defmacro with-dead-server [c id & body]
   `(try
      (cluster/kill-server ~c ~id)
+     (Thread/sleep 100)
      ~@body
      (finally
        (cluster/rez-server ~c ~id))))


prob_inheritance

--- ws/gorilla_run.clj
+++ ws/gorilla_run.clj
@@ -37,6 +37,14 @@
 ;; <=

 ;; **
+;;; **Genetic-algorithm declared variables required in the run**
+;; **
+
+;; @@
+(def prob_inheritance 0.75)   ;probability that terms are directly inherited from parent to child.
+;; @@
+
+;; **
 ;;; ##Create New Individual
 ;;;
 ;; **
@@ -71,14 +79,11 @@
 ;; @@
 (defn cross-over
   "takes two individuals and crosses over the polynomial from one parent to another under a weighted selection bias"
-  [parent-1 parent-2 prob]
-  (let [offspring (mapv vec (mapv set (mapv concat (distribute-parent parent-1 prob) (reverse (distribute-parent parent-2 prob)))))]
+  [parent-1 parent-2]
+  (let [offspring (mapv vec (mapv set (mapv concat (distribute-parent (:genotype parent-1) prob_inheritance) (reverse (distribute-parent (:genotype parent-2) prob_inheritance)))))]
     [(offspring 0) (offspring 1)]
     ))
 ;; @@
-;; =>
-;;; {"type":"html","content":"#'goliath/cross-over","value":"#'goliath/cross-over"}
-;; <=

 ;; @@
 (cross-over (create-genotype 6 4 2) (create-genotype 6 4 2) 0.75)


CMR-3931: Fix the CI build error.

CMR-3931: Fix the CI build error.

--- umm-spec-lib/src/cmr/umm_spec/umm_spec_core.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_spec_core.clj
@@ -20,7 +20,11 @@
    [cmr.umm-spec.xml-to-umm-mappings.dif9 :as dif9-to-umm]
    [cmr.umm-spec.xml-to-umm-mappings.echo10 :as echo10-to-umm]
    [cmr.umm-spec.xml-to-umm-mappings.iso-smap :as iso-smap-to-umm]
-   [cmr.umm-spec.xml-to-umm-mappings.iso19115-2 :as iso19115-2-to-umm])
+   [cmr.umm-spec.xml-to-umm-mappings.iso19115-2 :as iso19115-2-to-umm]
+   ;; Added this to force the loading of the class, so that in CI build, it won't complain about
+   ;; "No implementation of method: :validate of protocol: #'cmr.spatial.validation/SpatialValidation
+   ;; found for class: cmr.spatial.cartesian_ring.CartesianRing."
+   [cmr.spatial-ring-validations]
   (:import
    (cmr.umm_spec.models.umm_collection_models UMM-C)
    (cmr.umm_spec.models.umm_service_models UMM-S)


CMR-2414 Added tests for ECHO10 conversion of CitationForExternalPublication

--- umm-lib/test/cmr/umm/test/echo10/collection.clj
+++ umm-lib/test/cmr/umm/test/echo10/collection.clj
@@ -111,6 +111,7 @@
     <ProcessingLevelId>1B</ProcessingLevelId>
     <ArchiveCenter>SEDAC AC</ArchiveCenter>
     <VersionDescription>Sample Version Description</VersionDescription>
+    <CitationForExternalPublication>Some Citation for Publication</CitationForExternalPublication>
     <CollectionState>COMPLETED</CollectionState>
     <RestrictionFlag>5.3</RestrictionFlag>
     <SpatialKeywords>
@@ -395,6 +396,7 @@
                                   :update-time (p/parse-datetime "1999-12-31T19:00:00-05:00")
                                   :delete-time (p/parse-datetime "2000-12-31T19:00:00-05:00")
                                   :revision-date-time (p/parse-datetime "1999-12-30T19:00:00-05:00")})
+     :collection-citations [(umm-c/map->PublicationReference {:other-reference-details "Some Citation for Publication"})]
      :spatial-keywords ["Word-2" "Word-1" "Word-0"]
      :access-value 5.3
      :temporal expected-parsed-temporal


Convert maze-wilsons to a lazy sequence generator.

--- src/snergly/algorithms.cljc
+++ src/snergly/algorithms.cljc
@@ -112,72 +112,30 @@
         path
         (let [next-coord (rand-nth (g/cell-neighbors (g/grid-cell grid current-coord)))
               position (#?(:clj .indexOf :cljs cljs-index-of) path next-coord)]
-          ;; in order to animate doing the walk in addition to actually carving
-          ;; the path, we would need to pass in result-chan here, include the
-          ;; grid in the recur *and* the return value, and at this point update
-          ;; the color of current-coord and, if result-chan, put the updated
-          ;; grid onto result-chan.  (Oh, and also we'd have to have conditional
-          ;; code for setting the color in both the cljs and clj ways, and we'd
-          ;; have to update wilsons-carve-passage to erase the cell color from
-          ;; each cell as it carves the path.)  Hardly seems worth it.
           (recur next-coord
                  (if (neg? position)
                    (conj path next-coord)
                    (subvec path 0 (inc position)))))))))

-(defn wilsons-carve-passage [grid path unvisited result-chan]
-  (go-loop [grid grid
-            unvisited unvisited
-            [[coord1 coord2] & pairs] (partition 2 1 path)]
-           (when (and result-chan (g/changed? grid))
-             (async/>! result-chan grid))
-    (let [new-grid (g/link-cells (g/begin-step grid) (g/grid-cell grid coord1) coord2)
-          new-unvisited (remove (partial = coord1) unvisited)]
-      (if (empty? pairs)
-        [new-grid new-unvisited]
-        (recur new-grid
-               new-unvisited
-               pairs)))))
-
-(s/defn maze-wilsons
-  ([grid :- g/Grid] (maze-wilsons grid nil))
-  ([grid :- g/Grid result-chan]
-    (go-loop [grid (assoc grid :algorithm-name "wilsons")
-              unvisited (rest (shuffle (g/grid-coords grid)))
-              coord (rand-nth unvisited)]
-             (let [path (wilsons-loop-erased-walk grid coord unvisited)
-                   ;; because this algorithm first finds a path and then carves
-                   ;; it out as separate steps, it would be good to have
-                   ;; wilsons-loop-erased-walk also animate the path-finding,
-                   ;; perhaps by annotating the path cells with a color.
-                   path-chan (wilsons-carve-passage grid path unvisited result-chan)
-                   [new-grid new-unvisited] (async/<! path-chan)]
-               (if (empty? new-unvisited)
-                 (do
-                   (when result-chan (async/close! result-chan))
-                   new-grid)
-                 (recur new-grid
-                        new-unvisited
-                        (rand-nth new-unvisited)))))))
-
-;(defn seq-wilsons
-;  ([grid]
-;    (let [unvisited (rest (shuffle (g/grid-coords grid)))
-;          coord (rand-nth unvisited)]
-;      (lazy-seq (cons grid (seq-wilsons (g/begin-step (assoc grid :algorithm-name "wilsons"))
-;                                        unvisited
-;                                        coord)))))
-;  ([grid unvisited coord]
-;   (let [path (wilsons-loop-erased-walk grid coord unvisited)
-;;        ;; because this algorithm first finds a path and then carves
-;;        ;; it out as separate steps, it would be good to have
-;;        ;; wilsons-loop-erased-walk also animate the path-finding,
-;;        ;; perhaps by annotating the path cells with a color.
-;         [new-grid new-unvisited] (wilsons-carve-passage grid path unvisited)]
-;     (if (empty? new-unvisited)
-;       (list new-grid)
-;       (lazy-seq (cons new-grid (seq-wilsons (g/begin-step grid))))))
-;    ))
+(declare seq-wilsons)
+
+(defn wilsons-carve-passage [grid unvisited [[coord1 coord2] & pairs]]
+  (let [new-grid (g/link-cells grid (g/grid-cell grid coord1) coord2)
+        new-unvisited (remove (partial = coord1) unvisited)]
+    (if (empty? pairs)
+      (lazy-seq (cons new-grid (seq-wilsons (g/begin-step new-grid) new-unvisited)))
+      (lazy-seq (cons new-grid (wilsons-carve-passage (g/begin-step new-grid) new-unvisited pairs))))))
+
+(defn seq-wilsons
+  ([grid]
+   (lazy-seq (cons grid (seq-wilsons (g/begin-step (assoc grid :algorithm-name "wilsons"))
+                                     (rest (shuffle (g/grid-coords grid)))))))
+  ([grid unvisited]
+   (if (empty? unvisited)
+     nil
+     (let [coord (rand-nth unvisited)
+           path (wilsons-loop-erased-walk grid coord unvisited)]
+       (wilsons-carve-passage grid unvisited (partition 2 1 path))))))

 (defn hunt-and-kill-start-new-walk [grid]
   (loop [[current-coord & other-coords] (g/grid-coords grid)]
@@ -294,6 +252,15 @@
 ;;   (fn [grid]
 ;;     (first (take-last 1 (seq-algorithm grid)))))
 ;;
+;; However ... it would be easy for a bunch of inefficiency to hide in this
+;; process, with the sequences including many redundant updates that get
+;; filtered out.  So it would be good to have a custom version of the
+;; transducer here:
+;;
+;;     (comp (dedupe) (filter grid/changed?))
+;;
+;; that would count how many elements get filtered.
+;;
 (defn async-from-seq [seq-algorithm]
   (fn [grid result-chan]
     (go-loop [[grid & grids] (sequence (comp (dedupe) (filter  grid/changed?)) (seq-algorithm grid))]
@@ -313,7 +280,7 @@
   {"binary-tree" (async-from-seq seq-binary-tree)
    "sidewinder" (async-from-seq seq-sidewinder)
    "aldous-broder" (async-from-seq seq-aldous-broder)
-   "wilsons" maze-wilsons
+   "wilsons" (async-from-seq seq-wilsons)
    "hunt-and-kill" (async-from-seq seq-hunt-and-kill)
    "recursive-backtracker" (async-from-seq seq-recursive-backtracker)
    })


fixes ens name wallet address

fixes ens name wallet address

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ens/core.cljs
+++ src/status_im/ens/core.cljs
@@ -131,7 +131,8 @@
   [{:keys [db] :as cofx}]
   (let [{:keys [custom-domain? username]}
         (:ens/registration db)
-        {:keys [address public-key]} (:multiaccount db)
+        {:keys [public-key]} (:multiaccount db)
+        address (ethereum/default-address db)
         chain (ethereum/chain-keyword db)
         chain-id (ethereum/chain-id db)
         contract (get stateofus/registrars chain)


[core] A little more indication here something goes wrong with make-a… (#3)

* [core] A little more indication here something goes wrong with make-array-of-type.

* [core] Throw an ex-info here rather than just printing.

--- src/think/datatype/core.clj
+++ src/think/datatype/core.clj
@@ -91,15 +91,21 @@

 (defn make-array-of-type
   [datatype elem-count-or-seq]
-  (cond
-    (= datatype :byte) (byte-array elem-count-or-seq)
-    (= datatype :short) (short-array elem-count-or-seq)
-    (= datatype :int) (int-array elem-count-or-seq)
-    (= datatype :long) (long-array elem-count-or-seq)
-    (= datatype :float) (float-array elem-count-or-seq)
-    (= datatype :double) (double-array elem-count-or-seq)
-    :else
-    (throw (Exception. (format "Unknown datatype in make-array-of-type")))))
+  (try
+    (cond
+      (= datatype :byte) (byte-array elem-count-or-seq)
+      (= datatype :short) (short-array elem-count-or-seq)
+      (= datatype :int) (int-array elem-count-or-seq)
+      (= datatype :long) (long-array elem-count-or-seq)
+      (= datatype :float) (float-array elem-count-or-seq)
+      (= datatype :double) (double-array elem-count-or-seq)
+      :else
+      (throw (Exception. (format "Unknown datatype in make-array-of-type"))))
+    (catch Throwable e
+      (throw (ex-info "make-array-of-type failed"
+                      {:datatype datatype
+                       :elem-count-or-seq elem-count-or-seq
+                       :error e})))))

 (defprotocol PBufferWrap ;;Conversion to nio buffer sharing underlying data
   (buffer-wrap-impl [item offset length]))


Quote compiler options to allow raw symbols

--- plugin/src/leiningen/doo.clj
+++ plugin/src/leiningen/doo.clj
@@ -199,7 +199,7 @@
        ;; add-implicit-options should be only called once. cljs.build.api does it
        ;; internally but doo.core functions expect us to do it. That's why we have
        ;; compiler# and full-compiler#.
-       `(let [compiler# ~compiler
+       `(let [compiler# '~compiler
               full-compiler# (cljs.build.api/add-implicit-options compiler#)]
           (doseq [js-env# ~js-envs]
             (doo.core/assert-compiler-opts js-env# full-compiler#))


added values bang for 0to255.com

added values bang for 0to255.com

--- src/xebang/models/bangs.clj
+++ src/xebang/models/bangs.clj
@@ -8,6 +8,7 @@
    '!w          "http://weatherspark.com/#!dashboard;q={{{s}}}"
    '!syn        "http://thesaurus.com/browse/{{{s}}}"
    '!def        "http://dictionary.com/browse/{{{s}}}"
+   '!values     "http://0to255.com/{{{s}}}"
    '!devdocs    "http://devdocs.io/#q={{{s}}}"
    '!js         "http://devdocs.io/#q=js {{{s}}}"
    '!css        "http://devdocs.io/#q=css {{{s}}}"


CMR-5131: Determine OPeNDAP URL based on tag association data for a collection.

--- dev-resources/src/user.clj
+++ dev-resources/src/user.clj
@@ -11,5 +11,8 @@
    [clojure.pprint :refer [pprint]]
    [clojure.tools.namespace.repl :as repl]
    [clojusc.system-manager.core :refer :all]
+   [clojusc.twig :as logger]
    [cmr.opendap.dev :as dev]
    [org.httpkit.client :as httpc]))
+
+(logger/set-level! '[cmr org.httpkit] :trace logger/no-color-log-formatter)


clean up an unused endpoint

clean up an unused endpoint

--- src/block_chain/message_handlers.clj
+++ src/block_chain/message_handlers.clj
@@ -65,27 +65,6 @@
    :payload (bc/txn-by-hash (:payload msg)
                               @db/block-chain)})

-(defn make-payment [msg sock-info]
-  ;; what if it fails?
-  ;; this should forward the new transaction to other nodes we're connected to
-  ;; {:message-type make_payment, :payload {:private-der pizza, :address pizza2, :amount 15}}
-  ;; get private der from the message and turn it into a key
-  ;; generate new payment transaction for that amount
-  ;; use that key to sign that txn
-  ;; ...
-
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;;;;;;;;; EXAMPLE ;;;;;;;;;;;;;;;;;;;;;;
-  #_(let [sample-private-key ""
-        sample-kp (ks/der-string->key-pair sample-private-key)
-        recipient-address ""
-        amount 15
-        txn (miner/generate-payment sample-kp recipient-address amount @db/block-chain 0)]
-    (swap! db/transaction-pool conj txn))
-
-  {:message-type "transaction_created"
-   :payload "lol"})
-
 (defn generate-payment
   "Generates an _unsigned_ payment transaction for supplied from-address,
    to-address, amount, and fee. Intended for use by wallet-only clients which
@@ -114,8 +93,7 @@
    "get_block" get-block
    "get_transaction" get-transaction
    "add_transaction" add-transaction
-   "generate_payment" generate-payment
-   "make_payment" make-payment})
+   "generate_payment" generate-payment})

 (defn handler [msg sock-info]


renaming

renaming

--- src/clj/algorithms_clj/perf_fibo.clj
+++ src/clj/algorithms_clj/perf_fibo.clj
@@ -20,9 +20,9 @@
   [n]
   (loop [curr 0N
          next 1N
-         iter n]
-    (if-not (zero? iter)
-      (recur next (+ curr next) (dec iter))
+         n n]
+    (if-not (zero? n)
+      (recur next (+ curr next) (dec n))
       curr)))

 (defn fibo-trampoline
@@ -33,7 +33,7 @@
               curr))]
     (trampoline (fibs 0N 1N n))))

-(defn fibo-imperative
+(defn fibo-local-vars
   [n]
   (with-local-vars [curr 0N
                     next 1N
@@ -104,7 +104,7 @@
     (run-bench (fibo-lazy-seq n))
     (run-bench (fibo-recur n))
     (run-bench (fibo-trampoline n))
-    (run-bench (fibo-imperative n))
+    (run-bench (fibo-local-vars n))
     (run-bench (fibo-volatile n))
     (run-bench (fibo-with-type n))
     #_(perf/quick-bench (fibo-lazy-cat n))


transport-buttons doesn't need entire app-state

--- cljs/sledge/core.cljs
+++ cljs/sledge/core.cljs
@@ -205,7 +205,7 @@
                                        tracks)))}
                     "+")
             track-components
-            (om/build-all results-track-view tracks)]
+            (om/build-all results-track-view tracks {:key "pathname"} )]
         (apply dom/div #js {:className "results tracks" }
                (dom/div #js {:className "track"}
                         (dom/span #js {:id "queue-all-tracks"}
@@ -281,12 +281,11 @@
 (defn player-el []
   (aget (.getElementsByTagName js/document "audio") 0))

-(defn transport-buttons-view [app owner]
+(defn transport-buttons-view [wanted owner]
   (reify
     om/IRender
     (render [this]
-      (let [wanted (:player app)
-            queue (:queue wanted)
+      (let [queue (:queue wanted)
             actual (player-el)
             want-play (:playing (:audio-el wanted))
             actually-playing (and actual (not (.-paused actual)))
@@ -302,7 +301,7 @@
             track (queue-current-entry queue)]
         (html
          [:div {:id "transport"
-                :onClick #(om/transact! app [:viewing-queue?] not)
+                :onClick #(om/transact! wanted [:viewing-queue?] not)
                 }
           [:span {:className "index"}
            [:span {:className "current"} (:next-track queue)]
@@ -482,11 +481,11 @@
        [:div
         [:header {:className "default-primary-color" } "sledge"]
         (om/build search-view (:search state))
-        (if (:viewing-queue? state)
+        (if (:viewing-queue? (:player state))
           [:div {:className "queue queue-open tracks" }
            (om/build queue-view (:queue (:player state)))]
           [:div {:className "queue tracks" } " "])
-        (om/build transport-buttons-view state)
+        (om/build transport-buttons-view (:player state))
         (om/build audio-el (:audio-el (:player state)))
         ]))))


Improve linear-forward! to avoid allocations of new output arrays

--- src/cortex/impl/layers.cljc
+++ src/cortex/impl/layers.cljc
@@ -212,24 +212,25 @@
 (defn blas-gemv-cutoff ^long [] 500000)

 (defn linear-forward!
-  "Linear backward pass.  Returns module updated with a new output."
+  "Linear forward pass.  Returns module updated with a new output."
   [this input]
-  (let [weights (:weights this)
-        bias (:bias this)
-        elem-count (long (m/ecount weights))]
-    (if (and
-         (> elem-count (blas-gemv-cutoff))
-         (blas/supports-blas? input)
-         (blas/supports-blas? weights)
-         (blas/supports-blas? bias))
-      (let [output (or (:output this)
-                       (b/new-array (m/shape bias)))]
+  (let [bias (:bias this)
+        weights (:weights this)
+        this (if (:output this) this (assoc this :output (b/new-array (m/shape bias))))
+        output (:output this)]
+    (if (and
+          (blas/supports-blas? input)
+          (blas/supports-blas? weights)
+          (blas/supports-blas? bias)
+          (> (long (m/ecount weights)) (blas-gemv-cutoff)))
+      (do
         (m/assign! output bias)
         (blas/gemv! output false 1.0 weights input 1.0)
         (assoc this :output output))
-      (let [output (m/inner-product weights input)]
+      (do
+        (m/set-inner-product! output weights input)
         (m/add! output bias)
-        (assoc this :output output)))))
+        this))))

 (defn linear-backward!


split out 'make-transformer

split out 'make-transformer

--- src/main/java/org/dada/demo/core.clj
+++ src/main/java/org/dada/demo/core.clj
@@ -172,6 +172,19 @@
 ;; each property should be able to register a converter fn as part of the transformation...
 ;; if  properties is null, don't do a transformation etc..

+(defn make-transformer [getters view view-class]
+  (new
+   Transformer
+   (list view)
+   (proxy
+    [Transformer$Transform]
+    []
+    (transform
+     [input]
+     ;; TODO: this code needs to be FAST - executed online
+     (apply make-instance view-class (map (fn [getter] (getter input)) getters)))
+    )))
+
 (defn transform [model names view view-class]
   (let [metadata (. model getMetadata)
 	property-names (. metadata getAttributeNames)]
@@ -188,16 +201,7 @@
 	    types (map property-map names)
 	    model-class (. metadata getValueClass)
 	    getters (map (fn [type name] (make-lambda-getter model-class type name)) types names)
-	    transformer (new
-			 Transformer
-			 (list view)
-			 (proxy
-			  [Transformer$Transform]
-			  []
-			  (transform [input]
-				     ;; TODO: this code needs to be FAST - executed online
-				     (apply make-instance view-class (map (fn [getter] (getter input)) getters)))
-			  ))]
+	    transformer (make-transformer getters view view-class)]
 	(connect model transformer)
 	))))


fix bug in initialize method

fix bug in initialize method

--- dropwizard-clojure-core/src/main/clojure/dropwizard_clojure/core.clj
+++ dropwizard-clojure-core/src/main/clojure/dropwizard_clojure/core.clj
@@ -3,11 +3,11 @@

 (defn- application
   ([app-name app-class run-fn]
-   (application app-name app-class nil run-fn))
+   (application app-name app-class '(constantly nil) run-fn))
   ([app-name app-class init-fn run-fn]
    `(def ~app-name
       (proxy [~app-class] []
-        (initialize [bootstrap#] ~init-fn)
+        (initialize [bootstrap#] (~init-fn bootstrap#))
         (run [configuration# environment#]
           (~run-fn configuration# environment#))))))


Appears to work bug-free; cleanup time.

Appears to work bug-free; cleanup time.

--- src/exp/sahucs_inverted.clj
+++ src/exp/sahucs_inverted.clj
@@ -81,16 +81,16 @@
         context (env/precondition-context a s)
         cache-key [(env/action-name a) (env/extract-context s context)]
         cache-val (.get cache cache-key)]
-    (println "get-sa" (env/action-name a) (when cache-val "t") (when (and cache-val (.contains (:parent-set cache-val) parent-entry)) "t") pre-reward (:reward-to-state parent-entry))
+;    (println "get-sa" (env/action-name a) (when cache-val "t") (when (and cache-val (.contains (:parent-set cache-val) parent-entry)) "t") pre-reward (:reward-to-state parent-entry))
     (when cache-val (assert (<= pre-reward (second (last @(:parent-vec-atom cache-val))))))
     (cond (and cache-val (.contains (:parent-set cache-val) parent-entry))
             []
           cache-val
             (do (swap! (:parent-vec-atom cache-val) conj [parent-entry pre-reward])
                 (.add  (:parent-set cache-val) parent-entry)
-                (println "REHIT" (env/action-name (:action cache-val)) "in service of" (env/action-name (:action (:sanode parent-entry))) (count @(:result-map-atom cache-val)))
+;                (println "REHIT" (env/action-name (:action cache-val)) "in service of" (env/action-name (:action (:sanode parent-entry))) (count @(:result-map-atom cache-val)))
                 (for [[ss sr] @(:result-map-atom cache-val)]
-                  (do (println "re-adding for result" (spos ss) pre-reward sr)
+                  (do ;(println "re-adding for result" (spos ss) pre-reward sr)
                       [(GQEntry ss sr cache-val [[parent-entry pre-reward]])
                        (- 0 pre-reward sr)])))
           :else
@@ -120,7 +120,7 @@
   (let [new-effects (env/extract-effects new-state (:context child-sanode))
         final-state  (env/apply-effects (:state parent-entry) new-effects)
         actions      (:remaining-actions parent-entry)]
-    (println "parent with" (map env/action-name actions) "for" (env/action-name (:action (:sanode parent-entry))) "from" (spos (:state (first (:parent-set (:sanode parent-entry))))))
+;    (println "parent with" (map env/action-name actions) "for" (env/action-name (:action (:sanode parent-entry))) "from" (spos (:state (first (:parent-set (:sanode parent-entry))))))
     (if (empty? actions)
        [[(GQEntry final-state
                   (+ (:reward-to-state parent-entry) new-reward)
@@ -136,7 +136,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    Top-level    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn pp [q xs]
+(defn pp [q xs]
   ;(println "adding" (count xs))
   (queues/pq-add-all! q xs))

@@ -156,7 +156,7 @@

               ]
 ;            (assert (<= neg-rew 10))
-            (println neg-rew (queues/pq-size queue) (env/action-name (:action (:sanode best))) (spos (:state best)) (spos (:state (first (:parent-set (:sanode best))))) #_ (:state best))
+ ;           (println neg-rew (queues/pq-size queue) (env/action-name (:action (:sanode best))) (spos (:state best)) (spos (:state (first (:parent-set (:sanode best))))) #_ (:state best))
             (if (nil? (:sanode (first (:parent-set (:sanode best)))))
                 (- neg-rew)
               (let [init-hash   (hash best)


change incoming data streams to match what sam is going to send

--- src/strangeloop_dance_party/core.clj
+++ src/strangeloop_dance_party/core.clj
@@ -29,7 +29,8 @@

 ; start a server and create a client to talk with it
 (def server (osc-server PORT))
-(def beat-num (atom 0))
+(def incoming-data (atom {}))
+

@@ -40,9 +41,11 @@
 (def BLUE 0x0000FF)
 (def PURPLE 0xFF00FF)

+
 (def sphero-action-list (atom  (map commands/colour [RED YELLOW BLUE PURPLE])))
 (def sphero-action-counter (atom 0))
 (def sphero-beat-mod (atom 1))
+

 (defn change-sphero-beat-mod [num]
   (reset! sphero-beat-mod num))
@@ -52,14 +55,15 @@
   (reset! sphero-action-counter 0))

 (defn stop! []
-  (set-sphero-action-list! [])
+  (change-sphero-moves [])
   (commands/execute sphero (commands/roll 0 0)))

 (defn do-action? []
-  (and
-   (pos? (count @sphero-action-list))
-   (zero? (mod @beat-num @sphero-beat-mod))))
+  (let [beat-num (get @incoming-data "/beat")]
+   (and
+    (pos? (count @sphero-action-list))
+    (zero? (mod beat-num @sphero-beat-mod)))))

 (defn sphero-action []
@@ -75,6 +79,7 @@

 (sphero-action)
+(do-action?)
 (stop!)

 (change-sphero-beat-mod 4)
@@ -89,3 +94,18 @@
                                      (swap! beat-num inc)
                                      (sphero-action)
                                      (println " hi MMSG: " msg)))
+
+(defn update-incoming-data [key val]
+  (swap! incoming-data assoc key val))
+
+(osc-handle server "/beat" (fn [msg]
+                             (update-incoming-data (:path msg) (first (:args msg)))
+                             (println " hi MMSG: " msg)
+                             (println "In beat" (pr-str @incoming-data))
+                             (println (get @incoming-data "/beat"))
+                             (sphero-action)))
+
+(osc-handle server "/amp" (fn [msg]
+                             (update-incoming-data (:path msg) (first (:args msg)))
+                             (println "In amp " (pr-str @incoming-data))
+                             (println (get @incoming-data "/amp"))))


Make melt-column-groups undocumented

Make melt-column-groups undocumented

We're discussing a possible breakding change in the API for this function
so it's being removed from the documentation. Use it at your own risk.

--- src/tabular/grafter/tabular/melt.clj
+++ src/tabular/grafter/tabular/melt.clj
@@ -52,7 +52,7 @@
           (build-row [[c] row] {:variable c :value (c row)})]
     (melt-gen dataset pivot-keys [:variable :value] col-partition build-row)))

-(defn melt-column-groups
+(defn ^:no-doc melt-column-groups
   "Melts a dataset into groups defined by the list of given column names. Given a collection of pivot columns and a collection
   of group column names, this splits each row in the input into a collection of groups and creates a row in the output for each
   group. The groups are all the length of the column name group and it is an error if the size of the group does not divide the number