cues creation

cues creation

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -6,6 +6,7 @@
             [afterglow.core :as core]
             [afterglow.controllers :as ct]
             [afterglow.transform :as tf]
+            [afterglow.effects :as fx]
             [afterglow.effects.color :as color-fx]
             [afterglow.effects.cues :as cues]
             [afterglow.effects.dimmer :refer [dimmer-effect]]
@@ -185,6 +186,81 @@
                       :color (create-color color))]
     (ct/set-cue! (:cue-grid *show*) x y cue)))

+
+(defn make-strobe-cue
+  "Create a cue which strobes a set of fixtures as long as the cue pad
+  is held down, letting the operator adjust the lightness of the
+  strobe color by varying the pressure they are applying to the pad on
+  controllers which support pressure sensitivity."
+  [name fixtures x y]
+  (ct/set-cue! (:cue-grid *show*) x y
+     (cues/cue (keyword (str "strobe-" (clojure.string/replace (clojure.string/lower-case name) " " "-")))
+         (fn [var-map] (fun/strobe (str "Strobe " name) fixtures
+             (:level var-map 50) (:lightness var-map 100)))
+         :color :purple
+         :held true
+         :priority 100
+         :variables [{:key "level" :min 0 :max 100 :start 100 :name "Level"}
+           {:key "lightness" :min 0 :max 100 :name "Lightness" :velocity true}])))
+
+(defn x-phase
+  "Return a value that ranges from zero for the leftmost fixture in a
+  show to 1 for the rightmost, for staggering the phase of an
+  oscillator in making a can-can chase."
+  [head show]
+  (let [dimensions @(:dimensions *show*)]
+    (/ (- (:x head) (:min-x dimensions)) (- (:max-x dimensions) (:min-x dimensions)))))
+
+(defn- name-torrent-gobo-cue
+  "Come up with a summary name for one of the gobo cues we are
+  creating that is concise but meaningful on a controller interface."
+  [prefix function]
+  (let [simplified (clojure.string/replace (name function) #"^gobo-fixed-" "")
+        simplified (clojure.string/replace simplified #"^gobo-moving-" "m/")
+        spaced (clojure.string/replace simplified "-" " ")]
+    (str (clojure.string/upper-case (name prefix)) " " spaced)))
+
+(defn- make-torrent-gobo-cues
+  "Create cues for the fixed and moving gobo options, stationary and
+  shaking. Takes up half a page on the Push, with the top left at the
+  coordinates specified."
+  [prefix fixtures top left]
+  ;; Make cues for the stationary and shaking versions of all fixed gobos
+  (doseq [_ (map-indexed (fn [i v]
+                           (let [blue (create-color :blue)
+                                 x (if (< i 8) left (+ left 2))
+                                 y (if (< i 8) (- top i) (- top i -1))
+                                 cue-key (keyword (str (name prefix) "-gobo-fixed"))]
+                             (ct/set-cue! (:cue-grid *show*) x y
+                                          (cues/function-cue cue-key (keyword v) fixtures :color blue
+                                                             :short-name (name-torrent-gobo-cue prefix v)))
+                             (let [function (keyword (str (name v) "-shake"))]
+                               (ct/set-cue! (:cue-grid *show*) (inc x) y
+                                            (cues/function-cue cue-key function fixtures :color blue
+                                                               :short-name (name-torrent-gobo-cue prefix function))))))
+                         ["gobo-fixed-mortar" "gobo-fixed-4-rings" "gobo-fixed-atom" "gobo-fixed-jacks"
+                          "gobo-fixed-saw" "gobo-fixed-sunflower" "gobo-fixed-45-adapter"
+                          "gobo-fixed-star" "gobo-fixed-rose-fingerprint"])])
+  ;; Make cues for the stationary and shaking versions of all rotating gobos
+  (doseq [_ (map-indexed (fn [i v]
+                           (let [green (create-color :green)
+                                 cue-key (keyword (str (name prefix) "-gobo-moving"))]
+                             (ct/set-cue! (:cue-grid *show*) (+ left 2) (- top i)
+                                          (cues/function-cue cue-key (keyword v) fixtures :color green
+                                                             :short-name (name-torrent-gobo-cue prefix v)))
+                             (let [function (keyword (str (name v) "-shake"))]
+                               (ct/set-cue! (:cue-grid *show*) (+ left 3) (- top i)
+                                            (cues/function-cue cue-key function fixtures :color green
+                                                               :short-name (name-torrent-gobo-cue prefix function))))))
+                         ["gobo-moving-rings" "gobo-moving-color-swirl" "gobo-moving-stars"
+                          "gobo-moving-optical-tube" "gobo-moving-magenta-bundt"
+                          "gobo-moving-blue-mega-hazard" "gobo-moving-turbine"])]))
+
+(defonce ^{:doc "A step parameter for controlling example chase cues.
+  Change it to experiment with other kinds of timing and fades."}
+  step-param
+  (atom nil))
+
 (defn make-cues
   "Create cues."
   []
@@ -207,21 +283,533 @@
   (global-color-cue "purple" 5 0 :include-color-wheels? true)
   (global-color-cue "white" 6 0 :include-color-wheels? true)

-  (ct/set-cue! (:cue-grid *show*) 0 1
-               (cues/cue :color (fn [_] (global-color-effect
-                                         (params/build-color-param :s :rainbow-saturation :l 50 :h hue-bar)))
-                         :short-name "Rainbow Bar Fade"
-                         :variables [{:key :rainbow-saturation :name "Saturatn" :min 0 :max 100 :start 100
-                                      :type :integer}]))
-  (ct/set-cue! (:cue-grid *show*) 1 1
-               (cues/cue :color (fn [_] (global-color-effect
-                                         (params/build-color-param :s :rainbow-saturation :l 50 :h hue-gradient)
-                                         :include-color-wheels? true))
-                         :short-name "Rainbow Grid"
-                         :variables [{:key :rainbow-saturation :name "Saturatn" :min 0 :max 100 :start 100
-                                      :type :integer}]))
-
-  ))
+
+    (ct/set-cue! (:cue-grid *show*) 0 1
+                 (cues/cue :color (fn [_] (global-color-effect
+                                           (params/build-color-param :s :rainbow-saturation :l 50 :h hue-bar)))
+                           :short-name "Rainbow Bar Fade"
+                           :variables [{:key :rainbow-saturation :name "Saturatn" :min 0 :max 100 :start 100
+                                        :type :integer}]))
+    (ct/set-cue! (:cue-grid *show*) 1 1
+                 (cues/cue :color (fn [_] (global-color-effect
+                                           (params/build-color-param :s :rainbow-saturation :l 50 :h hue-gradient)
+                                           :include-color-wheels? true))
+                           :short-name "Rainbow Grid"
+                           :variables [{:key :rainbow-saturation :name "Saturatn" :min 0 :max 100 :start 100
+                                        :type :integer}]))
+    (ct/set-cue! (:cue-grid *show*) 2 1
+                 (cues/cue :color (fn [_] (global-color-effect
+                                           (params/build-color-param :s :rainbow-saturation :l 50 :h hue-gradient
+                                                                     :adjust-hue hue-bar)))
+                           :short-name "Rainbow Grid+Bar"
+                           :variables [{:key :rainbow-saturation :name "Saturatn" :min 0 :max 100 :start 100
+                                        :type :integer}]))
+    (ct/set-cue! (:cue-grid *show*) 3 1  ; Desaturate the rainbow as each beat progresses
+                 (cues/cue :color (fn [_] (global-color-effect
+                                           (params/build-color-param :s desat-beat :l 50 :h hue-gradient
+                                                                     :adjust-hue hue-bar)))
+                           :short-name "Rainbow Pulse"))
+
+    (ct/set-cue! (:cue-grid *show*) 5 1
+                 (cues/cue :color (fn [_] (global-color-effect
+                                           (params/build-color-param :s 100 :l 50 :h hue-z-gradient)
+                                           :include-color-wheels? true))
+                           :short-name "Z Rainbow Grid"))
+    (ct/set-cue! (:cue-grid *show*) 6 1
+                 (cues/cue :color (fn [_] (global-color-effect
+                                           (params/build-color-param :s 100 :l 50 :h hue-z-gradient
+                                                                     :adjust-hue hue-bar)))
+                           :short-name "Z Rainbow Grid+Bar"))
+
+    (ct/set-cue! (:cue-grid *show*) 7 1
+                 (cues/cue :color (fn [_] (global-color-effect
+                                           (params/build-color-param :s 100 :l 50 :h hue-gradient
+                                                                     :adjust-hue hue-bar)
+                                           :lights (show/fixtures-named "blade")))
+                           :short-name "Rainbow Blades"))
+
+
+    ;; TODO: Write a macro to make it easier to bind cue variables.
+    (ct/set-cue! (:cue-grid *show*) 0 7
+                 (cues/cue :sparkle (fn [var-map] (fun/sparkle (show/all-fixtures)
+                                                               :chance (:chance var-map 0.05)
+                                                               :fade-time (:fade-time var-map 50)))
+                           :held true
+                           :priority 100
+                           :variables [{:key "chance" :min 0.0 :max 0.4 :start 0.05 :velocity true}
+                                       {:key "fade-time" :name "Fade" :min 1 :max 2000 :start 50 :type :integer}]))
+
+    (ct/set-cue! (:cue-grid *show*) 2 7
+                 (cues/cue :transform-colors (fn [_] (color-fx/transform-colors (show/all-fixtures)))
+                           :priority 1000))
+
+
+    (ct/set-cue! (:cue-grid *show*) 7 7
+                 (cues/function-cue :strobe-all :strobe (show/all-fixtures) :effect-name "Raw Strobe"))
+
+
+    ;; 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 [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :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 [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :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 [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :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 [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :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 [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :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 [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 7 2
+                 (cues/cue :torrent-1-dimmer (fn [var-map] (dimmer-effect
+                                                            (params/bind-keyword-param (:level var-map 255) Number 255)
+                                                            (show/fixtures-named "torrent-1")
+                                                            :effect-name "Torrent 1 Dimmer"))
+                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :end-keys [:dimmers :torrent-dimmers]))
+
+    ;; Dimmer oscillator cues: Sawtooth down each beat
+    (ct/set-cue! (:cue-grid *show*) 0 3
+                 (cues/cue :dimmers (fn [_] (global-dimmer-effect
+                                             (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
+                                             :effect-name "All Saw Down Beat"))
+                           :color :yellow :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers
+                                                     :puck-dimmers :hex-dimmers :snowball-dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 1 3
+                 (cues/cue :torrent-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
+                                    (show/fixtures-named "torrent") :effect-name "Torrent Saw Down Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 2 3
+                 (cues/cue :blade-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
+                                    (show/fixtures-named "blade") :effect-name "Blade Saw Down Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 3 3
+                 (cues/cue :ws-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
+                                    (show/fixtures-named "ws") :effect-name "WS Saw Down Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 4 3
+                 (cues/cue :hex-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
+                                    (show/fixtures-named "hex") :effect-name "Hex Saw Down Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 5 3
+                 (cues/cue :puck-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
+                                    (show/fixtures-named "puck") :effect-name "Puck Saw Down Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 6 3
+                 (cues/cue :snowball-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
+                                    (show/fixtures-named "snowball") :effect-name "Snowball Saw Down Beat"))
+                           :color :orange :end-keys [:dimmers]))
+
+    ;; Dimmer oscillator cues: Sawtooth up over 2 beat
+    (ct/set-cue! (:cue-grid *show*) 0 4
+                 (cues/cue :dimmers (fn [_] (global-dimmer-effect
+                                             (params/build-oscillated-param (oscillators/sawtooth-beat :beat-ratio 2))
+                                             :effect-name "All Saw Up 2 Beat"))
+                           :color :yellow :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers
+                                                     :puck-dimmers :hex-dimmers :snowball-dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 1 4
+                 (cues/cue :torrent-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :beat-ratio 2))
+                                    (show/fixtures-named "torrent") :effect-name "Torrent Saw Up 2 Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 2 4
+                 (cues/cue :blade-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :beat-ratio 2))
+                                    (show/fixtures-named "blade") :effect-name "Blade Saw Up 2 Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 3 4
+                 (cues/cue :ws-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :beat-ratio 2))
+                                    (show/fixtures-named "ws") :effect-name "WS Saw Up 2 Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 4 4
+                 (cues/cue :hex-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :beat-ratio 2))
+                                    (show/fixtures-named "hex") :effect-name "Hex Saw Up 2 Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 5 4
+                 (cues/cue :puck-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :beat-ratio 2))
+                                    (show/fixtures-named "puck") :effect-name "Puck Saw Up 2 Beat"))
+                           :color :orange :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 6 4
+                 (cues/cue :snowball-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sawtooth-beat :beat-ratio 2))
+                                    (show/fixtures-named "snowball") :effect-name "Snowball Saw Up 2 Beat"))
+                           :color :orange :end-keys [:dimmers]))
+
+    ;; Dimmer oscillator cues: Sine over a bar
+    (ct/set-cue! (:cue-grid *show*) 0 5
+                 (cues/cue :dimmers (fn [_] (global-dimmer-effect
+                                             (params/build-oscillated-param (oscillators/sine-bar) :min 1)
+                                             :effect-name "All Sine Bar"))
+                           :color :cyan :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers
+                                                   :puck-dimmers :hex-dimmers :snowball-dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 1 5
+                 (cues/cue :torrent-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sine-bar) :min 1)
+                                    (show/fixtures-named "torrent") :effect-name "Torrent Sine Bar"))
+                           :color :blue :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 2 5
+                 (cues/cue :blade-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sine-bar) :min 1)
+                                    (show/fixtures-named "blade") :effect-name "Blade Sine Bar"))
+                           :color :blue :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 3 5
+                 (cues/cue :ws-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sine-bar) :min 1)
+                                    (show/fixtures-named "ws") :effect-name "WS Sine Bar"))
+                           :color :blue :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 4 5
+                 (cues/cue :hex-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sine-bar) :min 1)
+                                    (show/fixtures-named "hex") :effect-name "Hex Sine Bar"))
+                           :color :blue :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 5 5
+                 (cues/cue :puck-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sine-bar) :min 1)
+                                    (show/fixtures-named "puck") :effect-name "Puck Sine Bar"))
+                           :color :blue :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 6 5
+                 (cues/cue :snowball-dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/sine-bar) :min 1)
+                                    (show/fixtures-named "snowball") :effect-name "Snowball Sine Bar"))
+                           :color :blue :end-keys [:dimmers]))
+    (ct/set-cue! (:cue-grid *show*) 7 5
+                 (cues/cue :dimmers
+                           (fn [_] (dimmer-effect
+                                    (params/build-oscillated-param (oscillators/triangle-bar) :min 1)
+                                    (show/all-fixtures) :effect-name "All Triangle Bar"))
+                           :color :red :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers
+                                                  :puck-dimmers :hex-dimmers :snowball-dimmers]))
+
+    ;; Strobe cues
+    (make-strobe-cue "All" (show/all-fixtures) 0 6)
+    (make-strobe-cue "Torrents" (show/fixtures-named "torrent") 1 6)
+    (make-strobe-cue "Blades" (show/fixtures-named "blade") 2 6)
+    (make-strobe-cue "Weather Systems" (show/fixtures-named "ws") 3 6)
+    (make-strobe-cue "Hexes" (show/fixtures-named "hex") 4 6)
+    (make-strobe-cue "Pucks" (show/fixtures-named "puck") 5 6)
+
+    (ct/set-cue! (:cue-grid *show*) 7 6
+                 (cues/cue :adjust-strobe (fn [_] (fun/adjust-strobe))
+                           :color :purple
+                           :variables [{:key :strobe-hue :min 0 :max 360 :name "Hue" :centered true}
+                                       {:key :strobe-saturation :min 0 :max 100 :name "Saturatn"}]))
+
+    ;; The upper page of torrent config cues
+    (ct/set-cue! (:cue-grid *show*) 0 15
+                 (cues/function-cue :torrent-shutter :shutter-open (show/fixtures-named "torrent")))
+    (ct/set-cue! (:cue-grid *show*) 1 15
+                 (cues/function-cue :torrent-reset :motor-reset (show/fixtures-named "torrent")
+                                    :color (create-color :red) :held true))
+
+    (ct/set-cue! (:cue-grid *show*) 6 15
+                 (cues/function-cue :t1-focus :focus (show/fixtures-named "torrent-1") :effect-name "Torrent 1 Focus"
+                                    :color (create-color :yellow)))
+    (ct/set-cue! (:cue-grid *show*) 7 15
+                 (cues/function-cue :t2-focus :focus (show/fixtures-named "torrent-2") :effect-name "Torrent 2 Focus"
+                                    :color (create-color :yellow)))
+    (ct/set-cue! (:cue-grid *show*) 6 14
+                 (cues/function-cue :t1-prism :prism-clockwise (show/fixtures-named "torrent-1") :level 100
+                                    :effect-name "T1 Prism Spin CW" :color (create-color :orange)))
+    (ct/set-cue! (:cue-grid *show*) 7 14
+                 (cues/function-cue :t2-prism :prism-clockwise (show/fixtures-named "torrent-2") :level 100
+                                    :effect-name "T2 Prism Spin CW" :color (create-color :orange)))
+    (ct/set-cue! (:cue-grid *show*) 6 13
+                 (cues/function-cue :t1-prism :prism-in (show/fixtures-named "torrent-1")
+                                    :effect-name "T1 Prism In" :color (create-color :orange)))
+    (ct/set-cue! (:cue-grid *show*) 7 13
+                 (cues/function-cue :t2-prism :prism-in (show/fixtures-named "torrent-2")
+                                    :effect-name "T2 Prism In" :color (create-color :orange)))
+    (ct/set-cue! (:cue-grid *show*) 6 12
+                 (cues/function-cue :t1-prism :prism-counterclockwise (show/fixtures-named "torrent-1")
+                                    :effect-name "T1 Prism Spin CCW" :color (create-color :orange)))
+    (ct/set-cue! (:cue-grid *show*) 7 12
+                 (cues/function-cue :t2-prism :prism-counterclockwise (show/fixtures-named "torrent-2")
+                                    :effect-name "T2 Prism Spin CCW" :color (create-color :orange)))
+    (ct/set-cue! (:cue-grid *show*) 6 11
+                 (cues/function-cue :t1-gobo-fixed :gobo-fixed-clockwise (show/fixtures-named "torrent-1")
+                                    :effect-name "T1 Fixed Gobos Swap CW" :color (create-color :blue)))
+    (ct/set-cue! (:cue-grid *show*) 7 11
+                 (cues/function-cue :t2-gobo-fixed :gobo-fixed-clockwise (show/fixtures-named "torrent-2")
+                                    :effect-name "T2 Fixed Gobos Swap CW" :color (create-color :blue)))
+    (ct/set-cue! (:cue-grid *show*) 6 10
+                 (cues/function-cue :t1-gobo-moving :gobo-moving-clockwise (show/fixtures-named "torrent-1")
+                                    :effect-name "T1 Moving Gobos Swap CW" :color (create-color :green)))
+    (ct/set-cue! (:cue-grid *show*) 7 10
+                 (cues/function-cue :t2-gobo-moving :gobo-moving-clockwise (show/fixtures-named "torrent-2")
+                                    :effect-name "T2 Moving Gobos Swap CW" :color (create-color :green)))
+    (ct/set-cue! (:cue-grid *show*) 6 9
+                 (cues/function-cue :t1-gobo-rotation :gobo-rotation-clockwise (show/fixtures-named "torrent-1")
+                                    :effect-name "T1 Spin Gobo CW" :color (create-color :cyan) :level 100))
+    (ct/set-cue! (:cue-grid *show*) 7 9
+                 (cues/function-cue :t2-gobo-rotation :gobo-rotation-clockwise (show/fixtures-named "torrent-2")
+                                    :effect-name "T2 Spin Gobo CW" :color (create-color :cyan) :level 100))
+    (ct/set-cue! (:cue-grid *show*) 6 8
+                 (cues/function-cue :t1-gobo-rotation :gobo-rotation-counterclockwise (show/fixtures-named "torrent-1")
+                                    :effect-name "T1 Spin Gobo CCW" :color (create-color :cyan)))
+    (ct/set-cue! (:cue-grid *show*) 7 8
+                 (cues/function-cue :t2-gobo-rotation :gobo-rotation-counterclockwise (show/fixtures-named "torrent-2")
+                                    :effect-name "T2 Spin Gobo CCW" :color (create-color :cyan)))
+
+    ;; Some basic moving head chases
+    (let [triangle-phrase (params/build-oscillated-param ; Move back and forth over a phrase
+                           (oscillators/triangle-phrase) :min -90 :max 90)
+          staggered-triangle-bar (params/build-spatial-param ; Bounce over a bar, staggered across grid x
+                                  (show/all-fixtures)
+                                  (fn [head]
+                                    (params/build-oscillated-param
+                                     (oscillators/triangle-bar :phase (x-phase head *show*))
+                                     :min -90 :max 0)))
+          can-can-dir (params/build-direction-param-from-pan-tilt :pan triangle-phrase :tilt staggered-triangle-bar)
+          can-can-p-t (params/build-pan-tilt-param :pan triangle-phrase :tilt staggered-triangle-bar)]
+      (ct/set-cue! (:cue-grid *show*) 0 9
+                   (cues/cue :movement (fn [var-map]
+                                         (move/direction-effect "Can Can" can-can-dir (show/all-fixtures)))))
+      (ct/set-cue! (:cue-grid *show*) 1 9
+                   (cues/cue :movement (fn [var-map]
+                                         (move/pan-tilt-effect "P/T Can Can" can-can-p-t (show/all-fixtures))))))
+
+    ;; A couple snowball cues
+    (ct/set-cue! (:cue-grid *show*) 0 10 (cues/function-cue :sb-pos :beams-fixed (show/fixtures-named "snowball")
+                                                            :effect-name "Snowball Fixed"))
+    (ct/set-cue! (:cue-grid *show*) 1 10 (cues/function-cue :sb-pos :beams-moving (show/fixtures-named "snowball")
+                                                            :effect-name "Snowball Moving"))
+
+    ;; The separate page of specific gobo cues for each Torrent
+    (make-torrent-gobo-cues :t1 (show/fixtures-named "torrent-1") 15 8)
+    (make-torrent-gobo-cues :t2 (show/fixtures-named "torrent-2") 15 12)
+
+    ;; TODO: Write a function to create direction cues, like function cues? Unless macro solves.
+    (ct/set-cue! (:cue-grid *show*) 0 8
+                 (cues/cue :torrent-dir (fn [var-map]
+                                          (move/direction-effect
+                                           "Pan/Tilt"
+                                           (params/build-direction-param-from-pan-tilt :pan (:pan var-map 0.0)
+                                                                                :tilt (:tilt var-map 0.0)
+                                                                                :degrees true)
+                                           (show/all-fixtures)))
+                           :variables [{:key "pan" :name "Pan"
+                                        :min -180.0 :max 180.0 :start 0.0 :centered true :resolution 0.5}
+                                       {:key "tilt" :name "Tilt"
+                                        :min -180.0 :max 180.0 :start 0.0 :centered true :resolution 0.5}]))
+    (ct/set-cue! (:cue-grid *show*) 1 8
+                 (cues/cue :torrent-dir (fn [var-map]
+                                          (move/aim-effect
+                                           "Aim"
+                                           (params/build-aim-param :x (:x var-map 0.0)
+                                                                   :y (:y var-map 0.0)
+                                                                   :z (:z var-map 1.0))
+                                           (show/all-fixtures)))
+                           :variables [{:key "x" :name "X"
+                                        :min -20.0 :max 20.0 :start 0.0 :centered true :resolution 0.05}
+                                       {:key "z" :name "Z"
+                                        :min -20.0 :max 20.0 :start 0.0 :centered true :resolution 0.05}
+                                       {:key "y" :name "Y"
+                                        :min 0.0 :max 20.0 :start 0.0 :centered false :resolution 0.05}]))
+    (ct/set-cue! (:cue-grid *show*) 3 8
+                 (cues/function-cue :blade-speed :movement-speed (show/fixtures-named "blade")
+                                    :color :purple :effect-name "Slow Blades"))
+
+    ;; Some fades
+    (ct/set-cue! (:cue-grid *show*) 0 12
+                 (cues/cue :color-fade (fn [var-map]
+                                         (fx/fade "Color Fade"
+                                                  (global-color-effect :red :include-color-wheels? true)
+                                                  (global-color-effect :green :include-color-wheels? true)
+                                                  (params/bind-keyword-param (:phase var-map 0) Number 0)))
+                           :variables [{:key "phase" :min 0.0 :max 1.0 :start 0.0 :name "Fade"}]
+                           :color :yellow))
+
+    (ct/set-cue!
+     (:cue-grid *show*) 1 12
+     (cues/cue :fade-test (fn [var-map]
+                            (fx/fade "Fade Test"
+                                     (fx/blank)
+                                     (global-color-effect :blue :include-color-wheels? true)
+                                     (params/bind-keyword-param (:phase var-map 0) Number 0)))
+               :variables [{:key "phase" :min 0.0 :max 1.0 :start 0.0 :name "Fade"}]
+               :color :cyan))
+
+    (ct/set-cue!
+     (:cue-grid *show*) 2 12
+     (cues/cue :fade-test-2 (fn [var-map]
+                              (fx/fade "Fade Test 2"
+                                       (move/direction-effect
+                                        "p/t" (params/build-direction-param-from-pan-tilt :pan 0 :tilt 0)
+                                        (show/fixtures-named "torrent"))
+                                       (move/direction-effect
+                                        "p/t" (params/build-direction-param-from-pan-tilt :pan 0 :tilt 0)
+                                        (show/fixtures-named "blade"))
+                                       (params/bind-keyword-param (:phase var-map 0) Number 0)))
+               :variables [{:key "phase" :min 0.0 :max 1.0 :start 0.0 :name "Fade"}]
+               :color :red))
+
+    (ct/set-cue!
+     (:cue-grid *show*) 3 12
+     (cues/cue :fade-test-3 (fn [var-map]
+                              (fx/fade "Fade Test P/T"
+                                       (move/pan-tilt-effect
+                                        "p/t" (params/build-pan-tilt-param :pan 0 :tilt 0)
+                                        (show/fixtures-named "torrent"))
+                                       (move/pan-tilt-effect
+                                        "p/t" (params/build-pan-tilt-param :pan 0 :tilt 0)
+                                        (show/fixtures-named "blade"))
+                                       (params/bind-keyword-param (:phase var-map 0) Number 0)))
+               :variables [{:key "phase" :min 0.0 :max 1.0 :start 0.0 :name "Fade"}]
+               :color :orange))
+
+    ;; Some chases
+    (ct/set-cue!
+     (:cue-grid *show*) 0 13
+     (cues/cue :chase (fn [var-map]
+                        (fx/chase "Chase Test"
+                                  [(global-color-effect :red :include-color-wheels? true)
+                                   (global-color-effect :green :lights (show/fixtures-named "hex"))
+                                   (global-color-effect :blue :include-color-wheels? true)]
+                                  (params/bind-keyword-param (:position var-map 0) Number 0)
+                                  :beyond :bounce)
+                        )
+               :variables [{:key "position" :min -0.5 :max 10.5 :start 0.0 :name "Position"}]
+               :color :purple))
+
+    ;; Set up an initial value for our step parameter
+    (reset! step-param (params/build-step-param :fade-fraction 0.3 :fade-curve :sine))
+
+    (ct/set-cue!
+     (:cue-grid *show*) 1 13
+     (cues/cue :chase (fn [var-map]
+                        (fx/chase "Chase Test 2"
+                                  [(global-color-effect :red :lights (show/fixtures-named "hex"))
+                                   (global-color-effect :green :lights (show/fixtures-named "blade"))
+                                   (global-color-effect :blue :lights (show/fixtures-named "hex"))
+                                   (global-color-effect :white :lights (show/all-fixtures))]
+                                  @step-param :beyond :loop))
+               :color :magenta))
+
+    ;; Some compound cues
+    (ct/set-cue! (:cue-grid *show*) 8 0
+                 (cues/cue :star-swirl (fn [_] (cues/compound-cues-effect
+                                                "Star Swirl" *show* [[8 12]
+                                                                     [10 9]
+                                                                     [6 15 {:level 60}]
+                                                                     [6 8 {:level 25}]]))))
+    ;; Some color cycle chases
+    (ct/set-cue! (:cue-grid *show*) 8 1
+                 (cues/cue :color (fn [_] (fun/iris-out-color-cycle-chase (show/all-fixtures)))))
+    (ct/set-cue! (:cue-grid *show*) 9 1
+                 (cues/cue :color (fn [_] (fun/wipe-right-color-cycle-chase
+                                           (show/all-fixtures) :transition-phase-function rhythm/snapshot-bar-phase))))
+    (ct/set-cue! (:cue-grid *show*) 10 1
+                 (cues/cue :color (fn [_] (fun/wipe-right-color-cycle-chase
+                                           (show/all-fixtures)
+                                           :color-index-function rhythm/snapshot-beat-within-phrase
+                                           :transition-phase-function rhythm/snapshot-beat-phase
+                                           :effect-name "Wipe Right Beat"))))
+
+    ;; Some cues to show the Hypnotic RGB Laser
+    (ct/set-cue! (:cue-grid *show*) 8 3
+                 (cues/function-cue :hypnotic-beam :beam-red (show/fixtures-named "hyp-rgb")
+                                    :color :red :effect-name "Hypnotic Red"))
+    (ct/set-cue! (:cue-grid *show*) 9 3
+                 (cues/function-cue :hypnotic-beam :beam-green (show/fixtures-named "hyp-rgb")
+                                    :color :green :effect-name "Hypnotic Green"))
+    (ct/set-cue! (:cue-grid *show*) 10 3
+                 (cues/function-cue :hypnotic-beam :beam-blue (show/fixtures-named "hyp-rgb")
+                                    :color :blue :effect-name "Hypnotic Blue"))
+    (ct/set-cue! (:cue-grid *show*) 11 3
+                 (cues/function-cue :hypnotic-beam :beam-red-green (show/fixtures-named "hyp-rgb")
+                                    :color :yellow :effect-name "Hypnotic Red Green"))
+    (ct/set-cue! (:cue-grid *show*) 12 3
+                 (cues/function-cue :hypnotic-beam :beam-red-blue (show/fixtures-named "hyp-rgb")
+                                    :color :purple :effect-name "Hypnotic Red Blue"))
+    (ct/set-cue! (:cue-grid *show*) 13 3
+                 (cues/function-cue :hypnotic-beam :beam-green-blue (show/fixtures-named "hyp-rgb")
+                                    :color :cyan :effect-name "Hypnotic Green Blue"))
+    (ct/set-cue! (:cue-grid *show*) 14 3
+                 (cues/function-cue :hypnotic-beam :beam-red-green-blue (show/fixtures-named "hyp-rgb")
+                                    :color :white :effect-name "Hypnotic Red Green Blue"))
+    (ct/set-cue! (:cue-grid *show*) 15 3
+                 (cues/function-cue :hypnotic-beam :beam-all-random (show/fixtures-named "hyp-rgb")
+                                    :color :white :effect-name "Hypnotic Random"))
+    (ct/set-cue! (:cue-grid *show*) 14 4
+                 (cues/function-cue :hypnotic-spin :beams-ccw (show/fixtures-named "hyp-rgb")
+                                    :color :cyan :effect-name "Hypnotic Rotate CCW" :level 50))
+    (ct/set-cue! (:cue-grid *show*) 15 4
+                 (cues/function-cue :hypnotic-spin :beams-cw (show/fixtures-named "hyp-rgb")
+                                    :color :cyan :effect-name "Hypnotic Rotate Clockwise" :level 50))
+
+    ;; What else?
+    ;; TODO: Refine this and make a cue
+    #_(show/add-effect! :torrent-focus (afterglow.effects.channel/function-effect
+                                        "F" :focus (params/build-oscillated-param (oscillators/sine-bar)
+                                                                                :min 20 :max 200)
+                                        (show/fixtures-named "torrent")))))
+

 (make-cues)


