sorta move-handler.. duplicates character at new location

--- clojure/src/dnd/core.cljs
+++ clojure/src/dnd/core.cljs
@@ -2,8 +2,8 @@
   (:require
     [ cljs.nodejs :as nodejs ]
     [ dnd.level :as level ]
-    [ dnd.character ]
-    [ dnd.show-screen :as show ]
+    [ dnd.character :as character]
+    [ dnd.showScreen :as show ]
     [ dnd.keyboard :as keyboard ]
     ))

@@ -23,22 +23,26 @@
   (.removeAllListeners term "key")
   (.removeAllListeners keyboard/emitter))

+(def character character/character)
+
+(def level
+  (let [level (level/make-level)
+        [updated] (character/move-character level character 2 1)]
+    updated))
+
+(defn move-handler []
+  (let [[level character] (character/move-character level character 0 (inc (character :x)))]
+    ;(set! level level)
+    ;(set! character character)
+    (show/show-screen term level)))
+
 (defn -main []
-  (def character dnd.character/character)
   (.clear term)
   (teardown term)
   (setup term)

-  (def level
-    (let [level (level/make-level)
-          firstOne (level 1)
-          updateHabs #(assoc firstOne :inhabitants [character])
-          updated (update level 1 updateHabs)
-          ]
-      updated))
-
   (keyboard/HandleCharacterKeys term level character)
-  (.on keyboard/emitter "up" #(println "UP!!!!!!!!!!!"))
+  (.on keyboard/emitter "up" move-handler)
   (show/show-screen term level))

 (set! *main-cli-fn* -main)


(maint) Remove unused import in core_test

--- test/unit/puppetlabs/pcp/broker/core_test.clj
+++ test/unit/puppetlabs/pcp/broker/core_test.clj
@@ -6,7 +6,6 @@
             [puppetlabs.pcp.broker.capsule :as capsule]
             [puppetlabs.pcp.broker.connection :as connection :refer [Codec]]
             [puppetlabs.pcp.message :as message]
-            [puppetlabs.experimental.websockets.client :as websockets-client]
             [schema.core :as s]
             [schema.test :as st]
             [slingshot.test])


fix: adds missing serverless-cljs-plugin dependency

--- templates/serverless/src/leiningen/new/serverless_cljs/project.clj
+++ templates/serverless/src/leiningen/new/serverless_cljs/project.clj
@@ -4,6 +4,7 @@
                  [io.nervous/cljs-lambda    "0.3.5"]]
   :plugins [[lein-npm                    "0.6.2"]
             [io.nervous/lein-cljs-lambda "0.6.5"]]
+  :npm {:dependencies [[serverless-cljs-plugin "0.1.2"]]}
   :cljs-lambda {:compiler
                 {:inputs  ["src"]
                  :options {:output-to     "target/{{name}}/{{sanitized}}.js"


CMR-3663 Simplifies ACL search parameter mappings

--- access-control-app/src/cmr/access_control/services/acl_search_service.clj
+++ access-control-app/src/cmr/access_control/services/acl_search_service.clj
@@ -43,8 +43,8 @@
    :permitted-group cpv/string-param-options
    :provider cpv/string-param-options
    :identity-type cpv/string-param-options
-   :target cpv/string-param-options
-   :legacy-guid cpv/string-param-options
+   :target #{}
+   :legacy-guid #{}
    :id #{}
    :permitted-user #{}
    :group-permission #{}})
@@ -177,7 +177,7 @@
   {:permitted-concept-id :permitted-concept-id
    :permitted-group :string
    :identity-type :acl-identity-type
-   :target ::target
+   :target :string
    :provider :string
    :permitted-user :acl-permitted-user
    :group-permission :acl-group-permission
@@ -207,10 +207,6 @@
                    (map #(cp/parameter->condition context concept-type param % options) value))
    (let [value (get acl-identity-type->search-value (str/lower-case value))]
      (cp/string-parameter->condition concept-type param value options))))
-
-(defmethod cp/parameter->condition ::target
-  [context concept-type param value options]
-  (cp/string-parameter->condition concept-type :target value options))

 (defmethod cp/parameter->condition :acl-permitted-user
   [context concept-type param value options]


Re-subscribe to mqtt topics on reconnect (#291)

* re-subscribe to mqtt topics on reconnect

* removing unused require

--- server/src/spacon/components/mqtt/core.clj
+++ server/src/spacon/components/mqtt/core.clj
@@ -81,10 +81,16 @@
     (log/debug "Nil message on topic " topic)
     (async/go (async/>!! (:subscribe-channel mqtt) {:topic topic :message (msg/from-bytes message)}))))

-(defn reconnect [reason]
+(defn reconnect [mqtt-comp reason ]
   (let [url (or (System/getenv "MQTT_BROKER_URL") "tcp://localhost:1883")]
-    (log/debugf "%s%nConnection lost. Attempting reconnect to %s" reason url)
-    (connectmqtt url)))
+    (log/debugf "Connection lost (%s). Attempting reconnect to %s" reason url)
+    (connectmqtt url)
+    (doall (map (fn [t]
+                  (mh/subscribe @conn {(subs (str t) 1) 2}
+                                (fn [^String topic _ ^bytes payload]
+                                  (receive mqtt-comp topic payload))
+                                {:on-connection-lost (partial reconnect mqtt-comp) }))
+                (keys @topics)))))

 (defn subscribe
   "Subscribe to mqtt topic with message handler function f"
@@ -94,7 +100,7 @@
   (mh/subscribe @conn {topic 2}
                 (fn [^String topic _ ^bytes payload]
                   (receive mqtt topic payload))
-                {:on-connection-lost reconnect}))
+                {:on-connection-lost (partial reconnect mqtt) }))

 (defn unsubscribe
   "Unsubscribe to mqtt topic"
@@ -111,7 +117,7 @@
                 (try
                   (if-not (mh/connected? @conn)
                     (do
-                      (reconnect nil)
+                      (reconnect mqtt nil)
                       (if-not (or (nil? t) (nil? m))
                         (mh/publish @conn t m)))
                     (if-not (or (nil? t) (nil? m))


Remove redundant if in packets.clj

Remove redundant if in packets.clj

--- src/packets.clj
+++ src/packets.clj
@@ -271,14 +271,12 @@
 (defn packet-getter-fns [{fields :fields}]
   (apply str
          (for [{name :name type :type getter-docs :getter} fields]
-           (if (or (nil? name) (nil? type))
-             ""
-             (format
-               (long-str "    /// %s"
-                         "    pub fn get_%s(&self) -> &%s {"
-                         "        &self.%s"
-                         "    }")
-               (or getter-docs (format "get the %s field (UNDOCUMENTED)" name)) name type name)))))
+           (format
+             (long-str "    /// %s"
+                       "    pub fn get_%s(&self) -> &%s {"
+                       "        &self.%s"
+                       "    }")
+             (or getter-docs (format "get the %s field (UNDOCUMENTED)" name)) name type name))))

 ;; Create the impl for a given packet
 (defn packet-impl [packet packet-type]


Add my meagre info

Add my meagre info

--- resources/members.clj
+++ resources/members.clj
@@ -2,4 +2,5 @@
   :projects [:leiningen :clojure-mode :swank-clojure
              :clojure-gem :clojure-http-client :mire]}
  {:name "Brendan Ribera" :url "http://threebrothers.org/brendan/"
-  :projects [:clj-kdtree]}]
+  :projects [:clj-kdtree]}
+ {:name "Eric Hanchrow"}]


CMR-1368: Minor refactoring

CMR-1368: Minor refactoring

--- transmit-lib/src/cmr/transmit/metadata_db.clj
+++ transmit-lib/src/cmr/transmit/metadata_db.clj
@@ -67,11 +67,11 @@
        (when throw-service-error?
          (errors/throw-service-error
            :not-found
-           (let [concept-type (get {:collection "Collection" :granule "Granule"}
-                                   concept-type
-                                   "Concept")]
+           (let [concept-type-str (get {:collection "Collection" :granule "Granule"}
+                                       concept-type
+                                       "Concept")]
              (format "%s with native id [%s] in provider [%s] does not exist."
-                     concept-type native-id provider-id))))
+                     concept-type-str native-id provider-id))))

        200
        (get body "concept-id")


Wrap prepared statement sql (change in finagle-mysql 6.25.0)

--- mysql/src/finagle_clojure/mysql/client.clj
+++ mysql/src/finagle_clojure/mysql/client.clj
@@ -1,6 +1,6 @@
 (ns finagle-clojure.mysql.client
   (:import (com.twitter.finagle Stack$Param)
-           (com.twitter.finagle.exp.mysql Row Client PreparedStatement Result OK ResultSet Field)
+           (com.twitter.finagle.exp.mysql Row Client PreparedStatement Result OK ResultSet Field Parameter$)
            (com.twitter.finagle.exp Mysql$Client Mysql)
            (com.twitter.util Future))
   (:require [finagle-clojure.scala :as scala]
@@ -208,7 +208,7 @@

     a [[com.twitter.finagle.exp.mysql.PreparedStatement]]"
   [^Client client sql]
-  (.prepare client sql))
+  (.prepare client (.unsafeWrap Parameter$/MODULE$ sql)))

 (defn ^Future ping
   "Given a rich client, pings it to verify connectivity.


Bumps version to 1.53.2-SNAPSHOT

Bumps version to 1.53.2-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.53.1"
+(defproject cook "1.53.2-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Spr printing getting there

Spr printing getting there

UV calc is a nonsense - sort out tomoz

--- go-fighweel/src/cloj/core.cljc
+++ go-fighweel/src/cloj/core.cljc
@@ -105,24 +105,25 @@
       (<??)
       (#(rend-p/make-spr! r :poo % (rend-p/dims %))))))

-(defn draw-sprs [r spr-printer t]
-  (rend-p/scale! r (v2 0.1 0.1))
-  (rend-p/spr! spr-printer :b-floor (v2 1 1)))
+(defn draw-sprs [r spr-printer pos t]
+  (rend-p/scale! r (v2 0.2 0.2))
+  (rend-p/spr! spr-printer :b-floor pos))

 ;; Some stuff to control things on screen
 (def func->vel
-  [[right? (v2  1  0)]
-   [left?  (v2 -1  0)]
-   [up?    (v2  0 -1)]
-   [down?  (v2  0  1)] ])
+  [[right?  (v2  1  0)]
+   [left?   (v2 -1  0)]
+   [up?     (v2  0 -1)]
+   [down?   (v2  0  1)] ])

-(defn new-pos [keyb pos]
+
+(defn new-pos [keyb pos scale]
   (->>
     ;; filter only pressed keys
     (filter (fn [[func _]]
               (func keyb)) func->vel)
     ;; strip out the func and leave the vel
-    (map (fn [_ v] v))
+    (map (fn [[_ v]] (v2/mul scale v)))
     ;; reduce add them all together
     (reduce v2/add pos)))

@@ -150,11 +151,11 @@
               (gamekeys/update! gkeys)

               (draw-frame dims r t)
-              (draw-sprs r spr-printer t)
+              (draw-sprs r spr-printer pos t)

               (when-not (quit? gkeys)
                 (recur (+ t (/ 1 60))
-                       (new-pos gkeys pos))))))
+                       (new-pos gkeys pos (v2 0.5 0.5)))))))

         (catch Exception e
           (println "[Error in main] " (.getMessage e)))


Fix a rookie mistake.

Fix a rookie mistake.

