:heart_eyes_cat: automatically infer the special_type of a Field if its name + base_type match a known pattern

--- src/metabase/driver/sync.clj
+++ src/metabase/driver/sync.clj
@@ -4,6 +4,7 @@
             [clojure.tools.logging :as log]
             [colorize.core :as color]
             [korma.core :as k]
+            [medley.core :as m]
             [metabase.db :refer :all]
             (metabase.driver [interface :refer :all]
                              [query-processor :as qp])
@@ -13,7 +14,8 @@
                              [table :refer [Table]])
             [metabase.util :as u]))

-(declare mark-category-field!
+(declare auto-assign-field-special-type-by-name!
+         mark-category-field!
          mark-no-preview-display-field!
          mark-url-field!
          sync-database-active-tables!
@@ -242,7 +244,8 @@
   (sync-field->> field
                  (mark-url-field! driver)
                  mark-category-field!
-                 (mark-no-preview-display-field! driver)))
+                 (mark-no-preview-display-field! driver)
+                 auto-assign-field-special-type-by-name!))

 ;; Each field-syncing function below should return FIELD with any updates that we made, or nil.
@@ -342,3 +345,72 @@
         (log/info (format "Field '%s.%s' has an average length of %d. Not displaying it in previews." (:name @(:table field)) (:name field) avg-len))
         (upd Field (:id field) :preview_display false)
         (assoc field :preview_display false)))))