Tighten the channel size

Tighten the channel size

--- jar-async/src/slipstream/async/collector.clj
+++ jar-async/src/slipstream/async/collector.clj
@@ -17,8 +17,8 @@
   (* 1000 seconds))

 (def collector-chan-size 50)
-(def metrics-update-chan-size 1000)
-(def number-of-readers 20)
+(def metrics-update-chan-size 50)
+(def number-of-readers 25)
 (def timeout-all-users-loop (seconds-in-msecs 120))
 (def timeout-online-loop (seconds-in-msecs 10))
 (def timeout-collect (seconds-in-msecs 9))


CMR-6890 moved a test up. (#1105)

CMR-6890 moved a test up. (#1105)

* CMR-6890 pushing the test to see if bamboo builds it correctly.

* moving the empty cache test up

--- search-app/test/cmr/search/test/services/humanizers/humanizer_range_facet_service.clj
+++ search-app/test/cmr/search/test/services/humanizers/humanizer_range_facet_service.clj
@@ -49,6 +49,24 @@
      :reportable false,
      :order 0}))

+(deftest get-range-facets-cache-empty-test
+  "Testing converting the humanizers to search facets when the cache is empty."
+  (let [context {:system {:caches  {hrfs/range-facet-cache-key (hrfs/create-range-facet-cache)}}}]
+    (is (= [{:key "0 to 1 meter", :from 0.0, :to (+ 1.0 hrfs/addition-factor)}
+            {:key "1 to 30 meters", :from 1.0, :to (+ 30.0 hrfs/addition-factor)}
+            {:key "30 to 100 meters", :from 30.0, :to (+ 100.0 hrfs/addition-factor)}
+            {:key "100 to 250 meters", :from 100.0, :to (+ 250.0 hrfs/addition-factor)}
+            {:key "250 to 500 meters", :from 250.0, :to (+ 500.0 hrfs/addition-factor)}
+            {:key "500 to 1000 meters", :from 500.0, :to (+ 1000.0 hrfs/addition-factor)}
+            {:key "1 to 10 km", :from 1000.0, :to (+ 10000.0 hrfs/addition-factor)}
+            {:key "10 to 50 km", :from 10000.0, :to (+ 50000.0 hrfs/addition-factor)}
+            {:key "50 to 100 km", :from 50000.0, :to (+ 100000.0 hrfs/addition-factor)}
+            {:key "100 to 250 km", :from 100000.0, :to (+ 250000.0 hrfs/addition-factor)}
+            {:key "250 to 500 km", :from 250000.0, :to (+ 500000.0 hrfs/addition-factor)}
+            {:key "500 to 1000 km", :from 500000.0, :to (+ 1000000.0 hrfs/addition-factor)}
+            {:key "1000 km & beyond", :from 1000000.0 :to (Float/MAX_VALUE)}]
+           (hrfs/get-range-facets context)))))
+
 (defn- get-sample-range-facet-humanizers
   "Get the sample humanizers that work for range facets."
   []
@@ -75,21 +93,3 @@
             {:key "500 to 1000 km", :from 500000.0, :to (+ 1000000.0 hrfs/addition-factor)}
             {:key "1000 km & above", :from 1000000.0 :to (Float/MAX_VALUE)}]
            (hrfs/get-range-facets context)))))