--- src/cljs/cljs_browser_repl/console/cljs.cljs
+++ src/cljs/cljs_browser_repl/console/cljs.cljs
@@ -84,17 +84,17 @@
    :gap "4px"
    :children [[md-icon-button
                :md-icon-name "zmdi-delete"
+               :on-click #(cljs-reset-console-and-prompt! (app/console :cljs-console))
+               :class "cljs-btn"
+               :disabled? (not (app/console-created? :cljs-console))]
+              [md-icon-button
+               :md-icon-name "zmdi-format-clear-all"
                :on-click #(console/clear-console! (app/console :cljs-console))
                :class "cljs-btn"
-               :disabled? (app/console-created? :cljs-console)]
-              [md-icon-button
-               :md-icon-name "zmdi-format-clear-all"
-               :on-click #(cljs-reset-console-and-prompt! (app/console :cljs-console))
-               :class "cljs-btn"
-               :disabled? (app/console-created? :cljs-console)]
+               :disabled? (not (app/console-created? :cljs-console))]
               ;; copy to clipboard?
               [md-icon-button
                :md-icon-name "zmdi-github"
                :on-click #()
                :class "cljs-btn"
-               :disabled? (app/console-created? :cljs-console)]]])
+               :disabled? (not (app/console-created? :cljs-console))]]])


Rework nil checks.

Rework nil checks.

--- src/dsbdp/local_data_processing_pipeline.clj
+++ src/dsbdp/local_data_processing_pipeline.clj
@@ -139,16 +139,11 @@
   [queue]
   (println "Retrieving data from queue via:")
   (let [expr (condp (fn [^String v ^String s] (.endsWith s v)) queue-setup
-               "remove-yield" `(loop []
-                                 (if (not (.isEmpty ~queue))
-                                   (.remove ~queue)
-                                   (do
-                                     (Thread/yield)
-                                     (recur))))
-               "remove" `(loop []
-                           (if (not (.isEmpty ~queue))
-                             (.remove ~queue)
-                             (recur)))
+               "remove-yield" `(if (not (.isEmpty ~queue))
+                                 (.remove ~queue)
+                                 (Thread/yield))
+               "remove" `(if (not (.isEmpty ~queue))
+                           (.remove ~queue))
                `(.take ~queue))]
     (println expr)
     expr))
@@ -166,10 +161,11 @@
           proc-fn (fn []
                     (try
                       (let [^LocalTransferContainer c (take-from-queue in-queue)
-                            new-out (f (.getIn c) (.getOut c))]
-                        (if (not (nil? new-out))
-                          (.setOut c new-out))
-                        (enqueue out-queue c out-counter out-drop-counter))
+                            new-out (if (not (nil? c))
+                                      (f (.getIn c) (.getOut c)))]
+                        (when (not (nil? new-out))
+                          (.setOut c new-out)
+                          (enqueue out-queue c out-counter out-drop-counter)))
                       (catch InterruptedException e
                         (if @running
                           (throw e)))))
@@ -228,8 +224,7 @@
                           (try
                             (let [^LocalTransferContainer c (take-from-queue out-queue)]
                               (if (not (nil? c))
-                                (out-fn (.getIn c) (.getOut c))
-                                (out-fn nil nil)))
+                                (out-fn (.getIn c) (.getOut c))))
                             (catch InterruptedException e
                               (if @running
                                 (throw e))))))


Rework implementation of approx-canonical-base

In particular fixed the number of iterations needed for the equivalence
oracle simulation.

Signed-off-by: Daniel Borchmann <3d0f3b9ddcacec30c4008c5e030e6c13a478cb4f@algebra20.de>

--- src/main/clojure/conexp/fca/implications.clj
+++ src/main/clojure/conexp/fca/implications.clj
@@ -682,26 +682,42 @@
   [implications]
   #(every? (fn [implication] (respects? % implication)) implications))

+
 ;;; Approximate Computation of the Canonical Base

 (defn approx-canonical-base
-  ""
-  ([ctx ε δ]
-   (approx-canonical-base ctx ε δ #(set (random-sample 0.5 (attributes ctx)))))
-  ([ctx ε δ subset-sampler]
-   (let [intent?       #(= % (adprime ctx %))
-         nr-iter       (inc (ceil (* (/ ε) (Math/log (/ δ)))))
-         respects-all? (fn [set impls]
-                         (every? (fn [impl] (respects? set impl)) impls))]
-     (learn-implications-by-queries (attributes ctx)
-                                    intent?
-                                    (fn [implications]
-                                      (or (some (fn [test-set]
-                                                  (when (not (<=> (intent? test-set)
-                                                                  (respects-all? test-set implications)))
-                                                    test-set))
-                                                (repeatedly nr-iter subset-sampler))
-                                          true))))))
+  "Compute a set L of implications that is an approximation to the canonical
+  base of the formal context `ctx'.  More precisely, if H is the canonical base
+  of ctx, then
+
+    |Mod(L) Δ Mod(H)|/2^{|M|} ≤ ε
+
+  with probability at least 1-δ.  The computation is done in polynomial time
+  with respect to |M|, |L|, 1/ε, and 1/δ. "
+  [ctx ε δ]
+  (assert (context? ctx))
+  (assert (and (number? ε)
+               (< 0 ε 1)))
+  (assert (and (number? δ)
+               (< 0 δ 1)))
+  (let [random-subset #(set (random-sample 0.5 (attributes ctx)))
+        intent?       #(= % (adprime ctx %))
+        respects-all? (fn [set impls]
+                        (every? (fn [impl] (respects? set impl)) impls))
+        iter-counter  (atom 0)]
+    (learn-implications-by-queries (attributes ctx)
+                                   intent?
+                                   (fn [implications]
+                                     (let [nr-iter (ceil (* (/ ε) (+ (swap! iter-counter inc)
+                                                                     (/ (Math/log (/ δ))
+                                                                        (Math/log 2)))))]
+                                       (or (some (fn [test-set]
+                                                   (when-not (<=> (intent? test-set)
+                                                                  (respects-all? test-set
+                                                                                implications))
+                                                     test-set))
+                                                 (repeatedly nr-iter random-subset))
+                                           true))))))

 ;;; The End


Provide button-held feedback when scrolling fx

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -1270,8 +1270,10 @@
       (if @(:shift-mode controller)
         ;; Trying to scroll back to older effects
         (let [[offset max-offset room] (find-effect-offset-range controller)
-              new-offset (+ offset room)]
-          (reset! (:effect-offset controller) (min max-offset new-offset)))
+              new-offset (min max-offset (+ offset room))]
+          (when (not= offset new-offset)
+            (reset! (:effect-offset controller) new-offset)
+            (add-button-held-feedback-overlay controller (:left-arrow control-buttons))))

         ;; Trying to scroll left in cue grid
         (let [[x y] @(:origin controller)]
@@ -1284,8 +1286,10 @@
       (if @(:shift-mode controller)
         ;; Trying to scroll forward to newer effects
         (let [[offset max-offset room] (find-effect-offset-range controller)
-              new-offset (- offset room)]
-          (reset! (:effect-offset controller) (max 0 new-offset)))
+              new-offset (max 0 (- offset room))]
+          (when (not= offset new-offset)
+            (reset! (:effect-offset controller) new-offset)
+            (add-button-held-feedback-overlay controller (:right-arrow control-buttons))))

         ;; Trying to scroll right in cue grid
         (let [[x y] @(:origin controller)]
@@ -1297,8 +1301,10 @@
     (when (pos? (:velocity message))
       (if @(:shift-mode controller)
         ;; Jump back to oldest effect
-        (let [[_ max-offset] (find-effect-offset-range controller)]
-          (reset! (:effect-offset controller) max-offset))
+        (let [[offset max-offset] (find-effect-offset-range controller)]
+          (when (not= offset max-offset)
+            (reset! (:effect-offset controller) max-offset)
+            (add-button-held-feedback-overlay controller (:up-arrow control-buttons))))

         ;; Trying to scroll up in cue grid
         (let [[x y] @(:origin controller)]
@@ -1310,7 +1316,9 @@
     (when (pos? (:velocity message))
       (if @(:shift-mode controller)
         ;; Jump forward to newest effect
-        (reset! (:effect-offset controller) 0)
+        (when (pos? @(:effect-offset controller))
+          (reset! (:effect-offset controller) 0)
+          (add-button-held-feedback-overlay controller (:down-arrow control-buttons)))

         ;; Trying to scroll down in cue grid
         (let [[x y] @(:origin controller)]


Исправление chart-2

Исправление chart-2

--- radiolamp-6P3S/src/r6p3s/cpt/d3/chart_2.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/d3/chart_2.cljs
@@ -306,8 +306,21 @@
                   (.attr "x1" 0)
                   (.attr "y1" 0)
                   (.attr "x2" 0)
-                  (.attr "y2" 0))))
-
+                  (.attr "y2" 0))
+
+
+              (-> chart-pano
+                  (.selectAll "g.charting.pathes circle")
+                  .remove)
+
+              (-> chart-pano
+                  (.selectAll "g.charting.pathes text")
+                  .remove)
+
+              (when on-selected-fn
+                (on-selected-fn {:interval [] :selected-rows []}))
+
+              ))
           ))

       om/IRenderState


Renamed the key :spec-refs to :data in the json that the backend returns to frontend. Implemented returning :actions and :data even when they are not found when composing the specification.

--- src/clj_formal_specifications_app/core.clj
+++ src/clj_formal_specifications_app/core.clj
@@ -61,13 +61,13 @@
    (assoc spec :actions (conj-actions (:actions spec) map-entry))

    (spec-ref-entry? map-entry)
