minor cleanups to end to end test

minor cleanups to end to end test

--- test/acceptance/e2e/end_to_end.clj
+++ test/acceptance/e2e/end_to_end.clj
@@ -5,14 +5,12 @@
             [ring.adapter.jetty :as jetty]))

 (def server (atom nil))
+
 (defn start-server []
   (when @server
     (throw (Exception. "Server started twice!")))
   (web/init)
   (reset! server (jetty/run-jetty web/app {:port 3001 :join? false})))
-
-(defn needs-server []
-  (when-not @server (start-server)))

 (defn stop-server []
   (when-not @server
@@ -22,9 +20,11 @@
   (reset! server nil))

 (fact "can view all the things"
-  (needs-server)
-  (taxi/set-driver! {:browser :firefox} "http://localhost:3001/index.html")
-  ;(taxi/to "http://localhost:3001/index.html")
+  (start-server)
+  ; clj-webdriver taxi lives around a global browser
+  ; TODO: maybe use core webdriver so we can be a bit cleaner?
+  (taxi/set-driver! {:browser :firefox})
+  (taxi/to "http://localhost:3001/index.html")
   (taxi/text "section>h1") => "Things!"
   (taxi/close)
   (stop-server))


adding :figwheel-always meta data for constant reload

--- support/src/figwheel/client/file_reloading.cljs
+++ support/src/figwheel/client/file_reloading.cljs
@@ -1,4 +1,4 @@
-(ns figwheel.client.file-reloading
+(ns ^:figwheel-always figwheel.client.file-reloading
   (:require
    [figwheel.client.utils :as utils :refer-macros [dev-assert get-all-ns-meta-data]]
    [goog.Uri :as guri]
@@ -133,6 +133,9 @@
           (filter #(and (:meta-data %) (:namespace %)) files)]
     (swap! ns-meta-data assoc namespace meta-data)))

+(defn always-loaded-ns []
+  (map first (filter (fn [[k v]] (get v :figwheel-always)) @ns-meta-data)))
+
 (defn expand-files-to-include-deps [file-msgs]
   (dev-assert (all? namespace-file-map? file-msgs))
   (store-meta-data-for-files! file-msgs)
@@ -142,7 +145,9 @@
         additional-files (map (fn [x] { :namespace x
                                        :meta-data (get @ns-meta-data x)
                                        :file (resolve-ns x)
-                                       :type :namespace }) additional-ns)]
+                                       :type :namespace })
+                              (set (concat additional-ns
+                                           (always-loaded-ns))))]
     (topo-sort-files (concat (set file-msgs)
                              additional-files))))


Removed cascalog require & query; moved over remaining cleaning funcs

--- src/clj/forma/postprocess/output.clj
+++ src/clj/forma/postprocess/output.clj
@@ -3,8 +3,7 @@
         [forma.reproject :only (modis->latlon)]
         [forma.date-time :only (period->datetime datetime->period)]
         [clojure.string :only (split join)]
-        [forma.utils :only (moving-average average)])
-  (:require [cascalog.ops :as c]))
+        [forma.utils :only (moving-average average)]))

 (defn get-val
   [out-m & k]
@@ -54,6 +53,21 @@
   [series]
   (vec-ify (cons (first series) (rest (reductions max series)))))