-
-; (deftest get-range-facets-cache-empty-test
-;   "Testing converting the humanizers to search facets when the cache is empty."
-;   (let [context {:system {:caches  {hrfs/range-facet-cache-key (hrfs/create-range-facet-cache)}}}]
-;     (is (= [{:key "0 to 1 meter", :from 0.0, :to (+ 1.0 hrfs/addition-factor)}
-;             {:key "1 to 30 meters", :from 1.0, :to (+ 30.0 hrfs/addition-factor)}
-;             {:key "30 to 100 meters", :from 30.0, :to (+ 100.0 hrfs/addition-factor)}
-;             {:key "100 to 250 meters", :from 100.0, :to (+ 250.0 hrfs/addition-factor)}
-;             {:key "250 to 500 meters", :from 250.0, :to (+ 500.0 hrfs/addition-factor)}
-;             {:key "500 to 1000 meters", :from 500.0, :to (+ 1000.0 hrfs/addition-factor)}
-;             {:key "1 to 10 km", :from 1000.0, :to (+ 10000.0 hrfs/addition-factor)}
-;             {:key "10 to 50 km", :from 10000.0, :to (+ 50000.0 hrfs/addition-factor)}
-;             {:key "50 to 100 km", :from 50000.0, :to (+ 100000.0 hrfs/addition-factor)}
-;             {:key "100 to 250 km", :from 100000.0, :to (+ 250000.0 hrfs/addition-factor)}
-;             {:key "250 to 500 km", :from 250000.0, :to (+ 500000.0 hrfs/addition-factor)}
-;             {:key "500 to 1000 km", :from 500000.0, :to (+ 1000000.0 hrfs/addition-factor)}
-;             {:key "1000 km & beyond", :from 1000000.0 :to (Float/MAX_VALUE)}]
-;            (hrfs/get-range-facets context)))))