-   (assoc spec :spec-refs (conj-spec-refs (:spec-refs spec) map-entry))
+   (assoc spec :data (conj-spec-refs (:data spec) map-entry))

    :else spec))

 (defn ns-spec
   [ns]
-  (reduce assoc-to-spec {} (ns-publics (symbol ns))))
+  (reduce assoc-to-spec {:actions #{} :data #{}} (ns-publics (symbol ns))))

 (defn compose
   [spec]


Calendar improvements

Calendar improvements

Introducing 'detached' state for calendar:
with this flag value changes from outside won't drop
current month selecting process with redraw. Choosing
day resets this flag and value changes will trigger
rendering proper month for up to date value.

--- src/cljs/re_form/inputs/calendar_impl.cljs
+++ src/cljs/re_form/inputs/calendar_impl.cljs
@@ -129,13 +129,15 @@
   (let [prev-month (fn [_]
                      (let [cal (:cal @state)
                            p (js/Date. (:y cal) (dec (:m cal)) 1)]
-                       (swap! state assoc :cal {:y (.getFullYear p)
-                                                :m (.getMonth p)})))
+                       (swap! state #(-> % (assoc :cal {:y (.getFullYear p)
+                                                        :m (.getMonth p)})
+                                         (assoc :detached true)))))
         next-month (fn [_]
                      (let [cal (:cal @state)
                            p (js/Date. (:y cal) (inc (:m cal)) 1)]
-                       (swap! state assoc :cal {:y (.getFullYear p)
-                                                :m (.getMonth p)})))
+                       (swap! state #(-> % (assoc :cal {:y (.getFullYear p)
+                                                        :m (.getMonth p)})
+                                         (assoc :detached true)))))
         switch-mode (fn [m] (fn [_] (swap! state assoc :mode m)))]
     (fn []
       [:thead
@@ -167,7 +169,8 @@
         [:tr {:key (let [f (first week)] (str (:m f) "-" (:d f)))}
          (for [day week]
            [:td {:key (str (:m day) (:d day))
-                 :on-click #(on-change day)
+                 :on-click (fn [_] (swap! state assoc :detached false)
+                             (on-change day))
                  :class (str
                          (when (= day v)
                            "active")
@@ -216,7 +219,8 @@
 (defn re-calendar [{:keys [value on-change errors]}]
   (let [state (r/atom {:mode :days})]
     (fn [{:keys [value on-change errors]}]
-      (swap! state assoc :cal value)
+      (when-not (:detached @state)
+        (swap! state assoc :cal value))
       [:div.re-calendar
        (case (:mode @state)
          :days


update frame/db info with new catalog

update frame/db info with new catalog

--- src/clojure/com/zensol/cisql/db_access.clj
+++ src/clojure/com/zensol/cisql/db_access.clj
@@ -29,6 +29,7 @@

 (defn set-catalog [catalog]
   (reset! current-catalog catalog)
+  (reset! dbspec nil)
   (log/infof "set catalog: %s" catalog))

 ;; db metadata


Added a design for toolsets

Added a design for toolsets

--- src/clojure/staircase/resources/schema.clj
+++ src/clojure/staircase/resources/schema.clj
@@ -53,5 +53,21 @@
    [[:id :uuid :primary :key ]
     [:root string ]
     [:token data ]
+    owner-column
+    [:UNIQUE "(owner, root)"]]})
+
+(def toolsets
+  {:toolsets
+   [[:id :uuid :primary :key]
+    [:active :boolean]
     owner-column]})
+
+(def tool-config
+   {:toolconfs
+    [[:name string :primary :key]
+     [:toolset :uuid :REFERENCES :toolsets "(id)"]
+     [:index :integer]
+     [:frontpage :boolean]
+     [:data data]
+     [:UNIQUE "(toolset, index)"]]})


Update generator docstring

Update generator docstring

--- language-adaptors/rxjava-clojure/src/main/clojure/rx/lang/clojure/core.clj
+++ language-adaptors/rxjava-clojure/src/main/clojure/rx/lang/clojure/core.clj
@@ -432,7 +432,7 @@
   Example:

     (->> (rx/seq->o [1 2 3])
-    (rx/do println)
+         (rx/do println)
     ...)

   Will print 1, 2, 3.
@@ -884,8 +884,8 @@
 ;################################################################################;

 (defn generator*
-  "Creates an observable that calls (f observable & args) which should emit values
-  with (rx/on-next observable value).
+  "Creates an observable that calls (f observer & args) which should emit values
+  with (rx/on-next observer value).

   Automatically calls on-completed on return, or on-error if any exception is thrown.

@@ -902,8 +902,8 @@
                    wrap-on-error)))

 (defmacro generator
-  "Create an observable that executes body which should emit a sequence. bindings
-  should be a single [observer] argument.
+  "Create an observable that executes body which should emit values with
+  (rx/on-next observer value) where observer comes from bindings.

   Automatically calls on-completed on return, or on-error if any exception is thrown.


Removed unnecessary try catch block.

Removed unnecessary try catch block.

--- common-lib/src/cmr/common/xml.clj
+++ common-lib/src/cmr/common/xml.clj
@@ -157,18 +157,15 @@
 (defn pretty-print-xml
   "Returns the pretty printed xml for the given xml string"
   [xml]
-  (try
-    (let [src (InputSource. (StringReader. xml))
-          builder (.newDocumentBuilder (DocumentBuilderFactory/newInstance))
-          document (.getDocumentElement (.parse builder src))
-          ^Boolean keep-declaration (.startsWith xml "<?xml")
-          registry (DOMImplementationRegistry/newInstance)
-          ^DOMImplementationLS impl (.getDOMImplementation registry "LS")
-          writer (.createLSSerializer impl)
-          dom-config (.getDomConfig writer)]
-      (.setParameter dom-config "format-pretty-print" true)
-      (.setParameter dom-config "xml-declaration" keep-declaration)
-      (.writeToString writer document))
-    (catch Throwable e
-      (errors/internal-error! "Failed to pretty print xml" e))))
+  (let [src (InputSource. (StringReader. xml))
+        builder (.newDocumentBuilder (DocumentBuilderFactory/newInstance))
+        document (.getDocumentElement (.parse builder src))
+        ^Boolean keep-declaration (.startsWith xml "<?xml")
+        registry (DOMImplementationRegistry/newInstance)
+        ^DOMImplementationLS impl (.getDOMImplementation registry "LS")
+        writer (.createLSSerializer impl)
+        dom-config (.getDomConfig writer)]
+    (.setParameter dom-config "format-pretty-print" true)
+    (.setParameter dom-config "xml-declaration" keep-declaration)
+    (.writeToString writer document)))


make get-status keywordize JSON from status.

--- src/kixi/hecuba/data/measurements/core.clj
+++ src/kixi/hecuba/data/measurements/core.clj
@@ -40,7 +40,7 @@
   (let [s3-key (s3/s3-key-from item )]
     (when (s3/item-exists? s3 s3-key)
       (with-open [in (s3/get-object-by-metadata s3 {:key s3-key})]
-        (:status (json/parse-string (slurp in)))))))
+        (:status (json/parse-string (slurp in) keyword))))))

 (defn write-status [store item]
   (let [status-file (ioplus/mk-temp-file! "hecuba" ".tmp")]


add more tests for notifications

add more tests for notifications

--- test/braid/test/common/notify_rules_test.clj
+++ test/braid/test/common/notify_rules_test.clj
@@ -84,5 +84,13 @@
       (db/create-message! m)
       (is (rules/notify? user-id [[:mention (:id g1)]] m))
       (is (rules/notify? user-id [[:tag (:id g1t1)]] m))
-      (is (not (rules/notify? user-id [[:tag (:id g1t2)]] m))))))
+      (is (not (rules/notify? user-id [[:tag (:id g1t2)]] m))))

+    (let [m1 (-> (msg)
+                (update :mentioned-tag-ids conj (:id g1t1)))
+          m2 (-> (msg) (assoc :thread-id (m1 :thread-id)))]
+      (db/create-message! m1)
+      (db/create-message! m2)
+      (is (rules/notify? (db/uuid) [[:any (:id g1)]] m2))
+      (is (not (rules/notify? (db/uuid) [[:any (:id g2)]] m2))))))
+


(PDB-5484) fact-environment-queries: fix bug to enable; update test data

--- test/puppetlabs/puppetdb/http/facts_test.clj
+++ test/puppetlabs/puppetdb/http/facts_test.clj
@@ -1050,7 +1050,7 @@
 (deftest-http-app fact-environment-queries
   [[_version endpoint] facts-endpoints
    method [:get :post]
-   :when (not #(re-find #"environment" endpoint))]
+   :when (not (re-find #"environment" endpoint))]

   (testing (str "endpoint " endpoint)
     (let [facts1 {"domain" "testing.com"
@@ -1082,22 +1082,26 @@
                                :values facts1
                                :timestamp (now)
                                :environment "DEV"
-                               :producer_timestamp (now)})
+                               :producer_timestamp (now)
+                               :producer "foo.com"})
         (scf-store/add-facts! {:certname "foo2"
                                :values facts2
                                :timestamp (now)
                                :environment "DEV"
-                               :producer_timestamp (now)})
+                               :producer_timestamp (now)
+                               :producer "foo.com"})
         (scf-store/add-facts! {:certname "foo3"
                                :values facts3
                                :timestamp (now)
                                :environment "PROD"
-                               :producer_timestamp (now)})
+                               :producer_timestamp (now)
+                               :producer "foo.com"})
         (scf-store/add-facts! {:certname "foo4"
                                :values facts4
                                :timestamp (now)
                                :environment "PROD"
-                               :producer_timestamp (now)}))
+                               :producer_timestamp (now)
+                               :producer "foo.com"}))

       (doseq [query '[[= environment PROD]
                       [not [= environment DEV]]


Fix failing test case

Fix failing test case

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -381,7 +381,7 @@
       (recur (aget (.-children node) 0)))))

 ;; trie view of a tree
-(deftype Trieterator [iterator seek-key ^:mutable pinned-key ^:mutable pinned-key-ix ^:mutable moving-key-ix ^:mutable end? key-len]
+(deftype Trieterator [iterator seek-key pinned-key ^:mutable moving-key-ix ^:mutable end? key-len]
   Object
   (key [this]
        (when (false? end?)
@@ -391,12 +391,11 @@
          (.val iterator)))
   (maintain [this]
             (if (or (true? (.-end? iterator))
-                    (not (or (< pinned-key-ix 0) ;; nothing to pin
-                             (identical? pinned-key (aget (.key iterator) pinned-key-ix)))))
+                    (not (key-lt (.key iterator) pinned-key)))
               (set! end? true)
               (do
                 (set! end? false)
-                (aset seek-key moving-key-ix (.key this)))))
+                (aset seek-key moving-key-ix (.key this))))) ;; is this needed?
   (next [this]
         (when (false? end?)
           (.seek iterator seek-key)
@@ -409,19 +408,18 @@
   (down [this]
         (assert (false? end?))
         (assert (< moving-key-ix (- (alength seek-key) 1)))
-        (set! pinned-key (.key this))
-        (set! pinned-key-ix moving-key-ix)
+        (aset pinned-key moving-key-ix (.key this))
         (set! moving-key-ix (+ moving-key-ix 1))
         (aset seek-key moving-key-ix (.key this))
         (.maintain this))
   (up [this]
       (assert (> moving-key-ix 0))
+      (when (false? end?)
+        (.seek iterator pinned-key))
       (aset seek-key moving-key-ix greatest)
-      (set! moving-key-ix pinned-key-ix)
-      (set! pinned-key-ix (- pinned-key-ix 1))
-      (set! pinned-key (when (>= pinned-key-ix 0) (aget seek-key pinned-key-ix)))
-      (when (false? end?)
-        (.seek iterator seek-key))
+      (set! moving-key-ix (- moving-key-ix 1))
+      (when (>= moving-key-ix 0)
+        (aset pinned-key moving-key-ix greatest))
       (.maintain this))
   (mark [this]
         (.mark iterator))
@@ -429,7 +427,7 @@
          (.reset iterator)))

 (defn trieterator [iterator]
-  (let [trieterator (Trieterator. iterator (greatest-key (.-key-len iterator)) nil -1 0 false (.-key-len iterator))]
+  (let [trieterator (Trieterator. iterator (greatest-key (.-key-len iterator)) (greatest-key (.-key-len iterator)) 0 false (.-key-len iterator))]
     (.maintain trieterator)
     trieterator))

@@ -826,8 +824,6 @@
                  movements (gen/vector (gen-next key-len))] ;; TODO use gen-movement once Treeterator supports seek
                 (run-self-join-prop min-keys key-len actions movements)))