+(defn dec->int100
+  [coll]
+  (map (comp int round (partial * 100)) coll))
+
+(defn clean-probs
+  "smooth the probabilities with a backward-looking moving average, make the
+  series monotonically increasing, and finally make each probability 0->1 an
+  integer 0->100"
+  [coll]
+  (let [window 3]
+    [(vec (-> coll
+              (backward-looking-mavg window)
+              (mono-inc)
+              (dec->int100)))]))
+
 (defn date-no-sep
   [date-str]
   (reduce str (split date-str #"-")))
@@ -70,16 +84,3 @@
   (let [dates (mk-date-header tres date-prefix ts)
         header (csv-ify args)]
     (csv-ify header dates)))
-
-(defn make-csv
-  [output-map window]
-  (<- [?out-str]
-      (output-map ?m)
-      (get-series ?m :> ?series)
-      (get-val ?m :modh :modv :sample :line :> ?modh ?modv ?sample ?line)
-      (convert-to-latlon ?m :> ?lat ?lon)
-      (float->str-10 ?lat :> ?str-lat)
-      (float->str-10 ?lon :> ?str-lon)
-      (backward-looking-mavg window ?series :> ?mavg-series)
-      (mono-inc ?mavg-series :> ?inc-series)
-      (csv-ify ?modh ?modv ?sample ?line ?str-lat ?str-lon ?inc-series :> ?out-str)))


do-nodes-in-panel is now thread-safe for swing

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

--- src/conexp/contrib/draw/lattices.clj
+++ src/conexp/contrib/draw/lattices.clj
@@ -419,9 +419,10 @@
   `(let [^JPanel scn# (get-scene-from-panel ~panel)]
      (when-not scn#
        (illegal-argument "Given panel for do-nodes-in-panel does not contain a lattice-editor."))
-     (do-nodes [~node scn#]
-               ~@body)
-     (redraw-scene scn#)))
+     (do-swing
+      (do-nodes [~node scn#]
+        ~@body)
+      (redraw-scene scn#))))

 ;;;


Logging transformation errors

Logging transformation errors

--- backend/src/akvo/lumen/transformation/engine.clj
+++ backend/src/akvo/lumen/transformation/engine.clj
@@ -43,7 +43,7 @@
   (try
     (apply-operation deps table-name columns op-spec)
     (catch Exception e
-      (log/debug e)
+      (log/info e)
       {:success? false
        :message (format "Failed to transform: %s" (.getMessage e))})))


delete command support

delete command support

--- src/digitalocean_routine/core.clj
+++ src/digitalocean_routine/core.clj
@@ -1,21 +1,13 @@
 (ns digitalocean-routine.core
   (:require [digitalocean.v2.core :as do]))

-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))

-(defn- droplets-exist? [token]
+(defn droplets-exist? [token]
   "return 0 if droplets exist."
   (not (= (count (:droplets (do/droplets token)))
           0)))

-(defn- delete-droplets [] "to be implemnted")
-
-(defn- create-droplets [token number image-id ssh_keys]
-  (if (droplets-exist? token)
-    (delete-droplets))
+(defn create-droplets [token number image-id ssh_keys]
   (for [name (map #(str "droplet" %) (range 0 number))]
     (doall (do/create-droplet token nil {:name name
                                          :region "nyc3"
@@ -23,6 +15,25 @@
                                          :image image-id
                                          :ssh_keys [ssh_keys]}))))

+(defn query-droplet-ids [token]
+  "return droplet ids as a list"
+  (let [dropletdetails (do/droplets token)]
+    (map #(:id %) (:droplets dropletdetails))))
+
+(def delete-droplet
+  "Delete a droplet by ID
+  (delete-droplet <token> dropletID) => nil (if it has been deleted successfully)"
+  (do/generic :delete :droplets))
+
+(defn delete-all-droplets [token]
+  (for [droplet-id (query-droplet-ids token)]
+    (doall (delete-droplet token droplet-id))))
+
 (defn -main [& args]
-  (if (= (first args) "create")
-    (create-droplets (nth args 1) (nth args 2) (nth args 3) (nth args 4))))
+  (cond (= (first args) "create")
+        (create-droplets (nth args 1) (nth args 2) (nth args 3) (nth args 4))
+        (= (first args) "delete")
+        (delete-all-droplets (nth args 1))
+        ))
+
+


Code cleanup.

Code cleanup.

--- src/oc/storage/resources/entry.clj
+++ src/oc/storage/resources/entry.clj
@@ -261,10 +261,10 @@
          (map? entry)]}
   (when-let [original-entry (get-entry conn uuid)]
     (let [ts (db-common/current-timestamp)
-          authors-entry (add-author-to-entry original-entry entry user)]
-      (let [updated-entry (update-entry conn authors-entry original-entry ts)]
+          authors-entry (add-author-to-entry original-entry entry user)
+          updated-entry (update-entry conn authors-entry original-entry ts)]
         ;; copy current version to versions table, increment revision uuid
-        (create-version conn updated-entry original-entry)))))
+        (create-version conn updated-entry original-entry))))

 (defn upsert-entry!
   "


fixed test

fixed test

--- spec/untangled/client/core_spec.cljs
+++ spec/untangled/client/core_spec.cljs
@@ -41,7 +41,7 @@
         data {}]
     (when-mocking
       (uc/preprocess-merge s c d) => {:merge-data :the-data :merge-query :the-query}
-      (uc/integrate-ident! s i rest) => :ignore
+      (uc/integrate-ident! s i op args op args) => :ignore
       (om/ident c p) => [:table :id]
       (om/merge! r d q) => :ignore
       (om/app-state r) => state


CMR-397: Added two-d-coordinate-system granule search parameter validation.

--- src/cmr/search/services/parameters/converters/two_d_coordinate_system.clj
+++ src/cmr/search/services/parameters/converters/two_d_coordinate_system.clj
@@ -30,12 +30,18 @@
 (defn string->coordinate-condition
   "Returns a list of coordinate conditions for the given search coordinate string"
   [coord-str]
-  (let [coord-str (s/trim coord-str)]
+  (let [coord-str (when coord-str (s/trim coord-str))]
     (when-not (or (empty? coord-str) (= "-" coord-str))
       (let [[x y] (string->coordinate-values coord-str)]
         (if (and (nil? y) (nil? (re-find #"-" coord-str)))
           (qm/->CoordinateValueCondition x)
-          (qm/->CoordinateRangeCondition x y))))))
+          (if (and (not (nil? x))
+                   (not (nil? y))
+                   (> x y))
+            (errors/throw-service-error
+              :bad-request
+              (format "Invalid grid range for [%s]" coord-str))
+            (qm/->CoordinateRangeCondition x y)))))))

 (defn string->TwoDCoordinateCondition
   "Returns a map of search coordinates for the given string
@@ -55,8 +61,12 @@
                                 (map string->TwoDCoordinateCondition)
                                 (remove nil?)
                                 seq))]
-    (qm/map->TwoDCoordinateSystemCondition {:two-d-name two-d-name
-                                            :two-d-conditions coordinate-conds})))
+    (if (s/blank? two-d-name)
+      (errors/throw-service-error
+        :bad-request
+        (format "grid name can not be empty, but is for [%s]" param-str))
+      (qm/map->TwoDCoordinateSystemCondition {:two-d-name two-d-name
+                                              :two-d-conditions coordinate-conds}))))

 ;; Converts two-d-coordinate-system parameter into a query condition
 (defmethod p/parameter->condition :two-d-coordinate-system


Add strip-trailing function

Add strip-trailing function

--- src/hu/ssh/github_changelog/util.clj
+++ src/hu/ssh/github_changelog/util.clj
@@ -6,3 +6,8 @@
 (defn gen-sha [] (join (repeatedly 40 #(rand-nth "0123456789ABCDEF"))))

 (defn str-map [f & sqs] (join (apply map f sqs)))
+
+(defn strip-trailing [str end]
+  (if (.endsWith str end)
+    (.substring str 0 (- (count str) (count end)))
+    str))


Fix docstring in random

Fix docstring in random

--- src/main/clojure/lazytest/random.clj
+++ src/main/clojure/lazytest/random.clj
@@ -1,5 +1,5 @@
 (ns lazytest.random
-  "Compostable generators for random data.")
+  "Composable generators for random data.")

 (defn rand-int-in-range
   "Returns a random integer between min (inclusive) and max (exclusive)."


more work on select and namespacing

more work on select and namespacing

--- src/main/java/org/dada/demo/core.clj
+++ src/main/java/org/dada/demo/core.clj
@@ -1,9 +1,11 @@
-(import org.dada.core.Update)
-(import org.dada.core.Model)
-(import org.dada.core.View)
-(import org.dada.demo.Client)
-(import org.springframework.context.support.ClassPathXmlApplicationContext)
-
+(ns org.dada.core
+    (:import (clojure.lang DynamicClassLoader)
+	     (java.beans PropertyDescriptor)
+	     (org.dada.core Getter GetterMetadata Model Transformer Transformer$Transform Update VersionedModelView View)
+	     (org.dada.demo Client)
+	     (org.springframework.context.support ClassPathXmlApplicationContext)
+	     (org.dada.asm ClassFactory)))
+
 (defn start-server [#^String name]
   (System/setProperty "server.name" name)
   (let [context (ClassPathXmlApplicationContext. "application-context.xml")]
@@ -41,45 +43,30 @@
     #(Update. % nil)
     (.getData model))))

-(import '(clojure.lang DynamicClassLoader))
-
 ;; e.g.
 ;;(make-class
 ;; factory
 ;; "org.dada.tmp.Amount"
 ;; ["int" "id"] ["int" "version"] ["double" "amount"])
-(defn make-class2 [factory name & properties]
+(defn make-class [factory name superclass & properties]
   (. #^DynamicClassLoader
      (deref clojure.lang.Compiler/LOADER)
      (defineClass name
        (.create
 	factory
 	name
-	(into-array (map #(into-array String %) properties))))))
-
-(defn make-class [factory name & properties]
-  (. #^DynamicClassLoader
-     (deref clojure.lang.Compiler/LOADER)
-     (defineClass name
-       (.create
-	factory
-	name
-	(into-array (map (fn [pair]
-			     (let [array (make-array String 2)]
-			       (aset array 0 (.getCanonicalName (first pair)))
-			       (aset array 1 (first (rest pair)))
-			       array))
-			 properties))))))
+	(. superclass getCanonicalName)
+	(if (empty? properties)
+	  nil
+	  (into-array (map (fn [pair]
+			       (let [array (make-array String 2)]
+				 (aset array 0 (.getCanonicalName (first pair)))
+				 (aset array 1 (first (rest pair)))
+				 array))
+			   properties)))))))

 ;; fields => [model field]

-(import org.dada.core.Getter)
-(import org.dada.core.Transformer)
-(import org.dada.core.Transformer$Transform)
-(import org.dada.core.GetterMetadata)
-(import org.dada.core.VersionedModelView)
-(import org.dada.asm.ClassFactory)
-(import java.beans.PropertyDescriptor)

 (defn make-constructor [class & types]
   (let [ctor (symbol (str (.getCanonicalName class) "."))]
@@ -188,10 +175,15 @@
 	     (apply expand-property src-type src-getter prop)))
        props))

+;; TODO
+;; allow selection from a number of src-models
+;; allow selection into a number of src views
+;; allow filtering :filter <filter-fn>
+;; allow splitting :split <split-fn> implemented by router - should provide fn for tgt-view construction...
+;; abstract out tgt-view construction so it can be done from parameters, during select, or on-demand from router...
+
 (defn select [src-model key-name version-name props & pvec]
   (let [pmap (apply array-map pvec)
-	tgt-class-name (or (pmap :class) (.toString (gensym "org.dada.tmp.OutputValue")))
-	tgt-model-name (or (pmap :model) (.toString (gensym "OutputModel")))
 	src-metadata (. src-model getMetadata)
 	src-class (. src-metadata getValueClass)
 	src-names (. src-metadata getAttributeNames)
@@ -200,13 +192,16 @@
 	src-getters (. src-metadata getAttributeGetters)
 	src-getter-map (apply array-map (interleave src-names src-getters)) ; name:getter
 	fields (make-fields src-type-map src-getter-map props) ; selection ([type name ...])
+	;; test to see if transform is needed should be done somewhere here...
+	;; what is an :into param was given...none of this needs calculating...
+	tgt-class-name (or (pmap :class) (.toString (gensym "org.dada.tmp.OutputValue")))
+	tgt-model-name (or (pmap :model) (.toString (gensym "OutputModel")))
    	tgt-types (map (fn [field] (nth field 0)) fields)
-	;; test to see if transform is needed should be done somewhere here...
    	tgt-names (map (fn [field] (nth field 1)) fields)
    	sel-getters (map (fn [field] (nth field 2)) fields)
 	tgt-props (map (fn [field] [(nth field 0) (nth field 1)]) fields) ; ([type name]..)
 	class-factory (new ClassFactory)
-  	tgt-class (apply make-class class-factory tgt-class-name tgt-props)
+  	tgt-class (apply make-class class-factory tgt-class-name Object tgt-props)
    	tgt-getter-map (make-getter-map tgt-class fields) ; name:getter
 	tgt-getters (vals tgt-getter-map)
    	tgt-key-getter (tgt-getter-map key-name)
@@ -222,13 +217,9 @@
   (def metamodel (start-server "Server0"))
   (start-client "Server0")

-  (import org.dada.asm.ClassFactory)
-  (import org.dada.core.VersionedModelView)
-  (import org.dada.core.GetterMetadata)
-
   (def factory (new ClassFactory))
   (def properties (list [(Integer/TYPE) "id"] [(Integer/TYPE) "version"] [(Long/TYPE) "time"] [(Double/TYPE) "amount"]))
-  (def input-class (apply make-class factory "org.dada.tmp.InputItem" properties))
+  (def input-class (apply make-class factory "org.dada.tmp.InputItem" Object properties))
   (def input-types (map (fn [property] (nth property 0)) properties))
   (def input-names (map (fn [property] (nth property 1)) properties))
   (def input-getters (map (fn [property] (make-proxy-getter input-class (nth property 0) (nth property 1))) properties))
@@ -247,11 +238,8 @@
 ;; & :class xxx :model yyy

   (def view
-       (select
-	input-model
-	"key"
-	"version"
-	(list ["id" :name "key"] ["version"] ["amount" :name "money"])))
+       (select input-model "key" "version"
+	       '(["id" :name "key"] ["version"] ["amount" :name "money"])))
   (insert metamodel view)

   (def item5 (make-instance input-class 3 2 2 6.0))


Remove unused function

Remove unused function

--- src/afrey/boot_asset_fingerprint.clj
+++ src/afrey/boot_asset_fingerprint.clj
@@ -1,16 +1,9 @@
 (ns afrey.boot-asset-fingerprint
   {:boot/export-tasks true}
   (:require [boot.core :as core]
-            [boot.pod :as pod]
             [boot.util :as util]
-            [boot.task.built-in :as built-in]
             [clojure.java.io :as io]
             [afrey.boot-asset-fingerprint.impl :as impl]))
-
-(defn- pod-init
-  [fresh-pod]
-  (pod/with-eval-in fresh-pod
-    (require '[afrey.boot-asset-fingerprint.impl])))

 (defn- fileset->html-files [fileset extensions]
   (->> fileset


Consolidate dimmer cue creation.

Consolidate dimmer cue creation.

By writing a set of helper functions, get rid of a lot of repeated code.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -356,6 +356,48 @@
                                        {:key "lightness" :min 0 :max 100 :name "Lightness" :velocity true}
                                        color-var]))))

+(def light-groups
+  "The named groupings of lights to build rows of effects in the cue grid."
+  [:torrent :blade :ws :hex :puck :snowball])
+
+(defn group-end-keys
+  "Helper function to produce a vector of effect keywords to end all
+  effects running on light groups with a given suffix."
+  [effect-suffix]
+  (mapv #(keyword (str (name %) "-" effect-suffix)) light-groups))
+
+(defn build-group-cue-elements
+  "Helper function which builds the common variables needed to create
+  a cue which runs on either all lights or a named group of lights."
+  [group effect-suffix name-suffix]
+  (let [effect-key (or (when group (keyword (str (name group) "-" effect-suffix)))
+                       (keyword effect-suffix))
+        fixtures (or (when group (show/fixtures-named group))
+                     (show/all-fixtures))
+        end-keys (or (when group [(keyword effect-suffix)])
+                     (group-end-keys effect-suffix))
+        effect-name (str (case group
+                           nil "All"
+                           :ws "WS"
+                           (clojure.string/capitalize (name group)))
+                         " " (clojure.string/capitalize name-suffix))]
+    [effect-key fixtures end-keys effect-name]))
+
+(defn make-dimmer-cue
+  "Creates a cue which lets the operator adjust the dimmer level of a
+  group of fixtures. Group will be one of the values
+  in [[light-groups]], or `nil` if the cue should affect all lights."
+  [group x y color]
+  (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "dimmers")]
+    (ct/set-cue! (:cue-grid *show*) x y
+                 (cues/cue effect-key
+                           (fn [var-map] (dimmer-effect
+                                          (params/bind-keyword-param (:level var-map 255) Number 255)
+                                          fixtures
+                                          :effect-name effect-name))
+                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
+                           :color color :end-keys end-keys))))
+
 (defn build-ratio-param
   "Creates a dynamic parameter for setting the beat ratio of one of
   the dimmer oscillator cues in [[make-cues]] by forming the ratio of
@@ -383,9 +425,9 @@

 (defn make-sawtooth-cue
   "Create a cue which applies a sawtooth oscillator to the specified
-  set of fixtures, with cue parameters to adjust the beat ratio,
+  group of fixtures, with cue parameters to adjust the beat ratio,
   starting with default values established by show parameters."
-  [effect-name x y effect-key fixtures & {:keys [color end-keys]}]
+  [group x y color]
   (when-not (= (type (show/get-variable :sawtooth-down?)) Boolean)
     ;; If the default sawtooth direction has not yet been set, establish it as down
     (show/set-variable! :sawtooth-down? true))
@@ -396,27 +438,28 @@
     ;; If the default beat ratio denominator has not yet been set, establish it as 1
     (show/set-variable! :starting-cycles 1))

-  (ct/set-cue! (:cue-grid *show*) x y
-               (cues/cue effect-key
-                         (fn [var-map] (dimmer-effect
-                                        (oscillators/build-oscillated-param
-                                         (oscillators/sawtooth :down? (params/bind-keyword-param (:down var-map)
-                                                                                Boolean true)
-                                                               :interval-ratio (build-ratio-param var-map)))
-                                        fixtures
-                                        :effect-name effect-name))
-                         :color color
-                         :variables [{:key "beats" :min 1 :max 32 :type :integer :start :starting-beats :name "Beats"}
-                                     {:key "down" :type :boolean :start :sawtooth-down? :name "Down?"}
-                                     {:key "cycles" :min 1 :max 10 :type :integer :start :starting-cycles
-                                      :name "Cycles"}]
-                         :end-keys end-keys)))
+  (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "saw")]
+    (ct/set-cue! (:cue-grid *show*) x y
+                 (cues/cue effect-key
+                           (fn [var-map] (dimmer-effect
+                                          (oscillators/build-oscillated-param
+                                           (oscillators/sawtooth :down? (params/bind-keyword-param (:down var-map)
+                                                                                Boolean true)
+                                                                 :interval-ratio (build-ratio-param var-map)))
+                                          fixtures
+                                          :effect-name effect-name))
+                           :color color
+                           :variables [{:key "beats" :min 1 :max 32 :type :integer :start :starting-beats :name "Beats"}
+                                       {:key "down" :type :boolean :start :sawtooth-down? :name "Down?"}
+                                       {:key "cycles" :min 1 :max 10 :type :integer :start :starting-cycles
+                                        :name "Cycles"}]
+                           :end-keys end-keys))))

 (defn make-triangle-cue
   "Create a cue which applies a triangle oscillator to the specified
   set of fixtures, with cue parameters to adjust the beat ratio,
   starting with default values established by show parameters."
-  [effect-name x y effect-key fixtures & {:keys [color end-keys]}]
+  [group x y color]
   (when-not (= (type (show/get-variable :starting-beats)) Long)
     ;; If the default beat ratio numerator has not yet been set, establish it as 2
     (show/set-variable! :starting-beats 2))
@@ -424,7 +467,8 @@
     ;; If the default beat ratio denominator has not yet been set, establish it as 1
     (show/set-variable! :starting-cycles 1))

-  (ct/set-cue! (:cue-grid *show*) x y
+  (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "triangle")]
+    (ct/set-cue! (:cue-grid *show*) x y
                (cues/cue effect-key
                          (fn [var-map] (dimmer-effect
                                         (oscillators/build-oscillated-param
@@ -435,13 +479,13 @@
                          :variables [{:key "beats" :min 1 :max 32 :type :integer :start :starting-beats :name "Beats"}
                                      {:key "cycles" :min 1 :max 10 :type :integer :start :starting-cycles
                                       :name "Cycles"}]
-                         :end-keys end-keys)))
+                         :end-keys end-keys))))

 (defn make-sine-cue
   "Create a cue which applies a sine oscillator to the specified
   set of fixtures, with cue parameters to adjust the beat ratio,
   starting with default values established by show parameters."
-  [effect-name x y effect-key fixtures & {:keys [color end-keys]}]
+  [group x y color]
   (when-not (= (type (show/get-variable :starting-beats)) Long)
     ;; If the default beat ratio numerator has not yet been set, establish it as 2
     (show/set-variable! :starting-beats 2))
@@ -449,24 +493,25 @@
     ;; If the default beat ratio denominator has not yet been set, establish it as 1
     (show/set-variable! :starting-cycles 1))

-  (ct/set-cue! (:cue-grid *show*) x y
-               (cues/cue effect-key
-                         (fn [var-map] (dimmer-effect
-                                        (oscillators/build-oscillated-param
-                                         (oscillators/sine :interval-ratio (build-ratio-param var-map)) :min 1)
-                                        fixtures
-                                        :effect-name effect-name))
-                         :color color
-                         :variables [{:key "beats" :min 1 :max 32 :type :integer :start :starting-beats :name "Beats"}
+  (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "sine")]
+    (ct/set-cue! (:cue-grid *show*) x y
+                 (cues/cue effect-key
+                           (fn [var-map] (dimmer-effect
+                                          (oscillators/build-oscillated-param
+                                           (oscillators/sine :interval-ratio (build-ratio-param var-map)) :min 1)
+                                          fixtures
+                                          :effect-name effect-name))
+                           :color color
+                           :variables [{:key "beats" :min 1 :max 32 :type :integer :start :starting-beats :name "Beats"}
                                      {:key "cycles" :min 1 :max 10 :type :integer :start :starting-cycles
                                       :name "Cycles"}]
-                         :end-keys end-keys)))
+                         :end-keys end-keys))))

 (defn make-square-cue
   "Create a cue which applies a square oscillator to the specified set
   of fixtures, with cue parameters to adjust the beat ratio and pulse
   width, starting with default values established by show parameters."
-  [effect-name x y effect-key fixtures & {:keys [color end-keys]}]
+  [group x y color]
   (when-not (= (type (show/get-variable :starting-beats)) Long)
     ;; If the default beat ratio numerator has not yet been set, establish it as 2
     (show/set-variable! :starting-beats 2))
@@ -481,7 +526,8 @@
     (show/set-variable! :starting-phase 0.0))

   ;; TODO: Make width and phase adjustable params. Is blowing up in oscillators/square right now
-  (ct/set-cue! (:cue-grid *show*) x y
+  (let [[effect-key fixtures end-keys effect-name] (build-group-cue-elements group "dimmers" "square")]
+    (ct/set-cue! (:cue-grid *show*) x y
                (cues/cue effect-key
                          (fn [var-map] (dimmer-effect
                                         (oscillators/build-oscillated-param
@@ -495,7 +541,7 @@
                                      {:key "cycles" :min 1 :max 10 :type :integer :start :starting-cycles
                                       :name "Cycles"}
                                      {:key "width" :min 0 :max 1 :start :starting-width :name "Width"}]
-                         :end-keys end-keys)))
+                         :end-keys end-keys))))

 (defn x-phase
   "Return a value that ranges from zero for the leftmost fixture in a
@@ -615,56 +661,8 @@

     ;; Dimmer cues to turn on and set brightness of groups of lights
-    (ct/set-cue! (:cue-grid *show*) 0 2
-                 (cues/cue :dimmers (fn [var-map] (global-dimmer-effect
-                                                   (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                   :effect-name "All Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers
-                                                     :puck-dimmers :hex-dimmers :snowball-dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 1 2
-                 (cues/cue :torrent-dimmers (fn [var-map] (dimmer-effect
-                                                           (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                           (show/fixtures-named "torrent")
-                                                           :effect-name "Torrent Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 2 2
-                 (cues/cue :blade-dimmers (fn [var-map] (dimmer-effect
-                                                         (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                         (show/fixtures-named "blade")
-                                                         :effect-name "Blade Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 3 2
-                 (cues/cue :ws-dimmers (fn [var-map] (dimmer-effect
-                                                      (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                      (show/fixtures-named "ws")
-                                                      :effect-name "Weather System Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:dimmers]))
-
-    (ct/set-cue! (:cue-grid *show*) 4 2
-                 (cues/cue :hex-dimmers (fn [var-map] (dimmer-effect
-                                                       (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                       (show/fixtures-named "hex")
-                                                       :effect-name "Hex Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 5 2
-                 (cues/cue :puck-dimmers (fn [var-map] (dimmer-effect
-                                                        (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                        (show/fixtures-named "puck")
-                                                        :effect-name "Puck Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 6 2
-                 (cues/cue :snowball-dimmers (fn [var-map] (dimmer-effect
-                                                            (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                            (show/fixtures-named "snowball")
-                                                            :effect-name "Snowball Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:dimmers]))
+    (make-dimmer-cue nil 0 2 :yellow)
+    (doall (map-indexed (fn [i group] (make-dimmer-cue group (inc i) 2 :yellow)) light-groups))

     ;; TODO: Write a macro to make it easier to bind cue variables?
     (ct/set-cue! (:cue-grid *show*) 7 2
@@ -677,78 +675,21 @@
                                        {:key "fade-time" :name "Fade" :min 1 :max 2000 :start 50 :type :integer}]))

-    ;; Dimmer oscillator cues: Sawtooth
-    (make-sawtooth-cue "All Sawtooth" 0 3 :dimmers (show/all-fixtures) :color :yellow
-                       :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers :puck-dimmers :hex-dimmers
-                                  :snowball-dimmers])
-
-    (make-sawtooth-cue "Torrent Saw" 1 3 :torrent-dimmers (show/fixtures-named "torrent") :color :orange
-                       :end-keys [:dimmers])
-
-    (make-sawtooth-cue "Blade Saw" 2 3 :blade-dimmers (show/fixtures-named "blade") :color :orange
-                       :end-keys [:dimmers])
-
-    (make-sawtooth-cue "WS Saw" 3 3 :ws-dimmers (show/fixtures-named "ws") :color :orange
-                       :end-keys [:dimmers])
-
-    (make-sawtooth-cue "Hex Saw" 4 3 :hex-dimmers (show/fixtures-named "hex") :color :orange
-                       :end-keys [:dimmers])
-
-    (make-sawtooth-cue "Puck Saw" 5 3 :puck-dimmers (show/fixtures-named "puck") :color :orange
-                       :end-keys [:dimmers])
-
-    (make-sawtooth-cue "Snowball Saw" 6 3 :snowball-dimmers (show/fixtures-named "snowball") :color :orange
-                       :end-keys [:dimmers])
+    ;; Dimmer oscillator cues: Sawtooth
+    (make-sawtooth-cue nil 0 3 :yellow)
+    (doall (map-indexed (fn [i group] (make-sawtooth-cue group (inc i) 3 :orange)) light-groups))

     (ct/set-cue! (:cue-grid *show*) 7 3
                  (cues/cue :sawtooth-down? (fn [_] (var-fx/variable-effect @var-binder :sawtooth-down? false))
                            :color :red :short-name "Saw Up"))

     ;; Dimmer oscillator cues: Triangle
-    (make-triangle-cue "All Triangle" 0 4 :dimmers (show/all-fixtures) :color :orange
-                       :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers :puck-dimmers :hex-dimmers
-                                  :snowball-dimmers])
-
-    (make-triangle-cue "Torrent Triangle" 1 4 :torrent-dimmers (show/fixtures-named "torrent") :color :red
-                       :end-keys [:dimmers])
-
-    (make-triangle-cue "Blade Triangle" 2 4 :blade-dimmers (show/fixtures-named "blade") :color :red
-                       :end-keys [:dimmers])
-
-    (make-triangle-cue "WS Triangle" 3 4 :ws-dimmers (show/fixtures-named "ws") :color :red
-                       :end-keys [:dimmers])
-
-    (make-triangle-cue "Hex Triangle" 4 4 :hex-dimmers (show/fixtures-named "hex") :color :red
-                       :end-keys [:dimmers])
-
-    (make-triangle-cue "Puck Triangle" 5 4 :puck-dimmers (show/fixtures-named "puck") :color :red
-                       :end-keys [:dimmers])
-
-    (make-triangle-cue "Snowball Triangle" 6 4 :snowball-dimmers (show/fixtures-named "snowball") :color :red
-                       :end-keys [:dimmers])
+    (make-triangle-cue nil 0 4 :orange)
+    (doall (map-indexed (fn [i group] (make-triangle-cue group (inc i) 4 :red)) light-groups))

     ;; Dimmer oscillator cues: Sine
-    (make-sine-cue "All Sine" 0 5 :dimmers (show/all-fixtures) :color :cyan
-                   :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers :puck-dimmers :hex-dimmers
-                              :snowball-dimmers])
-
-    (make-sine-cue "Torrent Sine" 1 5 :torrent-dimmers (show/fixtures-named "torrent") :color :blue
-                       :end-keys [:dimmers])
-
-    (make-sine-cue "Blade Sine" 2 5 :blade-dimmers (show/fixtures-named "blade") :color :blue
-                       :end-keys [:dimmers])
-
-    (make-sine-cue "WS Sine" 3 5 :ws-dimmers (show/fixtures-named "ws") :color :blue
-                       :end-keys [:dimmers])
-
-    (make-sine-cue "Hex Sine" 4 5 :hex-dimmers (show/fixtures-named "hex") :color :blue
-                       :end-keys [:dimmers])
-
-    (make-sine-cue "Puck Sine" 5 5 :puck-dimmers (show/fixtures-named "puck") :color :blue
-                       :end-keys [:dimmers])
-
-    (make-sine-cue "Snowball Sine" 6 5 :snowball-dimmers (show/fixtures-named "snowball") :color :blue
-                       :end-keys [:dimmers])
+    (make-sine-cue nil 0 5 :cyan)
+    (doall (map-indexed (fn [i group] (make-sine-cue group (inc i) 5 :blue)) light-groups))

     (ct/set-cue! (:cue-grid *show*) 7 5
                  (cues/cue :beat-ratio
@@ -757,27 +698,8 @@
                                        {:key :starting-cycles :min 1 :max 10 :type :integer :name "Cycles"}]))

     ;; Dimmer oscillator cues: Square
-    (make-square-cue "All Square" 0 6 :dimmers (show/all-fixtures) :color :cyan
-                   :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers :puck-dimmers :hex-dimmers
-                              :snowball-dimmers])
-
-    (make-square-cue "Torrent Square" 1 6 :torrent-dimmers (show/fixtures-named "torrent") :color :green
-                       :end-keys [:dimmers])
-
-    (make-square-cue "Blade Square" 2 6 :blade-dimmers (show/fixtures-named "blade") :color :green
-                       :end-keys [:dimmers])
-
-    (make-square-cue "WS Square" 3 6 :ws-dimmers (show/fixtures-named "ws") :color :green
-                       :end-keys [:dimmers])
-
-    (make-square-cue "Hex Square" 4 6 :hex-dimmers (show/fixtures-named "hex") :color :green
-                       :end-keys [:dimmers])
-
-    (make-square-cue "Puck Square" 5 6 :puck-dimmers (show/fixtures-named "puck") :color :green
-                       :end-keys [:dimmers])
-
-    (make-square-cue "Snowball Square" 6 6 :snowball-dimmers (show/fixtures-named "snowball") :color :green
-                       :end-keys [:dimmers])
+    (make-square-cue nil 0 6 :cyan)
+    (doall (map-indexed (fn [i group] (make-square-cue group (inc i) 6 :green)) light-groups))

     (ct/set-cue! (:cue-grid *show*) 7 6
                  (cues/cue :beat-ratio


Set up for OSC control of groups of lights.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -284,18 +284,32 @@
   grids, and the like."
   []
   (when (nil? @core/osc-server) (core/start-osc-server 16010))
-  (show/set-variable! :y (tf/inches 118))
-  (osc/osc-handle @core/osc-server "/aim" (fn [msg]
-                                            (let [left (tf/inches -88)
-                                                  right (tf/inches 86)
-                                                  width (- right left)
-                                                  front (tf/inches -21)
-                                                  rear (tf/inches 295)
-                                                  depth (- rear front)]
-                                              (show/set-variable! :x (+ left (* width (first (:args msg)))))
-                                              (show/set-variable! :z (+ front (* depth (second (:args msg))))))
-                                            #_(timbre/info msg)))
-  (osc/osc-handle @core/osc-server "/sparkle" (fn [msg]
+  (let [left (tf/inches -88)
+        right (tf/inches 86)
+        width (- right left)
+        front (tf/inches -21)
+        rear (tf/inches 295)
+        depth (- rear front)
+        height 3]
+    (osc/osc-handle @core/osc-server "/1/aim-a"
+                    (fn [msg]
+                      (show/set-variable! :aim-group-a-x (+ left (* width (first (:args msg)))))
+                      (show/set-variable! :aim-group-a-z (+ front (* depth (second (:args msg)))))
+                      #_(timbre/info msg)))
+    (osc/osc-handle @core/osc-server "/1/aim-a-y"
+                    (fn [msg]
+                      (show/set-variable! :aim-group-a-y (* height (first (:args msg))))
+                      #_(timbre/info msg)))
+    (osc/osc-handle @core/osc-server "/1/aim-b"
+                    (fn [msg]
+                      (show/set-variable! :aim-group-b-x (+ left (* width (first (:args msg)))))
+                      (show/set-variable! :aim-group-b-z (+ front (* depth (second (:args msg)))))
+                      #_(timbre/info msg)))
+    (osc/osc-handle @core/osc-server "/1/aim-b-y"
+                    (fn [msg]
+                      (show/set-variable! :aim-group-b-y (* height (first (:args msg))))
+                      #_(timbre/info msg))))
+  (osc/osc-handle @core/osc-server "/1/sparkle" (fn [msg]
                                                 (if (pos? (first (:args msg)))
                                                   (show/add-effect! :sparkle (fun/sparkle (show/all-fixtures)
                                                                                :chance 0.1


Conditional specs on run-graph

Conditional specs on run-graph

--- src/com/wsscode/pathom/connect/run_graph.cljc
+++ src/com/wsscode/pathom/connect/run_graph.cljc
@@ -6,6 +6,21 @@
             [com.wsscode.pathom.misc :as p.misc]
             [edn-query-language.core :as eql]))

+(when p.misc/INCLUDE_SPECS
+  (s/def ::node-id pos-int?)
+  (s/def ::root ::node-id)
+  (s/def ::run-next ::node-id)
+  (s/def ::after-node ::node-id)
+  (s/def ::run-and (s/coll-of ::node-id :kind vector?))
+  (s/def ::run-or (s/coll-of ::node-id :kind vector?))
+  (s/def ::nodes (s/map-of ::node-id (s/keys :req [::node-id])))
+  (s/def ::provides :com.wsscode.pathom.connect/io-map)
+  (s/def ::requires :com.wsscode.pathom.connect/io-map)
+  (s/def ::unreachable-attrs (s/coll-of :com.wsscode.pathom.connect/attribute :kind set?))
+  (s/def ::unreachable-syms (s/coll-of :com.wsscode.pathom.connect/sym :kind set?))
+  (s/def ::available-data :com.wsscode.pathom.connect/io-map)
+  (s/def ::index-syms (s/map-of :com.wsscode.pathom.connect/sym (s/keys :req [::node-id]))))
+
 (def pc-sym :com.wsscode.pathom.connect/sym)
 (def pc-attr :com.wsscode.pathom.connect/attribute)
 (def pc-input :com.wsscode.pathom.connect/input)
@@ -18,20 +33,6 @@
    (pci/merge-io a b)))

 (declare compute-run-graph)
-
-(s/def ::node-id pos-int?)
-(s/def ::root ::node-id)
-(s/def ::run-next ::node-id)
-(s/def ::after-node ::node-id)
-(s/def ::run-and (s/coll-of ::node-id :kind vector?))
-(s/def ::run-or (s/coll-of ::node-id :kind vector?))
-(s/def ::nodes (s/map-of ::node-id (s/keys :req [::node-id])))
-(s/def ::provides :com.wsscode.pathom.connect/io-map)
-(s/def ::requires :com.wsscode.pathom.connect/io-map)
-(s/def ::unreachable-attrs (s/coll-of :com.wsscode.pathom.connect/attribute :kind set?))
-(s/def ::unreachable-syms (s/coll-of :com.wsscode.pathom.connect/sym :kind set?))
-(s/def ::available-data :com.wsscode.pathom.connect/io-map)
-(s/def ::index-syms (s/map-of :com.wsscode.pathom.connect/sym (s/keys :req [::node-id])))

 (defn next-node-id [{::keys [id-counter]}]
   (swap! id-counter inc))


Spike

Spike

--- src/desdemona/launcher/aeron_media_driver.clj
+++ src/desdemona/launcher/aeron_media_driver.clj
@@ -2,7 +2,8 @@
   (:gen-class)
   (:require
    [clojure.core.async :refer [chan <!!]]
-   [clojure.tools.cli :refer [parse-opts]])
+   [clojure.tools.cli :refer [parse-opts]]
+   [clojure.string :as s])
   (:import
    [uk.co.real_logic.aeron.driver MediaDriver MediaDriver$Context]))

@@ -20,19 +21,38 @@
    "has been started and then use -d to delete the directory on startup"))

 (defn ^:private run-media-driver!
-  [opts]
+  [options]
   (let [ctx (doto (MediaDriver$Context.)
-              (.dirsDeleteOnStart (-> opts :options :delete-dirs)))]
+              (.dirsDeleteOnStart (options :delete-dirs)))]
     (try (MediaDriver/launch ctx)
          (catch IllegalStateException ise
            (throw (Exception. aeron-launch-error-message ise))))))

+(defn ^:private run-media-driver-and-block!
+  [options]
+  (do (run-media-driver! options)
+      (println "Launched the Media Driver. Blocking forever...")
+      (<!! (chan))))
+
+(defn ^:private usage
+  "Given usage summary, returns lines suitable to print as a usage summary."
+  [summary]
+  (concat ["Usage:" ""] summary))
+
+(defn ^:private cli-error-msg
+  "Given errors, returns lines suitable to print as error summary."
+  [errors]
+  (concat ["Couldn't parse your command:" ""] errors))
+
+(defn ^:private exit!
+  "Prints lines to *out* and exit with status."
+  [status lines]
+  (println (s/join \newline lines))
+  (System/exit status))
+
 (defn -main [& args]
-  (let [opts (parse-opts args cli-options)]
-    (if (-> opts :options :help)
-      (do (run! (fn [opt]
-                  (println (clojure.string/join " " (take 3 opt))))
-                cli-options))
-      (do (run-media-driver!)
-          (println "Launched the Media Driver. Blocking forever...")
-          (<!! (chan))))))
+  (let [{:keys [options errors summary]} (parse-opts args cli-options)]
+    (cond
+      (options :help) (exit! 0 (usage summary))
+      errors (exit! 1 (concat (cli-error-msg errors) ( q)))
+      :else (run-media-driver-and-block! options))))


:bug: Deselect all shapes when new shape is inserted.

--- frontend/src/uxbox/main/ui/workspace/drawarea.cljs
+++ frontend/src/uxbox/main/ui/workspace/drawarea.cljs
@@ -281,7 +281,8 @@
                          shape)
                  shape (dissoc shape ::initialized? :modifier-mtx)]
              ;; Add & select the created shape to the workspace
-             (rx/of (dw/add-shape shape)))))))))
+             (rx/of dw/deselect-all
+                    (dw/add-shape shape)))))))))

 (def close-drawing-path
   (ptk/reify ::close-drawing-path


Fix button styling

Fix button styling

--- src/braid/client/gateway/styles.cljs
+++ src/braid/client/gateway/styles.cljs
@@ -98,7 +98,10 @@
          {:color vars/placeholder-color}]

         [:>.explanation
-         (vars/small-text-mixin)]
+         (vars/small-text-mixin)
+
+         [:button
+          (vars/small-button-mixin)]]

         [:>.error-message
          {:position "absolute"


remove with-conn from asana extension

remove with-conn from asana extension

--- src/chat/server/extensions/asana.clj
+++ src/chat/server/extensions/asana.clj
@@ -29,31 +29,29 @@
 (defn create-asana-extension
   [{:keys [id group-id user-name tag-id]}]
   ; TODO: verify user name is valid
-  (db/with-conn
-    (let [user-id (db/uuid)]
-      ; TODO: need a reasonable way to create this extension-only user
-      (db/create-user! {:id user-id
-                        :email (random-nonce 50)
-                        :password (random-nonce 50)
-                        ; TODO: ability to set avatar/reasonable default avatar
-                        :avatar "data:image/gif;base64,R0lGODlhAQABAPAAAP///wAAACH5BAEAAAAALAAAAAABAAEAAAICRAEAOw=="
-                        :nickname user-name})
-      (db/user-add-to-group! user-id group-id)
-      (db/create-extension! {:id id
-                             :group-id group-id
-                             :type :asana
-                             :user-id user-id
-                             :config {:tag-id tag-id}}))))
+  (let [user-id (db/uuid)]
+    ; TODO: need a reasonable way to create this extension-only user
+    (db/create-user! {:id user-id
+                      :email (random-nonce 50)
+                      :password (random-nonce 50)
+                      ; TODO: ability to set avatar/reasonable default avatar
+                      :avatar "data:image/gif;base64,R0lGODlhAQABAPAAAP///wAAACH5BAEAAAAALAAAAAABAAEAAAICRAEAOw=="
+                      :nickname user-name})
+    (db/user-add-to-group! user-id group-id)
+    (db/create-extension! {:id id
+                           :group-id group-id
+                           :type :asana
+                           :user-id user-id
+                           :config {:tag-id tag-id}})))

 (declare unregister-webhook)

 (defn destroy-asana-extension
   [id]
-  (db/with-conn
-    (when-let [webhook-id (-> (db/extension-by-id id)
-                              (get-in [:config :webhook-id]))]
-      (unregister-webhook id webhook-id))
-    (db/retract-extension! id)))
+  (when-let [webhook-id (-> (db/extension-by-id id)
+                            (get-in [:config :webhook-id]))]
+    (unregister-webhook id webhook-id))
+  (db/retract-extension! id))

 ;; Authentication flow
 (def token-url "https://app.asana.com/-/oauth_token")
@@ -89,9 +87,8 @@
           (if (= 200 (:status resp))
             (let [{:strs [access_token refresh_token]} (-> resp :body
                                                            json/read-str)]
-              (db/with-conn
-                (db/save-extension-token! ext-id {:access-token access_token
-                                                  :refresh-token refresh_token})))
+              (db/save-extension-token! ext-id {:access-token access_token
+                                                :refresh-token refresh_token}))
             (timbre/warnf "Bad response when exchanging token %s" (:body resp))))))))

 (defn refresh-token
@@ -105,11 +102,10 @@
                                           "refresh_token" refresh-tok}})]
       (if (= 200 (:status resp))
         (let [{:strs [access_token refresh_token]} (json/read-str (:body resp))]
-          (db/with-conn
-            (db/save-extension-token! (ext :id)
-                                      {:access-token access_token
-                                       :refresh-token (or refresh_token
-                                                          refresh-tok)})))
+          (db/save-extension-token! (ext :id)
+                                    {:access-token access_token
+                                     :refresh-token (or refresh_token
+                                                        refresh-tok)}))
         (do (timbre/warnf "Bad response when exchanging token %s" (:body resp))
             nil)))))

@@ -118,7 +114,7 @@
   ([ext-id path] (fetch-asana-info ext-id :get path {}))
   ([ext-id method path] (fetch-asana-info ext-id method path {}))
   ([ext-id method path opts]
-   (let [ext (db/with-conn (db/extension-by-id ext-id))
+   (let [ext (db/extension-by-id ext-id)
          resp @(http/request (merge {:method method
                                      :url (str api-url path)
                                      :oauth-token (ext :token)}
@@ -153,8 +149,7 @@
         (fetch-asana-info extension-id :post "/webhooks"
                           {:form-params {"resource" resource-id
                                          "target" (str webhook-uri "/" extension-id)}})]
-    (db/with-conn
-      (db/set-extension-config! extension-id :webhook-id (data "id")))))
+    (db/set-extension-config! extension-id :webhook-id (data "id"))))

 (defn unregister-webhook
   [extension-id webhook-id]
@@ -180,22 +175,21 @@
             tag-id (get-in extension [:config :tag-id])]
         (if-let [task-data (get task "data")]
           (do (timbre/debugf "adding thread for task %s" task-data)
-              (db/with-conn
-                (db/create-message! {:thread-id thread-id
-                                     :group-id (extension :group-id)
-                                     :id (db/uuid)
-                                     :content (format new-issue-format
-                                                      (get-in task-data ["followers" 0 "name"])
-                                                      (task-data "name")
-                                                      (task-data "notes"))
-                                     :user-id (extension :user-id)
-                                     :created-at (java.util.Date.)
-                                     :mentioned-user-ids ()
-                                     :mentioned-tag-ids [tag-id]})
-                (db/set-extension-config!
-                  (extension :id)
-                  :thread->issue (assoc thread->issue thread-id resource))
-                (db/extension-subscribe (extension :id) thread-id))
+              (db/create-message! {:thread-id thread-id
+                                   :group-id (extension :group-id)
+                                   :id (db/uuid)
+                                   :content (format new-issue-format
+                                              (get-in task-data ["followers" 0 "name"])
+                                              (task-data "name")
+                                              (task-data "notes"))
+                                   :user-id (extension :user-id)
+                                   :created-at (java.util.Date.)
+                                   :mentioned-user-ids ()
+                                   :mentioned-tag-ids [tag-id]})
+              (db/set-extension-config!
+                (extension :id)
+                :thread->issue (assoc thread->issue thread-id resource))
+              (db/extension-subscribe (extension :id) thread-id)
               (sync/broadcast-thread thread-id ()))
           (timbre/warnf "No such task %s" resource))))

@@ -211,17 +205,16 @@
                           (.startsWith (story-data "text") comment-prefix))
               (timbre/debugf "new comment %s" story story-data)
               ; TODO: check to make sure comment wasn't one we sent
-              (db/with-conn
-                (db/create-message! {:thread-id thread-id
-                                     :id (db/uuid)
-                                     :content (format issue-comment-format
-                                                (get-in story-data ["created_by" "name"])
-                                                (story-data "text"))
-                                     :user-id (extension :user-id)
-                                     :group-id (extension :group-id)
-                                     :created-at (java.util.Date.)
-                                     :mentioned-user-ids ()
-                                     :mentioned-tag-ids ()}))
+              (db/create-message! {:thread-id thread-id
+                                   :id (db/uuid)
+                                   :content (format issue-comment-format
+                                              (get-in story-data ["created_by" "name"])
+                                              (story-data "text"))
+                                   :user-id (extension :user-id)
+                                   :group-id (extension :group-id)
+                                   :created-at (java.util.Date.)
+                                   :mentioned-user-ids ()
+                                   :mentioned-tag-ids ()})
               (sync/broadcast-thread thread-id ())))
           (timbre/warnf "No existing thread for resource %s" resource))))))

@@ -229,8 +222,7 @@
   [extension event-req]
   (if-let [secret (get-in event-req [:headers "x-hook-secret"])]
     (do (timbre/debugf "webhook handshake for %s" (extension :id))
-        (db/with-conn
-          (db/set-extension-config! (extension :id) :webhook-secret secret))
+        (db/set-extension-config! (extension :id) :webhook-secret secret)
       {:status 200 :headers {"X-Hook-Secret" secret}})
     (if-let [signature (get-in event-req [:headers "x-hook-signature"])]
       (let [body (:body event-req)
@@ -256,7 +248,7 @@
   [extension msg]
   (timbre/debugf "New message %s for extension %s" msg extension)
   (if-let [issue (get-in extension [:config :thread->issue (msg :thread-id)])]
-    (let [sender (db/with-conn (db/user-by-id (msg :user-id)))]
+    (let [sender (db/user-by-id (msg :user-id))]
       (fetch-asana-info
         (extension :id) :post (str "/tasks/" issue "/stories")
         {:form-params {"text" (format comment-format-str (sender :nickname)
@@ -280,8 +272,7 @@

 (defn select-project
   [ext project-id]
-  (db/with-conn
-    (db/set-extension-config! (ext :id) :project-id project-id))
+  (db/set-extension-config! (ext :id) :project-id project-id)
   (register-webhook (ext :id) project-id)
   (edn-response {:ok true}))


Disable anti-forgery

Disable anti-forgery

--- src/clj/ikea_clojure_cup/handler.clj
+++ src/clj/ikea_clojure_cup/handler.clj
@@ -50,6 +50,6 @@
    {:format {:formats [:transit-json]}}
    (middlewares [(wrap-gzip)
                  (wrap-exceptions)
-                 (wrap-defaults site-defaults)
+                 (wrap-defaults (assoc-in site-defaults [:security :anti-forgery] false))
                  (wrap-reload)]
                 ikea-routes)))


Handle repeated lesson types in url hash

We adopt the policy of using the lesson group that appears last in the
url hash for that lesson type.

To avoid crowding the `add-module-lesson-groups-from-url-hash` function,
we add a new `get-module-info-from-url-hash-module-info` function (long
names, yes...) to help us deal with duplicate lesson types.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -339,6 +339,34 @@
     (= lessonTypeShortForm "T2")  "TUTORIAL TYPE 2"
     (= lessonTypeShortForm "T3")  "TUTORIAL TYPE 3"))

+(defn- get-module-info-from-url-hash-module-info
+  "Computes the final module info sequence for modules added via the url hash
+   on page initialization.
+
+   NOTE: This function should only be called by
+         `add-module-lesson-groups-from-url-hash`"
+  [moduleInfoSeq]
+  (let [moduleLessonGroupsMap
+        (reduce (fn [lgMap modInfo]
+                  ; Replaces earlier lesson groups with later ones if we
+                  ; encounter a duplicate lesson type
+                  (assoc-in lgMap [(:moduleCode modInfo) (:lessonType modInfo)]
+                            (:lessonGroup modInfo)))
+                {}
+                moduleInfoSeq)]
+
+    ; Produce the final module info sequence
+    (flatten
+      (map (fn [moduleCode]
+             (let [lessonTypesMap (get moduleLessonGroupsMap moduleCode)]
+               (map (fn [lessonType]
+                      (let [lessonGroup (get lessonTypesMap lessonType)]
+                        {:moduleCode  moduleCode
+                         :lessonType  lessonType
+                         :lessonGroup lessonGroup}))
+                    (keys lessonTypesMap))))
+           (keys moduleLessonGroupsMap)))))
+
 (defn add-module-lesson-groups-from-url-hash
   "Adds the module lesson groups available in the url hash. Erroneous lesson
    groups are ignored. If there are missing lesson groups for any module after
@@ -392,10 +420,13 @@
             (assoc m2cMap moduleCode (get-next-lesson-bg-color-css-class)))
           {}
           (distinct (map (fn [modInfo] (:moduleCode modInfo))
-                         moduleInfoExistent)))]
+                         moduleInfoExistent)))
+
+        moduleInfoFinal
+        (get-module-info-from-url-hash-module-info moduleInfoExistent)]

     ; Add the module lesson groups
-    (doseq [modInfo moduleInfoExistent]
+    (doseq [modInfo moduleInfoFinal]
       (let [moduleCode      (:moduleCode modInfo)
             bgColorCssClass (get moduleToColorsMap moduleCode)]
         (add-module-lesson-group moduleCode


[TEMP COMMIT] Create `update-ModulesSelected-for-affected-days` function

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -734,6 +734,7 @@
                               (and (not (nil? ttLessonInfoAfter))
                                    (>= stime endTime)
                                    (< stime (:endTime ttLessonInfoAfter)))
+                              ttLessonInfo

                               :else ttLessonInfoAfter)))
                     nil
@@ -969,6 +970,37 @@
                              emptyRowsToRemoveVec)]
                   (.remove (nth (children $day "tr") (- rowIdx idx))))))))))

+(defn- update-ModulesSelected-for-affected-days
+  "Given a set of days that may possibly be affected by removal and shifting of
+   lessons, update the individual entries in the `ModulesSelected` global."
+  [affectedDaysSet]
+  (doseq [day affectedDaysSet]
+    (let [ttDay (get-timetable-day day)]
+      (doseq [[rowIdx ttRow] (map vector (range (count ttDay)) ttDay)]
+        (doseq [[ttLessonInfo _] ttRow]
+          (let [moduleCode  (:moduleCode ttLessonInfo)
+                lessonType  (:lessonType ttLessonInfo)
+                lessonGroup (:lessonGroup ttLessonInfo)
+                startTime   (:startTime ttLessonInfo)
+                endTime     (:endTime ttLessonInfo)]
+            (set! ModulesSelected
+                  (update-in
+                    ModulesSelected
+                    [moduleCode lessonType lessonGroup :info]
+                    (fn [modSelLessonInfoSeq]
+                      (conj
+                        (filter (fn [modSelLessonInfo]
+                                  (or (not= (:day modSelLessonInfo) day)
+                                      (not= (:startTime modSelLessonInfo)
+                                            startTime)
+                                      (not= (:endTime modSelLessonInfo)
+                                            endTime)))
+                                modSelLessonInfoSeq)
+                        {:day day,
+                         :rowNum rowIdx,
+                         :startTime startTime,
+                         :endTime endTime}))))))))))
+
 (defn remove-module
   "Removes a module from the timetable.

@@ -1004,7 +1036,7 @@
         (timetable-prune-empty-rows affectedDaysSet)

         ; Update `ModulesSelected`
-        (s)
+        (update-ModulesSelected-for-affected-days affectedDaysSet)

         ; Remove from `ModulesSelectedOrder`
         (set! ModulesSelectedOrder (remove #{moduleCode} ModulesSelectedOrder))


Shift fiddling with `ModulesSelectedOrder` and Exam Timetable outside `add-module-lesson-group!`

In preparation for adding modules without any lessons to
`document.location.hash`.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -1338,14 +1338,6 @@
               (update-ModulesSelected-with-lesson-group! moduleCode lessonType
                                                          lessonGroup
                                                          lessonInfoSeq)
-              (if (module-not-in-ModulesSelectedOrder? moduleCode)
-                  (do
-                    (add-to-ModulesSelectedOrder! moduleCode)
-                    (add-module-to-exam-timetable! moduleCode bgColorCssClass)
-                    ; Micro optimization for modules added via url hash
-                    ; during initialization
-                    (if (not addedViaUrlHashInit?)
-                        (select2-box-update-modules!))))

               ; Only lesson types with more than 1 option of lesson group
               ; will be draggable
@@ -1388,6 +1380,10 @@
                              moduleCode lessonType)}))
                   []
                   lessonTypes)]
+
+      (add-to-ModulesSelectedOrder! moduleCode)
+      (add-module-to-exam-timetable! moduleCode bgColorCssClass)
+      (select2-box-update-modules!)

       (doseq [moduleInfo newModInfoSeq]
         (add-module-lesson-group! (:moduleCode moduleInfo)
@@ -1527,10 +1523,19 @@
                          moduleInfoExistent)))

         moduleInfoFinal
-        (get-module-info-from-url-hash-module-info moduleInfoExistent)]
+        (get-module-info-from-url-hash-module-info moduleInfoExistent)
+
+        moduleCodes
+        (distinct (map #(:moduleCode %1) moduleInfoFinal))]

     (.log js/console (str "moduleInfoExistent = " (.stringify js/JSON (clj->js moduleInfoExistent))))
     (.log js/console (str "moduleInfoFinal = " (.stringify js/JSON (clj->js moduleInfoFinal))))
+
+    (doseq [moduleCode moduleCodes]
+      (add-to-ModulesSelectedOrder! moduleCode)
+      (add-module-to-exam-timetable! moduleCode
+                                     (get moduleToColorsMap moduleCode)))
+
     ; Add the module lesson groups
     (doseq [modInfo moduleInfoFinal]
       (let [moduleCode      (:moduleCode modInfo)


This needs to be the right compiler

This needs to be the right compiler

--- test/cljs/go_test.clj
+++ test/cljs/go_test.clj
@@ -2,6 +2,7 @@
   (:refer-clojure :exclude [test])
   (:require [clojure.test :refer :all]
             [cljs.go :refer :all]
+            [cljs.go.compiler :as cljs.compiler]
             [cljs.analyzer :as ana]
             [cljs.env :as env]
             [cljs.tagged-literals]


cleanup; Added background to main toolbar css example

--- src/css-guide/styles/components.cljs
+++ src/css-guide/styles/components.cljs
@@ -1680,21 +1680,22 @@
         menu-action (fn [menu opened item]
                       (om/update-state! this assoc :changed-menu {:id menu :open-state opened :selected-item item}))]

-    (e/ui-iframe {:width "100%" :backgroundImage "img/welcome_card.jpg"}
-      (dom/div #js {:className "c-toolbar"}
-        (dom/link #js {:rel "stylesheet" :href "css/untangled-ui.css"})
-        (dom/div #js {:className "c-toolbar__button"}
-          (dom/button #js {:className "c-button c-button--icon"}
-            (e/ui-icon {:glyph :menu})))
-
-        (dom/div #js {:className "c-toolbar__row"}
-          (dom/div #js {:className "c-toolbar__actions"}
-
-            (dom/button #js {:className "c-button c-button--icon"} (icons/icon :help))
-
-            (dom/button #js {:className "c-button c-button--icon"
-                             :title     "Kevin Mitnick"}
-              (icons/icon :account_circle))))))))
+    (e/ui-iframe {:width "100%" :height "300px"}
+      (dom/div #js { :style #js {:backgroundColor "#efefef" :height "300px"}}
+        (dom/div #js {:className "c-toolbar"}
+         (dom/link #js {:rel "stylesheet" :href "css/untangled-ui.css"})
+         (dom/div #js {:className "c-toolbar__button"}
+           (dom/button #js {:className "c-button c-button--icon"}
+             (e/ui-icon {:glyph :menu})))
+
+         (dom/div #js {:className "c-toolbar__row"}
+           (dom/div #js {:className "c-toolbar__actions"}
+
+             (dom/button #js {:className "c-button c-button--icon"} (icons/icon :help))
+
+             (dom/button #js {:className "c-button c-button--icon"
+                              :title     "Kevin Mitnick"}
+               (icons/icon :account_circle)))))))))

 (defexample toolbar-colors


Make code more Clojure-idiomatic

Make code more Clojure-idiomatic

--- src/cyanite_remover/metric_store.clj
+++ src/cyanite_remover/metric_store.clj
@@ -135,7 +135,7 @@
                                           stats-errors))))))
                       (catch Exception e
                         (log-error e rollup period path stats-errors))))
-                  (when (not @data-processed?)
+                  (when-not @data-processed?
                     (swap! data-processed? (fn [_] true))))))
     ch-in))

@@ -154,8 +154,7 @@
                          default-cassandra-options
                          (:cassandra-options options {}))
         _ (log/info "Cassandra options: " c-options)
-        session (-> (alia/cluster c-options)
-                    (alia/connect keyspace))
+        session (alia/connect (alia/cluster c-options) keyspace)
         fetch-pcqls (prepare-cqls fetch-cqls session)
         chan-size (:cassandra-channel-size options default-cassandra-channel-size)
         batch-size (:cassandra-batch-size options default-cassandra-batch-size)
@@ -217,11 +216,11 @@
          :errors @stats-errors})
       (shutdown [this]
         (log/info "Shutting down the metric store...")
-        (swap! batch #(if (> (count %) 0)
+        (swap! batch #(if (pos? (count %))
                         (do (async/>!! channel {:values %}) [])
                         %))
         (async/close! channel)
-        (while (and (> @stats-processed 0) (not @delete-processed?))
+        (while (and (pos? @stats-processed) (not @delete-processed?))
           (Thread/sleep 100))
         (.close session)
         (log/info "The metric store has been down")))))


also set up http correlations

also set up http correlations

--- src/io/sarnowski/swagger1st/util/newrelic.clj
+++ src/io/sarnowski/swagger1st/util/newrelic.clj
@@ -1,21 +1,76 @@
 (ns io.sarnowski.swagger1st.util.newrelic
-  (:import [com.newrelic.agent NewRelic Trace]))
+  (:require [io.sarnowski.swagger1st.util.api :as api]
+            [clojure.tools.logging :as log]
+            [io.sarnowski.swagger1st.core :as s1st])
+  (:import (com.newrelic.api.agent NewRelic Trace ExtendedRequest HeaderType Response)
+           (clojure.lang ExceptionInfo)))
+
+(defn newrelic-request [method uri headers]
+  (proxy [ExtendedRequest] []
+    (getAttribute [name] nil)
+    (getCookieValue [name] nil)                             ; currently not supported
+    (getHeader [name] (get headers name))
+    (getHeaderType [] (HeaderType/HTTP))
+    (getMethod [] method)
+    (getParameterNames [] [])
+    (getParameterValues [ name] nil)
+    (getRemoteUser [] nil)
+    (getRequestURI [] uri)))
+
+(defrecord newrelic-response [content-type status headers]
+  Response
+  (getContentType [_] content-type)
+  (getHeaderType [_] (HeaderType/HTTP))
+  (setHeader [_ name value] (swap! headers assoc name value))
+  (getStatus [_] status)
+  (getStatusMessage [_] nil))
+
+(defn setup-http-correlation
+  "Provides the NewRelic agent information about the incoming request and the given response in order to correlate
+   upstream transactions and also collect generic http information."
+  [request response]
+  (let [nrreq (newrelic-request (-> request :request-method name .toUpperCase)
+                                      (:uri request)
+                                      (:headers request))
+        nrresp (map->newrelic-response {:content-type (-> response :headers (get "Content-Type"))
+                                        :status (:status response)
+                                        :headers      (atom {})})]
+    ; setup the actual correlation for upstream systems
+    (NewRelic/setRequestAndResponse nrreq nrresp)
+
+    (let [headers (merge (:headers response) (deref (:headers nrresp)))]
+      (assoc response :headers headers))))

 (definterface NewRelicTraceable
-  (callWithTrace [transaction-name custom-parameters callback]))
+  (callWithTrace [transaction-name custom-parameters request callback]))

 (deftype NewRelicTracer []
   NewRelicTraceable
-    ; create a method with the @Trace annotation
-    (^{Trace {:dispatcher true}}
-      callWithTrace [_ transaction-name custom-parameters callback]
-        ; set up transaction name
-        (NewRelic/setTransactionName nil transaction-name)
-        ; add all custom parameters
-        (doseq [[key val] (sort-by key custom-parameters)]
-          (NewRelic/addCustomParameter (name key) (str val)))
-        ; call the actual function
-        (callback)))
+  ; create a method with the @Trace annotation
+  (^{Trace {:dispatcher true}}
+  callWithTrace [_ transaction-name custom-parameters request callback]
+
+
+    ; set up transaction name
+    (NewRelic/setTransactionName nil transaction-name)
+    ; add all custom parameters
+    (doseq [[key val] (sort-by key custom-parameters)]
+      (NewRelic/addCustomParameter (name key) (str val)))
+
+    ; call the actual function
+    (try
+      (->> (callback)
+           (setup-http-correlation request))
+      (catch Throwable e
+        (let [response (if (and (instance? ExceptionInfo e) (contains? (ex-data e) :http-code))
+                         ; nice errors
+                         (let [{:keys [http-code] :as data} (ex-data e)]
+                           (api/error http-code (.getMessage e) (:details data)))
+                         ; unexpected errors
+                         (do
+                           (log/error e "internal server error" (str e))
+                           (api/error 500 "Internal Server Error")))]
+          (setup-http-correlation request response))))))

 (def newrelic-tracer (NewRelicTracer.))

@@ -23,12 +78,16 @@
   (if (keyword? x) (str "{" (name x) "}") x))

 (defn swagger-path-to-str
-  ([[x]] x)
-  ([[x & xs]] (str "/" (path-to-str x) (recur xs))))
+  ([paths] (swagger-path-to-str paths ""))
+  ([paths path]
+   (if (empty? paths)
+     path
+     (swagger-path-to-str (butlast paths) (str "/" (path-to-str (last paths)) path)))))

 (defn swagger-path [request]
-  ; first is method, second is path array
-  (-> request (get-in :swagger :key) second))
+  (swagger-path-to-str
+    ; first is method, second is path array
+    (-> request (get-in [:swagger :key]) second)))

 (defn swagger-parameters [request]
   ; filter out body parameters and merge to flat map
@@ -40,16 +99,13 @@
 (defn tracer
   "A swagger middleware that configures NewRelic agents to track all operations as transactions."
   [context]
-  (chain-handler
+  (s1st/chain-handler
     context
     :on-request (fn [context next-handler request]
                   (let [transaction-name (swagger-path request)
                         custom-parameters (swagger-parameters request)]
-                    (try
-                      (.callWithTrace newrelic-tracer
-                                      transaction-name
-                                      custom-parameters
-                                      #(next-handler request))
-                      (catch Throwable e
-                        (NewRelic/noticeError e)
-                        (throw e)))))))
+                    (.callWithTrace newrelic-tracer
+                                    transaction-name
+                                    custom-parameters
+                                    request
+                                    #(next-handler request))))))


comment

comment

--- src/babel/english/lab.cljc
+++ src/babel/english/lab.cljc
@@ -10,7 +10,7 @@
    [dag_unify.core :as u :refer [pprint strip-refs unify]]))

 (defn parse [surface-string]
-  (english/parse surface-string model false))
+  (english/parse surface-string model false)) ;; false: don't truncate.

 (defn downtown []
   (let [specs


(SERVER-2681) Enable metrics tests in multithreaded mode

Now that we report the JRuby thread id in place of the instance id for
multithreaded mode, these tests pass as expected.

--- test/integration/puppetlabs/services/jruby/jruby_metrics_service_test.clj
+++ test/integration/puppetlabs/services/jruby/jruby_metrics_service_test.clj
@@ -283,7 +283,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Tests

-(deftest ^:metrics ^:single-threaded-only basic-metrics-test
+(deftest ^:metrics basic-metrics-test
   (with-metrics-test-env test-env default-test-config
     (let [{:keys [num-jrubies num-free-jrubies requested-count
                   requested-jrubies-histo borrow-count borrow-timeout-count
@@ -401,7 +401,7 @@
                                  :current-borrowed-instances -1})
         (is (= (expected-metrics-values) (current-metrics-values)))))))

-(deftest ^:metrics ^:single-threaded-only requested-instances-test
+(deftest ^:metrics requested-instances-test
   (with-metrics-test-env test-env default-test-config
     (let [{:keys [coordinator update-expected-values expected-metrics-values
                   current-metrics-values jruby-service]} test-env
@@ -884,7 +884,7 @@
               (is (= 1 (.getCount timer))
                   (str "Timer has a accumulated a count for borrow reason: " timer-name)))))))))

-(deftest ^:metrics ^:single-threaded-only borrow-timeout-test
+(deftest ^:metrics borrow-timeout-test
   (with-metrics-test-env
     test-env
     (assoc-in default-test-config


Experiment with putting mapping functions in metadata

--- src/beehive/guard_rail.clj
+++ src/beehive/guard_rail.clj
@@ -46,14 +46,26 @@
 (defn guard-rail
   [name result-metrics rejected-metrics
    & {:keys [latency-metrics reason->backpressure]}]
-  (-> (GuardRailBuilder.)
-      (.name name)
-      (.resultMetrics result-metrics)
-      (.rejectedMetrics rejected-metrics)
-      (cond->
-        latency-metrics
-        (.resultLatency latency-metrics)
-        reason->backpressure
-        (add-backpressure reason->backpressure))))
+  (with-meta
+    {:guard-rail
+     (-> (GuardRailBuilder.)
+         (.name name)
+         (.resultMetrics result-metrics)
+         (.rejectedMetrics rejected-metrics)
+         (cond->
+           latency-metrics
+           (.resultLatency latency-metrics)
+           reason->backpressure
+           (add-backpressure reason->backpressure)))}
+    {:enum->keyword (fn [e]
+                      (cond
+                        (identical? e Rejected/MAX_CONCURRENCY_LEVEL_EXCEEDED)
+                        :max-concurrency
+                        (identical? e Rejected/CIRCUIT_OPEN)
+                        :circuit-open))
+     :keyword->enum (fn [k]
+                      (case k
+                        :max-concurrency Rejected/MAX_CONCURRENCY_LEVEL_EXCEEDED
+                        :circuit-open Rejected/CIRCUIT_OPEN))}))


Change check-store! to interpret the result.

--- src/blocks/store/tests.clj
+++ src/blocks/store/tests.clj
@@ -229,7 +229,7 @@
       true)))

-(defn check-store!
+(defn check-store
   [constructor & {:keys [blocks max-size iterations eraser]
                   :or {blocks 20, max-size 1024, iterations 100}}]
   {:pre [(some? constructor)]}
@@ -255,6 +255,22 @@
                 (catch Exception ex
                   (println "Error stopping store:" ex))))))))))

+
+(defn check-store!
+  "Interprets test results from `check-store!` for a `clojure.test` result."
+  [& args]
+  (let [info (apply check-store args)]
+    (cond
+      (true? (:result info))
+        true
+
+      (instance? Throwable (:result info))
+        (throw (ex-info (str "Tests failed after " (:num-tests info) " iterations")
+                        info
+                        (:result info)))
+
+      :else
+        (throw (ex-info "Unknown info format" info)))))


bump language in when processing shadow-js

Closure compilation failed with 1 errors
--- node_modules/dialog-polyfill/dialog-polyfill.js:692
this language feature is only supported for ECMASCRIPT6 mode or better:
block-scoped function declaration. Use --language_in=ECMASCRIPT6 or
ECMASCRIPT6_STRICT or higher to enable ES6 features.

errors out since

https://github.com/google/closure-compiler/commit/41331b3d98612101fe09bd01bdd5b305526281e5

--- src/main/shadow/build/closure.clj
+++ src/main/shadow/build/closure.clj
@@ -1591,7 +1591,10 @@
          ;; that might not matter, should cache anyways
          :optimizations (:optimizations js-options :simple) ;; FIXME: validate whitespace or simple
          :pretty-print (:pretty-print js-options false)
-         :language-in :ecmascript5 ;; es6+ is transformed by babel first
+         ;; es6+ is transformed by babel first
+         ;; but closure got real picky and complains about some things being es6 that aren't
+         ;; doesn't really impact much here anyways
+         :language-in :ecmascript-next
          :language-out :ecmascript5}

         property-collector
@@ -1634,7 +1637,7 @@
         (try
           (util/with-logged-time [state {:type ::shadow-convert
                                          :num-sources (count sources)}]
-            (.compile cc [] source-files closure-opts))
+            (.compile cc default-externs source-files closure-opts))
           ;; catch internal closure errors
           (catch Exception e
             (throw (ex-info "failed to convert sources"


relax AOT compile, only do it if shadow-cljs version changes

adding a new CLJS lib doesn't need a full recompile

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -187,6 +187,18 @@
   (let [aot-path
         (path/resolve project-root cache-root "aot-classes")

+        aot-version-path
+        (path/resolve aot-path "version.txt")
+
+        ;; only aot compile when the shadow-cljs version changes
+        ;; changing the version of a lib (eg. reagent) does not need a new AOT compile
+        ;; actual shadow-cljs deps should only change when shadow-cljs version itself changes
+        aot-compile?
+        (if-not (fs/existsSync aot-version-path)
+          true
+          (let [aot-version (util/slurp aot-version-path)]
+            (not= jar-version aot-version)))
+
         classpath
         (get-classpath project-root config)

@@ -200,21 +212,23 @@
         (-> []
             (into jvm-opts)
             (cond->
-              (:updated? classpath) ;; FIXME: maybe try direct linking?
+              aot-compile? ;; FIXME: maybe try direct linking?
               (into [(str "-Dclojure.compile.path=" aot-path)]))
             (into ["-cp" classpath-str "clojure.main"])
             (cond->
-              (:updated? classpath)
+              aot-compile?
               (into ["-e" "(require 'shadow.cljs.aot-helper)"]))
             (into ["-m" "shadow.cljs.devtools.cli"
                    "--npm"])
             (into args))]

-    (when (:updated? classpath)
+
+    (mkdirp/sync aot-path)
+
+    (when aot-compile?
       (println "shadow-cljs - re-building aot cache on startup, that will take some time.")
-      (remove-class-files aot-path))
-
-    (mkdirp/sync aot-path)
+      (remove-class-files aot-path)
+      (fs/writeFileSync aot-version-path jar-version))

     (println "shadow-cljs - starting ...")
     (run-java project-root cli-args {}))


fix z-index and add cljs svg logo

fix z-index and add cljs svg logo


:bug: Fix uploaded-at date formatting on images list.

--- frontend/src/uxbox/main/ui/dashboard/images.cljs
+++ frontend/src/uxbox/main/ui/dashboard/images.cljs
@@ -235,7 +235,7 @@
                               :default-value (:name image)}]
         [:h3 {:on-double-click on-edit} (:name image)])
       [:span.date (str (tr "ds.uploaded-at"
-                           (dt/format (:created-at image) "DD/MM/YYYY")))]]]))
+                           (dt/format (:created-at image) "dd/MM/yyyy")))]]]))

 ;; --- Grid Form


Silence output during test

Silence output during test

--- test/midje/t_repl.clj
+++ test/midje/t_repl.clj
@@ -578,11 +578,11 @@
         (autotest) => anything)))

   (fact "skips adding nonexistent files or dirs"
-    (autotest :files "blah/src" "blah/test") => anything
-    (autotest :files "blah/src.clj" "blah/test.clj") => anything
-
-    (autotest :dirs "blah/src" "blah/test") => anything
-    (autotest :dirs "blah/src.clj" "blah/test.clj") => anything
+    (captured-output (autotest :files "blah/src" "blah/test")) => anything
+    (captured-output (autotest :files "blah/src.clj" "blah/test.clj")) => anything
+
+    (captured-output (autotest :dirs "blah/src" "blah/test")) => anything
+    (captured-output (autotest :dirs "blah/src.clj" "blah/test.clj")) => anything

     (provided
       (set-autotest-option! :files anything) => irrelevant :times 0))


Update neko

Update neko

--- android/project.clj
+++ android/project.clj
@@ -11,7 +11,7 @@

   :dependencies [[com.h2database/h2 "1.3.173"]
                  [markdown-clj "0.9.33"]
-                 [neko/neko "3.0.0-preview3"]
+                 [neko/neko "3.0.0-preview4"]
                  [org.clojure/java.jdbc "0.3.0-beta1"]
                  [org.clojure-android/clojure "1.5.1-jb" :use-resources true]]
   :profiles {:dev {:dependencies [[android/tools.nrepl "0.2.0-bigstack"]]


patch CLJ URI matching in internal/match-uri to Util/matchURI method

--- src/calfpath/internal.cljc
+++ src/calfpath/internal.cljc
@@ -12,7 +12,8 @@
   (:require
     [clojure.string :as string])
   #?(:clj (:import
-            [java.util Iterator Map Map$Entry])))
+            [java.util Map Map$Entry]
+            [calfpath Util])))

 (defn expected
@@ -127,7 +128,7 @@
              init
              (let [i (.iterator (.entrySet m))]
                (loop [last-result init]
-                 (if (.hasNext ^Iterator i)
+                 (if (.hasNext i)
                    (let [^Map$Entry pair (.next i)]
                      (recur (f last-result (.getKey pair) (.getValue pair))))
                    last-result))))))
@@ -321,9 +322,6 @@
 ;; ----- URI match -----

-(def ^:const NO-MATCH nil)
-
-
 (def ^:const NO-PARAMS {})

@@ -344,7 +342,8 @@

 (defn match-uri
-  "Match given URI string against URI pattern:
+  "Match given URI string against URI pattern, returning a vector `[params-map ^int end-index]` on success,
+  and `nil` on no match.

   | Argument               | Description                                       |
   |------------------------|---------------------------------------------------|
@@ -353,41 +352,42 @@
   | pattern-tokens         | URI pattern tokens to match against               |
   | attempt-partial-match? | flag to indicate whether to attempt partial-match |"
   [uri ^long begin-index pattern-tokens attempt-partial-match?]
-  (when-not (= begin-index FULL-MATCH-INDEX)  ; if already a full-match then no need to match any further
-    (let [token-count (count pattern-tokens)
-          actual-uri  (subs uri begin-index)
-          actual-len  (count actual-uri)]
-      (if (= token-count 1)  ; if length==1, then token must be string (static URI path)
-        (let [static-path (first pattern-tokens)
-              static-size (count static-path)]
-          (when (string/starts-with? actual-uri static-path)  ; URI begins with the path, so at least partial match exists
-            (if (= (count actual-uri) (count static-path))  ; if full match exists, then return as such
-              FULL-MATCH-NO-PARAMS
-              (when attempt-partial-match?
-                (partial-match static-size)))))
-        (loop [path-params  (transient {})
-               actual-index 0
-               token-index  0]
-          (if (>= token-index token-count)
-            (if (< actual-index actual-len)
-              (when attempt-partial-match?
-                (partial-match (persistent! path-params) actual-index))
-              (full-match (persistent! path-params)))
-            (let [token (get pattern-tokens token-index)]
-              (if (instance? String token)
-                ;; string token
-                (when (string/starts-with? actual-uri token)
-                  (recur path-params (unchecked-add actual-index (count token)) (unchecked-inc token-index)))
-                ;; must be a keyword
-                (let [[u-path-params
-                       u-actual-index] (loop [sb (transient [])  ; string buffer
-                                              j actual-index]
-                                         (if (>= j actual-len)  ; 'separator not found' implies URI has ended
-                                           [(assoc! path-params token (apply str (persistent! sb)))
-                                            actual-len]
-                                           (let [ch (get uri j)]
-                                             (if (= \/ ch)
-                                               [(assoc! path-params token (apply str (persistent! sb)))
-                                                j]
-                                               (recur (conj! sb ch) (unchecked-inc j))))))]
-                  (recur u-path-params (long u-actual-index) (unchecked-inc token-index)))))))))))
+  #?(:cljs (when-not (= begin-index FULL-MATCH-INDEX)  ; if already a full-match then no need to match any further
+             (let [token-count (count pattern-tokens)
+                   actual-uri  (subs uri begin-index)
+                   actual-len  (count actual-uri)]
+               (if (= token-count 1)  ; if length==1, then token must be string (static URI path)
+                 (let [static-path (first pattern-tokens)
+                       static-size (count static-path)]
+                   (when (string/starts-with? actual-uri static-path)  ; URI begins with path, so at least partial match exists
+                     (if (= (count actual-uri) (count static-path))  ; if full match exists, then return as such
+                       FULL-MATCH-NO-PARAMS
+                       (when attempt-partial-match?
+                         (partial-match static-size)))))
+                 (loop [path-params  (transient {})
+                        actual-index 0
+                        token-index  0]
+                   (if (>= token-index token-count)
+                     (if (< actual-index actual-len)
+                       (when attempt-partial-match?
+                         (partial-match (persistent! path-params) actual-index))
+                       (full-match (persistent! path-params)))
+                     (let [token (get pattern-tokens token-index)]
+                       (if (instance? String token)
+                         ;; string token
+                         (when (string/starts-with? actual-uri token)
+                           (recur path-params (unchecked-add actual-index (count token)) (unchecked-inc token-index)))
+                         ;; must be a keyword
+                         (let [[u-path-params
+                                u-actual-index] (loop [sb (transient [])  ; string buffer
+                                                       j actual-index]
+                                                  (if (>= j actual-len)  ; 'separator not found' implies URI has ended
+                                                    [(assoc! path-params token (apply str (persistent! sb)))
+                                                     actual-len]
+                                                    (let [ch (get uri j)]
+                                                      (if (= \/ ch)
+                                                        [(assoc! path-params token (apply str (persistent! sb)))
+                                                         j]
+                                                        (recur (conj! sb ch) (unchecked-inc j))))))]
+                           (recur u-path-params (long u-actual-index) (unchecked-inc token-index))))))))))
+      :clj (Util/matchURI uri begin-index pattern-tokens attempt-partial-match?)))


function used also in proxmox so no need to mention vmware

--- src/celestial/provider.clj
+++ src/celestial/provider.clj
@@ -52,7 +52,7 @@
         (apply hypervisor ks)
         (catch [:type :celestial.common/missing-conf] e
           (throw+ {:type :missing-template}
-                  (<< "no matching vmware template found for ~{os} add one to configuration under ~{ks}")))))))
+                  (<< "no matching template found for ~{os} add one to configuration under ~{ks}")))))))

 (defn transform
   "specific model transformations"


Better messaging write-batch comments.

Better messaging write-batch comments.

--- src/onyx/plugin/messaging_output.clj
+++ src/onyx/plugin/messaging_output.clj
@@ -100,6 +100,8 @@

   (write-batch [this event replica messenger]
     (cond add-failed
+          ;; previous addition of segment to buffer resulted in an overflow
+          ;; offer the full buffer, and then add the serialized segment to the reset buffer
           (let [[publisher segment-bytes] add-failed]
             (if (neg? (offer-segments! publisher (m/epoch messenger)))
               false
@@ -113,6 +115,7 @@
                   (p/write-batch this event replica messenger))))

           (.hasNext iterator)
+          ;; add segment to corresponding buffer
           (loop []
             (if (.hasNext iterator)
               (let [[segment publisher] (.next iterator)


Add TODO comment.

Add TODO comment.

--- src/onyx/plugin/messaging_output.clj
+++ src/onyx/plugin/messaging_output.clj
@@ -86,6 +86,7 @@
                                hsh (hash (group-fn segment))
                                dest-pubs (m/task->publishers messenger dst-task-id)]
                            (get dest-pubs (mod hsh (count dest-pubs))))))
+          ;; TODO, avoid initial flattening preprocessing step
           _ (run! (fn [{:keys [leaves] :as result}]
                     (run! (fn [seg]
                             (add-segment segments seg event result get-pub-fn))


Implemented pattern matching conditions for canon.

--- src/clj/minijava/canon.clj
+++ src/clj/minijava/canon.clj
@@ -20,8 +20,9 @@
         expr (get-in tree [:exp1 :exp])]
     (conj (vec stmt)
           (merge tree [:exp1 expr]))))
-
-(defn remove-eseq-commute
+
+ ;;is this correct for CJumps, or just for Binops? As seen in figure 8.1 (3), if a Cjump is fed into this, it should end up with no ESeqs, just Seqs.
+(defn remove-eseq-commute
   "(BinaryOp op e1 (ExpSeq s2 e2)) -> [s2 (BinaryOp op e1 e2)]"
   [tree]
   (let [e1 (get tree :exp1)
@@ -49,13 +50,26 @@

 (defn matches-eseq-left?
   [s]
-  (and (= :minijava.ir/BinaryOp (type s)) ;; FIXME: generalize to all expressions
-       (= :minijava.ir/ExpSeq (type (:exp1 s)))))
+  (or
+   (and (= :minijava.ir/BinaryOp (type s)) ;; What follows are the conditions listed in figure 8.1
+       (= :minijava.ir/ExpSeq (type (:exp1 s))))
+   (and (= :minijava.ir/Mem (type s))
+       (= :minijava.ir/ExpSeq (type (:adr s))))
+   (and (= :minijava.ir/Jump (type s))
+       (= :minijava.ir/ExpSeq (type (:lbl s))))
+   (and (= :minijava.ir/Conditional (type s))
+       (= :minijava.ir/ExpSeq (type (:exp1 s))))
+ ))
+

 (defn matches-eseq-commute?
   [s]
-  (and (= :minijava.ir/BinaryOp (type s)) ;; FIXME: generalize to all expressions
-       (= :minijava.ir/ExpSeq (type (:exp2 s)))))
+  (or
+  (and (= :minijava.ir/BinaryOp (type s)) ;; What follows are the conditions listed in figure 8.1
+       (= :minijava.ir/ExpSeq (type (:exp2 s))))
+   (and (= :minijava.ir/Conditional (type s))
+       (= :minijava.ir/ExpSeq (type (:exp2 s))))
+  ))

 (defn isit? [x t]
 (= (type x) t)


Add lines.

Add lines.

--- src/clj_mrazik/irc_bot.clj
+++ src/clj_mrazik/irc_bot.clj
@@ -181,6 +181,12 @@
                     "%s, congrats on your new achievement! Your achievement is indeed a great addition to your personality."
                     "Many dream, few dare and very few actually succeed. Long live %s."
                     "%s, you have proved once again that hard work pays off! I am so happy for you."
+                    "Your work and dedication is inspirational, %s."
+                    "%s, you have been instrumental in Red Hat's success with your exceptional attention to detail."
+                    "You always have the customer's best interest at heart, %s."
+                    "You truly are leading the Red Hat Way, %s."
+                    "It's been a privilege to see you going the Red Hat way, %s."
+                    "The world would be a lot worse, if your expertise and knowledge weren't leading us to the stars."
                     "Keep going, %s, and may your achievement bring even more hapinness into your life and family."]
           message (rand-nth messages)]
     (format message name)))


Use log module, not printing to the standard output

--- src/clj_mrazik/irc_bot.clj
+++ src/clj_mrazik/irc_bot.clj
@@ -14,6 +14,8 @@

 (require '[irclj.core :as irc])
 (require '[clj-calendar.calendar :as calendar])
+
+(require '[clojure.tools.logging :as log])

 (require '[clj-mrazik.dyncfg   :as dyncfg])
 (require '[clj-mrazik.schedule :as schedule])
@@ -202,7 +204,7 @@
         {:prefix prefix
          :response response})
         (catch Exception e
-            (println (.getMessage e))
+            (log/error e "prepare-reply-text")
             {:prefix ""
              :response ""})))

@@ -213,8 +215,8 @@
            nick    :nick
            host    :host
            command :command} incoming-message]
-           (println "Received message from" nick "to" target ":" text "(" host command ")")
-           (println incoming-message)
+           (log/info (str "Received message from" nick "to" target ":" text "(" host command ")"))
+           (log/info incoming-message)
            (if (message-for-me? @dyncfg/bot-nick (-> @dyncfg/configuration :bot :prefix) incoming-message)
                (let [reply  (create-reply incoming-message)
                      output (prepare-reply-text incoming-message nick text)]
@@ -238,14 +240,14 @@
           channels (:channels configuration)
           chanlist (clojure.string/split channels #" ")
           nick     (:nick configuration)]
-        (println "Connecting to" server "on port" port)
+        (log/info "Connecting to" server "on port" port)
         (let [conn (irc/connect server port nick
                                 :callbacks {:privmsg on-incoming-message})]
-            (println "Connected, joining to channels" channels)
+            (log/info "Connected, joining to channels" channels)
             (reset! dyncfg/connection conn)
             (reset! dyncfg/bot-nick nick)
             (doseq [channel chanlist]
-                (println channel)
+                (log/info channel)
                 (irc/join @dyncfg/connection (clojure.string/trim channel)))
-            (println "Connected..."))))
-
+            (log/info "Connected..."))))
+