+
+
+;; ### auto-assign-field-special-type-by-name!
+
+(def ^{:arglists '([field])}
+  field->name-inferred-special-type
+  "If FIELD has a `name` and `base_type` that matches a known pattern, return the `special_type` we should assign to it."
+  (let [bool-or-int #{:BooleanField :BigIntegerField :IntegerField}
+        float       #{:DecimalField :FloatField}
+        int-or-text #{:BigIntegerField :IntegerField :CharField :TextField}
+        text        #{:CharField :TextField}
+        pattern+base-types+special-type [[#"^.*_lat$"       float       :latitude]  ; tuples of [pattern set-of-valid-base-types special-type]
+                                         [#"^.*_lon$"       float       :longitude] ; we'll consider a nil set-of-valid-base-types to mean "match any base type"
+                                         [#"^.*_lng$"       float       :longitude]
+                                         [#"^.*_long$"      float       :longitude]
+                                         [#"^.*_longitude$" float       :longitude]
+                                         [#"^.*_rating$"    int-or-text :category]
+                                         [#"^.*_type$"      int-or-text :category]
+                                         [#"^.*_url$"       text        :url]
+                                         [#"^_latitude$"    float       :latitude]
+                                         [#"^active$"       bool-or-int :category]
+                                         [#"^city$"         text        :city]
+                                         [#"^country$"      text        :country]
+                                         [#"^countryCode$"  text        :country]
+                                         [#"^currency$"     int-or-text :category]
+                                         [#"^first_name$"   text        :name]
+                                         [#"^full_name$"    text        :name]
+                                         [#"^gender$"       int-or-text :category]
+                                         [#"^id$"           nil         :id]
+                                         [#"^last_name$"    text        :name]
+                                         [#"^lat$"          float       :latitude]
+                                         [#"^latitude$"     float       :latitude]
+                                         [#"^lon$"          float       :longitude]
+                                         [#"^lng$"          float       :longitude]
+                                         [#"^long$"         float       :longitude]
+                                         [#"^longitude$"    float       :longitude]
+                                         [#"^name$"         text        :name]
+                                         [#"^postalCode$"   int-or-text :zip_code]
+                                         [#"^postal_code$"  int-or-text :zip_code]
+                                         [#"^rating$"       int-or-text :category]
+                                         [#"^role$"         int-or-text :category]
+                                         [#"^sex$"          int-or-text :category]
+                                         [#"^state$"        text        :state]
+                                         [#"^status$"       int-or-text :category]
+                                         [#"^type$"         int-or-text :category]
+                                         [#"^url$"          text        :url]
+                                         [#"^zip_code$"     int-or-text :zip_code]
+                                         [#"^zipCode$"      int-or-text :zip_code]]]
+    ;; Check that all the pattern tuples are valid
+    (doseq [[name-pattern base-types special-type] pattern+base-types+special-type]
+      (assert (u/regex? name-pattern))
+      (assert (every? (partial contains? field/base-types) base-types))
+      (assert (contains? field/special-types special-type)))
+    (fn [field]
+      (m/find-first (fn [[name-pattern valid-base-types _]]
+                      (and (or (nil? valid-base-types)
+                               (contains? valid-base-types (:base_type field)))
+                           (re-matches name-pattern (:name field))))
+                    pattern+base-types+special-type))))
+
+(defn auto-assign-field-special-type-by-name!
+  "If FIELD doesn't have a special type, but has a name that matches a known pattern like `latitude`, mark it as having the specified special type."
+  [field]
+  (when-not (:special_type field)
+    (when-let [[pattern _ special-type] (field->name-inferred-special-type field)]
+      (log/info (format "%s '%s.%s' matches '%s'. Setting special_type to '%s'."
+                        (name (:base_type field)) (:name @(:table field)) (:name field) pattern (name special-type)))
+      (upd Field (:id field) :special_type special-type)
+      (assoc field :special_type special-type))))


limit field distinct count query when syncing

--- src/metabase/driver/sync.clj
+++ src/metabase/driver/sync.clj
@@ -297,7 +297,7 @@
   "If FIELD doesn't yet have a `special_type`, and has low cardinality, mark it as a category."
   [field]
   (when-not (:special_type field)
-    (let [cardinality (queries/field-distinct-count field)]
+    (let [cardinality (queries/field-distinct-count field low-cardinality-threshold)]
       (when (and (> cardinality 0)
                  (< cardinality low-cardinality-threshold))
         (log/info (format "Field '%s.%s' has %d unique values. Marking it as a category." (:name @(:table field)) (:name field) cardinality))


Add unit tests for entity state computation.

--- test/vault/entity/core_test.clj
+++ test/vault/entity/core_test.clj
@@ -123,3 +123,83 @@
     (let [datoms (mapcat entity/blob->datoms [root-a root-b update])]
       (puget/cprint (entity/entity-state (:id root-a) datoms))
       (puget/cprint (entity/entity-state (:id root-b) datoms)))))
+
+
+(deftest entity-state
+  (let [t (time/date-time 2014 5 14 3 20 36)
+        root-id (blob/hash (.getBytes "foo"))]
+    (is (thrown? RuntimeException
+          (entity/entity-state root-id
+            [(entity/->Datom :foo/bar root-id :attr "value" root-id t)]))
+        "Unknown datom operation throws an exception.")
+    (is (= {:vault.entity/id root-id}
+           (entity/entity-state root-id []))
+        "No datoms should produce an empty map.")
+    (is (= {:vault.entity/id root-id
+            :title "Entity Title"}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/set root-id :title "Entity Title" root-id t)]))
+        "Setting a value for an unset attribute should produce an attribute with that value.")
+    (is (= {:vault.entity/id root-id
+            :title "Title Revision"}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/set root-id :title "Entity Title" root-id t)
+              (entity/->Datom :attr/set root-id :title "Title Revision" root-id t)]))
+        "Setting an attribute to new value should produce an attribute with the new value.")
+    (is (= {:vault.entity/id root-id
+            :tags #{"foo"}}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/add root-id :tags "foo" root-id t)]))
+        "Adding a value to unset attribute should produce a set with a single entry.")
+    (is (= {:vault.entity/id root-id
+            :tags #{"bar" "foo"}}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/add root-id :tags "foo" root-id t)
+              (entity/->Datom :attr/add root-id :tags "bar" root-id t)]))
+        "Adding two values to an attribute should produce a set with two entries.")
+    (is (= {:vault.entity/id root-id
+            :flexible #{"123" "abc"}}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/set root-id :flexible "123" root-id t)
+              (entity/->Datom :attr/add root-id :flexible "abc" root-id t)]))
+        "Adding a value to a single-valued attribute should produce a set with two entries.")
+    (is (= {:vault.entity/id root-id
+            :abc 123}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/set root-id :abc 123 root-id t)
+              (entity/->Datom :attr/del root-id :foo nil root-id t)]))
+        "Deleting an unset attribute should produce the same map.")
+    (is (= {:vault.entity/id root-id}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/set root-id :foo "123" root-id t)
+              (entity/->Datom :attr/del root-id :foo nil root-id t)]))
+        "Deleting an attribute with nil value should remove any value for attribute.")
+    (is (= {:vault.entity/id root-id}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/set root-id :foo "123" root-id t)
+              (entity/->Datom :attr/del root-id :foo "123" root-id t)]))
+        "Deleting a value for an attribute with the same value should remove it.")
+    (is (= {:vault.entity/id root-id
+            :foo "123"}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/set root-id :foo "123" root-id t)
+              (entity/->Datom :attr/del root-id :foo "abc" root-id t)]))
+        "Deleting a value for an attribute with a different value should not remove it.")
+    (is (= {:vault.entity/id root-id}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/add root-id :foo "123" root-id t)
+              (entity/->Datom :attr/add root-id :foo "abc" root-id t)
+              (entity/->Datom :attr/del root-id :foo nil root-id t)]))
+        "Deleting a set attribute with nil value should remove the whole set.")
+    (is (= {:vault.entity/id root-id}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/add root-id :foo "123" root-id t)
+              (entity/->Datom :attr/del root-id :foo "123" root-id t)]))
+        "Deleting the only value from a set attribute should remove it.")
+    (is (= {:vault.entity/id root-id
+            :foo #{"abc"}}
+           (entity/entity-state root-id
+             [(entity/->Datom :attr/add root-id :foo "123" root-id t)
+              (entity/->Datom :attr/add root-id :foo "abc" root-id t)
+              (entity/->Datom :attr/del root-id :foo "123" root-id t)]))
+        "Deleting a value from a set attribute should remove the value.")))


[Issue #82] pulled duplicated code into private fn

--- src/midje/ideas/formulas.clj
+++ src/midje/ideas/formulas.clj
@@ -19,12 +19,15 @@

 (defn shrink [& _args] [])

+(defn- formula-fact [docstring body]
+  `(midje.sweet/fact ~docstring
+     ~@body :formula :formula-in-progress))
+
 (defmacro shrink-failure-case [docstring binding-name failed-binding-val body]
   `(loop [[cur-shrunk# & rest#] (midje.ideas.formulas/shrink ~failed-binding-val)]
      (when cur-shrunk#
        (when (let [~binding-name cur-shrunk#]
-               (midje.sweet/fact ~docstring   ;; duplicated
-                 ~@body :formula :formula-in-progress))
+               ~(formula-fact docstring body))
          (recur rest#)))))

 (defmacro formula
@@ -42,8 +45,7 @@
   [& args]
   (when-valid &form
     (let [[docstring? [bindings & body]] (pop-docstring args)
-          fact `(midje.sweet/fact ~docstring? ;; duplicated
-                  ~@body :formula :formula-in-progress )
+          fact (formula-fact docstring? body)
           conclusion-signal `(midje.sweet/fact
                                :always-pass midje.sweet/=> :always-pass :formula :formula-conclude )]


Refactor sending into its own function

Refactor sending into its own function

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -1,7 +1,7 @@
 (ns ^:no-doc onyx.messaging.aeron
   (:require [clojure.core.async :refer [chan >!! <!! alts!! timeout close! sliding-buffer]]
             [com.stuartsierra.component :as component]
-            [taoensso.timbre :refer [fatal] :as timbre]
+            [taoensso.timbre :refer [fatal info] :as timbre]
             [onyx.messaging.aeron.peer-manager :as pm]
             [onyx.messaging.protocol-aeron :as protocol]
             [onyx.messaging.common :as common]
@@ -360,23 +360,29 @@
       (pm/peer-channels id)
       ch-k))

+
+(def ^:const publication-backpressured (long -2))
+(def ^:const publication-not-connected (long -1))
+
+(defn send-pub [messenger ^Publication pub buf start end]
+  (let [offer-f (fn [] (.offer pub buf start end))]
+    (while (let [result ^long (offer-f)]
+             (or (= result publication-backpressured)
+                 (= result publication-not-connected)))
+      (.idle ^IdleStrategy (:send-idle-strategy messenger) 0))))
+
 (defn send-messages-short-circuit [ch batch]
   (when ch
     (doseq [segment batch]
       (>!! ch segment))))
-
-(def ^:const publication-backpressured? (long -2))

 (defmethod extensions/send-messages AeronConnection
   [messenger event {:keys [id channel] :as conn-info} batch]
   (if ((:short-circuitable? messenger) channel)
     (send-messages-short-circuit (short-circuit-ch messenger (:id conn-info) :inbound-ch) batch)
     (let [pub ^Publication (get-publication messenger conn-info)
-          [len unsafe-buffer] (protocol/build-messages-msg-buf (:compress-f messenger) id batch)
-          offer-f (fn [] (.offer pub unsafe-buffer 0 len))
-          idle-strategy (:send-idle-strategy messenger)]
-      (while (= ^long (offer-f) publication-backpressured?)
-        (.idle ^IdleStrategy idle-strategy 0)))))
+          [len unsafe-buffer] (protocol/build-messages-msg-buf (:compress-f messenger) id batch)]
+      (send-pub messenger pub unsafe-buffer 0 len))))

 (defn ack-segments-short-circuit [ch acks]
   (when ch
@@ -387,13 +393,10 @@
   [messenger event {:keys [id channel] :as conn-info} acks]
   (if ((:short-circuitable? messenger) channel)
     (ack-segments-short-circuit (short-circuit-ch messenger id :acking-ch) acks)
-    (let [pub ^Publication (get-publication messenger conn-info)
-          idle-strategy (:send-idle-strategy messenger)]
+    (let [pub ^Publication (get-publication messenger conn-info)]
       (doseq [ack acks]
-        (let [unsafe-buffer (protocol/build-acker-message id (:id ack) (:completion-id ack) (:ack-val ack))
-              offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/ack-msg-length))]
-      (while (= ^long (offer-f) publication-backpressured?)
-        (.idle ^IdleStrategy idle-strategy 0)))))))
+        (let [unsafe-buffer (protocol/build-acker-message id (:id ack) (:completion-id ack) (:ack-val ack))]
+          (send-pub messenger pub unsafe-buffer 0 protocol/ack-msg-length))))))

 (defn complete-message-short-circuit [ch completion-id]
   (when ch
@@ -403,12 +406,9 @@
   [messenger event completion-id {:keys [id channel] :as conn-info}]
   (if ((:short-circuitable? messenger) channel)
     (complete-message-short-circuit (short-circuit-ch messenger id :release-ch) completion-id)
-    (let [idle-strategy (:send-idle-strategy messenger)
-          pub ^Publication (get-publication messenger conn-info)
-          unsafe-buffer (protocol/build-completion-msg-buf id completion-id)
-          offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/completion-msg-length))]
-      (while (= ^long (offer-f) publication-backpressured?)
-        (.idle ^IdleStrategy idle-strategy 0)))))
+    (let [pub ^Publication (get-publication messenger conn-info)
+          unsafe-buffer (protocol/build-completion-msg-buf id completion-id)]
+      (send-pub messenger pub unsafe-buffer 0 protocol/completion-msg-length))))

 (defn retry-segment-short-circuit [ch retry-id]
   (when ch
@@ -420,10 +420,8 @@
     (retry-segment-short-circuit (short-circuit-ch messenger id :retry-ch) retry-id)
     (let [idle-strategy (:send-idle-strategy messenger)
           pub ^Publication (get-publication messenger conn-info)
-          unsafe-buffer (protocol/build-retry-msg-buf id retry-id)
-          offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/retry-msg-length))]
-      (while (= ^long (offer-f) publication-backpressured?)
-        (.idle ^IdleStrategy idle-strategy 0)))))
+          unsafe-buffer (protocol/build-retry-msg-buf id retry-id)]
+      (send-pub messenger pub unsafe-buffer 0 protocol/retry-msg-length))))

 (defmethod extensions/close-peer-connection AeronConnection
   [messenger event peer-link]


Update for Issue 203.  Add rotate function for diatonic, pentatonic and hex scales.

--- src/overtone/music/pitch.clj
+++ src/overtone/music/pitch.clj
@@ -230,23 +230,38 @@
 ;; All sequences should add up to 12 - the number of semitones in an octave

 (def SCALE
-  (let [ionian-sequence [2 2 1 2 2 2 1]
-        ionian-len      (count ionian-sequence)
-        rotate-ionian   (fn [offset]
-                          (take ionian-len
-                                (drop offset (cycle ionian-sequence))))]
+  (let [ionian-sequence     [2 2 1 2 2 2 1]
+        hex-sequence        [2 2 1 2 2 3]
+        pentatonic-sequence [3 2 2 3 2]
+        rotate (fn [scale-sequence offset]
+                 (take (count scale-sequence)
+                       (drop offset (cycle scale-sequence))))]
     {:diatonic           ionian-sequence
-     :ionian             (rotate-ionian 0)
-     :major              (rotate-ionian 0)
-     :dorian             (rotate-ionian 1)
-     :phrygian           (rotate-ionian 2)
-     :lydian             (rotate-ionian 3)
-     :mixolydian         (rotate-ionian 4)
-     :aeolian            (rotate-ionian 5)
-     :minor              (rotate-ionian 5)
-     :locrian            (rotate-ionian 6)
-     :major-pentatonic   [2 2 3 2 3]
-     :minor-pentatonic   [3 2 2 3 2]
+     :ionian             (rotate ionian-sequence 0)
+     :major              (rotate ionian-sequence 0)
+     :dorian             (rotate ionian-sequence 1)
+     :phrygian           (rotate ionian-sequence 2)
+     :lydian             (rotate ionian-sequence 3)
+     :mixolydian         (rotate ionian-sequence 4)
+     :aeolian            (rotate ionian-sequence 5)
+     :minor              (rotate ionian-sequence 5)
+     :locrian            (rotate ionian-sequence 6)
+     :hex-major6         (rotate hex-sequence 0)
+     :hex-dorian         (rotate hex-sequence 1)
+     :hex-phrygian       (rotate hex-sequence 2)
+     :hex-major7         (rotate hex-sequence 3)
+     :hex-sus            (rotate hex-sequence 4)
+     :hex-aeolian        (rotate hex-sequence 5)
+     :minor-pentatonic   (rotate pentatonic-sequence 0)
+     :yu                 (rotate pentatonic-sequence 0)
+     :major-pentatonic   (rotate pentatonic-sequence 1)
+     :gong               (rotate pentatonic-sequence 1)
+     :egyptian           (rotate pentatonic-sequence 2)
+     :shang              (rotate pentatonic-sequence 2)
+     :jiao               (rotate pentatonic-sequence 3)
+     :pentatonic         (rotate pentatonic-sequence 4) ;; historical match
+     :zhi                (rotate pentatonic-sequence 4)
+     :ritusen            (rotate pentatonic-sequence 4)
      :whole-tone         [2 2 2 2 2 2]
      :whole              [2 2 2 2 2 2]
      :chromatic          [1 1 1 1 1 1 1 1 1 1 1 1]
@@ -268,10 +283,7 @@
      :bartok             [2 2 1 2 1 2 2]
      :bhairav            [1 3 1 2 1 3 1]
      :locrian-major      [2 2 1 1 2 2 2]
-     :gong               [2 2 3 2 3]
-     :hex-phrygian       [1 2 2 3 2 2]
      :ahirbhairav        [1 3 1 2 2 1 2]
-     :yu                 [3 2 2 3 2]
      :enigmatic          [1 3 2 2 2 1 1]
      :neapolitan-minor   [1 2 2 2 1 3 1]
      :pelog              [1 2 4 1 4]
@@ -279,7 +291,6 @@
      :scriabin           [1 3 3 2 3]
      :harmonic-major     [2 2 1 2 1 3 1]
      :melodic-minor-desc [2 1 2 2 1 2 2]
-     :hex-dorian         [2 1 2 2 3 2]
      :romanian-minor     [2 1 3 1 2 1 2]
      :hindu              [2 2 1 2 1 2 2]
      :iwato              [1 4 1 4 2]
@@ -288,22 +299,13 @@
      :marva              [1 3 2 1 2 2 1]
      :melodic-major      [2 2 1 2 1 2 2]
      :indian             [4 1 2 3 2]
-     :hex-major6         [2 2 1 2 2 3]
      :spanish            [1 3 1 2 1 2 2]
      :prometheus         [2 2 2 5 1]
      :diminished         [1 2 1 2 1 2 1 2]
-     :hex-aeolian        [3 2 2 1 2 2]
-     :ritusen            [2 3 2 2 3]
-     :hex-sus            [2 3 2 2 1 2]
      :todi               [1 2 3 1 1 3 1]
-     :zhi                [2 3 2 2 3]
      :leading-whole      [2 2 2 2 2 1 1]
      :augmented          [3 1 3 1 3 1]
-     :shang              [2 3 2 3 2]
-     :jiao               [3 2 3 2 2]
-     :egyptian           [2 3 2 3 2]
      :purvi              [1 3 2 1 1 3 1]
-     :hex-major7         [2 2 3 2 2 1]
      :chinese            [4 2 1 4 1]
      :lydian-minor       [2 2 2 1 1 2 2]}))


Add unique device num integer to all full MIDI device keys. These increment when another identical device has already been registered to allow for multiple identical devices to be uniquely handled by the event system.

Also add:

* midi-connected-devices - for listing all connected MIDI sources
* midi-find-connected-devices - for searching for a set of specific MIDI sources
* midi-find-connected-device - for searching for the first matching MIDI source

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -1,8 +1,8 @@
 (ns overtone.studio.midi
   (:use [overtone.sc node]
-        [overtone midi]
+        [overtone.midi]
         [overtone.at-at :only (mk-pool every)]
-        [overtone.libs.event]
+        [overtone.libs event counters]
         [overtone.sc.defaults :only [INTERNAL-POOL]])
   (:require [overtone.config.log :as log]))

@@ -13,8 +13,45 @@
 (def EXCLUDED-DEVICES #{"Real Time Sequencer" "Java Sound Synthesizer"})

 (defn midi-mk-full-device-key
+  "Returns a unique key for the specific device. In the case of multiple
+   identical devices, the final integer of the key, dev-num, will be
+   different to ensure key uniqueness.
+
+   Is able to handle either a MIDI device stored in this namespace via
+   detect-midi-devices or a raw MIDI device map from overtone.midi. "
   [dev]
-  [:midi-device (dev :vendor) (dev :name) (dev :description)])
+  (or (::full-device-key dev)
+      (let [dev-num (or (::dev-num dev)
+                        (::dev-num (get @midi-devices* (:device dev)))
+                        -1)]
+        [:midi-device (dev :vendor) (dev :name) (dev :description) dev-num])))
+
+
+
+(defn midi-connected-devices
+  "Return a list of maps representing all of the connected MIDI
+   devices. Prefer using this fn to midi-devices from overtone.midi"
+  []
+  (vals @midi-devices*))
+
+(defn midi-find-connected-devices
+  "Returns a list of connected MIDI devices where the full device key
+   either contains the search string or matches the search regexp
+   depending on the type of parameter supplied"
+  [search]
+  (let [filter-pred (fn [dev]
+                      (let [key-as-str (str (midi-mk-full-device-key dev))]
+                        (if (= java.util.regex.Pattern (type search))
+                          (re-find search key-as-str)
+                          (.contains key-as-str search))))]
+    (filter filter-pred (midi-connected-devices))))
+
+(defn midi-find-connected-device
+  "Returns the first connected MIDI device found where the full device
+   key either contains the search string or matches the search regexp
+   depending on the type of parameter supplied"
+  [search]
+  (first (midi-find-connected-devices search)))

 (defn midi-mk-full-device-event-key
   "Creates the device-specific part of the key used for events generated
@@ -38,6 +75,7 @@
         dev-key       (midi-mk-full-device-key dev)
         dev-event-key (midi-mk-full-device-event-key dev command)]
     (event [:midi command] msg)
+    (event (midi-mk-full-device-key dev) msg)
     (event (midi-mk-full-control-event-key dev command (:data1 msg)) msg)
     (event dev-event-key msg)))

@@ -49,6 +87,8 @@
     (let [old-devs     (set (keys @midi-devices*))
           devs         (midi-sources)
           devs         (filter #(not (old-devs (:device %))) devs)
+          devs         (map #(assoc % ::dev-num (next-id (str (:vendor %) (:name %) (:description %)))) devs)
+          devs         (map #(assoc % ::full-device-key (midi-mk-full-device-key %)) devs)
           receivers    (doall (filter
                                (fn [dev]
                                  (try
@@ -63,16 +103,16 @@
           dev-map      (apply hash-map (interleave (map :device devs) receivers))]
       (swap! midi-devices* merge dev-map)
       (when (pos? n-devs)
-         (log/info "Connected " n-devs " midi devices: " device-names)))
+        (log/info "Connected " n-devs " midi devices: " device-names)))
     (catch Exception ex
-      (println "Got exception in detect-midi-devices!" ex))))
-
-; The rate at which we poll for new midi devices
+      (println "Got exception in detect-midi-devices!" (.printStackTrace ex)))))
+
+;; The rate at which we poll for new midi devices
 (def MIDI-POLL-RATE 2000)

 (defonce __DEVICE-POLLER__
   (detect-midi-devices))
-;  (every MIDI-POLL-RATE #'detect-midi-devices INTERNAL-POOL :desc "Check for new midi devices"))
+;;  (every MIDI-POLL-RATE #'detect-midi-devices INTERNAL-POOL :desc "Check for new midi devices"))

 (defn midi-poly-player
   "Sets up the event handlers and manages synth instances to easily play
@@ -235,15 +275,15 @@
   arbitrarily ordered."
   [control-key]
   (let [control-agents (swap! midi-control-agents*
-                             (fn [prev]
-                               (if (get prev control-key)
-                                 prev
-                                 (let [new-control-agent (agent 0)]
-                                   (on-sync-event control-key
-                                             (fn [msg]
-                                               (send new-control-agent
-                                                     (fn [old-val]
-                                                       (:data2 msg))))
-                                             (mk-control-key-keyword-for-agent control-key))
-                                   (assoc prev control-key new-control-agent)))))]
+                              (fn [prev]
+                                (if (get prev control-key)
+                                  prev
+                                  (let [new-control-agent (agent 0)]
+                                    (on-sync-event control-key
+                                                   (fn [msg]
+                                                     (send new-control-agent
+                                                           (fn [old-val]
+                                                             (:data2 msg))))
+                                                   (mk-control-key-keyword-for-agent control-key))
+                                    (assoc prev control-key new-control-agent)))))]
     (get control-agents control-key)))


Add macro versions of the render functions

--- src/play_clj/core_render.clj
+++ src/play_clj/core_render.clj
@@ -2,11 +2,17 @@

 ; tiled maps

-(defn tiled-map
+(defn tiled-map*
   [s]
   (if (string? s)
     (.load (TmxMapLoader.) s)
     s))
+
+(defmacro tiled-map
+  [s & options]
+  `(let [object# (tiled-map* ~s)]
+     (u/calls! ^TiledMap object# ~@options)
+     object#))

 (defmacro tiled-map!
   [{:keys [^BatchTiledMapRenderer renderer]} k & options]
@@ -19,7 +25,7 @@
     (for [^long i (range (.getCount layers))]
       (.get layers i))))

-(defn tiled-map-layer
+(defn tiled-map-layer*
   [screen layer]
   (if (isa? (type layer) MapLayer)
     layer
@@ -27,13 +33,25 @@
          (drop-while #(not= layer (.getName ^MapLayer %)))
          first)))

+(defmacro tiled-map-layer
+  [screen layer & options]
+  `(let [object# (tiled-map-layer* ~screen ~layer)]
+     (u/calls! ^TiledMapTileLayer object# ~@options)
+     object#))
+
 (defmacro tiled-map-layer!
   [layer k & options]
   `(u/call! ^TiledMapTileLayer (cast TiledMapTileLayer ~layer) ~k ~@options))

-(defn tiled-map-cell
+(defn tiled-map-cell*
   [screen layer x y]
   (.getCell ^TiledMapTileLayer (tiled-map-layer screen layer) x y))
+
+(defmacro tiled-map-cell
+  [screen layer x y & options]
+  `(let [object# (tiled-map-cell* ~screen ~layer ~x ~y)]
+     (u/calls! ^TiledMapTileLayer$Cell object# ~@options)
+     object#))

 (defmacro tiled-map-cell!
   [cell k & options]
@@ -54,42 +72,72 @@

 ; renderers

-(defn orthogonal-tiled-map
-  [path unit]
-  (OrthogonalTiledMapRenderer. ^TiledMap (tiled-map path) ^double unit))
+(defn orthogonal-tiled-map*
+  [path unit]
+  (OrthogonalTiledMapRenderer. ^TiledMap (tiled-map* path) ^double unit))
+
+(defmacro orthogonal-tiled-map
+  [path unit & options]
+  `(let [object# (orthogonal-tiled-map* ~path ~unit)]
+     (u/calls! ^OrthogonalTiledMapRenderer object# ~@options)
+     object#))

 (defmacro orthogonal-tiled-map!
   [screen k & options]
   `(u/call! ^OrthogonalTiledMapRenderer (:renderer ~screen) ~k ~@options))

-(defn isometric-tiled-map
-  [path unit]
-  (IsometricTiledMapRenderer. ^TiledMap (tiled-map path) ^double unit))
+(defn isometric-tiled-map*
+  [path unit]
+  (IsometricTiledMapRenderer. ^TiledMap (tiled-map* path) ^double unit))
+
+(defmacro isometric-tiled-map
+  [path unit & options]
+  `(let [object# (isometric-tiled-map* ~path ~unit)]
+     (u/calls! ^IsometricTiledMapRenderer object# ~@options)
+     object#))

 (defmacro isometric-tiled-map!
   [screen k & options]
   `(u/call! ^IsometricTiledMapRenderer (:renderer ~screen) ~k ~@options))

-(defn isometric-staggered-tiled-map
-  [path unit]
-  (IsometricStaggeredTiledMapRenderer. ^TiledMap (tiled-map path) ^double unit))
+(defn isometric-staggered-tiled-map*
+  [path unit]
+  (IsometricStaggeredTiledMapRenderer. ^TiledMap (tiled-map* path) ^double unit))
+
+(defmacro isometric-staggered-tiled-map
+  [path unit & options]
+  `(let [object# (isometric-staggered-tiled-map* ~path ~unit)]
+     (u/calls! ^IsometricStaggeredTiledMapRenderer object# ~@options)
+     object#))

 (defmacro isometric-staggered-tiled-map!
   [screen k & options]
   `(u/call! ^IsometricStaggeredTiledMapRenderer (:renderer ~screen)
                 ~k ~@options))

-(defn hexagonal-tiled-map
-  [path unit]
-  (HexagonalTiledMapRenderer. ^TiledMap (tiled-map path) ^double unit))
+(defn hexagonal-tiled-map*
+  [path unit]
+  (HexagonalTiledMapRenderer. ^TiledMap (tiled-map* path) ^double unit))
+
+(defmacro hexagonal-tiled-map
+  [path unit & options]
+  `(let [object# (hexagonal-tiled-map* ~path ~unit)]
+     (u/calls! ^HexagonalTiledMapRenderer object# ~@options)
+     object#))

 (defmacro hexagonal-tiled-map!
   [screen k & options]
   `(u/call! ^HexagonalTiledMapRenderer (:renderer ~screen) ~k ~@options))

-(defn stage
+(defn stage*
   []
   (Stage.))
+
+(defmacro stage
+  [& options]
+  `(let [object# (stage*)]
+     (u/calls! ^Stage object# ~@options)
+     object#))

 (defmacro stage!
   [screen k & options]
@@ -113,9 +161,15 @@

 ; cameras

-(defn orthographic-camera
+(defn orthographic-camera*
   []
   (OrthographicCamera.))
+
+(defmacro orthographic-camera
+  [& options]
+  `(let [object# (orthographic-camera*)]
+     (u/calls! ^OrthographicCamera object# ~@options)
+     object#))

 (defmacro orthographic-camera!
   [screen k & options]
@@ -124,6 +178,12 @@
 (defn perspective-camera
   []
   (PerspectiveCamera.))
+
+(defmacro perspective-camera
+  [& options]
+  `(let [object# (perspective-camera*)]
+     (u/calls! ^PerspectiveCamera object# ~@options)
+     object#))

 (defmacro perspective-camera!
   [screen k & options]


Add ansi-codes for background black and white

--- src/zprint/ansi.cljc
+++ src/zprint/ansi.cljc
@@ -24,13 +24,15 @@
    :cyan 36,
    :white 37,
    :xsf 38,
+   :back-black 40,
    :back-red 41,
    :back-green 42,
    :back-yellow 43,
    :back-blue 44,
    :back-magenta 45,
    :back-purple 45,
-   :back-cyan 46})
+   :back-cyan 46,
+   :back-white 47})

 (defn color-str
   "Wraps a string with ANSI escape codes."


Get arrow head directions right.

Get arrow head directions right.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -163,7 +163,7 @@
    "<marker id='triangle'"
    " viewBox='0 0 10 10' refX='0' refY='5'"
    " markerUnits='strokeWidth'"
-   " markerWidth='4' markerHeight='3'"
+   " markerWidth='8' markerHeight='6'"
    " orient='auto'>"
    " <path d='M 0 0 L 10 5 L 0 10 z'/>"
    "</defs>"
@@ -182,10 +182,10 @@
                      (if (= :put wait-kind)
                        ["<line x1='400' y1='" (* actx-position line-height)
                         "' x2='500' y2='" (* ch-position line-height)
-                        "' stroke='green' stroke-width='1' marker-start='url(#triangle)'/>"]
+                        "' stroke='green' stroke-width='1' marker-end='url(#triangle)'/>"]
                        ["<line x1='500' y1='" (* ch-position line-height)
                         "' x2='400' y2='" (* actx-position line-height)
-                        "' stroke='red' stroke-width='1' marker-start='url(#triangle)'/>"])))
+                        "' stroke='red' stroke-width='1' marker-end='url(#triangle)'/>"])))
                  wait-chs)))
         (:actxs vis))])


handles NPE while deleting frequently restarting pods (#1285)

--- waiter/src/waiter/scheduler/kubernetes.clj
+++ waiter/src/waiter/scheduler/kubernetes.clj
@@ -195,7 +195,7 @@
    when a new pod failure is listed in the given pod's lastState container status.
    Note that unique instance-ids are deterministically generated each time the pod is restarted
    by passing the pod's restartCount value to the pod->instance-id function."
-  [{:keys [service-id] :as live-instance} {:keys [service-id->failed-instances-transient-store] :as scheduler} pod]
+  [{:keys [service-id] :as live-instance} {:keys [service-id->failed-instances-transient-store] :as scheduler-config} pod]
   (try
     (let [primary-container-status (get-in pod [:status :containerStatuses 0])]
       (when-let [newest-failure (get-in primary-container-status [:lastState :terminated])]
@@ -228,7 +228,7 @@
    - it has restarted too many times (reached the restart-expiry-threshold threshold)
    - the primary container (waiter-apps) has not transitioned to running state in container-running-grace-secs seconds
    - the pod has the waiter/pod-expired=true annotation."
-  [{:keys [container-running-grace-secs restart-expiry-threshold watch-state]}
+  [{:keys [container-running-grace-secs restart-expiry-threshold watch-state] :as scheduler-config}
    service-id instance-id restart-count {:keys [waiter/pod-expired waiter/revision-timestamp]}
    primary-container-status pod-started-at]
   (let [rs-revision-timestamp-path [:service-id->service service-id :k8s/replicaset-annotations :waiter/revision-timestamp]
@@ -271,20 +271,20 @@
 (let [kill-restart-threshold-exceeded-pod-thread-pool (Executors/newFixedThreadPool 1)]
   (defn kill-restart-threshold-exceeded-pod
     "Processes killing of a frequently restarting pod (service instance)."
-    [scheduler {:keys [k8s/pod-name k8s/restart-count service-id] :as instance}]
+    [scheduler-config {:keys [k8s/pod-name k8s/restart-count service-id] :as instance}]
     (au/execute
       (fn kill-restart-threshold-exceeded-pod-task []
         (try
           (log/info "deleting frequently restarting pod"
                     {:pod-name pod-name :restart-count restart-count :service-id service-id})
-          (hard-delete-service-instance scheduler instance)
+          (hard-delete-service-instance scheduler-config instance)
           (catch Exception ex
             (log/error ex "error in deleting frequently restarting pod" pod-name))))
       kill-restart-threshold-exceeded-pod-thread-pool)))

 (defn pod->ServiceInstance
   "Convert a Kubernetes Pod JSON response into a Waiter Service Instance record."
-  [{:keys [api-server-url leader?-fn restart-kill-threshold] :as scheduler} pod]
+  [{:keys [api-server-url leader?-fn restart-kill-threshold] :as scheduler-config} pod]
   (try
     (let [;; waiter-app is the first container we register
           primary-container-restart-count (or (get-in pod [:status :containerStatuses 0 :restartCount]) 0)
@@ -318,7 +318,7 @@
           instance (scheduler/make-ServiceInstance
                      (cond-> {:extra-ports (->> pod-annotations :waiter/port-count Integer/parseInt range next (mapv #(+ port0 %)))
                               :flags (cond-> #{}
-                                       (check-expired scheduler service-id instance-id pod-restart-count pod-annotations primary-container-status pod-started-at)
+                                       (check-expired scheduler-config service-id instance-id pod-restart-count pod-annotations primary-container-status pod-started-at)
                                        (conj :expired))
                               :healthy? (and (true? (get primary-container-status :ready))
                                              ;; Note that when exceeded-restart-kill-threshold? becomes true, the container *just* restarted and is non-ready,
@@ -350,10 +350,13 @@
                                                                   (some? state) (assoc :state state))))
                                                             container-statuses))))]
       (when exceeded-restart-kill-threshold?
-        (if (leader?-fn)
-          (kill-restart-threshold-exceeded-pod scheduler instance)
-          (log/info "skipping deleting frequently restarting pod on non-leader"
-                    {:pod-name pod-name :restart-count primary-container-restart-count :service-id service-id})))
+        (try
+          (if (leader?-fn)
+            (kill-restart-threshold-exceeded-pod scheduler-config instance)
+            (log/info "skipping deleting frequently restarting pod on non-leader"
+                      {:pod-name pod-name :restart-count primary-container-restart-count :service-id service-id}))
+          (catch Throwable e
+            (log/error e "error killing frequently restarting pod" pod-name))))
       instance)
     (catch Throwable e
       (log/error e "error converting pod to waiter service instance" pod)
@@ -426,12 +429,12 @@

 (defn- get-services
   "Get all Waiter Services (reified as ReplicaSets) running in this Kubernetes cluster."
-  [{:keys [watch-state] :as scheduler}]
+  [{:keys [watch-state] :as scheduler-config}]
   (-> watch-state deref :service-id->service vals))

 (defn- get-replicaset-pods
   "Get all Kubernetes pods associated with the given Waiter Service's corresponding ReplicaSet."
-  [{:keys [watch-state] :as scheduler} {service-id :id}]
+  [{:keys [watch-state] :as scheduler-config} {service-id :id}]
   (-> watch-state deref :service-id->pod-id->pod (get service-id) vals))

 (defn- live-pod?
@@ -443,13 +446,14 @@
   "Get all active Waiter Service Instances associated with the given Waiter Service.
    Also updates the service-id->failed-instances-transient-store as a side-effect.
    Pods reporting Failed phase status are treated as failed instances and are excluded from the return value."
-  [{:keys [service-id->failed-instances-transient-store] :as scheduler} basic-service-info]
-  (let [all-instances (for [pod (get-replicaset-pods scheduler basic-service-info)
+  [{:keys [service-id->failed-instances-transient-store] :as scheduler-config} basic-service-info]
+  (let [all-instances (for [pod (get-replicaset-pods scheduler-config basic-service-info)
                             :when (live-pod? pod)]
-                        (let [service-instance (pod->ServiceInstance scheduler pod)]
-                          (track-failed-instances! service-instance scheduler pod)
+                        (when-let [service-instance (pod->ServiceInstance scheduler-config pod)]
+                          (track-failed-instances! service-instance scheduler-config pod)
                           service-instance))
-        {active-instances false failed-instances true} (group-by #(-> % :k8s/pod-phase (= "Failed")) all-instances)]
+        {active-instances false failed-instances true}
+        (->> all-instances (remove nil?) (group-by #(-> % :k8s/pod-phase (= "Failed")) ))]
     ;; pods with Failed phase are treated as failed instances
     (doseq [{:keys [service-id] :as failed-instance} failed-instances]
       (->> (assoc failed-instance :healthy? false)
@@ -461,8 +465,8 @@
 (defn instances-breakdown!
   "Get all Waiter Service Instances associated with the given Waiter Service.
    Grouped by liveness status, i.e.: {:active-instances [...] :failed-instances [...] :killed-instances [...]}"
-  [{:keys [service-id->failed-instances-transient-store] :as scheduler} {service-id :id :as basic-service-info}]
-  {:active-instances (get-service-instances! scheduler basic-service-info)
+  [{:keys [service-id->failed-instances-transient-store] :as scheduler-config} {service-id :id :as basic-service-info}]
+  {:active-instances (get-service-instances! scheduler-config basic-service-info)
    :failed-instances (-> @service-id->failed-instances-transient-store (get service-id) vec)})

 (defn- patch-object-json
@@ -546,10 +550,10 @@
   "Force kill the Kubernetes pod corresponding to the given Waiter Service Instance.
    Does not adjust ReplicaSet replica count; preventing scheduling of a replacement pod must be ensured by the callee.
    Returns nil on success, but throws on failure."
-  [{:keys [api-server-url] :as scheduler} {:keys [service-id] :as instance}]
+  [{:keys [api-server-url] :as scheduler-config} {:keys [service-id] :as instance}]
   (let [pod-url (instance->pod-url api-server-url instance)]
     (try
-      (api-request pod-url scheduler :request-method :delete)
+      (api-request pod-url scheduler-config :request-method :delete)
       (catch Throwable t
         (log/error t "Error force-killing pod")))))

@@ -1408,9 +1412,10 @@
                         watch-socket-timeout-ms (assoc :socket-timeout-ms watch-socket-timeout-ms))
         watch-state (atom nil)
         scheduler-config {:api-server-url url
-                          :http-client http-client
                           :cluster-name cluster-name
                           :container-running-grace-secs container-running-grace-secs
+                          :http-client http-client
+                          :leader?-fn leader?-fn
                           :replicaset-api-version replicaset-api-version
                           :restart-expiry-threshold restart-expiry-threshold
                           :restart-kill-threshold restart-kill-threshold
@@ -1433,35 +1438,27 @@
           auth-renewer (when authentication
                          (start-auth-renewer authentication))
           retrieve-auth-token-state-fn (or (:query-state-fn auth-renewer) (constantly nil))
-          scheduler (->KubernetesScheduler url
-                                           authorizer
-                                           cluster-name
-                                           container-running-grace-secs
-                                           custom-options
-                                           daemon-state
-                                           fileserver
-                                           http-client
-                                           leader?-fn
-                                           log-bucket-url
-                                           max-patch-retries
-                                           max-name-length
-                                           pdb-api-version
-                                           pdb-spec-builder-fn
-                                           pod-base-port
-                                           pod-sigkill-delay-secs
-                                           pod-suffix-length
-                                           replicaset-api-version
-                                           replicaset-spec-builder-fn
-                                           restart-expiry-threshold
-                                           restart-kill-threshold
-                                           retrieve-auth-token-state-fn
-                                           retrieve-syncer-state-fn
-                                           reverse-proxy
-                                           service-id->failed-instances-transient-store
-                                           service-id->password-fn
-                                           service-id->service-description-fn
-                                           scheduler-name
-                                           watch-state)
+          extended-scheduler-config (assoc scheduler-config
+                                      :authorizer authorizer
+                                      :custom-options custom-options
+                                      :daemon-state daemon-state
+                                      :fileserver fileserver
+                                      :log-bucket-url log-bucket-url
+                                      :max-patch-retries max-patch-retries
+                                      :max-name-length max-name-length
+                                      :pdb-api-version pdb-api-version
+                                      :pdb-spec-builder-fn pdb-spec-builder-fn
+                                      :pod-base-port pod-base-port
+                                      :pod-sigkill-delay-secs pod-sigkill-delay-secs
+                                      :pod-suffix-length pod-suffix-length
+                                      :replicaset-spec-builder-fn replicaset-spec-builder-fn
+                                      :retrieve-auth-token-state-fn retrieve-auth-token-state-fn
+                                      :retrieve-syncer-state-fn retrieve-syncer-state-fn
+                                      :reverse-proxy reverse-proxy
+                                      :service-id->password-fn service-id->password-fn
+                                      :service-id->service-description-fn service-id->service-description-fn
+                                      :scheduler-name scheduler-name)
+          scheduler (map->KubernetesScheduler extended-scheduler-config)
           pod-watch-thread (start-pods-watch! scheduler watch-options)
           rs-watch-thread (start-replicasets-watch! scheduler watch-options)]
       (reset! daemon-state {:pod-watch-daemon pod-watch-thread


Fix bad symbol names in random

Fix bad symbol names in random

--- src/main/clojure/lazytest/random.clj
+++ src/main/clojure/lazytest/random.clj
@@ -20,7 +20,7 @@
   are :min (inclusive) and :max (exclusive). Defaults are
   min-random-integer and max-random-integer."
   (let [{:keys [min max]
-	 :or {min min-integer, max max-integer}} options]
+	 :or {min min-random-integer, max max-random-integer}} options]
     (fn [] (rand-int-in-range min max))))

 (defn rand-double-in-range
@@ -40,7 +40,7 @@
   and :max. Defaults are min-random-double and max-random-double."
   [& options]
   (let [{:keys [min max]
-	 :or {min min-integer, max max-integer}} options]
+	 :or {min min-random-double, max max-random-double}} options]
     (fn [] (rand-double-in-range min max))))

 (def ^{:doc "Default minimum length for random collections"}


fix str->int parsing error

fix str->int parsing error

--- src/cljam/util.clj
+++ src/cljam/util.clj
@@ -49,10 +49,25 @@
                        from-hex-digit (nth s (inc (* % 2)))))
         (range (count s)))))

-(defn str->int [str]
-  (try
-    (Integer. ^String (re-find #"\d+" str))
-    (catch Exception e nil)))
+(defn str->long [s]
+  (if-not (nil? s)
+    (try
+      (let [[n _ _] (re-matches #"(|-|\+)(\d+)" s)]
+        (Long. n))
+      (catch Exception e
+        nil))
+    nil))
+
+(defn str->int [s]
+  (if-not (nil? s)
+    (try
+      (let [[n _ _] (re-matches #"(|-|\+)(\d+)" s)]
+        (Integer. n))
+      (catch NumberFormatException e
+        (str->long s))
+      (catch Exception e
+        nil))
+    nil))

 (defn graph?
   "Returns true if c is a visible character, false if not."


whitespace

whitespace

--- src/bzzz/index.clj
+++ src/bzzz/index.clj
@@ -41,7 +41,9 @@
 (defn new-index-writer ^IndexWriter [name]
   (IndexWriter. (new-index-directory name)
                 (IndexWriterConfig. *version* @analyzer*)))
+
 (def taxo-prefix "__taxo-")
+
 (defn taxo-dir-name [name]
   (str taxo-prefix (as-str name)))

@@ -109,7 +111,7 @@
     (conj
      m
      (when explanation (assoc m :_explain (.toString explanation)))
-     (when highlighted   (assoc m :_highlight highlighted)))))
+     (when highlighted (assoc m :_highlight highlighted)))))

 (defn get-search-manager ^SearcherManager [index]
   (locking mapping*


Add full stops to sentences.

Add full stops to sentences.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -55,8 +55,8 @@
                                  (connected-rooms (:room player) this)))
             (creturn
              (assoc this :player (assoc player :room (get rooms name)))
-             (str "You are in the " name))
-            (creturn this (str "You cannot go into the " name)))))))
+             (str "You are in the " name "."))
+            (creturn this (str "You cannot go into the " name ".")))))))
   (look [this arguments-str]
     (let [arguments (extract-arguments arguments-str)]
       (if (empty? arguments)


Rename to num-events.

Rename to num-events.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -33,14 +33,14 @@
         w [{:last-id (atom 0)
             :event-ch event-ch
             :chs (atom {}) :tot-chs 0}]]
-    (go-loop [t 0]
+    (go-loop [num-events 0]
       (let [tdv @event-delay]
         (when (> tdv 0)
           (<! (timeout tdv))))
-      (let [event [t (<! event-ch)]]
-        (println event)
-        (set-el-innerHTML "event" event))
-      (recur (inc t)))
+      (let [event (<! event-ch)]
+        (println num-events event)
+        (set-el-innerHTML "event" [num-events event]))
+      (recur (inc num-events)))
     (ago w-actx w
          (while true
            (.log js/console (<! clicks))


update instructions

update instructions

--- src/chat/client/views/threads.cljs
+++ src/chat/client/views/threads.cljs
@@ -209,7 +209,7 @@
                            :onClick (fn [_] (store/clear-error!))}
               "×")))
         (dom/div #js {:className "instructions"}
-          "Tag a conversation with /... Mention tags with #... and users with @...")
+          "Tag a conversation with /... Mention tags with #... and users with @... Emoji :shortcode: support too!")
         (om/build user-modal-view data)
         (om/build sidebar-view {})
         (apply dom/div #js {:className "threads"}


Add in-processing step to visibility calculation to reduce artifacts

--- src/cljc/robinson/lineofsight.cljc
+++ src/cljc/robinson/lineofsight.cljc
@@ -60,6 +60,7 @@
         (butlast
           (map (fn [[x y]] [(+ ox x) (+ oy y)])
                (line-segment [0 0] [(- dx ox) (- dy oy)]))))))))
+

 (defn square-points [x0 y0 radius]
   (letfn [(points [x y m]
@@ -128,6 +129,24 @@
              {}
              m))

+(defn adj-xys
+  [x y]
+  [[(inc x) y]
+   [(dec x) y]
+   [x (inc y)]
+   [x (dec y)]])
+
+(defn assoc-adj [m [x y] exclude-subtree?]
+  (reduce (fn [m k]
+            (log/info "testing" k)
+            (if (exclude-subtree? k)
+              (do
+                (log/info "adding post-process" k)
+                (assoc m k {}))
+              m))
+          m
+          (adj-xys x y)))
+
 ;; cull subtries with parent keys if `(exclude-subree? key)` is false.
 (defn cull-trie [exclude-subtree? trie]
   (w/prewalk (fn [m] (if (and (map? m)
@@ -135,7 +154,9 @@
                        (reduce-kv (fn [m k v]
                                     (if (exclude-subtree? k)
                                       (assoc m k {})
-                                      (assoc m k v)))
+                                      (-> m
+                                        (assoc k v)
+                                        (assoc-adj k exclude-subtree?))))
                                   {}
                                   m)
                        m))
@@ -152,6 +173,14 @@
       :leaf
       (log/info "got leaf" (z/node t)))))

+(defn conj!-adj [children [x y] exclude-subtree?]
+  (reduce (fn [children xy]
+            (if (exclude-subtree? xy)
+              (conj! children {xy {}})
+              children))
+          children
+          (adj-xys x y)))
+
 (defn cull-trie->keys [exclude-subtree? trie]
   (loop [t  (z/zipper ; branch?
                       map?
@@ -161,7 +190,9 @@
                           (reduce-kv (fn [children xy subtree]
                                        (if (exclude-subtree? xy)
                                          children
-                                         (conj! children subtree)))
+                                         (-> children
+                                           (conj! subtree)
+                                           (conj!-adj xy exclude-subtree?))))
                                      (transient [])
                                      node)))
                       ; make node


Hide things.

Hide things.

--- src/cljs/nested_sortable/tree.cljs
+++ src/cljs/nested_sortable/tree.cljs
@@ -115,8 +115,7 @@
    [:div
     (if-not is-root?
       [:div
-       [display node path]
-       ])
+       [display node path]])
     [:div.children
      (if (:add-as-child @state)
        [placeholder display path])
@@ -129,8 +128,7 @@
 (defn tree [root-node]
   (let [display (fn [item path]
                   [:div.node
-                   (:name item)
-                   (str " " path)])]
+                   (:name item)])]
     [:div.tree
      {:on-drag-over allow-drop
       :on-drag-enter allow-drop


Fix input id

Fix input id

--- src/cljs/salava/user/ui/input.cljs
+++ src/cljs/salava/user/ui/input.cljs
@@ -50,7 +50,7 @@
     (fn []
       [:div.input-group
        [:input {:class       "form-control"
-                :id          (str "input-" name)
+                :id          (str "input-emailwhitelist")
                 :name        "email-text"
                 :type        "text"


Make new zipper data work in diagram

Make new zipper data work in diagram

--- src/gigrig/components/diagram.cljs
+++ src/gigrig/components/diagram.cljs
@@ -39,21 +39,17 @@

 (defn child [loc]
   (case (gzip/loc-type loc)
-    :pedal (boxes/boxed-text (gzip/box-meta loc))))
-
-(defn map-siblings [f loc]
-  (if (= (zip/rightmost loc) loc)
-    [(f loc)]
-    (cons (f loc) (map-siblings f (zip/right loc)))))
+    :pedal (boxes/boxed-text (gzip/box-meta loc))
+    :distributor [tree loc]))

 (defn tree [loc]
-  [:g]
   (let [root (gzip/box-meta loc)
         children (align (zip/down loc) (- (:x root) ROOT-OFFSET) (+ (:y root) CHILDREN-OFFSET))]
+    ^{:key (str (-> root :text :value) (:x root) (:y root))}
     [:g
-     [lines (line/connect-trident root (map-siblings gzip/box-meta (zip/leftmost children)))]
+     [lines (line/connect-trident root (gzip/map-siblings gzip/box-meta (zip/leftmost children)))]
      [boxes/boxed-text root]
-     (map-siblings child (zip/leftmost children))]))
+     (seq (gzip/map-siblings child (zip/leftmost children)))]))

 (defn component [{:keys [zipper]}]
   (let [generator (boxes/generator {:x 0 :y 0})]


Throw if aws/invoke returns an error

Throw if aws/invoke returns an error

We were silently ignoring failures before this change.

--- src/clojars/s3.clj
+++ src/clojars/s3.clj
@@ -15,14 +15,21 @@
   (-list-objects [client prefix])
   (-put-object [client key stream opts]))

+(defn- throw-on-error
+  [v]
+  (if (some? (:cognitect.anomalies/category v))
+    (throw (ex-info "S3 request failed" v))
+    v))
+
 (defn- list-objects-chunk
   [client bucket-name prefix marker]
   (let [request (cond-> {:Bucket bucket-name}
                   prefix (assoc :Prefix prefix)
                   marker (assoc :Marker marker))]
-    (aws/invoke client
-                {:op :ListObjects
-                 :request request})))
+    (throw-on-error
+      (aws/invoke client
+                  {:op :ListObjects
+                   :request request}))))

 (defn- list-objects-seq
   "Generates a lazy seq of objects, chunked by the API's paging."
@@ -50,31 +57,41 @@
 (defrecord S3Client [s3 bucket-name]
   S3Bucket
   (-delete-object [_ key]
-    (aws/invoke s3 {:op :DeleteObject
-                    :request {:Bucket bucket-name
-                              :Key key}}))
+    (->> {:op :DeleteObject
+          :request {:Bucket bucket-name
+                    :Key key}}
+         (aws/invoke s3)
+         (throw-on-error)))
+
   (-get-object-details [_ key]
-    (-> {:op :HeadObject
-         :request {:Bucket bucket-name
-                   :Key key}}
-        (as-> % (aws/invoke s3 %))
-        (not-found->nil)
-        (strip-etag)))
+    (->> {:op :HeadObject
+          :request {:Bucket bucket-name
+                    :Key key}}
+         (aws/invoke s3)
+         (not-found->nil)
+         (throw-on-error)
+         (strip-etag)))
+
   (-get-object-stream [_ key]
-    (-> {:op :GetObject
-         :request {:Bucket bucket-name
-                   :Key key}}
-        (as-> % (aws/invoke s3 %))
-        (not-found->nil)
-        :Body))
+    (->> {:op :GetObject
+          :request {:Bucket bucket-name
+                    :Key key}}
+         (aws/invoke s3)
+         (not-found->nil)
+         (throw-on-error)
+         :Body))
+
   (-list-objects [_ prefix]
     (map strip-etag (list-objects-seq s3 bucket-name prefix nil)))
+
   (-put-object [_ key stream opts]
-    (aws/invoke s3 {:op :PutObject
-                    :request (merge {:Bucket bucket-name
-                                     :Key key
-                                     :Body stream}
-                                    opts)})))
+    (->> {:op :PutObject
+          :request (merge {:Bucket bucket-name
+                           :Key key
+                           :Body stream}
+                          opts)}
+         (aws/invoke s3)
+         (throw-on-error))))

 (defn s3-client
   [access-key-id secret-access-key region bucket]


Enable console print to fix prod app crash

--- src/mobile_patient/android/core.cljs
+++ src/mobile_patient/android/core.cljs
@@ -4,6 +4,8 @@
             [mobile-patient.routes :refer [routes]]
             [mobile-patient.events]
             [mobile-patient.subs]))
+
+(enable-console-print!)

 (def ReactNative (js/require "react-native"))
 (def app-registry (.-AppRegistry ReactNative))


enhance comparative and non-comparative

enhance comparative and non-comparative

--- src/babel/pos.cljc
+++ src/babel/pos.cljc
@@ -161,11 +161,19 @@

 ;; "Y is Xer than Z".
 (def comparative
-  {:synsem {:sem {:comparative true}
-            :cat :adjective
-            :subcat {:1 {:cat :noun}
-                     :2 {:cat :prep
-                         :subcat '()}}}})
+  (let [complement-sem (atom :top)
+        subject-sem (atom :top)]
+    {:synsem {:sem {:comparative true
+                    :arg1 subject-sem
+                    :arg2 complement-sem}
+              :cat :adjective
+              :subcat {:1 {:cat :noun
+                           :sem subject-sem}
+                       :2 {:cat :prep
+                           :sem {:pred :di ;; Italian name for pred, for now: TODO: change to English :than.
+                                 :obj complement-sem}
+                           :subcat {:1 {:sem complement-sem}
+                                    :2 '()}}}}}))

 (def pronoun-acc (atom :acc))

@@ -173,9 +181,12 @@
                                 :2 '()}}})

 ;; "Y is X."
-;; TODO: put semantics here.
 (def non-comparative-adjective
-  subcat1)
+  (let [subject (atom :top)]
+    (unifyc
+     subcat1
+     {:synsem {:sem {:arg1 subject}
+               :subcat {:1 {:sem subject}}}})))

 (def comp-sem (atom {:activity false
                     :discrete false}))


Catch .getExpressionType exceptions

Catch .getExpressionType exceptions

--- src/quark/tree_tokenizer.clj
+++ src/quark/tree_tokenizer.clj
@@ -1,3 +1,6 @@
+;; Convert a C/C++/Header file into an edn representation containing the
+;; structure and (partial) type information of the AST
+
 (ns quark.tree-tokenizer
   (:require [atom-finder.util :refer :all]
             [atom-finder.constants :refer :all]
@@ -19,7 +22,9 @@

 (defn expr-typename
   [node]
-  (let [expr-type (.getExpressionType node)]
+  (let [expr-type (log-err (str "Exception getting expression type for [file node] "
+                                [(filename node) (tree-path node)]) nil
+                           (-> node .getExpressionType))]
     (condp instance? expr-type
         IProblemBinding "problem-binding"
         IProblemType "problem-type"
@@ -54,7 +59,10 @@
           src-file (c-files src-path)
           :let [src-filename (.getAbsolutePath src-file)
                 out-filename (str (str/replace src-filename src-path out-path) ".edn")]]
+    ;(pprn src-filename)
     (clojure.java.io/make-parents out-filename)
     (->> src-filename parse-file to-edn (spit out-filename))))

-'((time-mins (src-dir-to-edn linux-path "tmp/src-to-edn/linux")))
+'((time-mins (src-dir-to-edn linux-path "tmp/src-to-edn/linux3")))
+
+


Fix main.

Fix main.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -102,20 +102,20 @@
                        out-fn))
           in-fn (cond
                   (nil? in-data) (fn [] (.inc in-cntr))
-                  (= scenario "pcap-direct") (fn [d]
-                                               (proc-fn d)
-                                               (.inc in-cntr))
-                  :default (get-in-fn pipeline))
+                  :default (if (not (nil? pipeline))
+                             (get-in-fn pipeline)))
           in-loop (ProcessingLoop.
                     "InLoop"
-                    (if (not (nil? in-data))
-                      (fn []
-                        (doseq [i (repeat 1000 0)]
-                          (in-fn in-data)
-                          (.inc in-cntr))
-                        (sleep 1))
-                      (fn []
-                        (.inc in-cntr))))
+                    (cond
+                      (= "pcap-direct" scenario) (fn []
+                                                   (proc-fn in-data)
+                                                   (.inc in-cntr))
+                      (not (nil? in-data)) (fn []
+                                             (doseq [i (repeat 1000 0)]
+                                               (in-fn in-data)
+                                               (.inc in-cntr))
+                                             (sleep 1))
+                      :default (fn [] (.inc in-cntr))))
           thread-info-fn (create-thread-info-fn)
           stats-fn (fn []
                      (let [in (double (/ (.value in-cntr) 1000.0))


synched app-state and csv referenced csv from app

--- src/unspun/db.cljs
+++ src/unspun/db.cljs
@@ -9,10 +9,13 @@

 (def max-nn 1000)                                           ; maximum number needed to treat

+(def winton-csv " https://www.dropbox.com/s/hk1co7elsw8bcvd/risk-app-data.csv?dl=0")
+
 ;;;
 ;; APP-STATE
 ;;;
-(def scenarios {:bacon   {:icon            "ios-man"
+(def scenarios {:bacon   {:tags            ["food" "bowel" "cancer"]
+                          :icon            "ios-man"
                           :subjects        ["person" "people"]
                           :exposure        "eating a bacon sandwich every day"
                           :baseline-risk   0.06
@@ -24,7 +27,8 @@
                           :without         "Normal"
                           :causative       false
                           }
-                :hrt5    {:icon            "ios-woman"
+                :hrt5    {:tags            ["preventitive" "breast" "cancer" "osteoporosis"]
+                          :icon            "ios-woman"
                           :subjects        ["woman" "women in their 50s"]
                           :exposure        "taking HRT for 5 years"
                           :baseline-risk   0.1
@@ -36,7 +40,8 @@
                           :without         "No HRT"
                           :causative       false
                           }
-                :wine    {:icon            "ios-wine"
+                :wine    {:tags            ["alcohol" "breast" "cancer"]
+                          :icon            "ios-wine"
                           :subjects        ["woman" "women"]
                           :exposure        "drinking half a bottle of wine a day"
                           :baseline-risk   0.12
@@ -48,7 +53,8 @@
                           :without         "Not drinking"
                           :causative       false
                           }
-                :wdoc    {:icon            "ios-person"
+                :wdoc    {:tags            ["gender" "care"]
+                          :icon            "ios-person"
                           :subjects        ["person" "US people over 65 admitted to hospital under Medicare"]
                           :exposure        "being seen by a female doctor"
                           :baseline-risk   0.115
@@ -60,7 +66,8 @@
                           :without         "Male doctor"
                           :causative       false
                           }
-                :statins {:icon            "ios-contact"
+                :statins {:tags            ["preventitive" "medication"]
+                          :icon            "ios-contact"
                           :subjects        ["person" "people just within NICE guidelines for prescribing statins"]
                           :exposure        "taking statins each day"
                           :baseline-risk   0.1
@@ -72,6 +79,8 @@
                           :without         "No statins"
                           :causative       true
                           }})
+
+

 (defn initial-stories []
@@ -187,12 +196,12 @@
          outcome-pp (str (present-participle outcome-verb) " " outcome)
          outcome-text (if (> relative-risk 1)
                         (str "would " outcome-inf " anyway. ")
-                        (str "would still " outcome-inf". ")
+                        (str "would still " outcome-inf ". ")
                         )]
      (if causative
        ["On average, for "                                  ; head
         (str "one " (extra relative-risk) " " (singular-form subjects) " ") ; mark-one
-        (format "to ~a, " outcome-inf)                 ; one-to-group
+        (format "to ~a, " outcome-inf)                      ; one-to-group
         (format "~d more " nn)                              ; group
         (format (str (n-plural-form subjects) " would need to be ~a. Of these, ") nn exposure) ; group-to-anyway
         (format "~d " anyway-count)                         ;anyway
@@ -200,7 +209,7 @@
         ]
        ["On average, for "                                  ; head
         (str "one " (extra relative-risk) " " (singular-form subjects) " ") ; mark-one
-        (format "to ~a, we would need " outcome-inf)   ; one-to-group
+        (format "to ~a, we would need " outcome-inf)        ; one-to-group
         (format "a group of ~d more " nn)                   ; group
         (format (str (n-plural-form subjects) " ~a. Of these, ") nn exposure) ; group-to-anyway
         (format "~d " anyway-count)                         ;anyway


Use map-entry instead of vectors for pairing

--- src/useful/map.clj
+++ src/useful/map.clj
@@ -40,7 +40,7 @@
   [f m]
   (into {}
         (for [[k v] m]
-          [k (f v)])))
+          (map-entry k (f v)))))

 (defn map-vals-with-keys
   "Create a new map from m by calling function f, with two arguments (the key and value)
@@ -48,7 +48,7 @@
   [f m]
   (into {}
         (for [[k v] m]
-          [k (f k v)])))
+          (map-entry k (f k v)))))

 (defn map-keys-and-vals
   "Create a new map from m by calling function f on each key & each value to get a new key & value"
@@ -100,19 +100,19 @@
   [f coll]
   (into {}
         (for [item coll]
-          [item (f item)])))
+          (map-entry item (f item)))))

 (defn index-by
   "Returns a map from the result of calling f on each item in coll to that item."
   [f coll]
   (into {}
         (for [item coll]
-          [(f item) item])))
+          (map-entry (f item) item))))

 (defn position
   "Returns a map from item to the position of its first occurence in coll."
   [coll]
-  (into {} (reverse (map-indexed (fn [idx val] [val idx]) coll))))
+  (into {} (reverse (map-indexed (fn [idx val] (map-entry val idx)) coll))))

 (defn filter-keys-by-val
   "Returns all keys in map for which (pred value) returns true."


'alet' docstring

'alet' docstring

--- src/cats/core.cljc
+++ src/cats/core.cljc
@@ -361,8 +361,52 @@
         (range join-count))))

 #?(:clj
-   (defmacro alet
-    "TODO"
+  (defmacro alet
+    "Applicative composition macro similar to Clojure's
+    `let`. This macro facilitates composition of applicative
+    computations using `fmap` and `fapply` and evaluating
+    applicative values in parallel.
+
+    Let's see an example to understand how it works.
+    This code uses fmap for executing computations inside
+    an applicative context:
+
+      (fmap (fn [a] (inc a)) (just 1))
+      ;=> #<Just [2]>
+
+    Now see how this code can be made clearer
+    by using the alet macro:
+
+      (alet [a (just 1)]
+        (inc a))
+      ;=> #<Just [2]>
+
+    Let's look at a more complex example, imagine we have
+    dependencies between applicative values:
+
+      (join
+        (fapply
+         (fmap
+           (fn [a]
+             (fn [b]
+               (fmap (fn [c] (inc c))
+                     (just (+ a b)))))
+           (just 1))
+         (just 2)))
+      ;=> #<Just [4]>
+
+    This is greatly simplified using `alet`:
+
+      (alet [a (just 1)
+             b (just 2)
+             c (just (+ a b))]
+        (inc c))
+     ;=> #<Just [4]>
+
+    The intent of the code is much clearer and evaluates `a` and `b`
+    at the same time, then proceeds to evaluate `c` when all the values
+    it depends on are available. This evaluation strategy is specially
+    helpful for asynchronous applicatives."
     [bindings body]
     (when-not (and (vector? bindings)
                    (not-empty bindings)


Remove some redundant usage of with-context macro.


add note.

add note.

--- src/pepa/model.clj
+++ src/pepa/model.clj
@@ -398,6 +398,7 @@
   (db/with-transaction [db db]
     (->> (db/query db ["SELECT page FROM inbox"])
          (map :page)
+         ;; `get-pages' takes care of grouping/sorting
          (get-pages db))))

 (defn add-to-inbox!


Bind quiescent/*component* when calling on-initial-render callback fn

--- src/quiescent.cljs
+++ src/quiescent.cljs
@@ -72,7 +72,8 @@
           (fn [node]
             (this-as this
               (when-let [f (aget (.-props this) "onMount")]
-                       (f node))))}))
+                (binding [*component* this]
+                  (f node)))))}))

 (defn on-update
   "Wrap a component, specifying a function to be called on the


Remove obsolete group reservation.

Remove obsolete group reservation.

--- src/clojars/db.clj
+++ src/clojars/db.clj
@@ -148,7 +148,7 @@
                             "and full-stops."))))
   (let [members (group-members group)]
     (if (empty? members)
-      (if (or (find-user group) (*reserved-names* group))
+      (if (*reserved-names* group)
         (throw (Exception. (str "The group name " group " is already taken.")))
         (add-member group account))
       (when-not (some #{account} members)


Put obj names into objs over whole ctx as a single move at the beginning.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -50,6 +50,10 @@
   (let [env (interpreter/interpret
              (parser/parse story-str)
              (library/get-initial-env types (get-story-ctx)))
+  (let [raw-env (interpreter/interpret
+                 (parser/parse story-str)
+                 (library/get-initial-env types (get-story-ctx)))
+        env (assoc raw-env :ctx (name-into-objs (:ctx raw-env)))
         ctx (interpreter/resolve- (:ctx env) env)

         rooms (seq-to-hash (name-into-objs


Problem 0066.

Problem 0066.

--- src/project_euler/problem_0066.clj
+++ src/project_euler/problem_0066.clj
@@ -48,7 +48,9 @@
   (let [a' (int-sqrt x)]
     (if (< (- x (sqr a')) (- (sqr (+ 1 a')) x)) a' (+ 1 a'))))

-(defn diophantine-solution [d x]
+(defn diophantine-solution
+  "Naive solution !!! Doesn't work :("
+  [d x]
   (let [x2-1 (- (* x x) 1)]
     (if (zero? (rem x2-1 d))
       (let [y2 (/ x2-1 d)
@@ -58,7 +60,9 @@
           nil))
       nil)))

-(defn diophantine-min-solution-in-x [d]
+(defn diophantine-min-solution-in-x
+  "Naive solution !!! Doesn't work :("
+  [d]
   (->> (iterate inc 2)
        (map (fn [x]
               [x  (diophantine-solution d x)]))
@@ -66,20 +70,39 @@
        (first)
        ))

-(defn chakravala [d]
-  (let [a  (nearest-int-sqrt d)
-        b  1
-        k  (- (sqr a) d)]
-    (println "a b k : " a b k)
+(defn abs [x] (if (< x 0) (- x) x))
+
+(defn mod [x y] (rem (+ y (rem x y)) y))
+
+(defn chakravala
+  "From : http://www.isibang.ac.in/~sury/chakravala.pdf"
+  [n]
+  (let [sqrt-n (int-sqrt n)
+        p0  (int-sqrt n)
+        q0  1
+        m0  (- (sqr p0) n)
+        x0  p0]
+    (loop [p0 p0, q0 q0, m0 m0, x0 x0]
+      (if (== m0 1)
+        [p0 q0]
+        (let [abs-m0 (abs m0)
+              r  (mod (- x0) abs-m0)
+              x1 (+ (* (quot (- sqrt-n r) abs-m0) abs-m0) r)
+              p1 (/ (+ (* p0 x1) (* n q0)) abs-m0)
+              q1 (/ (+ p0 (* x1 q0)) abs-m0)
+              m1 (/ (- (sqr x1) n) m0)]
+          (recur p1 q1 m1 x1))))

     ))

 (defn solution []
-  (->> (range 2 1001)
+  (->> (range 2N 1001)
        (remove is-square?)
-       (map (fn [d] (let [[x y] (diophantine-min-solution-in-x d)]
+       (map (fn [d] (let [[x y] (chakravala d)]
                       [x d])))
        (sort)
        (last)
        (second)
        ))
+
+;;-> 661


create-tracker method

create-tracker method

--- src/ruuvi_server/models/entities.clj
+++ src/ruuvi_server/models/entities.clj
@@ -118,6 +118,13 @@
           (set-fields {:latest_activity (java.sql.Timestamp. (System/currentTimeMillis)) })
           (where {:id id})))

+(defn create-tracker [code name shared-secret]
+  (info "Create new tracker" name "(" code ")")
+  (insert tracker (values
+                   {:tracker_identifier code
+                    :shared_secret shared-secret
+                    :name name})))
+
 (defn create-event [data]
   (let [extension-keys (filter (fn [key]
                                  (.startsWith (str (name key)) "X-"))


RP + RS | 167 | loading public-key from file on each request

--- src/stonecutter_client/handler.clj
+++ src/stonecutter_client/handler.clj
@@ -96,7 +96,8 @@
     (if-let [auth-code (get-in request [:params :code])]
       (let [token-response (client/request-access-token! stonecutter-config auth-code)
             access-token (:access_token token-response)
-            user-info (jwt/decode stonecutter-config (:id_token token-response))]
+            public-key (public-key)
+            user-info (jwt/decode (assoc stonecutter-config :public-key public-key) (:id_token token-response))]
         (logged-in-redirect protocol access-token user-info))
       (r/redirect (absolute-path :home)))))


Check dir in specificity-sort

Check dir in specificity-sort

--- src/lt/object.cljs
+++ src/lt/object.cljs
@@ -47,7 +47,7 @@
     (doseq [x xs]
       (.push arr #js [(count (string/split (str x) ".")) (str x) x]))
     (.sort arr)
-    (.reverse arr)
+    (when-not dir (.reverse arr))
     (amap arr i _ (aget arr i 2))))

 (defn tags->behaviors [ts]


fix reversing of behaviors when they're translated to triggers

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/object.cljs
+++ src/lt/object.cljs
@@ -40,7 +40,7 @@
   (let [result (atom (transient {}))]
     (doseq [beh behs
             t (:triggers (->behavior beh))]
-      (swap! result assoc! t (conj (or (get @result t) '()) beh)))
+      (swap! result assoc! t (conj (or (get @result t) '[]) beh)))
     (persistent! @result)))

 (defn specificity-sort


Add the library number to the catalog view

--- src/mdr2/views.clj
+++ src/mdr2/views.clj
@@ -134,13 +134,15 @@
      (when error
        [:p [:ul.alert.alert-danger [:li error]]])
      [:table.table.table-striped
-      [:thead [:tr [:th "Title"] [:th "Product Number"] [:th "DAM Number"] [:th "Total time"] [:th "Number of CDs"] [:th "Depth"] [:th "Narrator"] [:th "Date of Production"] [:th "Libary signature"]]]
+      [:thead [:tr [:th "Title"] [:th "Product Number"] [:th "Library Number"] [:th "DAM Number"] [:th "Total time"] [:th "Number of CDs"] [:th "Depth"] [:th "Narrator"] [:th "Date of Production"] [:th "Libary signature"]]]
       [:tbody
-       (for [{:keys [id title product_number total_time volumes depth narrator produced_date]
+       (for [{:keys [id title product_number library_number
+                     total_time volumes depth narrator produced_date]
               :as production} (prod/find-by-state "encoded")]
          [:tr
           [:td (link-to (str "/production/" id) title)]
           [:td product_number]
+          [:td library_number]
           [:td (prod/dam-number production)]
           [:td (quot total_time (* 1000 60))] ; in minutes
           [:td volumes]


fixes #368

fixes #368

Former-commit-id: 2c72274025a3f8ea3866dd337571d0777b9b467e

--- src/status_im/protocol/handlers.cljs
+++ src/status_im/protocol/handlers.cljs
@@ -63,12 +63,12 @@

 (register-handler :initialize-sync-listener
   (fn [{:keys [web3 sync-listener] :as db} _]
-    (when sync-listener
-      (.stopWatching sync-listener))
-    (->> (.isSyncing (.-eth web3)
-                     (fn [error sync]
-                       (dispatch [:update-sync-state error sync])))
-         (assoc db :sync-listener))))
+    (if-not sync-listener
+      (->> (.isSyncing (.-eth web3)
+                       (fn [error sync]
+                         (dispatch [:update-sync-state error sync])))
+           (assoc db :sync-listener))
+      db)))

 (register-handler :incoming-message
   (u/side-effect!


fix extraction on zdt and offset dt

fix extraction on zdt and offset dt

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -364,6 +364,15 @@
   (time [odt] (cljc.java-time.offset-date-time/to-local-time odt))
   (date [odt] (cljc.java-time.offset-date-time/to-local-date odt))
   (date-time [odt] (cljc.java-time.offset-date-time/to-local-date-time odt))
+  (nanosecond [t] (cljc.java-time.offset-date-time/get t cljc.java-time.temporal.chrono-field/nano-of-second))
+  (microsecond [t] (cljc.java-time.offset-date-time/get t cljc.java-time.temporal.chrono-field/micro-of-second))
+  (millisecond [t] (cljc.java-time.offset-date-time/get t cljc.java-time.temporal.chrono-field/milli-of-second))
+  (second [t] (cljc.java-time.offset-date-time/get-second t))
+  (minute [t] (cljc.java-time.offset-date-time/get-minute t))
+  (hour [t] (cljc.java-time.offset-date-time/get-hour t))
+  (day-of-week [t] (cljc.java-time.offset-date-time/get-day-of-week t))
+  (day-of-month [t] (cljc.java-time.offset-date-time/get-day-of-month t))
+  (month [zdt] (cljc.java-time.offset-date-time/get-month zdt))
   (year [odt] (p/year (cljc.java-time.offset-date-time/get-year odt)))
   (zone-offset [odt] (cljc.java-time.offset-date-time/get-offset odt))

@@ -372,8 +381,8 @@
   (date [zdt] (cljc.java-time.zoned-date-time/to-local-date zdt))
   (date-time [zdt] (cljc.java-time.zoned-date-time/to-local-date-time zdt))
   (nanosecond [t] (cljc.java-time.zoned-date-time/get t cljc.java-time.temporal.chrono-field/nano-of-second))
-  (microsecond [t] (cljc.java-time.local-time/get t cljc.java-time.temporal.chrono-field/micro-of-second))
-  (millisecond [t] (cljc.java-time.local-time/get t cljc.java-time.temporal.chrono-field/milli-of-second))
+  (microsecond [t] (cljc.java-time.zoned-date-time/get t cljc.java-time.temporal.chrono-field/micro-of-second))
+  (millisecond [t] (cljc.java-time.zoned-date-time/get t cljc.java-time.temporal.chrono-field/milli-of-second))
   (second [t] (cljc.java-time.zoned-date-time/get-second t))
   (minute [t] (cljc.java-time.zoned-date-time/get-minute t))
   (hour [t] (cljc.java-time.zoned-date-time/get-hour t))


Add path rendering support for view app.

--- src/uxbox/view/ui/viewer/shapes.cljs
+++ src/uxbox/view/ui/viewer/shapes.cljs
@@ -15,6 +15,7 @@
             [uxbox.main.ui.shapes.text :refer (text-shape)]
             [uxbox.main.ui.shapes.group :refer (group-shape)]
             [uxbox.main.ui.shapes.line :refer (line-shape)]
+            [uxbox.main.ui.shapes.path :refer (path-shape)]
             [uxbox.main.ui.shapes.circle :refer (circle-shape)]
             [uxbox.view.ui.viewer.interactions :as itx])
   (:import goog.events.EventType))
@@ -67,6 +68,7 @@
     :line (line-shape shape)
     :icon (icon-shape shape)
     :rect (rect-shape shape)
+    :path (path-shape shape)
     :circle (circle-shape shape)))

 (mx/defc shape


add custom format to content disposition header

--- src/vignette/util/image_response.clj
+++ src/vignette/util/image_response.clj
@@ -4,6 +4,7 @@
             [ring.util.response :refer [response status header]]
             [digest :as digest]
             [vignette.media-types :refer :all]
+            [vignette.util.query-options :refer :all]
             [vignette.storage.local :refer [create-stored-object]]
             [vignette.storage.protocols :refer :all]
             [vignette.util.thumbnail :refer :all]))
@@ -49,9 +50,10 @@

 (defn add-content-disposition-header
   [response-map image-map]
-  (header response-map "Content-Disposition"
-          (format "inline; filename=\"%s\""
-                  (original image-map))))
+  (let [requested-format (query-opt image-map :format)
+        filename (cond-> (original image-map)
+                         requested-format (str "." requested-format))]
+    (header response-map "Content-Disposition" (format "inline; filename=\"%s\"" filename))))

 (defn add-surrogate-header
   [response-map image-map]


handle fire direction too

handle fire direction too

--- src/voke/core.cljs
+++ src/voke/core.cljs
@@ -6,8 +6,8 @@
                    [schema.core :as sm])
   (:use [cljs.core.async :only [chan <! >! put! timeout]]))

-(sm/defschema MoveDirection (s/enum :up :right :down :left))
-(sm/defschema IntendedMoveDirection #{MoveDirection})
+(sm/defschema Direction (s/enum :up :right :down :left))
+(sm/defschema IntendedDirection #{Direction})

 (sm/defschema Entity {:id                         s/Int
                       (s/maybe :position)         {:x s/Num
@@ -15,16 +15,19 @@
                       (s/maybe :collision-box)    {:width  s/Int
                                                    :height s/Int}
                       (s/maybe :render-info)      {:shape (s/enum :square)}
-                      (s/maybe :human-controlled) {:indended-move-direction IntendedMoveDirection
-                                                   :intended-fire-direction s/Any}})
+                      (s/maybe :human-controlled) {:indended-move-direction IntendedDirection
+                                                   :intended-fire-direction IntendedDirection}})

 (def player {:id               1
              :position         {:x 10
                                 :y 10}
              :collision-box    {:width 50 :height 50}
              :render-info      {:shape :square}
-             :human-controlled {:intended-move-direction #{}}
+             :human-controlled {:intended-move-direction #{}
+                                :intended-fire-direction #{}}
              })
+
+(sm/defschema GameState {:entities [Entity]})

 ; TODO :mode? :active-level?
 (def game-state (atom {:entities [player]}))
@@ -71,6 +74,12 @@
               (put! event-chan {:type      event-type
                                 :direction (key-mappings code)}))))))))

+(sm/defn update-player [state :- GameState & args]
+  (apply update-in
+         state
+         (concat [:entities 0] (first args))
+         (rest args)))
+
 (defn handle-events [state event-chan]
   (listen-to-keyboard-inputs event-chan)

@@ -78,11 +87,11 @@
     (let [msg (<! event-chan)]
       (js/console.log (clj->js msg))
       (case (msg :type)
-        ; TODO function for getting the player
-        :move-key-down (swap! state update-in [:entities 0 :human-controlled :intended-move-direction] conj (msg :direction))
-        :move-key-up (swap! state update-in [:entities 0 :human-controlled :intended-move-direction] disj (msg :direction))
-        )
-      (js/console.log (clj->js (get-in @state [:entities 0 :human-controlled :intended-move-direction])))
+        :move-key-down (swap! state update-player [:human-controlled :intended-move-direction] conj (msg :direction))
+        :move-key-up (swap! state update-player [:human-controlled :intended-move-direction] disj (msg :direction))
+        :fire-key-down (swap! state update-player [:human-controlled :intended-fire-direction] conj (msg :direction))
+        :fire-key-up (swap! state update-player [:human-controlled :intended-fire-direction] disj (msg :direction)))
+      (js/console.log (clj->js (get-in @state [:entities 0 :human-controlled])))
       (recur))))

 (defn ^:export main []


debugging showing mount/unmount of main component

--- frontend/src/leftover/ui.cljs
+++ frontend/src/leftover/ui.cljs
@@ -128,4 +128,10 @@
         (case (:state app)
           :loading ()
           :enter-payment (om/build enter-payment app)
-          :view-history (om/build view-history (:data app)))))))
+          :view-history (om/build view-history (:data app)))))
+    om/IWillMount
+    (will-mount [this]
+      (util/log "MOUNT"))
+    om/IWillUnmount
+    (will-unmount [this]
+      (util/log "UNMOUNT"))))


Consolidate tasks in example file

Consolidate tasks in example file

--- example/build.boot
+++ example/build.boot
@@ -11,7 +11,6 @@
 (deftask dev []
   (comp
     (watch)
-    (asset-fingerprint :extension [".css"])
-    (asset-fingerprint :extension [".html"])
+    (asset-fingerprint :extension [".css" ".html"])
     (jetty/serve :port 5000)
     (target)))


wait adapted

wait adapted

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -905,8 +905,11 @@
 (def default-timeout 10)
 (def default-interval 0.1)

-(defn wait [sec]
-  (Thread/sleep (* sec 1000)))
+(defn wait
+  ([driver sec]
+   (wait sec))
+  ([sec]
+   (Thread/sleep (* sec 1000))))

 (defn wait-predicate
   ([pred]