-(run-trie-tree-prop 1 3 [[:assoc! #js [-86 90 "-9"] #js [-77 20 -16]] [:assoc! #js [-64 90 -44] #js [7 -8 -47]]] [[:next]])
-
 (comment
   (dc/quick-check 1000 (least-prop 1))
   (dc/quick-check 1000 (least-prop 2))


Bugfixes for join

Bugfixes for join

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -397,11 +397,17 @@
   Object
   (reset [this]
          (.reset iterator))
-  (inner-key [this]
-       (.key iterator))
+  (key [this]
+       (when (false? (.-end? iterator))
+         (let [inner-key (.key iterator)
+               outer-key (make-array key-len)]
+           (dotimes [i (alength inner->outer)]
+             (aset outer-key (aget inner->outer i) (aget inner-key i)))
+           outer-key)))
   (key-at [this outer-ix]
-              (let [inner-key (.key iterator)]
-                (aget inner-key (aget outer->inner outer-ix))))
+          (when (false? (.-end? iterator))
+            (let [inner-key (.key iterator)]
+              (aget inner-key (aget outer->inner outer-ix)))))
   (next [this]
         (.next iterator))
   (seek [this outer-key]
@@ -465,10 +471,10 @@
           nil ;; done
           (let [new-var (+ old-var 1)
                 iterators (aget var->iterators new-var)]
+            (dotimes [i (alength iterators)]
+              (doto (aget iterators i) (.reset) (.seek seek-key))) ;; TODO this could be implemented more efficiently
             (when (>= old-var 0)
               (aset seek-key old-var old-key))
-            (dotimes [i (alength iterators)]
-              (doto (aget iterators i) (.reset) (.seek seek-key))) ;; TODO this could be implemented more efficiently
             (assert (every? #(not (.end? %)) iterators) (js/console.log iterators)) ;; TODO remove this when debugged
             (js/goog.array.sort iterators (fn [i0 i1] (compare (.key-at i0 new-var) (.key-at i1 new-var))))
             (if (== (.key-at (aget iterators 0) new-var) (.key-at (aget iterators (- (alength iterators) 1)) new-var))


Fix defaulted scheduler lag.

Fix defaulted scheduler lag.

--- src/onyx/monitoring/metrics_monitoring.clj
+++ src/onyx/monitoring/metrics_monitoring.clj
@@ -85,7 +85,7 @@
                                            (fn []
                                              (ns->ms (- (System/nanoTime)
                                                         (.get ^AtomicLong last-heartbeat)))))
-          scheduler-lag (AtomicLong. (System/nanoTime))
+          scheduler-lag (AtomicLong. 0)
           peer-group-scheduler-lag (g/gauge-fn reg
                                                ["peer-group" "scheduler-lag"]
                                                (fn []


remove some unprincipled js* usage

remove some unprincipled js* usage

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -526,10 +526,9 @@
         this-sym (gensym "_")
         locals (keys (:locals &env))
         ns     (-> &env :ns :name)
-        munge  cljs.compiler/munge
-        ns-t   (list 'js* (core/str (munge ns) "." (munge t)))]
+        munge  cljs.compiler/munge]
     `(do
-       (when (undefined? ~ns-t)
+       (when-not (exists? (. ~ns ~(symbol (core/str "-" t))))
          (deftype ~t [~@locals ~meta-sym]
            IWithMeta
            (~'-with-meta [~this-sym ~meta-sym]
@@ -839,7 +838,7 @@
                                         sigs))))]
     `(do
        (set! ~'*unchecked-if* true)
-       (def ~psym (~'js* "{}"))
+       (def ~psym (js-obj))
        ~@(map method methods)
        (set! ~'*unchecked-if* false))))


CLJS-1205: Support conditional reading in REPLs

Same as CLJ-1200

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -93,7 +93,7 @@
                     *in*)]
      (or ({:line-start request-prompt :stream-end request-exit}
           (skip-whitespace *in*))
-        (let [input (reader/read)]
+        (let [input (reader/read {:read-cond :allow :features #{:cljs}} *in*)]
           (skip-if-eol *in*)
           input)))))


first cut of `cljs.test/run-all-tests`, change `cljs.test/test-all-vars` macro so that we filter only vars that actually have `:test` metadata

--- src/clj/cljs/test.clj
+++ src/clj/cljs/test.clj
@@ -8,7 +8,8 @@

 (ns cljs.test
   (:require [cljs.env :as env]
-            [cljs.analyzer :as ana]))
+            [cljs.analyzer :as ana]
+            [cljs.analyzer.api :as ana-api]))

 ;; =============================================================================
 ;; Utilities for assertions
@@ -234,12 +235,33 @@
         (assoc (:report-counters summary#) :type :summary))
       summary#)))

+(defmacro run-all-tests
+  "Runs all tests in all namespaces; prints results.
+  Optional argument is a regular expression; only namespaces with
+  names matching the regular expression (with re-matches) will be
+  tested."
+  ([] `(cljs.test/run-all-tests nil))
+  ([re]
+   `(cljs.test/run-tests (cljs.test/empty-env)
+      ~@(map
+          (fn [ns] `(quote ~ns))
+          (cond->> (ana-api/all-ns)
+            re (filter #(re-matches re (name %))))))))
+
 (defmacro test-all-vars
-  "Calls test-vars on every var interned in the namespace, with fixtures."
+  "Calls test-vars on every var with :test metadata interned in the
+  namespace, with fixtures."
   ([ns]
-   `(cljs.test/test-vars (vals (ns-interns ~ns))))
-  ([env ns]
-   `(cljs.test/test-vars ~env (vals (ns-interns ~ns)))))
+   `(cljs.test/test-all-vars
+      (cljs.test/empty-env) ~ns))
+  ([env [quote ns]]
+   `(cljs.test/test-vars ~env
+      [~@(map
+           (fn [[k _]]
+             `(var ~k))
+           (filter
+             (fn [[_ v]] (:test v))
+             (ana-api/ns-interns ns)))])))

 (defmacro test-ns
   "If the namespace defines a function named test-ns-hook, calls that.


rename misleading `with-routing` to `set-routing`

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -61,7 +61,7 @@

 (def ^{:dynamic true} *cookie-store* nil)

-(defn- with-routing
+(defn- set-routing
   "Use ProxySelectorRoutePlanner to choose proxy sensible based on
   http.nonProxyHosts"
   [client]
@@ -161,7 +161,8 @@
            retry-handler response-interceptor] :as req}]
   (let [conn-mgr (or conn/*connection-manager*
                      (conn/make-regular-conn-manager req))
-        http-client (with-routing (DefaultHttpClient. ^ClientConnectionManager conn-mgr))
+        http-client (set-routing (DefaultHttpClient.
+                                   ^ClientConnectionManager conn-mgr))
         scheme (name scheme)]
     (when-let [cookie-store (or cookie-store *cookie-store*)]
       (.setCookieStore http-client cookie-store))


Add support for proxy settings on a per-request basis

Sometimes it is very useful to only proxy some specific requests.

Also note that I could not find any tests for proxy support and understand
that it may significantly complicate the test suite. So I decided to not add
them without a discussion with the library maintainer.

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -111,9 +111,17 @@
         (.addPart mp-entity keytext part)))
     mp-entity))

+(defn- default-proxy-host-for
+  [scheme]
+  (System/getProperty (str scheme ".proxyHost")))
+
+(defn- default-proxy-port-for
+  [scheme]
+  (Integer/parseInt (System/getProperty (str scheme ".proxyPort"))))
+
 (defn add-client-params!
   "Add various client params to the http-client object, if needed."
-  [http-client scheme socket-timeout conn-timeout server-name]
+  [http-client scheme socket-timeout conn-timeout server-name proxy-host proxy-port]
   (doto http-client
     (set-client-param ClientPNames/COOKIE_POLICY
                       CookiePolicy/BROWSER_COMPATIBILITY)
@@ -123,11 +131,10 @@
     (set-client-param "http.connection.timeout"
                       (and conn-timeout (Integer. ^Long conn-timeout))))
   (when (nil? (#{"localhost" "127.0.0.1"} server-name))
-    (when-let [proxy-host (System/getProperty (str scheme ".proxyHost"))]
-      (let [proxy-port (Integer/parseInt
-                        (System/getProperty (str scheme ".proxyPort")))]
+    (when-let [effective-proxy-host (or proxy-host (default-proxy-host-for scheme))]
+      (let [effective-proxy-port (or proxy-port (default-proxy-port-for scheme))]
         (set-client-param http-client ConnRoutePNames/DEFAULT_PROXY
-                          (HttpHost. proxy-host proxy-port))))))
+                          (HttpHost. effective-proxy-host effective-proxy-port))))))

 (defn request
   "Executes the HTTP request corresponding to the given Ring request map and
@@ -137,12 +144,12 @@
    the clj-http uses ByteArrays for the bodies."
   [{:keys [request-method scheme server-name server-port uri query-string
            headers content-type character-encoding body socket-timeout
-           conn-timeout multipart debug insecure? save-request?] :as req}]
+           conn-timeout multipart debug insecure? save-request? proxy-host proxy-port] :as req}]
   (let [conn-mgr (or *connection-manager* (make-regular-conn-manager insecure?))
         http-client (DefaultHttpClient.
                       ^org.apache.http.conn.ClientConnectionManager conn-mgr)]
     (add-client-params! http-client scheme socket-timeout
-                        conn-timeout server-name)
+                        conn-timeout server-name proxy-host proxy-port)
     (let [http-url (str scheme "://" server-name
                         (when server-port (str ":" server-port))
                         uri


Display the entire criteria again if user deletes query

--- src/cljs/app/app.cljs
+++ src/cljs/app/app.cljs
@@ -1,5 +1,6 @@
 (ns app.app
   (:require [goog.dom :as dom]
+            [clojure.string :as string :refer [blank?]]
             [cljs.core.async :refer [<! >! put! close! chan
                                      timeout sliding-buffer]]
             [reagent.core :as reagent]
@@ -103,10 +104,12 @@
                              (:results @state)))})

 (deftemplate page "index.html" []
-  {[:.search-field] (kioo/listen :on-key-press
+  {[:.search-field] (kioo/listen :on-key-down
                       (fn [_]
-                        (put! query-chan
-                          (.-value (dom/getElement "search-field")))))
+                        (let [input (.-value (dom/getElement "search-field"))]
+                          (if (blank? input)
+                            (init-state)
+                            (put! query-chan input)))))

    [:.test-button] (kioo/listen :on-click
                      (fn [_]


fixed post mutate

fixed post mutate

--- src/untangled/client/impl/om_plumbing.cljs
+++ src/untangled/client/impl/om_plumbing.cljs
@@ -33,15 +33,18 @@
 (defn write-entry-point [env k params]
   (let [rv (try
              (m/mutate env k params)
-             (m/post-mutate env k params)
              (catch :default e
                (log/error (str "Mutation " k " failed with exception") e)
                nil))
         action (:action rv)]
     (if action
-      (assoc rv :action (fn [env k params]
+      (assoc rv :action (fn []
                           (try
-                            (action env k params)
+                            (let [action-result (action env k params)]
+                              (try
+                                (m/post-mutate env k params)
+                                (catch :default e (log/error (str "Post mutate failed on dispatch to " k))))
+                              action-result)
                             (catch :default e
                               (log/error (str "Mutation " k " failed with exception") e)
                               (throw e)))))


Minor

Minor

--- src/discuss/find.cljs
+++ src/discuss/find.cljs
@@ -67,7 +67,7 @@
   (dom/div #js {:className "form-group"}
            (dom/select #js {:className "form-control"
                             :onChange  #(store-selected-issue % owner)}
-                       (map #(issue-selector-view % owner) (lib/get-issues)))))
+                       (map #(issue-selector-view (lib/merge-react-key %) owner) (lib/get-issues)))))

 (defn form-view [_ owner]
   (reify


fix snapshot function

fix snapshot function

--- src/domshot/core.cljs
+++ src/domshot/core.cljs
@@ -4,7 +4,7 @@
 (enable-console-print!)

 (defn get-attrs [node]
-  (if (.hasAttributes node)
+  (if (.-attributes node)
     (into {}
           (let [attrs (.-attributes node)]
             (for [i (range (.-length attrs))
@@ -14,19 +14,17 @@
               [name value])))
     {}))

-(defn get-children [node]
-  (if (.hasChildNodes node)
-    (let [child-nodes (.-childNodes node)]
-      (for [i (range (.-length child-nodes))]
-        (snapshot node)))
-    []))
+(defn handle-special-nodes
+  "Fills in important node-specific key-val pairs"
+  [node-map native-node]
+  (let [node-types goog.dom/NodeType]
+    (condp = (.-nodeType native-node)
+      (.-COMMENT node-types) (assoc node-map :text (.-nodeValue native-node))
+      node-map)))

-  (defn complete-map "Fills in important node-specific key-val pairs"
-    [node-map native-node]
-    (let [node-types goog.dom/NodeType]
-      (condp = (.-nodeType native-node)
-        (.-COMMENT node-types) (assoc node-map :text (.-nodeValue native-node))
-        node-map)))
+(defn gen-basic-node-map [node]
+  {:node-name (.-nodeName node)
+   :attributes (get-attrs node)})

 (defn snapshot
   "Recursively serialize validated nodes into a clojure data structure"
@@ -34,10 +32,12 @@
    (let [all-html (.-documentElement (goog.dom/getDocument))]
      (snapshot all-html)))
   ([node]
-   (let [basic-mapping {:node-name (.-nodeName node)
-                        :attributes (get-attrs node)
-                        :children (get-children node)}
-         complete-mapping (complete-map basic-mapping node)]
-     complete-mapping)))
+   (let [node-map (-> node gen-basic-node-map (handle-special-nodes node))]
+     (assoc node-map
+       :children (if (not (.hasChildNodes node))
+                   []
+                   (vec (for [index (range (-> node .-childNodes .-length))
+                              :let [child (aget (.-childNodes node) index)]]
+                          (snapshot child))))))))

-(println "snapshot result" (snapshot))
+(.log js/console "snapshot result" (clj->js (snapshot)))


fix adding text content for text node

fix adding text content for text node

--- src/domshot/core.cljs
+++ src/domshot/core.cljs
@@ -36,7 +36,7 @@
   [node-map native-node]
   (let [node-types goog.dom/NodeType]
     (condp = (.-nodeType native-node)
-      (.-COMMENT node-types) (assoc node-map :text (.-nodeValue native-node))
+      (.-TEXT node-types) (assoc node-map :text (.-nodeValue native-node))
       node-map)))

 (defn gen-basic-node-map [node]


Rename parameter to POLLING_INTERVAL for clarity

--- src/greenyet/core.clj
+++ src/greenyet/core.clj
@@ -20,13 +20,15 @@

 (def ^:private config-dir (System/getenv "CONFIG_DIR"))

-(def ^:private timeout-in-ms (or (some-> (System/getenv "TIMEOUT")
-                                         Integer/parseInt)
-                                 5000))
+(def ^:private polling-interval-in-ms (or (some-> (System/getenv "POLLING_INTERVAL")
+                                                  Integer/parseInt)
+                                          (some-> (System/getenv "TIMEOUT")
+                                                  Integer/parseInt)
+                                          5000))

 (def ^:private config-params [["CONFIG_DIR" (or config-dir
                                                 "")]
-                              ["TIMEOUT" timeout-in-ms]
+                              ["POLLING_INTERVAL" polling-interval-in-ms]
                               ["PORT" (or (System/getenv "PORT")
                                           3000)]])

@@ -44,8 +46,8 @@
 (defn- query-param-as-vec [params key]
   (let [value (get params key)
         value-vector (if (string? value)
-                     (vector value)
-                     value)]
+                       (vector value)
+                       value)]
     (seq (mapcat #(str/split % #",") value-vector))))

 (defn- html-response [body]
@@ -60,9 +62,9 @@
     (html-response (styleguide/render (keywordize-keys params) (styleguide-template)))
     (let [[host-with-statuses last-changed] @poll/statuses]
       (-> (html-response (view/render host-with-statuses
-                                 (query-param-as-vec params "systems")
-                                 (page-template)
-                                 (environment-names)))
+                                      (query-param-as-vec params "systems")
+                                      (page-template)
+                                      (environment-names)))
           (header "Last-Modified" (format-date (.toDate last-changed)))))))

@@ -81,7 +83,7 @@

 (defn init []
   (try
-    (poll/start-polling (config/hosts-with-config config-dir) timeout-in-ms)
+    (poll/start-polling (config/hosts-with-config config-dir) polling-interval-in-ms)
     (catch FileNotFoundException e
       (binding [*out* *err*]
         (println (.getMessage e))


Disable custom compression test as custom compression has been disabled.

--- test/onyx/peer/custom_compression_test.clj
+++ test/onyx/peer/custom_compression_test.clj
@@ -29,7 +29,8 @@
 (def out-calls
   {:lifecycle/before-task-start inject-out-ch})

-(deftest compression
+;; We don't support custom compression formats
+(deftest ^:broken compression
   (let [id (random-uuid)
         config (load-config)
         env-config (assoc (:env-config config) :onyx/tenancy-id id)


Fixed grammar.

Fixed grammar.

--- src/notes/handler.clj
+++ src/notes/handler.clj
@@ -47,7 +47,7 @@
        [:header
         [:div.container
           [:h1 "Notes!"]
-         [:p.lead [:small " Create and read awesome note, right here!"]]]]
+         [:p.lead [:small " Create and read awesome notes, right here!"]]]]

        [:div.container
         [:div.row-fluid


Minor renaming.

Minor renaming.

--- src/octet/buffer.cljc
+++ src/octet/buffer.cljc
@@ -38,7 +38,7 @@
               io.netty.buffer.ByteBuf
               io.netty.buffer.ByteBufAllocator)))

-(def ^:dynamic *byteorder*
+(def ^:dynamic *byte-order*
   "Defines the default byte order used for the write and read
   operations on the byte buffers."
   :big-endian)
@@ -86,9 +86,9 @@

 ;; ---- NIO & Netty Buffer implementations

-(defn- set-current-bytebuffer-byteorder!
+(defn- set-current-bytebuffer-byte-order!
   [buff]
-  (case *byteorder*
+  (case *byte-order*
     :big-endian (.order buff ByteOrder/BIG_ENDIAN)
     :little-endian (.order buff ByteOrder/LITTLE_ENDIAN)))

@@ -96,82 +96,82 @@
    (extend-type ByteBuffer
      IBufferShort
      (read-short [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.getShort buff pos))
      (write-short [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.putShort buff pos value))
      (read-ushort [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [val (.getShort buff pos)]
          (bit-and 0xFFFF (Integer. (int val)))))
      (write-ushort [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [value (.shortValue (Integer. (int value)))]
          (.putShort buff pos value)))

      IBufferInt
      (read-int [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.getInt buff pos))
      (write-int [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.putInt buff pos value))
      (read-uint [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [val (.getInt buff pos)]
          (bit-and 0xFFFFFFFF (Long. (long val)))))
      (write-uint [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [value (.intValue (Long. (long value)))]
          (.putInt buff pos value)))

      IBufferLong
      (read-long [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.getLong buff pos))
      (write-long [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.putLong buff pos value))
      (read-ulong [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [val (.getLong buff pos)
              ^bytes magnitude (-> (ByteBuffer/allocate 8) (.putLong val) .array)]
          (bigint (BigInteger. 1 magnitude))))
      (write-ulong [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [value (.longValue (bigint value))]
          (.putLong buff pos value)))

      IBufferFloat
      (read-float [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.getFloat buff pos))
      (write-float [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.putFloat buff pos value))

      IBufferDouble
      (read-double [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.getDouble buff pos))
      (write-double [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.putDouble buff pos value))

      IBufferByte
      (read-byte [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.get buff pos))
      (write-byte [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (.put buff pos value))
      (read-ubyte [buff pos]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [val (.get buff pos)]
          (bit-and 0xFF (short val))))
      (write-ubyte [buff pos value]
-       (set-current-bytebuffer-byteorder! buff)
+       (set-current-bytebuffer-byte-order! buff)
        (let [value (.byteValue (Short. (short value)))]
          (.put buff pos value)))

@@ -197,11 +197,11 @@
    (extend-type ByteBuf
      IBufferShort
      (read-short [buff pos]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.getShortLE buff pos)
          (.getShort buff pos)))
      (write-short [buff pos value]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.setShortLE buff pos value)
          (.setShort buff pos value)))
      (read-ushort [buff pos]
@@ -213,11 +213,11 @@

      IBufferInt
      (read-int [buff pos]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.getIntLE buff pos)
          (.getInt buff pos)))
      (write-int [buff pos value]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.setIntLE buff pos value)
          (.setInt buff pos value)))
      (read-uint [buff pos]
@@ -229,11 +229,11 @@

      IBufferLong
      (read-long [buff pos]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.getLongLE buff pos)
          (.getLong buff pos)))
      (write-long [buff pos value]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.setLongLE buff pos value)
          (.setLong buff pos value)))
      (read-ulong [buff pos]
@@ -246,21 +246,21 @@

      IBufferFloat
      (read-float [buff pos]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.getFloatLE buff pos)
          (.getFloat buff pos)))
      (write-float [buff pos value]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.setFloatLE buff pos value)
          (.setFloat buff pos value)))

      IBufferDouble
      (read-double [buff pos]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.getDoubleLE buff pos)
          (.getDouble buff pos)))
      (write-double [buff pos value]
-       (if (= *byteorder* :little-endian)
+       (if (= *byte-order* :little-endian)
          (.setDoubleLE buff pos value)
          (.setDouble buff pos value)))

@@ -391,35 +391,35 @@
    (extend-type js/DataView
      IBufferShort
      (read-short [buff pos]
-       (.getInt16 buff pos (= *byteorder* :little-endian)))
+       (.getInt16 buff pos (= *byte-order* :little-endian)))
      (write-short [buff pos value]
-       (.setInt16 buff pos value (= *byteorder* :little-endian)))
+       (.setInt16 buff pos value (= *byte-order* :little-endian)))
      (read-ushort [buff pos]
-       (.getUint16 buff pos (= *byteorder* :little-endian)))
+       (.getUint16 buff pos (= *byte-order* :little-endian)))
      (write-ushort [buff pos value]
-       (.setUint16 buff pos value (= *byteorder* :little-endian)))
+       (.setUint16 buff pos value (= *byte-order* :little-endian)))

      IBufferInt
      (read-int [buff pos]
-       (.getInt32 buff pos (= *byteorder* :little-endian)))
+       (.getInt32 buff pos (= *byte-order* :little-endian)))
      (write-int [buff pos value]
-       (.setInt32 buff pos value (= *byteorder* :little-endian)))
+       (.setInt32 buff pos value (= *byte-order* :little-endian)))
      (read-uint [buff pos]
-       (.getUint32 buff pos (= *byteorder* :little-endian)))
+       (.getUint32 buff pos (= *byte-order* :little-endian)))
      (write-uint [buff pos value]
-       (.setUint32 buff pos value (= *byteorder* :little-endian)))
+       (.setUint32 buff pos value (= *byte-order* :little-endian)))

      IBufferFloat
      (read-float [buff pos]
-       (.getFloat32 buff pos (= *byteorder* :little-endian)))
+       (.getFloat32 buff pos (= *byte-order* :little-endian)))
      (write-float [buff pos value]
-       (.setFloat32 buff pos value (= *byteorder* :little-endian)))
+       (.setFloat32 buff pos value (= *byte-order* :little-endian)))

      IBufferDouble
      (read-double [buff pos]
-       (.getFloat64 buff pos (= *byteorder* :little-endian)))
+       (.getFloat64 buff pos (= *byte-order* :little-endian)))
      (write-double [buff pos value]
-       (.setFloat64 buff pos value (= *byteorder* :little-endian)))
+       (.setFloat64 buff pos value (= *byte-order* :little-endian)))

      IBufferByte
      (read-byte [buff pos]


Add update-modules & rewrite update-forms using it

--- src/oxcart/passes.clj
+++ src/oxcart/passes.clj
@@ -10,7 +10,8 @@
 (ns oxcart.passes
   {:doc "Implements a naive pass manager and dependency system."
    :author "Reid McKenzie"
-   :added  "0.0.6"})
+   :added  "0.0.6"}
+  (:require [oxcart.util :refer [update]]))

 ;; Whole-ASTs are maps of this structure:
@@ -50,19 +51,33 @@
        (mapcat :forms)))

+(defn update-modules
+  "λ Whole-AST → (λ Module → args * → Module) → args *
+
+  Updates every module in the AST, replacing it with (apply f module
+  args). Intended to eliminate repetitive Whole-AST comprehensions in
+  pass implementations."
+  [{:keys [modules] :as whole-ast} f & args]
+  (->> (for [m modules]
+         [m (apply f (get whole-ast m) args)])
+       (into {})
+       (merge whole-ast)))
+
+
 (defn update-forms
-  "λ Whole-AST → (λ Form → Form) → arg *
+  "λ Whole-AST → (λ Form → args * → Form) → args *

   Updates every form in the given Whole-ast, replacing it with (apply
   f form args). Intended to eliminate repetitive Whole-AST
   comprehensions in pass implementations."
-  [{:keys [modules] :as whole-ast} f & args]
-  (->> (for [m modules]
-         [m {:forms
-             (for [form (:forms (get whole-ast m))]
-               (apply f form args))}])
-       (into {})
-       (merge whole-ast)))
+  [whole-ast f & args]
+  (-> whole-ast
+      (update-modules
+       (fn [module]
+         (update module :forms
+                 (fn [forms]
+                   (mapv #(apply f %1 args)
+                         forms)))))))

 ;; Passes are then functions from Whole-ASTs to Whole-ASTs. For user


only show privacy toggle to people with access

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -328,31 +328,32 @@
              (om/build private-sharing app)
              (om/build public-sharing app))

-           ;; TODO: keep track of invites
-           [:div.menu-foot
-            [:form.privacy-select
-             [:input.privacy-radio {:type "radio"
-                                    :hidden "true"
-                                    :id "privacy-public"
-                                    :name "privacy"
-                                    :checked (not private?)
-                                    :onChange #(cast! :document-privacy-changed
-                                                      {:doc-id doc-id
-                                                       :setting :document.privacy/public})}]
-             [:label.privacy-label {:for "privacy-public" :role "button"}
-              (common/icon :globe)
-              [:span "Public"]]
-             [:input.privacy-radio {:type "radio"
-                                    :hidden "true"
-                                    :id "privacy-private"
-                                    :name "privacy"
-                                    :checked private?
-                                    :onChange #(cast! :document-privacy-changed
-                                                      {:doc-id doc-id
-                                                       :setting :document.privacy/private})}]
-             [:label.privacy-label {:for "privacy-private" :role "button"}
-              (common/icon :lock)
-              [:span "Private"]]]]]])))))
+           (when (and (contains? (get-in app [:cust :flags]) :flags/private-docs)
+                      (auth/admin? @db doc {:cust/uuid (get-in app [:cust :uuid])}))
+             [:div.menu-foot
+              [:form.privacy-select
+               [:input.privacy-radio {:type "radio"
+                                      :hidden "true"
+                                      :id "privacy-public"
+                                      :name "privacy"
+                                      :checked (not private?)
+                                      :onChange #(cast! :document-privacy-changed
+                                                        {:doc-id doc-id
+                                                         :setting :document.privacy/public})}]
+               [:label.privacy-label {:for "privacy-public" :role "button"}
+                (common/icon :globe)
+                [:span "Public"]]
+               [:input.privacy-radio {:type "radio"
+                                      :hidden "true"
+                                      :id "privacy-private"
+                                      :name "privacy"
+                                      :checked private?
+                                      :onChange #(cast! :document-privacy-changed
+                                                        {:doc-id doc-id
+                                                         :setting :document.privacy/private})}]
+               [:label.privacy-label {:for "privacy-private" :role "button"}
+                (common/icon :lock)
+                [:span "Private"]]]])]])))))

 (defn info [app owner]
   (reify
@@ -493,9 +494,7 @@
    :doc-viewer {:title "Recent Documents"
                 :component doc-viewer/doc-viewer}
    :document-permissions {:title "Request Access"
-                          :component document-access/permission-denied-overlay}
-   :manage-permissions {:title "Manage Access"
-                        :component document-access/manage-permissions-overlay}})
+                          :component document-access/permission-denied-overlay}})

 (defn overlay [app owner]


Fixed update bugs wip

Fixed update bugs wip

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -107,8 +107,7 @@
        {:handler  (fn [x]
                     (println "Fetching programmes.")
                     (om/update! data [:programmes :data] (mapv slugify-programme x))
-                    (om/update! data [:programmes :fetching] (if (empty? x) :no-data :has-data))
-                    (om/update! data [:programmes :selected] nil))
+                    (om/update! data [:programmes :fetching] (if (empty? x) :no-data :has-data)))
         :error-handler (fn [{:keys [status status-text]}]
                          (om/update! data [:programmes :fetching] :error)
                          (om/update! data [:programmes :error-status] status)
@@ -117,14 +116,12 @@
         :response-format :text}))

 (defn fetch-projects [programme-id data]
-  (om/update! data [:projects :programme_id] programme-id)
   (om/update! data [:projects :fetching] :fetching)
   (GET (str "/4/programmes/" programme-id "/projects/")
        {:handler  (fn [x]
                     (println "Fetching projects for programme: " programme-id)
                     (om/update! data [:projects :data] (mapv slugify-project x))
-                    (om/update! data [:projects :fetching] (if (empty? x) :no-data :has-data))
-                    (om/update! data [:projects :selected] nil))
+                    (om/update! data [:projects :fetching] (if (empty? x) :no-data :has-data)))
         :error-handler (fn [{:keys [status status-text]}]
                          (om/update! data [:projects :fetching] :error)
                          (om/update! data [:projects :error-status] status)
@@ -133,14 +130,12 @@
         :response-format :text}))

 (defn fetch-properties [project-id data]
-  (om/update! data [:properties :project_id] project-id)
   (om/update! data [:properties :fetching] :fetching)
   (GET (str "/4/projects/" project-id "/properties/")
        {:handler  (fn [x]
                     (println "Fetching properties for project: " project-id)
                     (om/update! data [:properties :data] (mapv slugify-property x))
-                    (om/update! data [:properties :fetching] (if (empty? x) :no-data :has-data))
-                    (om/update! data [:properties :selected] nil))
+                    (om/update! data [:properties :fetching] (if (empty? x) :no-data :has-data)))
         :error-handler (fn [{:keys [status status-text]}]
                          (om/update! data [:properties :fetching] :error)
                          (om/update! data [:properties :error-status] status)
@@ -176,20 +171,19 @@
       (println "New Active Components: " (-> nav-event :args :ids))

       ;; Clear down
-      (when (and old-programmes
-                 (nil? programmes))
+      (when (or (nil? programmes)
+                (empty? (-> @data :programmes :data)))
         (println "Clearing projects.")
         (om/update! data [:projects :data] [])
-        (om/update! data [:projects :programme_id] nil))
-
-      (when (and old-projects
-                 (nil? projects))
+        (om/update! data [:projects :programme_id] nil)
+        (fetch-programmes data))
+
+      (when-not projects
         (println "Clearing properties.")
         (om/update! data [:properties :data] [])
         (om/update! data [:properties :project_id] nil))

-      (when (and old-properties
-                 (nil? properties))
+      (when-not properties
         (println "Clearing devices, sensors and measurements.")
         (om/update! data [:property-details :data] {})
         (om/update! data [:property-details :property_id] nil)
@@ -197,35 +191,33 @@
         (om/update! data [:sensors :data] [])
         (om/update! data [:measurements :data] []))

-      ;; Fetchers
-      (when-not programmes
-        (om/update! data [:programmes :selected] nil)
-        (fetch-programmes data))
-
-      (when (and programmes
-                 (not= programmes old-programmes))
+      (when (and (not= programmes old-programmes)
+                 programmes)
         (println "Setting selected programme to: " programmes)
         (om/update! data [:programmes :selected] programmes)
+        (om/update! data [:projects :programme_id] programmes)
         (fetch-projects programmes data))

-      (when (and projects
-                 (not= projects old-projects))
+      (when (and (not= projects old-projects)
+                 projects)
         (println "Setting selected project to: " projects)
         (om/update! data [:projects :selected] projects)
+        (om/update! data [:properties :project_id] projects)
         (fetch-properties projects data))

       ;; property handling is special as it gets a tree of data
-      (when (and properties
-                 (not= properties old-properties))
+      (when (and (not= properties old-properties)
+                 properties)
+        (println "Setting property details to: " properties)
         (om/update! data [:properties :selected] properties)
         (om/update! data [:property-details :property_id] properties)
+        ;; Handle flattened sensors
         (let [property-details (->> @data
                                     :properties
                                     :data
                                     (filter #(= (:id %) properties))
                                     first)
               devices (get property-details :devices [])]
-          (println "property-details keys: " (keys property-details))
           (om/update! data [:property-details :data] property-details)
           (om/update! data [:sensors :data] (extract-sensors devices))))


Do not println in IE9

Do not println in IE9

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -19,13 +19,11 @@
    [kixi.hecuba.tabs.property-details :as property-details]
    [sablono.core :as html :refer-macros [html]]))

-(when (or (not agent/IE)
-          (agent/isVersionOrHigher 9))
+(when (not agent/IE)
   (enable-console-print!))

 (defn log [& msgs]
-  (when (or (not agent/IE)
-            (agent/isVersionOrHigher 9))
+  (when (not agent/IE)
     (apply println msgs)))

 ;; our banner is 50px so we need to tweak the scrolling


fix the documents with zero clients

fix the documents with zero clients

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -119,7 +119,7 @@
   (check-document-access (-> ?data :document-id) req :admin)
   (let [document-id (-> ?data :document-id)]
     (log/infof "unsubscribing %s from %s" client-id document-id)
-    (swap! document-subs update-in [document-id] dissoc client-id)
+    (close-connection client-id)
     (doseq [[uid _] (get @document-subs document-id)]
       ((:send-fn @sente-state) uid [:frontend/subscriber-left {:client-id client-id}]))))


Fix bug in gpio

Fix bug in gpio

--- src/pericles/gpio.clj
+++ src/pericles/gpio.clj
@@ -33,11 +33,11 @@
   "Reads port value."
   []
   (if (port-available?)
-    {:status (name (gpio/read-value @port))}))
+    {:status (name (gpio/read-value (:port @port)))}))

 (defn write-port
   "Writes 1 or 0 to port."
   [value]
   {:pre [(or (= 1 value) (= 0 value))]}
   (if (port-available?)
-    (gpio/write-value! @port value)))
+    (gpio/write-value! (:port @port) value)))


Set AJAX requests async. Fix library versions for test function.

--- src/cljs/hatnik/web/client/z_actions.cljs
+++ src/cljs/hatnik/web/client/z_actions.cljs
@@ -19,7 +19,7 @@
                               (clj->js data))
             :contentType "application/json"
             :dataType "json"
-            :async false
+            :async true
             :success callback}))

 (defn create-new-project-callback [name reply]
@@ -72,8 +72,8 @@
               :address email
               :template email-body
               :library artifact
-              :version "NEW-VERSION"
-              :previous-version "OLD-VERSION"}]
+              :version "2.3.4"
+              :previous-version "1.2.3"}]
     (if (or
          (= "" artifact)
          (= "" email)


return nil instead of crashing when gamepads not present

--- src/cljs/infinitelives/utils/gamepad.cljs
+++ src/cljs/infinitelives/utils/gamepad.cljs
@@ -3,7 +3,8 @@

 (defn axis
   ([gamepad gamepad-num axis-num]
-   (aget (.-axes gamepad) axis-num))
+   (when gamepad
+     (aget (.-axes gamepad) axis-num)))
   ([gamepad-num axis-num]
    (axis (aget (events/get-gamepads) gamepad-num) gamepad-num axis-num))
   ([axis-num]
@@ -40,14 +41,20 @@

 (defn button
   ([gamepad gamepad-num button-num]
-   (aget (.-buttons gamepad)
-         (get ->buttons button-num button-num)))
+   (when gamepad
+     (aget (.-buttons gamepad)
+           (get ->buttons button-num button-num))))
   ([gamepad-num button-num]
    (button (aget (events/get-gamepads) gamepad-num) gamepad-num button-num))
   ([button-num]
    (button 0 button-num)))

+(defn value-of [button]
+  (when button
+    (.-value button)))
+
 (defn pressed? [val]
-  (> val 0.1))
+  (when val
+    (> val 0.1)))

-(def button-pressed? (comp pressed? button))
+(def button-pressed? (comp pressed? value-of button))


Mention :on-timer in the defscreen docstring

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -128,6 +128,10 @@
         entities)
       :on-pause ; the screen paused (mobile only)
       (fn [screen entities]
+        entities)
+      :on-timer ; a timer created with add-timer! executed
+      (fn [screen entities]
+        (println (:id screen)) ; the id supplied when the timer was created
         entities))

     ; input functions


Improve with-bindings helper

Improve with-bindings helper

--- src/promesa/exec.cljc
+++ src/promesa/exec.cljc
@@ -123,23 +123,50 @@
   [f]
   #?(:cljs f
      :clj
-     (let [frame (Var/cloneThreadBindingFrame)]
+     (let [bindings (get-thread-bindings)]
        (fn
          ([]
-          (Var/resetThreadBindingFrame frame)
-          (f))
-         ([x]
-          (Var/resetThreadBindingFrame frame)
-          (f x))
-         ([x y]
-          (Var/resetThreadBindingFrame frame)
-          (f x y))
-         ([x y z]
-          (Var/resetThreadBindingFrame frame)
-          (f x y z))
-         ([x y z & args]
-          (Var/resetThreadBindingFrame frame)
-          (apply f x y z args))))))
+          (push-thread-bindings bindings)
+          (try
+            (f)
+            (finally
+              (pop-thread-bindings))))
+         ([a]
+          (push-thread-bindings bindings)
+          (try
+            (f a)
+            (finally
+              (pop-thread-bindings))))
+         ([a b]
+          (push-thread-bindings bindings)
+          (try
+            (f a b)
+            (finally
+              (pop-thread-bindings))))
+         ([a b c]
+          (push-thread-bindings bindings)
+          (try
+            (f a b c)
+            (finally
+              (pop-thread-bindings))))
+         ([a b c d]
+          (push-thread-bindings bindings)
+          (try
+            (f a b c d)
+            (finally
+              (pop-thread-bindings))))
+         ([a b c d e]
+          (push-thread-bindings bindings)
+          (try
+            (f a b c d e)
+            (finally
+              (pop-thread-bindings))))
+         ([a b c d e & args]
+          (push-thread-bindings bindings)
+          (try
+            (apply f a b c d e args)
+            (finally
+              (pop-thread-bindings))))))))

 ;; --- Public API


use db:create:all rather than db:create

use db:create:all rather than db:create

--- src/circle/backend/build/inference/rails.clj
+++ src/circle/backend/build/inference/rails.clj
@@ -165,7 +165,7 @@
         (cp-database-yml repo))
       (ensure-db-user repo)
       (when has-db-yml?
-        (rake db:create))
+        (rake db:create:all))
       (cond
        (data-mapper? repo) (rake db:automigrate)
        (schema-rb? repo) (rake db:schema:load)


small-fix

small-fix

--- src/cljs/salava/extra/passport/ui/block.cljs
+++ src/cljs/salava/extra/passport/ui/block.cljs
@@ -23,7 +23,7 @@
   [:div {:style {:padding "30px"}}
    [:div
     [:h1 {:style {:text-align "center"}} (clojure.string/upper-case "Conditions d’utilisation")]]
-   [:div
+   [:div {:style {:text-align "center"}}
     [:p "Mis à jour le 29.1.2019 "]]
    [:div
     [:h2 "Informations générales sur l’utilisation du service Open Badge Passport"]
@@ -74,7 +74,7 @@
     [:div {:style {:padding "15px"}}
      [:h1 {:style {:text-align "center"}} "Déclaration de protection des données"]
      [:div
-      [:p "Mis à jour le 29.1.2019 "]
+      [:p {:style {:text-align "center"}} "Mis à jour le 29.1.2019 "]
       [:p " "]
       [:ol {:style {:list-style-type "none"}}
        [:li [:h3 "Responsable du traitement"]
@@ -165,7 +165,7 @@
   [:div {:style {:padding "30px"}}
    [:div
     [:h1 {:style {:text-align "center"}} "TERMS OF USE"]]
-   [:div
+   [:div {:style {:text-align "center"}}
     [:p "Updated 29.1.2019 "]]
    [:div
     [:h2 "General information about the use of Open Badge Passport service"]
@@ -225,7 +225,7 @@
     [:div {:style {:padding "15px"}}
      [:h1 {:style {:text-align "center"}} " Privacy Notice"]
      [:div
-      [:p "Updated 29.01.2019"]
+      [:p {:style {:text-align "center"}} "Updated 29.01.2019"]
       [:p ""]
       [:ol {:style {:list-style-type "none"}}
        [:li [:h3 "Controller"]


Solved 5.5 and fixed fold-right as it wasn't terminating when it should have

--- src/fpinscala/strictness_and_laziness.clj
+++ src/fpinscala/strictness_and_laziness.clj
@@ -73,7 +73,7 @@
     (go s [])))
 ;fpins
 (defn my-take-while-fpins
-  "fpins variant of take-while"                                   ;obviously - less verbose than mine and no (obvious) accumulation :)
+  "fpins variant of take-while"                             ;obviously - less verbose than mine and no (obvious) accumulation :)
   [f s]
   (let [value (first s)]
     (when (f value)
@@ -82,9 +82,11 @@

 ;auxiliary - direct translation from book
 (defn fold-right [z f s]
-  (if-let [[h & t] s]
-    (f h (fold-right z f t))
-    z))
+  (let [[h & t] s]
+    (if t
+      (f h (fold-right z f t))
+      (if h (f h z) z))))
+;it would be more concise should I have used core.match

 ;example - exists via f-r - also direct translation from book
 (defn exists
@@ -107,3 +109,13 @@
   [p s]
   (fold-right true #(and (p %) %2) s))
 ;-----------------------------------------------------------------------
+
+;5.5
+;mine
+(defn take-while-fr
+  "Reimplementing take-while via f-r"
+  [p s]
+  (fold-right '() #(if (p %) (conj %2 %) %2) s))
+;fpins
+;conceptually the same
+;-----------------------------------------------------------------------


make settings arguments explicit

make settings arguments explicit

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@5836 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- sandbox/AcquisitionEngine/src/main/java/main/sequence_generator.clj
+++ sandbox/AcquisitionEngine/src/main/java/main/sequence_generator.clj
@@ -5,8 +5,6 @@
 (defstruct acq-settings :frames :positions :channels :slices :slices-first
   :time-first :keep-shutter-open-slices :keep-shutter-open-channels
   :use-autofocus :autofocus-skip :relative-slices :exposure)
-
-(declare settings)

 (defn pairs [x]
   (partition 2 1 (concat x [nil])))
@@ -17,7 +15,7 @@
       (assoc event dim dim-val))
     events))

-(defn make-dimensions []
+(defn make-dimensions [settings]
   (let [{:keys [slices channels frames positions
                 slices-first time-first]} settings
         a [[slices :slice] [channels :channel]]
@@ -29,32 +27,31 @@
 (defn create-loops [dimensions]
   (reduce #(apply (partial nest-loop %1) %2) [{:task :snap}] dimensions))

-(defn make-main-loops []
-  (create-loops (make-dimensions)))
+(defn make-main-loops [settings]
+  (create-loops (make-dimensions settings)))

-(defn manage-shutter [events]
-  (for [[e1 e2] (pairs events)]
-    (assoc e1 :close-shutter
-      (if e2 (or
-               (and
-                 (not (settings :keep-shutter-open-channels))
-                 (not= (e1 :channel) (e2 :channel)))
-               (and
-                 (not (settings :keep-shutter-open-slices))
-                 (not= (e1 :slice) (e2 :slice)))
-               (not= (e1 :frame) (e2 :frame))
-               (not= (e1 :position) (e2 :position)))
-        true))))
-
-(defn process-skip-z-stack [events]
-  (let [slices (settings :slices)
-        middle-slice (nth slices (int (/ (count slices) 2)))]
+(defn process-skip-z-stack [events slices]
+  (let [middle-slice (nth slices (int (/ (count slices) 2)))]
     (filter
       #(or
          (nil? (% :channel))
          (-> % :channel :use-z-stack)
          (= middle-slice (% :slice)))
       events)))
+
+(defn manage-shutter [events keep-shutter-open-channels keep-shutter-open-slices]
+  (for [[e1 e2] (pairs events)]
+    (assoc e1 :close-shutter
+      (if e2 (or
+               (and
+                 (not keep-shutter-open-channels)
+                 (not= (e1 :channel) (e2 :channel)))
+               (and
+                 (not keep-shutter-open-slices)
+                 (not= (e1 :slice) (e2 :slice)))
+               (not= (e1 :frame) (e2 :frame))
+               (not= (e1 :position) (e2 :position)))
+        true))))

 (defn process-channel-skip-frames [events]
   (filter
@@ -64,30 +61,39 @@
        (not= 0 (mod (% :frame) (-> % :channel :skip-frames inc))))
     events))

-(defn process-use-autofocus [events]
+(defn process-use-autofocus [events use-autofocus autofocus-skip]
   (for [event events]
     (assoc event :autofocus
-      (and (settings :use-autofocus)
+      (and use-autofocus
         (or
           (nil? (event :frame))
-          (zero? (mod (event :frame) (inc (settings :autofocus-skip)))))))))
+          (zero? (mod (event :frame) (inc autofocus-skip))))))))

-(defn process-wait-time [events]
+(defn process-wait-time [events interval-ms]
   (cons
     (assoc (first events) :wait-time-ms 0)
     (for [[e1 e2] (pairs events) :when e2]
       (assoc e2 :wait-time-ms
         (if (= (:frame e1) (:frame e2))
           0
-          (settings :interval-ms))))))
+          interval-ms)))))

-(defn generate-acq-sequence [seq-settings]
-  (binding [settings seq-settings]
-    (-> (make-main-loops)
-      process-skip-z-stack
-      manage-shutter
-      process-use-autofocus
-      process-wait-time)))
+(defn generate-acq-sequence [settings]
+  (let [{:keys [slices keep-shutter-open-channels keep-shutter-open-slices
+         use-autofocus autofocus-skip interval-ms]} settings]
+    (-> (make-main-loops settings)
+      (process-skip-z-stack slices)
+      (manage-shutter keep-shutter-open-channels keep-shutter-open-slices)
+      (process-channel-skip-frames)
+      (process-use-autofocus use-autofocus autofocus-skip)
+      (process-wait-time interval-ms))))
+; Interop
+(defn data-object-to-map [obj]
+  (into {}
+    (for [f (.getFields (type obj))
+          :when (zero? (bit-and
+                         (.getModifiers f) java.lang.reflect.Modifier/STATIC))]
+      [(keyword (.getName f)) (.get f obj)])))

 ; Testing:


Trying to get back to laziness... but wondering what the advantage is for writes

--- src/main/clojure/stl_collector/writer.clj
+++ src/main/clojure/stl_collector/writer.clj
@@ -6,33 +6,49 @@
    [nio.core :as nio]
    [clojure.pprint :as pp])

-  (:import (java.nio ByteOrder)))
+  (:import (java.nio ByteOrder DirectByteBuffer)))

-(defn pad [buffer num_bytes]
-  (doseq [_ (range num_bytes)]
-    (.put buffer (byte 0))))
+(defn calculate-offset [offset n size]
+  (+ offset (* n size)))
+
+(defn pad [buffer offset num_bytes]
+  (if (> num_bytes 0)
+    (do
+      (.put buffer offset (byte 0))
+      (recur buffer (inc offset) (dec num_bytes)))
+    offset))

 (defn write-vector
-  [buffer vs]
-  (let [{x :x
-         y :y
-         z :z} vs]
-    (.putFloat buffer (float x))
-    (.putFloat buffer (float y))
-    (.putFloat buffer (float z))
-    [x y z]))
+  [^DirectByteBuffer buffer ^Integer offset vertex]
+  (let [{x :x y :y z :z} vertex
+        values [x y z]
+        put-float (fn [o vs]
+                    (if (seq vs)
+                      (let [[v & vss] vs]
+                        (.putFloat buffer o v)
+                        (recur (+ o 4) vss))
+                      o))]
+    (put-float offset values)))

 (defn write-header
   [buffer count]
-  (pad buffer stl-file/MESSAGE_LENGTH)
-  (.putInt buffer count))
+  (pad buffer 0 stl-file/MESSAGE_LENGTH)
+  (.putInt buffer 0 count)
+  stl-file/HEADER_LENGTH)

 (defn write-facet
-  [buffer facet]
-  (let [n  (write-vector buffer (:normal facet))
-        vs (doall (for [v  (:vertices facet)]
-                     (write-vector buffer v)))]
-    (pad buffer 2)))
+  [buffer offset facet]
+  (let [post_normal_offset (write-vector buffer offset (:normal facet))
+        process_vertices (fn [buffer offset facets]
+                           (if (seq facets)
+                             (let [[f & fs] facets
+                                   new_offset (write-vector buffer offset f)]
+                               (recur buffer new_offset fs))
+                             offset))
+        post_vertices_offset (process_vertices buffer
+                                               post_normal_offset
+                                               (:vertices facet))]
+    pad buffer post_vertices_offset 2))

 (defn calculate-file-size
   [num_facets]
@@ -43,11 +59,18 @@
   (let [num_facets (count stl-seq)
         offset 0
         length (calculate-file-size num_facets)]
-    (let [buffer (doto (nio/mmap filename offset length)
-                  (.order ByteOrder/LITTLE_ENDIAN))]
-      (write-header buffer num_facets)
-      (doseq [facet stl-seq]
-        (write-facet buffer facet)))))
+    (let [buffer             (doto (nio/mmap filename
+                                             offset
+                                             length)
+                               (.order ByteOrder/LITTLE_ENDIAN))
+          post-header-offset (write-header buffer num_facets)
+          process-facets     (fn [buffer offset facets]
+                               (if (seq facets)
+                                 (let [[f & fs] facets
+                                       new-offset (write-facet buffer offset f)]
+                                   (recur buffer new-offset fs))
+                                 offset))]
+      (process-facets buffer post-header-offset stl-seq))))


More experiments with the way data is enqueued.

--- src/dsbdp/local_data_processing_pipeline.clj
+++ src/dsbdp/local_data_processing_pipeline.clj
@@ -24,23 +24,24 @@

 (defmacro create-queue
   []
-;  `(LinkedBlockingQueue.))
+  `(LinkedBlockingQueue. *queue-size*))
 ;  `(ArrayBlockingQueue. *queue-size*))
-  `(LinkedTransferQueue.))
+;  `(LinkedTransferQueue.))

 (defmacro enqueue
-;  [^BlockingQueue queue data enqueued-counter dropped-counter]
-;  `(.put ~queue ~data))
-  [^TransferQueue queue data enqueued-counter dropped-counter]
+  [^BlockingQueue queue data enqueued-counter dropped-counter]
+  `(.put ~queue ~data))
+;  `(.offer ~queue ~data))
+;  [^TransferQueue queue data enqueued-counter dropped-counter]
 ;  `(.transfer ~queue ~data))
-  `(if (.hasWaitingConsumer ~queue)
-     (do
-       (.transfer ~queue ~data)
-       (.inc ~enqueued-counter))
-     (do
-       (.inc ~dropped-counter)
-       ;(sleep 1)
-       )))
+;  `(if (.hasWaitingConsumer ~queue)
+;     (do
+;       (.transfer ~queue ~data)
+;       (.inc ~enqueued-counter))
+;     (do
+;       (.inc ~dropped-counter)
+;       ;(sleep 1)
+;       )))
 ;  `(if (.tryTransfer ~queue ~data 1 TimeUnit/MILLISECONDS)
 ;     (.inc ~enqueued-counter)
 ;     (.inc ~dropped-counter)))


disassociate picture property from tags even when empty

--- src/server/rooms.cljs
+++ src/server/rooms.cljs
@@ -215,7 +215,7 @@
 (defn handle-album-art [tags track-id callback]
   (let [pictures (get tags "picture")]
     (if (empty? pictures)
-      (callback tags)
+      (callback (dissoc tags "picture"))
       (let [picture (first (get tags "picture"))
             picture-format (get picture "format")
             picture-data   (get picture "data")


Access the canvas the preferred way.

Access the canvas the preferred way.

When I originally tried to do it the way David recommended in Clojurians,
it didn't work.  Perhaps I was doing something wrong then, or perhaps it was
broken.  But I tried it again, and it works.  Now I'm down to just one atom
again, as it should be.

--- src/snergly/core.cljs
+++ src/snergly/core.cljs
@@ -22,13 +22,6 @@
       (xact! reconciler
              (snergly.core/set-status {:status msg})
              (snergly.core/set-grid {:grid grid})))))
-
-;; I shouldn't have to do this; the "right way", apparently, is to set the
-;; ref as a property on the component.  And that works great in figwheel
-;; development mode, but in a production build with optimizations on, it
-;; doesn't work at all.  This is the only way I've been able to get it to
-;; work in both.
-(def thecanvas (atom nil))

 (def init-data
   {;; application initialization
@@ -109,11 +102,11 @@
        (and (integer? rows) (> rows 1) (< rows 100))
        (and (integer? columns) (> columns 1) (< columns 100))))

-(defn animate-if-active [{:keys [animation params]}]
+(defn animate-if-active [{:keys [animation params]} canvas]
   (let [{:keys [active grid animator]} animation
         {:keys [cell-size]} params]
     (when active
-      (protocols/animate-frame animator grid cell-size @thecanvas))))
+      (protocols/animate-frame animator grid cell-size canvas))))

 (defui MazeDisplay
   static om/IQuery
@@ -121,9 +114,9 @@
     '[:maze])
   Object
   (componentDidMount [this]
-    (animate-if-active (om/props this)))
+    (animate-if-active (om/props this) (om.next/react-ref this "maze-canvas")))
   (componentDidUpdate [this _ _]
-    (animate-if-active (om/props this)))
+    (animate-if-active (om/props this) (om.next/react-ref this "maze-canvas")))
   (render [this]
     (let [{:keys [animation params]} (om/props this)
           {:keys [rows columns cell-size]} params
@@ -135,9 +128,7 @@
                  (dom/canvas #js {:id     "c1"
                                   :height height
                                   :width  width
-                                  :ref    (fn [c]
-                                            (when-not (nil? c)
-                                              (reset! thecanvas c)))})
+                                  :ref "maze-canvas"})
                  )))))

 (def maze-display (om/factory MazeDisplay))


Fix CLJS-specific bugs

Fix CLJS-specific bugs

--- src/specium/core.cljc
+++ src/specium/core.cljc
@@ -18,8 +18,8 @@
      :cljs (try
              ;; I'm not sure this is the right way to resolve a symbol
              ;; in CLJS
-             (js/eval (str (comp/munge multi-name)))
-             (catch js/Error _ nil))))
+             (js/eval (comp/munge (str x)))
+             (catch :default _ nil))))

 (defn ->spec [x]
   (cond (or (keyword? x) (set? x)) x
@@ -33,9 +33,10 @@
 (defmethod ->spec* `s/multi-spec [[_ mm retag]]
   ;; Essentially identical to `delay`, but won't cache the result.
   ;; This behavior successfully emulates deref'ing a var.
-  (let [v (reify #?(:clj clojure.lang.IDeref
-                    :cljs cljs.core.IDeref)
-            (deref [this] (resolve* mm)))]
+  (let [v #?(:clj (reify clojure.lang.IDeref
+                    (deref [this] (resolve* mm)))
+             :cljs (reify IDeref
+                     (-deref [this] (resolve* mm))))]
     (s/multi-spec-impl mm v (->spec retag))))

 (defmethod ->spec* `s/and [[_ & pred-forms]]
@@ -111,7 +112,8 @@
                                              (inc max-count)
                                              min-count)
                                            %)
-                            (or max-count Integer/MAX_VALUE)))
+                            (or max-count #?(:clj Integer/MAX_VALUE
+                                             :cljs s/MAX_INT))))

                  distinct (conj #(or (empty? %) (apply distinct? %))))]
     (s/every-impl pred


Add backup functions and cleanup the split between open-local and open-pool.

--- src/sql_file/core.clj
+++ src/sql_file/core.clj
@@ -98,6 +98,17 @@
         (throw (Exception. (str "Error installing schema: " schema) ex))))
     (set-schema-version! conn schema-name schema-version)))

+;; Public Entry points
+
+(defn hsqldb-conn [ desc ]
+  "Construct a connection map for an HSQLDB database with the given
+filename and schema. A name with a \"mem:\" prefix may be used to
+request a memory database."
+  (cond-> {:classname "org.hsqldb.jdbc.JDBCDriver"
+           :subprotocol  "hsqldb"
+           :subname (:name desc)}
+    (:schema-path desc) (assoc :schema-path (:schema-path desc))))
+
 (defn ensure-schema [ conn schema ]
   "Locate and run the scripts necessary to install the specified
 schema in the target database instance."
@@ -114,17 +125,6 @@
             (recur)))))
     conn))

-(defn hsqldb-conn [ desc ]
-  "Construct a connection map for an HSQLDB database with the given
-filename and schema. A name with a \"mem:\" prefix may be used to
-request a memory database."
-  (cond-> {:classname "org.hsqldb.jdbc.JDBCDriver"
-           :subprotocol  "hsqldb"
-           :subname (:name desc)}
-    (:schema-path desc) (assoc :schema-path (:schema-path desc))))
-
-;; Public Entry points
-
 (defn backup-to-file-blocking [ conn output-path ]
   (jdbc/db-do-prepared conn (str "BACKUP DATABASE TO '" output-path "' BLOCKING")))

@@ -138,12 +138,10 @@

 (defn open-pool [ desc ]
   (log/info "Opening sql-file (pooled):" desc)
-  (let [conn (hsqldb-conn desc)
-        cpds (doto (com.zaxxer.hikari.HikariDataSource.)
-               (.setDriverClassName (:classname conn))
-               (.setJdbcUrl (str "jdbc:hsqldb:" (:subname conn)))
-               (.setMaximumPoolSize (get desc :pool-size 4)))]
-    (-> conn
-        (assoc :datasource cpds)
-        (ensure-schema [ "sql-file" 0]))))
+  (let [conn (open-local desc)]
+    (assoc conn :datasource
+           (doto (com.zaxxer.hikari.HikariDataSource.)
+             (.setDriverClassName (:classname conn))
+             (.setJdbcUrl (str "jdbc:hsqldb:" (:subname conn)))
+             (.setMaximumPoolSize (get desc :pool-size 4))))))