republish and republish* are no longer are exposed to public API

--- src/midje/checkers.clj
+++ src/midje/checkers.clj
@@ -5,27 +5,23 @@
   midje.checkers
   (:use [midje.util.thread-safe-var-nesting :only [var-root]]))

-(defn republish* [namespace symbols]
-  (require namespace)
-  (doseq [sym symbols]
-    (let [^clojure.lang.Var var ( (ns-publics namespace) sym)]
-      (let [sym (with-meta sym (assoc (meta var) :ns *ns*))]
-        (if (.hasRoot var)
-          (intern *ns* sym (var-root var))
-          (intern *ns* sym))))))
+(letfn [(republish [namespace symbols]
+          (require namespace)
+          (doseq [sym symbols]
+            (let [^clojure.lang.Var var ((ns-publics namespace) sym)]
+              (let [sym (with-meta sym (assoc (meta var) :ns *ns*))]
+                (if (.hasRoot var)
+                  (intern *ns* sym (var-root var))
+                  (intern *ns* sym)))))) ]

-(defmacro republish [namespace & symbols]
-  `(republish* '~namespace '~symbols))
-
-(republish midje.checkers.defining
-           defchecker checker as-checker)
-(republish midje.checkers.chatty
-           chatty-checker)
-(republish midje.checkers.simple
-           truthy falsey TRUTHY FALSEY anything irrelevant exactly throws roughly)
-(republish midje.checkers.collection
-           has has-suffix has-prefix just contains
-           one-of two-of three-of four-of five-of six-of seven-of eight-of nine-of ten-of
-           n-of)
-(republish midje.checkers.deprecated
-           map-containing only-maps-containing maps-containing in-any-order)
+  (republish 'midje.checkers.defining
+             '[defchecker checker as-checker])
+  (republish 'midje.checkers.chatty
+             '[chatty-checker])
+  (republish 'midje.checkers.simple
+             '[truthy falsey TRUTHY FALSEY anything irrelevant exactly throws roughly])
+  (republish 'midje.checkers.collection
+             '[has has-suffix has-prefix just contains n-of
+              one-of two-of three-of four-of five-of six-of seven-of eight-of nine-of ten-of])
+  (republish 'midje.checkers.deprecated
+             '[map-containing only-maps-containing maps-containing in-any-order]))


CMR-2253 Updates mmt-ingest-round-trip test.

The test now ingests UMM JSON metadata directly and performs searches on
previously unimplemented fields. Still checking for any fields we have
not covered.

--- system-int-test/test/cmr/system_int_test/ingest/ingest_lifecycle_integration_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/ingest_lifecycle_integration_test.clj
@@ -101,20 +101,26 @@
   [coll gran attribs]
   (ingest-gran coll (merge gran attribs)))

+(comment
+  ;; for REPL testing purposes
+  (cmr.umm.core/parse-concept {:metadata (cmr.umm-spec.core/generate-metadata :collection :echo10 expected-conversion/example-record)
+                               :concept-type :collection
+                               :format "application/echo10+xml"})
+  )
+
 ;; Test that the MMT round trip for ingesting works and ingested collections can be found
 ;; Test Outline
 ;; - Convert example UMM-JSON record to ISO-19115 using translate API
 ;; - Ingest ISO-19115
 ;; - Search for a collection using various fields and verify it is found
 (deftest mmt-ingest-round-trip
-    (testing "translate umm-json to iso-19115 then ingest and search"
+    (testing "ingest and search UMM JSON metadata"
       (let [example-record expected-conversion/example-record
             umm-json (umm-spec/generate-metadata :collection :umm-json example-record)
-            metadata (:body (ingest/translate-metadata :collection :umm-json umm-json :iso19115))
             coll (d/ingest-concept-with-metadata {:provider-id "PROV1"
                                                   :concept-type :collection
-                                                  :format-key :iso19115
-                                                  :metadata metadata})]
+                                                  :format-key :umm-json
+                                                  :metadata umm-json})]
         (index/wait-until-indexed)
         ;; parameter queries
          (are2 [items params]
@@ -126,7 +132,7 @@
            [] {:entry_title "foo"}

            "entry-id matches"
-           [coll] {:entry_id (:EntryId example-record)}
+           [coll] {:entry_id "short_V1_V5"}
            "entry-id not matches"
            [] {:entry_id "foo"}

@@ -179,12 +185,12 @@
            "platform not matches"
            [] {:platform "foo"}

-           ;; instrument - TODO failing test
-           ;;[coll] {:instrument (-> example-record :Platforms first :Instruments first :ShortName)}
-
-           ;; sensor - TODO failing test
-           ; [coll] {:sensor (-> example-record :Platforms first :Instruments first :Sensors
-           ;                     first :ShortName)}
+           "instrument"
+           [coll] {:instrument (-> example-record :Platforms first :Instruments first :ShortName)}
+
+           "sensor"
+           [coll] {:sensor (-> example-record :Platforms first :Instruments first :Sensors
+                               first :ShortName)}

            "project matches"
            [coll] {:project (-> example-record :Projects first :ShortName)}
@@ -198,10 +204,10 @@
            ;; two-d-coordinate-system-name - TODO add test for this when
            ;; two-d-coordinate-system-name is added to UMM-JSON

-           ;; science-keywords - TODO failing test
-           ; [coll] {:science-keywords {:0 {:category "cat"
-           ;                                         :topic "top"
-           ;                                         :term "ter"}}}
+           "science-keywords"
+           [coll] {:science-keywords {:0 {:category "EARTH SCIENCE"
+                                          :topic "top"
+                                          :term "ter"}}}

            "downloadable matches"
            [] {:downloadable false}
@@ -209,12 +215,12 @@
            [coll] {:downloadable true}

            "browsable matches"
-           [coll] {:browsable false}
+           [coll] {:browsable true}
            "browsable not matches"
-           [] {:browsable true}
-
-           ;; bounding box - TODO - uncomment when spatial is implemented for UMM-JSON
-           ; [coll] {:bounding_box "-180,-90,180,90"}
+           [] {:browsable false}
+
+           "bounding box"
+           [coll] {:bounding_box "-180,-90,180,90"}

            ))))


CMR-2716 Update a test

CMR-2716 Update a test

--- system-int-test/test/cmr/system_int_test/ingest/ingest_lifecycle_integration_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/ingest_lifecycle_integration_test.clj
@@ -128,7 +128,8 @@
           output-version "1.2"
           {:keys [status headers body]} (ingest/translate-between-umm-versions :collection input-version input-str output-version nil)
           content-type (first (mt/extract-mime-types (:content-type headers)))]
-      (is (some? (get (json/parse-string body) "LocationKeywords"))))))
+      (is (some? (get (json/parse-string body) "LocationKeywords")))
+      (is (some? (get (json/parse-string body) "SpatialKeywords"))))))

 (deftest mmt-ingest-round-trip
   (testing "ingest and search UMM JSON metadata"


better parsley usage

better parsley usage


specification related changes

specification related changes

--- src/s7p/slave/core.clj
+++ src/s7p/slave/core.clj
@@ -11,7 +11,8 @@
    [com.fasterxml.jackson.core JsonParseException]))

 (def options {:timeout 100
-              :keepalive 3000})
+              :keepalive 3000
+              :headers {"Content-Type" "application/json"}})

 (defn json-request-option [hash]
   (assoc options :as :text :body (json/generate-string hash)))
@@ -26,7 +27,7 @@
     true))

 (defn validate [request {dsp :dsp status :status body :body}]
-  ;; TODO: validate id identity
+  ;; TODO: validate status before parse json
   (try
    (let [body (and body (json/parse-string body true))
          {:keys [id bidPrice advertiserId]} body
@@ -55,7 +56,7 @@
                (not bidPrice)
                {:status :invalid :reason "no bid price"}

-               (not (instance? Double bidPrice))
+               (not (instance? Number bidPrice))
                {:status :invalid :reason "bidPrice not double" :bidPrice bidPrice}

                (not (over-floor? (:floorPrice request) bidPrice))
@@ -70,8 +71,8 @@
                true
                {:status :valid :response body})]
      (assoc ret :dsp dsp))
-   (catch JsonParseException e {:status :invalid :reason "invalid JSON"})
-   (catch Exception          e {:status :invalid :reason (format "validation process raised unexpected error: %s" e)})))
+   (catch JsonParseException e {:status :invalid :reason "invalid JSON" :body body :dsp dsp})
+   (catch Exception          e {:status :invalid :reason (format "validation process raised unexpected error: %s" e) :dsp dsp})))

 (defn log-validated [test arg]
   (let [{dsp :dsp res :response status :status} arg]
@@ -85,17 +86,18 @@

 (defn auction [floor-price resps]
-  (case  (count resps)
-    0 nil
-    1 (let [{dsp :dsp res :response} (first resps)
-            fp (or floor-price (:bidPrice res))]
-        {:dsp dsp :response res :win-price fp})
-    (let [[{dsp :dsp res :response} {win-price :response}]
-          (->> resps
-               (shuffle)
-               (sort-by (comp :bidPrice :response) >)
-               (take 2))]
-      {:dsp dsp :response res :win-price (:bidPrice win-price)})))
+  (let [floor-price (and floor-price (* 1000 floor-price))]
+   (case  (count resps)
+     0 nil
+     1 (let [{dsp :dsp res :response} (first resps)
+             fp (or floor-price (:bidPrice res))]
+         {:dsp dsp :response res :win-price (float (/ fp 1000))})
+     (let [[{dsp :dsp res :response} {win-price :response}]
+           (->> resps
+                (shuffle)
+                (sort-by (comp :bidPrice :response) >)
+                (take 2))]
+       {:dsp dsp :response res :win-price (float (/ (:bidPrice win-price) 1000))}))))

 (defn click? [result response]
   (result (.indexOf (map :id advertisers) (:advertiserId response))))


Added 2 tests for calls-finalizer?

Added 2 tests for calls-finalizer?

--- test/app/test/core.clj
+++ test/app/test/core.clj
@@ -59,6 +59,14 @@
   (let [cl (parseType "ClassWithoutFinalizers")]
     (is (false? (calls-finalizers? cl)))))

+(deftest testClassWithCommentedCallToFinalize
+  (let [cl (parseType "ClassWithCommentedCallToFinalize")]
+    (is (false? (calls-finalizers? cl)))))
+
+(deftest testClassWithCallToFinalizeWithParams
+  (let [cl (parseType "ClassWithCallToFinalizeWithParams")]
+    (is (false? (calls-finalizers? cl)))))
+
 (deftest testConflictingOptions
   (is (true? (conflicting-options?
                {:query 'mc :linter true :interactive true})))


let sabolono perform its optmizations

let sabolono perform its optmizations

--- frontend/utils.clj
+++ frontend/utils.clj
@@ -45,9 +45,9 @@
        (~'render [~'_] ~@body))))

 (defmacro html [body]
-  `(let [body# ~body]
-     (if-not (:render-colors? initial-query-map)
-       (html/html body#)
+  `(if-not (:render-colors? initial-query-map)
+     (html/html ~body)
+     (let [body# ~body]
        (try
          (let [[tag# & rest#] body#
                attrs# (if (map? (first rest#))
@@ -66,4 +66,3 @@
                                    rest#))))
          (catch :default e#
            (html/html body#))))))
-


initial code & tests

initial code & tests

--- src/tupelo/strvec.cljc
+++ src/tupelo/strvec.cljc
@@ -12,7 +12,7 @@
     [clojure.string :as str]
     [schema.core :as s]
     [tupelo.core :as t]
-    [tupelo.core :as tsch]
+    [tupelo.schema :as tsch]
   ))
 (t/refer-tupelo)

@@ -22,16 +22,18 @@

 ; #todo add readme

+(def StringOrCharSeq (s/if string? s/Str tsch/StrVec))
+
 (s/defn drop :- tsch/StrVec
   "Drops the first N chars of a sequence, returning a StrVec result."
   [n    :- s/Int
-   txt  :- tsch/List]
+   txt  :- StringOrCharSeq ]
   (vec (cc/drop n (seq txt))))

 (s/defn take :- tsch/StrVec
   "Drops the first N chars of a sequence, returning a StrVec result."
   [n    :- s/Int
-   txt  :- tsch/List]
+   txt  :- StringOrCharSeq]
   (vec (cc/take n (seq txt))))

 (s/defn ->string :- s/Str


Enable login submit with enter key.

Enable login submit with enter key.

--- src/uxbox/ui/auth.cljs
+++ src/uxbox/ui/auth.cljs
@@ -18,7 +18,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn- login-submit
-  [local]
+  [event local]
+  (dom/prevent-default event)
   (let [form (:form @local)]
     (rs/emit! (da/login {:username (:email form)
                          :password (:password form)}))))
@@ -32,49 +33,43 @@
 (defn- login-field-change
   [local field event]
   (let [value (str/trim (dom/event->value event))]
-    (println @local value)
     (swap! local assoc-in [:form field] value)))

 (defn- login-render
   [own local]
-  (let [on-submit #(login-submit local)
+  (let [on-submit #(login-submit % local)
         submit-enabled? (login-submit-enabled? local)
         form (:form @local)]
-    (println "submit-enabled?" submit-enabled?)
     (html
      [:div.login
       [:div.login-body
        (uum/messages)
        [:a i/logo]
-       [:div.login-content
-        [:input.input-text
-         {:name "email"
-          :ref "email"
-          :value (:email form "")
-          :on-change #(login-field-change local :email %)
-          :placeholder "Email or Username"
-          :type "text"}]
-        [:input.input-text
-         {:name "password"
-          :ref "password"
-          :value (:password form "")
-          :on-change #(login-field-change local :password %)
-          :placeholder "Password"
-          :type "password"}]
-        #_[:div.input-checkbox.check-primary
-         [:input#checkbox1 {:value "1"
-                            :type "checkbox"}]
-         [:label {:for "checkbox1"} "Keep Me Signed in"]]
-        [:input.btn-primary
-         {:name "login"
-          :class (when-not submit-enabled? "btn-disabled")
-          :disabled (not submit-enabled?)
-          :value "Continue"
-          :type "submit"
-          :on-click on-submit}]
-        [:div.login-links
-         [:a {:on-click #(r/go :auth/recover-password)} "Forgot your password?"]
-         [:a {:on-click #(r/go :auth/register)} "Don't have an account?"]]]]])))
+       [:form {:on-submit on-submit}
+        [:div.login-content
+         [:input.input-text
+          {:name "email"
+           :ref "email"
+           :value (:email form "")
+           :on-change #(login-field-change local :email %)
+           :placeholder "Email or Username"
+           :type "text"}]
+         [:input.input-text
+          {:name "password"
+           :ref "password"
+           :value (:password form "")
+           :on-change #(login-field-change local :password %)
+           :placeholder "Password"
+           :type "password"}]
+         [:input.btn-primary
+          {:name "login"
+           :class (when-not submit-enabled? "btn-disabled")
+           :disabled (not submit-enabled?)
+           :value "Continue"
+           :type "submit"}]
+         [:div.login-links
+          [:a {:on-click #(r/go :auth/recover-password)} "Forgot your password?"]
+          [:a {:on-click #(r/go :auth/register)} "Don't have an account?"]]]]]])))

 (def ^:const login
   (mx/component


Update flow.clj

Update flow.clj

--- backend/src/akvo/lumen/component/flow.clj
+++ backend/src/akvo/lumen/component/flow.clj
@@ -52,5 +52,5 @@
 (defn >api-model [ds-source]
   (let [instance (get ds-source "instance")
         survey (get ds-source "surveyId")]
-    {:instance_id (if (= "uat1" instance) (str "akvoflow-" instance) instance)
+    {:instance_id instance
      :survey_id survey}))


[#359] Removed redundant java.net.URI import.

--- backend/src/org/akvo/lumen/import/csv.clj
+++ backend/src/org/akvo/lumen/import/csv.clj
@@ -6,8 +6,7 @@
             [hugsql.core :as hugsql]
             [org.akvo.lumen.import.common :as import]
             [org.akvo.lumen.util :refer [squuid]])
-  (:import java.net.URI
-           java.util.UUID
+  (:import java.util.UUID
            org.postgresql.PGConnection
            org.postgresql.copy.CopyManager
            com.ibm.icu.text.CharsetDetector


Added unit test.

Added unit test.

--- common-lib/test/cmr/common/test/xml.clj
+++ common-lib/test/cmr/common/test/xml.clj
@@ -119,3 +119,30 @@
        [(t/date-time 1989 10 14 4 3 27 456)] [:inner :single_datetime]
        [] [:foo]
        [] [:inner :foo]))
+
+(def iso-xml
+  "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+  <gmi:MI_Metadata xmlns:gmi=\"http://www.isotc211.org/2005/gmi\"
+  xmlns:gco=\"http://www.isotc211.org/2005/gco\"
+  xmlns:gmd=\"http://www.isotc211.org/2005/gmd\"
+  xmlns:gmx=\"http://www.isotc211.org/2005/gmx\"
+  xmlns:gsr=\"http://www.isotc211.org/2005/gsr\"
+  xmlns:gss=\"http://www.isotc211.org/2005/gss\"
+  xmlns:gts=\"http://www.isotc211.org/2005/gts\"
+  xmlns:srv=\"http://www.isotc211.org/2005/srv\"
+  xmlns:gml=\"http://www.opengis.net/gml/3.2\"
+  xmlns:xlink=\"http://www.w3.org/1999/xlink\"
+  xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
+  xmlns:swe=\"http://schemas.opengis.net/sweCommon/2.0/\"
+  xmlns:eos=\"http://earthdata.nasa.gov/schema/eos\"
+  xmlns:xs=\"http://www.w3.org/2001/XMLSchema\"><!--Other Properties, all:0, coi:0,ii:0,si:0,pli:0,pri:0,qi:0,gi:0,ci:0,dk:0,pcc:0,icc:0,scc:0-->
+  <gmd:fileIdentifier>
+  <gco:CharacterString>gov.nasa.echo:DatasetID</gco:CharacterString>
+  </gmd:fileIdentifier>
+  </gmi:MI_Metadata>")
+
+(def pretty-printed-iso-xml
+  "<?xml version=\"1.0\" encoding=\"UTF-16\"?>\n<gmi:MI_Metadata xmlns:eos=\"http://earthdata.nasa.gov/schema/eos\"\n    xmlns:gco=\"http://www.isotc211.org/2005/gco\"\n    xmlns:gmd=\"http://www.isotc211.org/2005/gmd\"\n    xmlns:gmi=\"http://www.isotc211.org/2005/gmi\"\n    xmlns:gml=\"http://www.opengis.net/gml/3.2\"\n    xmlns:gmx=\"http://www.isotc211.org/2005/gmx\"\n    xmlns:gsr=\"http://www.isotc211.org/2005/gsr\"\n    xmlns:gss=\"http://www.isotc211.org/2005/gss\"\n    xmlns:gts=\"http://www.isotc211.org/2005/gts\"\n    xmlns:srv=\"http://www.isotc211.org/2005/srv\"\n    xmlns:swe=\"http://schemas.opengis.net/sweCommon/2.0/\"\n    xmlns:xlink=\"http://www.w3.org/1999/xlink\"\n    xmlns:xs=\"http://www.w3.org/2001/XMLSchema\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\">\n    <!--Other Properties, all:0, coi:0,ii:0,si:0,pli:0,pri:0,qi:0,gi:0,ci:0,dk:0,pcc:0,icc:0,scc:0-->\n    <gmd:fileIdentifier>\n        <gco:CharacterString>gov.nasa.echo:DatasetID</gco:CharacterString>\n    </gmd:fileIdentifier>\n</gmi:MI_Metadata>\n")
+
+(deftest pretty-print-xml-test
+  (is (= pretty-printed-iso-xml (cx/pretty-print-xml iso-xml))))


Fix failing test

Fix failing test

--- test/gpx/core_test.clj
+++ test/gpx/core_test.clj
@@ -8,8 +8,8 @@

   (testing "Stats are correctly combined"
     (let [gpx (parse-gpx-file (io/resource "test/multi-segment.gpx"))
-          s1 (-> gpx :segments first stats)
-          s2 (-> gpx :segments second stats)
+          s1 (segment-stats (-> gpx :segment first))
+          s2 (segment-stats (-> gpx :segment second))
           sc (combine-stats s1 s2)]

       (is (= (-> sc :total :distance) (+ (-> s1 :total :distance) (-> s2 :total :distance))))
@@ -20,4 +20,5 @@

       (is (= (-> sc :elevation :gain) (+ (-> s1 :elevation :gain) (-> s2 :elevation :gain))))
       (is (= (-> sc :elevation :loss) (+ (-> s1 :elevation :loss) (-> s2 :elevation :loss))))
-      (is (= (-> sc :elevation :diff) (+ (-> s1 :elevation :diff) (-> s2 :elevation :diff)))) )))
+      (is (= (-> sc :elevation :diff) (+ (-> s1 :elevation :diff) (-> s2 :elevation :diff))))
+    )))


:bug: Fix text shape impl (unexpected exception on prod build).

--- frontend/src/app/main/ui/shapes/text.cljs
+++ frontend/src/app/main/ui/shapes/text.cljs
@@ -111,54 +111,56 @@
                         (p/all))]
     (reduce (fn [text [url data]] (str/replace text url data)) font-text url-to-data)))

-(defn- render-text-node
-  ([node] (render-text-node 0 node))
-  ([index {:keys [type text children] :as node}]
-   (let [embed-resources? (mf/use-ctx muc/embed-ctx)
-         embeded-fonts (mf/use-state nil)]
-     (mf/use-effect
-      (mf/deps node)
-      (fn []
-        (when (and embed-resources? (= type "root"))
-          (let [font-to-embed (get-all-fonts node)
-                embeded (map embed-font font-to-embed)]
-            (-> (p/all embeded)
-                (p/then (fn [result] (reset! embeded-fonts (str/join "\n" result)))))))))
+(mf/defc text-node
+  [{:keys [node index] :as props}]
+  (let [embed-resources? (mf/use-ctx muc/embed-ctx)
+        embeded-fonts    (mf/use-state nil)
+        {:keys [type text children]} node]

-     (mf/html
-      (if (string? text)
-        (let [style (generate-text-styles (clj->js node))]
-          [:span {:style style :key index} text])
-        (let [children (map-indexed render-text-node children)]
-          (case type
-            "root"
-            (let [style (generate-root-styles (clj->js node))]
-
-              [:div.root.rich-text
-               {:key index
-                :style style
-                :xmlns "http://www.w3.org/1999/xhtml"}
-               (when (not (nil? @embeded-fonts))
-                  [:style @embeded-fonts])
-               children])
+    (mf/use-effect
+     (mf/deps node)
+     (fn []
+       (when (and embed-resources? (= type "root"))
+         (let [font-to-embed (get-all-fonts node)
+               embeded (map embed-font font-to-embed)]
+           (-> (p/all embeded)
+               (p/then (fn [result] (reset! embeded-fonts (str/join "\n" result)))))))))

-            "paragraph-set"
-            (let [style #js {:display "inline-block"
-                             :width "100%"}]
+    (if (string? text)
+      (let [style (generate-text-styles (clj->js node))]
+        [:span {:style style :key index} text])
+      (let [children (map-indexed (fn [index node]
+                                    (mf/element text-node {:index index :node node :key index}))
+                                  children)]
+        (case type
+          "root"
+          (let [style (generate-root-styles (clj->js node))]
+
+            [:div.root.rich-text
+             {:key index
+              :style style
+              :xmlns "http://www.w3.org/1999/xhtml"}
+             (when (not (nil? @embeded-fonts))
+               [:style @embeded-fonts])
+             children])
+
+          "paragraph-set"
+          (let [style #js {:display "inline-block"
+                           :width "100%"}]
               [:div.paragraphs {:key index :style style} children])

-            "paragraph"
-            (let [style (generate-paragraph-styles (clj->js node))]
-              [:p {:key index :style style} children])
+          "paragraph"
+          (let [style (generate-paragraph-styles (clj->js node))]
+            [:p {:key index :style style} children])

-            nil)))))))
+          nil)))))

 (mf/defc text-content
   {::mf/wrap-props false
    ::mf/wrap [mf/memo]}
   [props]
   (let [root (obj/get props "content")]
-    (render-text-node root)))
+    [:& text-node {:index 0 :node root}]))

 (defn- retrieve-colors
   [shape]


focus fix

focus fix

--- src/cljs/re_form/inputs/date_input_impl.cljs
+++ src/cljs/re_form/inputs/date_input_impl.cljs
@@ -46,7 +46,7 @@
                       :border :none
                       :padding-left 0
                       :width (u/px- 244 h2 (* 3 w))}
-     [:&:focus
+     #_[:&:focus
       {:outline :none}]]]])

 (def simple-regex #"^(\d\d)(\d\d)(\d\d\d\d)$")
@@ -172,10 +172,11 @@
            [:div.date-chevrons
             {:on-click #(on-change (dec-iso value))}
             [:i.material-icons "chevron_left"]])
-         [:div.date-input {:on-blur #(my-on-blur % (or on-blur identity))
-                           :class (if label
-                                    (str "input-field")
-                                    (when-not (empty? errors) :error))}
+         [:div.date-input
+          {:on-blur #(my-on-blur % (or on-blur identity))
+           :class (if label
+                    (str "input-field")
+                    (when-not (empty? errors) :error))}
           [:i.material-icons
            {:on-click
             #(let [parent-node (.. % -target -parentNode)


:fire: Remove useless prn's.

:fire: Remove useless prn's.

--- frontend/src/uxbox/main/data/pages.cljs
+++ frontend/src/uxbox/main/data/pages.cljs
@@ -241,7 +241,6 @@

     ptk/UpdateEvent
     (update [_ state]
-      (prn "page-persisted" data)
       (let [{:keys [id version]} data]
         (-> state
             (assoc-in [:pages id :version] version)
@@ -263,7 +262,6 @@

      ptk/WatchEvent
      (watch [this state s]
-       (prn "persist-page" id)
        (let [page (get-in state [:pages id])]
          (if (:history page)
            (rx/empty)


avoid repeated merge conflict comments

avoid repeated merge conflict comments

this avoids adding additional merge conflict
comments on a PR when a comment has already been
added and no commits have been commited since.

--- src/github_bot_app/action/merge_conflict.clj
+++ src/github_bot_app/action/merge_conflict.clj
@@ -24,6 +24,43 @@
     (gh-pulls/specific-pull
      owner repo pull-id
      (:auth-options config))))
+
+
+(def conflict-comment-pat
+  #"^It looks like #\d+ got there first")
+
+
+(defn- last-conflict-comment-instant
+  [owner repo pull-id config]
+  (let [comments (github-api-time!
+          (gh-issues/issue-comments
+           owner repo pull-id
+           (:auth-options config)))]
+    (log/info (pr-str
+               {:api-all :issue-comments
+                :number pull-id
+                :count (count comments)}))
+    (->> comments
+         (filter #(re-find conflict-comment-pat (:body %)))
+         (map :created_at)
+         sort
+         last)))
+
+
+(defn- last-commit-instant
+  [owner repo pull-id config]
+  (let [commits (github-api-time!
+                 (gh-pulls/commits
+                  owner repo pull-id
+                  (:auth-options config)))]
+    (log/info (pr-str
+               {:api-all :pull-commits
+                :number pull-id
+                :count (count commits)}))
+    (->> commits
+         (map #(get-in % [:commit :committer :date]))
+         sort
+         last)))

 (defn run-action [event payload config]
@@ -84,20 +121,26 @@
                                    :base-ref base-ref
                                    :head-ref (get-in pull [:head :ref])
                                    :last-merged merged-pull-id}))
-                       (github-api-time!
-                        (gh-issues/create-comment
-                         owner repo pull-id
-                         (str "It looks like #"
-                              merged-pull-id
-                              " got there first and ruined your clean merge!\n\n"
-                              "You'll need to need to resolve the conflicts with the `"
-                              base-ref
-                              "` branch.\n")
-                         (:auth-options config)))
-                       (log/info (pr-str
-                                  {:api-call :create-comment
-                                   :url (:comments_url p)
-                                   :info :merge-conflict}))))))))))))
+                       (if (< 0 (compare (last-conflict-comment-instant owner repo pull-id config)
+                                         (last-commit-instant owner repo pull-id config))) ;; true if comment-instant is nil
+                         (do
+                           (github-api-time!
+                            (gh-issues/create-comment
+                             owner repo pull-id
+                             (str "It looks like #"
+                                  merged-pull-id
+                                  " got there first and ruined your clean merge!\n\n"
+                                  "You'll need to need to resolve the conflicts with the `"
+                                  base-ref
+                                  "` branch.\n")
+                             (:auth-options config)))
+                           (log/info (pr-str
+                                      {:api-call :create-comment
+                                       :url (:comments_url p)
+                                       :info :merge-conflict})))
+                         (log/info (pr-str
+                                    {:info :existing-merge-conflict
+                                     :url (:url p)})))))))))))))
       (log/info (pr-str
                  {:schedule
                   {:delay 5


Fix failing tx test, ffs

Fix failing tx test, ffs

--- integration-tests/apps/tx/src/tx/core.clj
+++ integration-tests/apps/tx/src/tx/core.clj
@@ -11,7 +11,7 @@
   (imsg/start "/queue/remote-test"))

 ;;; And an Infinispan cache
-(def cache (ic/cache "tx.core"))
+(def cache (ic/cache "tx.core" :mode :local))

 (defn cache-fixture [f]
   (ic/delete-all cache)


Safer URL generation for company.

Safer URL generation for company.

--- src/open_company/representations/company.clj
+++ src/open_company/representations/company.clj
@@ -10,7 +10,7 @@

 (defun url
   ([ticker :guard string?] (str "/v1/companies/" ticker))
-  ([company] (url (:symbol company))))
+  ([company :guard map?] (url (:symbol company))))

 (defn- self-link [company]
   (common/self-link (url company) media-type))


Fix broken test.

Fix broken test.

--- src/open_company/representations/section.clj
+++ src/open_company/representations/section.clj
@@ -1,5 +1,5 @@
 (ns open-company.representations.section
-  (:require [defun.core :refer (defun-)]
+  (:require [defun.core :refer (defun defun-)]
             [cheshire.core :as json]
             [open-company.representations.common :as common]
             [open-company.resources.section :as section]))
@@ -9,7 +9,7 @@

 (def ^:private clean-properties [:id :company-slug :section-name])

-(defun- url
+(defun url

   ([company-slug section-name]
   (str "/companies/" (name company-slug) "/" (name section-name)))


rewrittenn characters range check

rewrittenn characters range check

--- exercises/pangram/src/example.clj
+++ exercises/pangram/src/example.clj
@@ -1,13 +1,11 @@
 (ns pangram)

-(def ^:private in-range? ((fn [] (let [start (int \a)
-                                       end (inc (int \z))]
-                                   #(<= start (int %) end)))))
+(defn- char<= [ch1 ch2] (<= (compare ch1 ch2) 0))

 (defn pangram? [input]
   (->> input
        (into [] (comp (map #(Character/toLowerCase %))
-                      (filter in-range?)
+                      (filter #(and (char<= \a %) (char<= % \z)))
                       (distinct)))
        count
        (= 26)))


Disabled next in password screen

Disabled next in password screen

Fixes #10965

Signed-off-by: Gheorghe Pinzaru <742a0a3885ab52ea1795e48e261ec4223e194612@gmail.com>

--- src/status_im/ui/screens/intro/password.cljs
+++ src/status_im/ui/screens/intro/password.cljs
@@ -27,7 +27,7 @@
             valid-form     (confirm-password @password @confirm)
             on-submit      (fn []
                              (when (not processing?)
-                               (if valid-form
+                               (if (and valid-password valid-form)
                                  (do (reset! show-error false)
                                      (re-frame/dispatch [forward-action {:key-code @password}]))
                                  (reset! show-error true))))]
@@ -106,6 +106,7 @@
                       :accessibility-label :onboarding-next-button
                       :disabled            (or (nil? @confirm)
                                                (not valid-password)
+                                               (not valid-form)
                                                processing?)
                       :type                :secondary
                       :after               :main-icons/next}


Indentation cleanup

Indentation cleanup

--- test/metabase/models/dashboard_card_test.clj
+++ test/metabase/models/dashboard_card_test.clj
@@ -159,21 +159,21 @@
                           :display                :table
                           :dataset_query          {}
                           :visualization_settings {}}]}
-   {:sizeX  4
-    :sizeY  3
-    :col    1
-    :row    1
+   {:sizeX              4
+    :sizeY              3
+    :col                1
+    :row                1
     :parameter_mappings [{:foo "barbar"}]
-    :series [{:name                   "Test Card 2"
-              :description            nil
-              :display                :table
-              :dataset_query          {}
-              :visualization_settings {}}
-             {:name                   "Test Card 1"
-              :description            nil
-              :display                :table
-              :dataset_query          {}
-              :visualization_settings {}}]}]
+    :series             [{:name                   "Test Card 2"
+                          :description            nil
+                          :display                :table
+                          :dataset_query          {}
+                          :visualization_settings {}}
+                         {:name                   "Test Card 1"
+                          :description            nil
+                          :display                :table
+                          :dataset_query          {}
+                          :visualization_settings {}}]}]
   (tu/with-temp* [Dashboard     [{dashboard-id :id}]
                   Card          [{card-id :id}]
                   DashboardCard [{dashcard-id :id} {:dashboard_id dashboard-id, :card_id card-id, :parameter_mappings [{:foo "bar"}]}]
@@ -194,15 +194,15 @@
                                                          :col          1
                                                          :series       [card-id-2 card-id-1]}))
      =======
-     (remove-ids-and-timestamps (update-dashboard-card {:id           dashcard-id
-                                                        :actor_id     (user->id :rasta)
-                                                        :dashboard_id nil
-                                                        :card_id      nil
-                                                        :sizeX        4
-                                                        :sizeY        3
-                                                        :row          1
-                                                        :col          1
+     (remove-ids-and-timestamps (update-dashboard-card {:id                 dashcard-id
+                                                        :actor_id           (user->id :rasta)
+                                                        :dashboard_id       nil
+                                                        :card_id            nil
+                                                        :sizeX              4
+                                                        :sizeY              3
+                                                        :row                1
+                                                        :col                1
                                                         :parameter_mappings [{:foo "barbar"}]
-                                                        :series       [card-id-2 card-id-1]}))
+                                                        :series             [card-id-2 card-id-1]}))
      >>>>>>> 6161e125978af1a6db7887464be4c5df48259464
      (remove-ids-and-timestamps (retrieve-dashboard-card dashcard-id))]))


Doctype added.

Doctype added.

--- test/plugboard/demos/accept/webfunctions.clj
+++ test/plugboard/demos/accept/webfunctions.clj
@@ -26,14 +26,15 @@
   index-xml []
   (with-out-str
     (binding [prxml/*prxml-indent* 4]
-      (prxml/prxml [:decl!]
+      (prxml/prxml
+       [:decl!]
+       [:doctype! "html" "PUBLIC" "\"-//W3C//DTD XHTML 1.0 Strict//EN\"" "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\""]
        [:html
         [:head]
         [:body
          [:h1 "Index"]
          [:p "Content type is " (str (web/get-content-type))]
-         (html/table (web/get-request))
-         ]]))))
+         (html/table (web/get-request))]]))))

 (defn ^{web/path "index"
         web/content-type "text/html"
@@ -45,8 +46,7 @@
     [:body
      [:h1 "Index"]
      [:p "Content type is " (str (web/get-content-type))]
-     (html/table (web/get-request))
-     ]]))
+     (html/table (web/get-request))]]))

 (defn ^{web/path "index"
         web/content-type "text/plain"


reduces output generated when assertion fails (#671)

## Changes proposed in this PR

- reduces output generated when assertion fails
- asserts on the 100th percentile value to avoid metrics aggregation issues.

## Why are we making these changes?

Reduces flakiness and output generated by the test.

--- waiter/integration/waiter/streaming_test.clj
+++ waiter/integration/waiter/streaming_test.clj
@@ -42,7 +42,7 @@
                         :x-cid request-cid)
               {:keys [body] :as response} (make-kitchen-request waiter-url headers :body post-body)]
           (is (= 200 (:status response)) (str "Request correlation-id: " request-cid))
-          (is (= post-body body) (str (:status response) (:headers response)))))
+          (is (.equals post-body body) (str response)))) ;; avoids printing the post-body when assertion fails
       ; wait to allow metrics to be aggregated
       (let [sleep-period (max (* 20 metrics-sync-interval-ms) 10000)]
         (log/debug "sleeping for" sleep-period "ms")
@@ -59,16 +59,14 @@
         (is (= (inc num-streaming-requests) (:successful request-counts)))
         (is (= (inc num-streaming-requests) (:total request-counts)))
         ;; there is no content length on the canary request
-        (is (= num-streaming-requests (get-in request-size-histogram [:count] 0))
+        (is (= num-streaming-requests (get request-size-histogram :count 0))
             (str "request-size-histogram: " request-size-histogram))
-        (is (->> (- body-size (get-in request-size-histogram [:value :0.0] 0.0)) (double) (Math/abs) (>= epsilon))
+        (is (->> (get-in request-size-histogram [:value :1.0] 0.0) (- body-size) Math/abs (>= epsilon))
             (str "request-size-histogram: " request-size-histogram))
-        (is (= (inc num-streaming-requests) (get-in response-size-histogram [:count]))
+        (is (= (inc num-streaming-requests) (get response-size-histogram :count))
             (str "response-size-histogram: " response-size-histogram))
         ;; all (canary and streaming) response sizes are logged
-        (is (->> (get-in response-size-histogram [:value :0.0] 0.0) (double) (Math/abs) (>= epsilon))
-            (str "response-size-histogram: " response-size-histogram))
-        (is (->> (- body-size (get-in response-size-histogram [:value :0.25] 0.0)) (double) (Math/abs) (>= epsilon))
+        (is (->> (get-in response-size-histogram [:value :1.0] 0.0) (- body-size) Math/abs (>= epsilon))
             (str "response-size-histogram: " response-size-histogram)))
       (delete-service waiter-url service-id))))


CMR-4558 Try pmap to improve performance

--- search-app/src/cmr/search/site/data.clj
+++ search-app/src/cmr/search/site/data.clj
@@ -109,7 +109,7 @@
   [context tag providers]
   (debug "Using providers:" providers)
   (->> providers
-       (map (partial provider-data context tag))
+       (pmap (partial provider-data context tag))
        ;; Only want to include providers with EOSDIS collections
        (remove #(zero? (get % :collections-count 0)))
        (sort-by :id)))


The action is "Log Out", not "Logout"

The action is "Log Out", not "Logout"

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -565,10 +565,10 @@
            (when-not (ld/feature-on? "top-bar-ui-v-1")
             [:a.aside-item.push-to-bottom {:data-placement "right"
                                            :data-trigger "hover"
-                                           :title "Logout"
+                                           :title "Log Out"
                                            :href "/logout"}
               [:i.material-icons "power_settings_new"]
-              [:div.nav-label "Logout"]])])))))
+              [:div.nav-label "Log Out"]])])))))

 (defn aside [{:keys [app show-aside-menu?]} owner]


removed the mixpanel file

removed the mixpanel file

--- src-cljs/frontend/analytics/mixpanel.cljs
+++ src-cljs/frontend/analytics/mixpanel.cljs
@@ -1,43 +0,0 @@
-(ns frontend.analytics.mixpanel
-  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
-            [frontend.async :refer [put!]]
-            [frontend.datetime :refer [unix-timestamp]]
-            [frontend.utils :as utils :include-macros true]))
-
-(defn get-property [prop]
-  (js/mixpanel.get_property prop))
-
-(defn track [event & [props]]
-  (utils/swallow-errors (js/mixpanel.track event (clj->js (merge {:event_time (unix-timestamp)} props)))))
-
-(defn track-link [element event & [props]]
-  (utils/swallow-errors (js/mixpanel.track_links element event (clj->js (merge {:event_time (unix-timestamp)} props)))))
-
-(defn track-pageview [path]
-  (utils/swallow-errors (js/mixpanel.track_pageview path)))
-
-(defn register [props]
-  (utils/swallow-errors (js/mixpanel.register (clj->js props))))
-
-(defn register-once [props]
-  (utils/swallow-errors (js/mixpanel.register_once (clj->js props))))
-
-(defn name-tag [username]
-  (utils/swallow-errors (js/mixpanel.name_tag username)))
-
-(defn identify [username]
-  (utils/swallow-errors (js/mixpanel.identify username)))
-
-(defn managed-track [event & [props]]
-  (let [ch (chan)]
-    (js/mixpanel.track event (clj->js props)
-                       #(do (put! ch %) (close! ch)))
-    ch))
-
-(defn init-user [login]
-  (name-tag login)
-  (identify login))
-
-(defn set-existing-user []
-  (utils/swallow-errors
-   (js/CI.ExistingUserHeuristics.)))


add in missing waits to fix problem reported by Helga

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -389,8 +389,8 @@
                  ;  (println "setting reference z position from msp")
                  ;  (state-assoc! :reference-z-position pos))
                  (apply set-stage-position axis pos))])
-    (for [prop (get-in event [:channel :properties])]
-      [(prop 0) #(core setProperty (prop 0) (prop 1) (prop 2))])
+    (for [[d p v] (get-in event [:channel :properties])]
+      [d #(core setProperty d p v)])
     (when-let [exposure (:exposure event)]
       (list [(core getCameraDevice) #(core setExposure exposure)]))))

@@ -415,9 +415,12 @@
           #(when-let [z-drive (@state :default-z-drive)]
             (let [z (compute-z-position event)]
               (when (not= z (@state :last-z-position))
-                (do (set-stage-position z-drive z)
-                    (wait-for-device z-drive)))))
-          #(do (expose event)
+                (set-stage-position z-drive z))))
+          #(do (for [[d _ _] (get-in event [:channel :properties])]
+                 (wait-for-device d))
+               (wait-for-device (@state :default-z-drive))
+               (wait-for-device (core getXYStageDevice))
+               (expose event)
                (collect-image event out-queue))))))

 (defn execute [event-fns]


Isolate clojure.core.async namespace in containium

--- resources/spec.clj
+++ resources/spec.clj
@@ -37,6 +37,7 @@
                       "qbits.*"
                       "clj.time.*"
                       "cljs.core.async.*"
+                      "clojure.core.async.*"
                       "lamina.*"
                       "taoensso.nippy.*"
                       "potemkin.*"


Logistic regression returns no errors. Still needs to be tested.

--- src/brevis/math/logistic_regression.clj
+++ src/brevis/math/logistic_regression.clj
@@ -22,10 +22,20 @@
     num
     (unchecked-negate num)))

-(defn csv-to-matrix
+(defn csv-to-nest-seq
   [path]
-  (map #(seq (clojure.string/split % #", "))
-       (clojure.string/split-lines (slurp path))))
+  (let
+    [data (map #(seq (clojure.string/split % #", "))
+               (clojure.string/split-lines (slurp path)))
+
+     width (count (first data))
+
+     output (partition width (map #(let [el (read-string %)]
+                                     (if (number? el)
+                                       el
+                                       %))
+                                  (flatten data)))]
+    output))

 (defn nest-seq-to-csv
   [seq path]
@@ -138,7 +148,7 @@
          :centroids (rvec-seq-sort new-means )
          ;:old-centroids means
          :iterations iterations
-         ;:distance mean-distance
+         :distance mean-distance
          }
         (recur (inc iterations)
                new-means))))))
@@ -154,10 +164,11 @@
       (if (= stop iteration)
         theta
         (recur (inc iteration)
-               (matrix-mult x
-                            (transpose (sub y
-                                            (matrix-pmap sigmoid
-                                                        (matrix-mult (transpose theta)
-                                                                     x))))))))))
+               (matrix-mult (transpose x)
+                            (sub y
+                                 (matrix-pmap sigmoid
+                                             (matrix-mult x
+                                                          theta
+                                                          )))))))))


redefine resource-pie val -> hover

redefine resource-pie val -> hover

--- src/cljs/swarmpit/component/common.cljs
+++ src/cljs/swarmpit/component/common.cljs
@@ -169,15 +169,15 @@
   (cond
     (< usage 75) {:name  "used"
                   :value usage
-                  :val   value
+                  :hover value
                   :color "#52B359"}
     (> usage 90) {:name  "used"
                   :value usage
-                  :val   value
+                  :hover value
                   :color "#d32f2f"}
     :else {:name  "used"
            :value usage
-           :val   value
+           :hover value
            :color "#ffa000"}))

 (rum/defc resource-pie < rum/static
@@ -186,7 +186,7 @@
         data [(resource-used usage value)
               {:name  "free"
                :value (- 100 usage)
-               :val   (- limit value)
+               :hover (- limit value)
                :color "#ccc"}]]
     (chart/pie
       data
@@ -194,9 +194,9 @@
       "Swarmpit-stat-graph"
       id
       {:formatter (fn [value name props]
-                    (let [val (.-val (.-payload props))]
+                    (let [hover-value (.-hover (.-payload props))]
                       (case type
-                        :disk (render-capacity val false)
-                        :memory (render-capacity val true)
-                        :cpu (str (render-cores val) " vCPU")
-                        val)))})))+                        :disk (render-capacity hover-value false)
+                        :memory (render-capacity hover-value true)
+                        :cpu (str (render-cores hover-value) " vCPU")
+                        hover-value)))})))


extract title setup to func

extract title setup to func

--- src/cljs/swarmpit/component/layout.cljs
+++ src/cljs/swarmpit/component/layout.cljs
@@ -52,6 +52,11 @@
 (rum/defc page-single < rum/static [route]
   (view/dispatch route))

+(defn- document-title
+  [layout-title]
+  (set! (-> js/document .-title)
+        (str layout-title " :: swarmpit")))
+
 (rum/defc page-layout < rum/reactive [route]
   (let [{:keys [opened]} (state/react menu/cursor)
         {:keys [handler]} route
@@ -59,7 +64,7 @@
                       "layout-opened"
                       "layout-closed")
         layout-title (page-title handler)]
-    (set! (. js/document -title) (str layout-title " :: swarmpit"))
+    (document-title layout-title)
     [:div {:class ["layout" layout-type]}
      [:header (header/appbar layout-title)]
      [:nav (menu/drawer layout-title)]


Remove authorization implementation for token and signet token backends.

--- src/clojure/buddy/auth/backends/token.clj
+++ src/clojure/buddy/auth/backends/token.clj
@@ -31,41 +31,22 @@
     (get matches 1)))

 (defn signed-token-backend
-  [& [{:keys [privkey unauthorized-handler max-age]}]]
+  [{:keys [privkey unauthorized-handler max-age]}]
   (reify
     proto/IAuthentication
     (parse [_ request]
       (parse-authorization-header request))
     (authenticate [_ request data]
-      (assoc request :identity (loads data privkey {:max-age max-age})))
-
-    proto/IAuthorization
-    (handle-unauthorized [_ request metadata]
-      (if unauthorized-handler
-        (unauthorized-handler request metadata)
-        (if (authenticated? request)
-          (-> (response "Permission denied")
-              (status 403))
-          (-> (response "Unauthorized")
-              (status 401)))))))
+      (assoc request :identity (loads data privkey {:max-age max-age})))))

 (defn token-backend
-  [& [{:keys [authfn unauthorized-handler]}]]
+  [{:keys [authfn unauthorized-handler]}]
+  {:pre [(fn? authfn)]}
   (reify
     proto/IAuthentication
     (parse [_ request]
       (parse-authorization-header request))
     (authenticate [_ request token]
-      (let [rsq (when authfn (authfn request token))]
+      (let [rsq (authfn request token)]
         (if (response? rsq) rsq
-            (assoc request :identity rsq))))
-
-    proto/IAuthorization
-    (handle-unauthorized [_ request metadata]
-      (if unauthorized-handler
-        (unauthorized-handler request metadata)
-        (if (authenticated? request)
-          (-> (response "Permission denied")
-              (status 403))
-          (-> (response "Unauthorized")
-              (status 401)))))))
+            (assoc request :identity rsq))))))


[#843] Actually using the hikary config

[#843] Actually using the hikary config

--- backend/src/akvo/lumen/component/hikaricp.clj
+++ backend/src/akvo/lumen/component/hikaricp.clj
@@ -3,7 +3,10 @@
             [duct.database.sql.hikaricp]))

 (defmethod ig/init-key :akvo.lumen.component.hikaricp/hikaricp  [_ {:keys [ config] :as opts}]
-  (ig/init-key :duct.database.sql/hikaricp {:jdbc-url (-> config :db :uri)}))
+  (ig/init-key :duct.database.sql/hikaricp
+               (-> config
+                   :db
+                   (clojure.set/rename-keys {:uri :jdbc-url}))))

 (defmethod ig/halt-key! :akvo.lumen.component.hikaricp/hikaricp  [_ opts]
   (ig/halt-key! :duct.database.sql/hikaricp opts))


[#2372] Decrease log level on keycloak component start

--- backend/src/akvo/lumen/component/keycloak.clj
+++ backend/src/akvo/lumen/component/keycloak.clj
@@ -32,7 +32,7 @@
   [issuer req-opts]
   (let [url (format "%s/.well-known/openid-configuration" issuer)
         res (-> (http.client/get* url (merge http-client-req-defaults req-opts)) :body json/decode)]
-    (log/info "Successfully got openid-config from provider.")
+    (log/debug "Successfully got openid-config from provider.")
     res))

 (defn get-roles [{:keys [api-root]} headers]
@@ -556,7 +556,7 @@
   ::public-client)

 (defmethod ig/init-key :akvo.lumen.component.keycloak/authorization-service  [_ {:keys [credentials public-client max-user-ids-cache monitoring paths-cache-seconds] :as opts}]
-  (log/info "Starting keycloak")
+  (log/debug "Starting keycloak")
   (assoc (init-keycloak (assoc public-client
                                :credentials credentials
                                :max-user-ids-cache max-user-ids-cache
@@ -575,7 +575,7 @@

 (defmethod ig/halt-key! :akvo.lumen.component.keycloak/authorization-service  [_ opts]
-  (log/info :keycloak "closing connection manager" (:connection-manager opts))
+  (log/debug :keycloak "closing connection manager" (:connection-manager opts))
   (http.client/shutdown-manager (:connection-manager opts)))


Add comment

Add comment

--- src/devcards/discuss/devcards/core.cljs
+++ src/devcards/discuss/devcards/core.cljs
@@ -31,7 +31,7 @@
                   (debug/control-buttons lib/app-state)))

 (defcard find-form
-         ""
+         "*Select issue and search for statements.*"
          (dc/om-root find/form-view))

 (defcard-om find-statement