Add shift button, bar adjustments.

Add shift button, bar adjustments.

Also move metronome info to top two display lines in preparation for
adding sync interface.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -135,9 +135,26 @@
    :quantize {:control 116 :kind :monochrome}
    :double   {:control 117 :kind :monochrome}
    :delete   {:control 118 :kind :monochrome}
-   :undo     {:control 119 :kind :monochrome}
-
-   })
+   :undo     {:control 119 :kind :monochrome}})
+
+(def special-symbols
+  "The byte values which draw special-purpose characters on the Push
+  display."
+  {:up-arrow (byte 0)
+   :down-arrow (byte 1)
+   :pancake (byte 2)
+   :fader-left (byte 3)
+   :fader-right (byte 4)
+   :fader-center (byte 5)
+   :fader-empty (byte 6)
+   :folder (byte 7)
+   :split-vertical-line (byte 8)
+   :degree (byte 9)
+   :ellipsis (byte 28)
+   :solid-block (byte 29)
+   :right-arrow (byte 30)
+   :left-arrow (byte 31)
+   :selected-triangle (byte 127)})

 (defn button-state
   "Calculate the numeric value that corresponds to a particular
@@ -265,6 +282,41 @@
     (doseq [[i val] (map-indexed vector bytes)]
       (aset (get (:next-display controller) row) (+ (* cell 17) i) (util/ubyte val)))))

+(defn- update-metronome-section
+  "Updates the sections of the interface related to metronome
+  control."
+  [controller]
+  (let [metronome (:metronome (:show controller))
+        metronome-button (:metronome control-buttons)
+        tap-tempo-button (:tap-tempo control-buttons)
+        metronome-mode @(:metronome-mode controller)]
+    ;; Should the first cell display metronome information?
+    (if (seq metronome-mode)
+      (let [metronome (:metronome (:show controller))
+            marker (rhythm/metro-marker metronome)
+            bpm (format "%.1f" (float (rhythm/metro-bpm metronome)))
+            chars (+ (count marker) (count bpm))
+            padding (apply str (take (- 17 chars) (repeat " ")))]
+        (swap! (:next-text-buttons controller)
+               assoc metronome-button (button-state metronome-button :bright))
+        (write-display-cell controller 1 0 (str marker padding bpm))
+        (write-display-cell controller 0 0 "Beat        BPM  ")
+        (when (:adjusting-beat metronome-mode)
+          (let [arrow-pos (if @(:shift-mode controller)
+                            (dec (.indexOf marker "." (inc (.indexOf marker "."))))
+                            (dec (count marker)))]
+            (aset (get (:next-display controller) 2) arrow-pos (:up-arrow special-symbols))))
+        (when (:adjusting-bpm metronome-mode)
+          (aset (get (:next-display controller) 2) 16 (:up-arrow special-symbols))))
+      (swap! (:next-text-buttons controller)
+             assoc metronome-button (button-state metronome-button :dim)))
+    ;; Regardless, flash the tap tempo button on beats
+    (swap! (:next-text-buttons controller)
+           assoc tap-tempo-button
+           (button-state tap-tempo-button
+                         (if (< (rhythm/metro-beat-phase metronome) 0.15)
+                           :bright :dim)))))
+
 (defn update-interface
   "Determine the desired current state of the interface, and send any
   changes needed to get it to that state."
@@ -278,33 +330,13 @@
     ;; TODO: Loop over the most recent four active cues, rendering information
     ;;       about them.

-    (let [metronome (:metronome (:show controller))
-          metronome-button (:metronome control-buttons)
-          tap-tempo-button (:tap-tempo control-buttons)
-          metronome-mode @(:metronome-mode controller)]
-      ;; Should the first cell display metronome information?
-      (if (seq metronome-mode)
-        (let [metronome (:metronome (:show controller))
-              marker (rhythm/metro-marker metronome)
-              bpm (format "%.1f" (float (rhythm/metro-bpm metronome)))
-              chars (+ (count marker) (count bpm))
-              padding (apply str (take (- 17 chars) (repeat " ")))]
-          (swap! (:next-text-buttons controller)
-                 assoc metronome-button (button-state metronome-button :bright))
-          (write-display-cell controller 3 0 (str marker padding bpm))
-          (write-display-cell controller 2 0 "Beat        BPM  ")
-          (when (:adjusting-beat metronome-mode)
-            (aset (get (:next-display controller) 2) (dec (count marker)) (byte 1)))
-          (when (:adjusting-bpm metronome-mode)
-            (aset (get (:next-display controller) 2) 16 (byte 1))))
-        (swap! (:next-text-buttons controller)
-               assoc metronome-button (button-state metronome-button :dim)))
-      ;; Regardless, flash the tap tempo button on beats
-      (swap! (:next-text-buttons controller)
-             assoc tap-tempo-button
-             (button-state tap-tempo-button
-                           (if (< (rhythm/metro-beat-phase metronome) 0.15)
-                             :bright :dim))))
+    (update-metronome-section controller)
+
+    ;; Reflect the shift button state
+    (swap! (:next-text-buttons controller)
+           assoc (:shift control-buttons)
+           (button-state (:shift control-buttons)
+                         (if @(:shift-mode controller) :bright :dim)))

     (update-text controller)
     (update-text-buttons controller)
@@ -446,13 +478,21 @@
     14 ; Beat encoder
     (let [delta (sign-velocity (:velocity message))
           snapshot (rhythm/metro-snapshot (:metronome (:show controller)))]
-      (rhythm/metro-start (:metronome (:show controller)) (+ (:beat snapshot) delta))
-      (rhythm/metro-beat-phase (:metronome (:show controller) (:beat-phase snapshot))))
+      (if @(:shift-mode controller)
+        ;; User is adjusting the current bar
+        (rhythm/metro-bar-start (:metronome (:show controller)) (+ (:bar snapshot) delta))
+        ;; User is adjusting the current beat; keep the phase unchanged
+        (do
+          (rhythm/metro-start (:metronome (:show controller)) (+ (:beat snapshot) delta))
+          (rhythm/metro-beat-phase (:metronome (:show controller) (:beat-phase snapshot))))))

     15 ; BPM encoder
     (let [delta (/ (sign-velocity (:velocity message)) 10)
           bpm (rhythm/metro-bpm (:metronome (:show controller)))]
       (rhythm/metro-bpm (:metronome (:show controller)) (+ bpm delta)))
+
+    49 ; Shift button
+    (swap! (:shift-mode controller) (fn [_] (> (:velocity message) 0)))

     ;; Something we don't care about
     nil))
@@ -533,6 +573,7 @@
          :last-text-buttons (atom {})
          :next-text-buttons (atom {})
          :metronome-mode (atom {:showing true})
+         :shift-mode (atom false)
          :midi-handler (atom nil)
          :tap-tempo-handler (amidi/create-tempo-tap-handler (:metronome show))
          }]


finished a first draft of the NDVI filter graph. still need to adjust colors and a little layout, but it's mostly done.

--- src/clj/forma/presentation/ndvi_filter.clj
+++ src/clj/forma/presentation/ndvi_filter.clj
@@ -8,9 +8,19 @@
             [incanter.charts :as c]
             [incanter.core :as i]))

+;; This is a presentation to show how the filtering techniques work on
+;; time-series data.  We can show the Hodrick-Prescott filter with a
+;; slider bar to adjust the smoothing parameter.  We can also show how
+;; to interpolate across "holes" as determined by the (fake)
+;; reliability time-series
+
 ;; Here are some time conversion functions -- note that Sam is being a
 ;; real bitch about them, so we'll probably be moving these bad boys
 ;; over to conversion.
+
+(defn round-places [decimals number]
+  (let [factor (expt 10 decimals)]
+    (float (/ (round (* factor number)) factor))))

 (defn msecs-from-epoch
   [date]
@@ -21,36 +31,73 @@
     (for [month (range total-months)]
       (msecs-from-epoch (time/plus start (time/months month))))))

+;; Create sample NDVI data for a single pixel, so that we can graph
+;; the filtering techniques on sample data.
+
+(def ndvi [7417 7568 7930 8049 8039 8533 8260 8192 7968 7148 7724 8800 8068 7680 7590 7882 8022 8194 8031 8100 7965 8538 7881 8347 8167 5295 8000 7874 8220 8283 8194 7826 8698 7838 8967 8136 7532 7838 8009 8136 8400 8219 8051 8091 7718 8095 8391 7983 8236 8091 7937 7958 8147 8134 7813 8146 7623 8525 8714 8058 6730 8232 7744 8030 8355 8216 7879 8080 8201 7987 8498 7868 7852 7983 8135 8012 8195 8157 7989 8372 8007 8081 7940 7712 7913 8021 8241 8041 7250 7884 8105 8033 8340 8288 7691 7599 8480 8563 8033 7708 7575 7996 7739 8058 7400 6682 7999 7655 7533 7904 8328 8056 7817 7601 7924 7905 7623 7615 7560 7330 7878 8524 8167 7526 7330 7325 7485 8108 7978 7035 7650])
+
+;; Create sample reliability time-series, assuming that any NDVI value
+;; below 7000 is "bad". A value of "2" indicates an offending value;
+;; all other observations are represented by "1".
+
+(def reli (replace-val (replace-val ndvi < 7000 2) > 2 1))
+
+;; Mark all offending values in order to graph the "kill points"
+
 (def kill-vals (replace-val ndvi > 7000 nil))
-(def reli (replace-val (replace-val ndvi < 7000 2) > 2 1))
+
+;; Create a time range for the x-axis on the time-series graph; NOTE
+;; that this will have to change, once the time functions are moved to
+;; conversion.
+
 (def forma-range (msec-range (date-time 2000 2) (date-time 2010 12)))

+;; Initialize the first plot with the raw NDVI time-series; the
+;; default color for this line is blue.  In order to view this plot,
+;; you only need to type (i/view plot1) in the REPL.
+
 (def plot1
-  (c/time-series-plot forma-range
-                      (hp-filter (fix-time-series #{1} reli ndvi) 2)
-                      :title "NDVI and The H-P Filter"
-                      :x-label "Year"
-                      :y-label "NDVI values"))
+  (doto (c/time-series-plot forma-range
+                            ndvi
+                            :title "NDVI with Unreliable Measurements"
+                            :x-label ""
+                            :y-label ""
+                            :legend true
+                            :series-label "NDVI")))

-;; (c/add-lines plot1 dates ndvi)
-#_(c/add-lines plot1
-             forma-range
-             (fix-time-series #{1} reli ndvi))
-;; (c/add-points plot1 dates kill-vals)
+;; (c/set-stroke-color java.awt.Color/red)
+;; Add the points indicating bad (read: unreliable) values on the
+;; original NDVI time-series.
+
+(c/add-points plot1 forma-range kill-vals :series-label "Unreliable Values")
+
+;; Create a new plot with the HP-filter to be updated by the slider,
+;; based on the interpolated NDVI values.
+
+(def plot2
+  (doto (c/time-series-plot forma-range
+                            ;; (fix-time-series #{1} reli ndvi)
+                            (hp-filter (fix-time-series #{1} reli ndvi) 2)
+                            :title "NDVI and the H-P Filter"
+                            :x-label ""
+                            :y-label ""
+                            :legend true
+                            :series-label "Filtered NDVI")
+    (c/set-stroke-color java.awt.Color/blue)))

 (let [x forma-range]
-  (c/slider #(i/set-data plot1
-                         [x (hp-filter (fix-time-series #{1}
-                                                        reli
-                                                        ndvi)
-                                        (short %))])
+  (c/slider #(i/set-data plot2
+                         [x (hp-filter (fix-time-series #{1} reli ndvi) %)])
             (map (partial round-places 2) (range 0 20 0.1))
             "lambda"))

-(defn round-places [decimals number]
-  (let [factor (expt 10 decimals)]
-    (float (/ (round (* factor number)) factor))))
+;; Add a plot of the interpolated NDVI values to serve as the
+;; background to the updating slider.

-#_(map (partial round-places 2) (range 0 20 0.1))
+;; TODO Swap colors and the layering, so that the filter is on top.

-(def ndvi [7417 7568 7930 8049 8039 8533 8260 8192 7968 7148 7724 8800 8068 7680 7590 7882 8022 8194 8031 8100 7965 8538 7881 8347 8167 5295 8000 7874 8220 8283 8194 7826 8698 7838 8967 8136 7532 7838 8009 8136 8400 8219 8051 8091 7718 8095 8391 7983 8236 8091 7937 7958 8147 8134 7813 8146 7623 8525 8714 8058 6730 8232 7744 8030 8355 8216 7879 8080 8201 7987 8498 7868 7852 7983 8135 8012 8195 8157 7989 8372 8007 8081 7940 7712 7913 8021 8241 8041 7250 7884 8105 8033 8340 8288 7691 7599 8480 8563 8033 7708 7575 7996 7739 8058 7400 6682 7999 7655 7533 7904 8328 8056 7817 7601 7924 7905 7623 7615 7560 7330 7878 8524 8167 7526 7330 7325 7485 8108 7978 7035 7650])
+(c/add-lines plot2 forma-range (fix-time-series #{1} reli ndvi) :series-label "Conditioned NDVI")
+
+
+
+


added links to service and node in task info

--- src/cljs/swarmpit/component/task/info.cljs
+++ src/cljs/swarmpit/component/task/info.cljs
@@ -32,7 +32,9 @@

 (rum/defc form-info < rum/static [{:keys [repository status] :as item}]
   (let [error (:error status)
-        image-digest (:imageDigest repository)]
+        image-digest (:imageDigest repository)
+        service (:serviceName item)
+        node (:nodeName item)]
     [:div
      [:div.form-panel
       [:div.form-panel-left
@@ -43,12 +45,15 @@
       [:div.form-view-group
        (form/section "General settings")
        (form/item "ID" (:id item))
+       (form/item "SERVICE" [:a {:href (routes/path-for-frontend :service-info {:id service})} service])
        (form/item "NAME" (:taskName item))
        (form/item-date "CREATED" (:createdAt item))
        (form/item-date "LAST UPDATE" (:updatedAt item))
        (form/item "IMAGE" (get-in item [:repository :image]))
        (when (some? image-digest)
-         (form/item "IMAGE DIGEST" image-digest))]
+         (form/item "IMAGE DIGEST" image-digest))
+       (when node
+         (form/item "NODE" [:a {:href (routes/path-for-frontend :node-info {:id node})} node]))]
       [:div.form-view-group
        (form/section "Status")
        (form/item "STATE" (:state item))


Don't hide changes with partial solutions

--- src/clojure/org/bytopia/foreclojure/db.clj
+++ src/clojure/org/bytopia/foreclojure/db.clj
@@ -181,7 +181,7 @@
      [:problems/_id :problems/title :problems/description :solutions/is_solved]
      (str "problems LEFT OUTER JOIN solutions ON solutions.problem_id = problems._id "
           "AND solutions.user_id = " user-id)
-     (when-not show-solved? {:solutions/user_id nil}))))
+     (when-not show-solved? {:solutions/is_solved [:or false nil]}))))

 ;; (get-problems-cursor (*a :main) "testclient" true)


convenience for cljs dev-repl setter

convenience for cljs dev-repl setter

--- dev/user.clj
+++ dev/user.clj
@@ -52,12 +52,13 @@
   (set-refresh-dirs "src/" "dev/")
   (refresh :after 'user/go))

+(defn cljs-repl-set! [repl]
+  (def repl-env (reset! cemerick.austin.repls/browser-repl-env repl)))

 (defn cljs-repl-setup
   "Setup the app to use a Austin browser hosted cljs-repl"
   []
-  (def repl-env (reset! cemerick.austin.repls/browser-repl-env
-                        (cemerick.austin/repl-env))))
+  (cljs-repl-set! (cemerick.austin/repl-env)))

 (defn cljs-repl-connect
   "Connect to the browser hosted cljs-repl"


Added gist and note about upgrading fires portion of timeseries.

--- src/clj/forma/hadoop/jobs/timeseries.clj
+++ src/clj/forma/hadoop/jobs/timeseries.clj
@@ -124,6 +124,9 @@
         (query ?name ?location ?fire-series)
         (io/mk-chunk ?name t-res nil ?location ?fire-series :> ?chunk))))

+;; TODO: Think of converting this to https://gist.github.com/1102111,
+;; and cutting fire-query totally out of the loop.
+
 (defn fire-query
   [source-pail-path t-res start end tile-seq]
   (let [tap (apply pail/split-chunk-tap


add missing sql-primitive

add missing sql-primitive

--- src/clj/org/openforis/ceo/db/imagery.clj
+++ src/clj/org/openforis/ceo/db/imagery.clj
@@ -49,13 +49,13 @@
         add-to-all-projects? (tc/str-bool (:addToAllProjects params) true)]
     (if (sql-primitive (call-sql "check_institution_imagery")) ; TODO this SQL function name is unclear
       (data-response "The title you have chosen is already taken")
-      (let [new-imagery-id (call-sql "add_institution_imagery"
-                                     institution-id
-                                     "private"
-                                     imagery-title
-                                     imagery-attribution
-                                     nil ; FIXME, this was being saved a string to match JSON, create update query to replace "null" with NULL
-                                     source-config)]
+      (let [new-imagery-id (sql-primitive (call-sql "add_institution_imagery"
+                                                    institution-id
+                                                    "private"
+                                                    imagery-title
+                                                    imagery-attribution
+                                                    nil ; FIXME, this was being saved a string to match JSON, create update query to replace "null" with NULL
+                                                    source-config))]
         (when add-to-all-projects?
           (call-sql "add_imagery_to_all_institution_projects" new-imagery-id))
         (data-response "")))))


correct item for transaction item ids

correct item for transaction item ids

--- src/clj_money/models/reconciliations.clj
+++ src/clj_money/models/reconciliations.clj
@@ -26,7 +26,7 @@
 (s/def ::end-of-period #(instance? LocalDate %))
 (s/def ::balance decimal?)
 (s/def ::status #{:new :completed})
-(s/def ::item-id integer?)
+(s/def ::item-id uuid?)
 (s/def ::item-ids (s/coll-of ::item-id))

 (s/def ::new-reconciliation (s/keys :req-un [::account-id ::end-of-period ::status ::balance] :opt-un [::item-ids]))
@@ -37,7 +37,7 @@
    (coercion/rule :decimal [:balance])
    (coercion/rule :integer [:account-id])
    (coercion/rule :integer [:id])
-   (coercion/rule :integer-collection [:item-ids])])
+   (coercion/rule :uuid-collection [:item-ids])])

 (defn- before-validation
   [reconciliation]
@@ -78,9 +78,9 @@
   (when reconciliation
     (assoc reconciliation
            :item-ids
-           (mapv :id (transactions/select-items-by-reconciliation-id
+           (mapv :id (transactions/select-items-by-reconciliation
                        storage
-                       (:id reconciliation))))))
+                       reconciliation)))))

 (defn find-by-id
   "Returns the specified reconciliation"


general transformation funcs

general transformation funcs

--- saas-dsl/src/saas_dsl/core.clj
+++ saas-dsl/src/saas_dsl/core.clj
@@ -1,6 +1,24 @@
-(ns saas-dsl.core)
+(ns saas-dsl.core
+  (:require [clojure.test :refer :all]
+            [sass-dsl.parse :as parse]
+            [sass-dsl.render :as render]
+            [sass-dsl.transform :as transform]))

-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))
+(defn sass-to-css-basic
+  "Given a basic set of SASS, transfom it to CSS."
+  [sass-val]
+  (-> sass-val
+      parse/transform-to-saas-nested-tree
+      transform/flatten-colon-suffixes
+      transform/saas-de-nest-flattentd-colons-vec-zip
+      render/output-css))
+
+(defn sass-to-css
+  "Given some sass with constants defined, transform it to css."
+  [sass-val]
+  (let [tree (parse/transform-to-sass-nested-tree sass-val)]
+    (-> tree
+        (transform/replaced-constants-structure-vec-zip-vz
+         (transform/extract-constants tree {}))
+        transform/strip-context-declarations
+        render/output-css)))


Improve Timing panel granularity

Improve Timing panel granularity

Fixes #136

--- src/day8/re_frame/trace/view/timing.cljs
+++ src/day8/re_frame/trace/view/timing.cljs
@@ -9,9 +9,7 @@
 (def timing-styles
   [:#--re-frame-trace--
    [:.timing-details
-    {:background-color common/white-background-color
-     :margin-top       common/gs-31s
-     :padding          common/gs-19}]
+    {:margin-top common/gs-31s}]
    [:.timing-details--line
     {:margin "1em 0"}]

@@ -28,10 +26,13 @@
      :font-weight      "normal"
      :font-size        "14px"}]

+   [".timing-elapsed-panel"
+    {:padding "12px"
+     :margin  common/gs-7s}]
    [".timing-part-panel"
     (merge (common/panel-style "3px")
            {:padding "12px"
-            :margin common/gs-7s})]
+            :margin  common/gs-7s})]
    ])

 (defn timing-tag [label]
@@ -50,13 +51,29 @@
     (if timing-data-available?
       [rc/v-box
        :class "timing-details"
-       :children [
+       :children [[rc/h-box
+                   :class "timing-elapsed-panel"
+                   :align :end
+                   :children [[timing-section "elapsed" @(rf/subscribe [:timing/total-epoch-time])]
+                              [rc/hyperlink-href
+                               :label "guide me to greatness"
+                               :style {:margin-left common/gs-19s}
+                               :attr {:rel "noopener noreferrer"}
+                               :target "_blank"
+                               :href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnderstandingTiming.md"]
+
+                              #_[rc/link {:label "Guide me to greatness"
+                                        :href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnderstandingTiming.md"}]]]
                   [rc/h-box
                    :gap common/gs-12s
                    :class "timing-part-panel"
                    :children
-                   [[timing-section "total" @(rf/subscribe [:timing/total-epoch-time])]
+                   [[:p "event" [:br] "processing"]
                     [timing-section "event" @(rf/subscribe [:timing/event-processing-time])]
+                    ;;; TODO: calculate handler and effects timing separately
+                    [timing-section "handler" -1]
+                    [timing-section "effects" -1]
+
                     ]]
                   (doall
                     (for [frame (range 1 (inc @(rf/subscribe [:timing/animation-frame-count])))
@@ -68,27 +85,19 @@
                         [rc/h-box
                          :align :center
                          :class "timing-part-panel"
-                         :gap "25px"
+                         :gap common/gs-12s
                          :children
-                         [[rc/label :label (str "Animation frame #" frame)]
+                         [[:p "Animation" [:br] "frame" [:br] (str "#" frame)]
                           [timing-section "total" @frame-time]
-                          #_[timing-section "subs" 2]
-                          #_[timing-section "views" 3]]])))
-
-                  [rc/line :class "timing-details--line"]
-
-                  [rc/v-box
-                   :children
-                   [[rc/p "Be careful. There are two problems with these numbers:"]
-                    [:ol
-                     [:li "Accurately timing anything in the browser is a nightmare. One moment a given function takes 1ms and the next it takes 10ms, and you'll never know why. So bouncy."]
-                     [:li "You're currently running the dev build, not the production build. So don't freak out too much. Yet."]]
-                    [rc/hyperlink-href
-                     :label "Timing documentation"
-                     :style {:margin-left common/gs-7s}
-                     :attr {:rel "noopener noreferrer"}
-                     :target "_blank"
-                     :href "https://github.com/Day8/re-frame-trace/blob/master/docs/HyperlinkedInformation/UnderstandingTiming.md"]]]]]
+                          [:span "="]
+                          ;; TODO: subs timing
+                          [timing-section "subs" -1]
+                          [:span "+"]
+                          ;; TODO: views timing
+                          [timing-section "views" -1]
+                          [:span "+"]
+                          ;; TODO: timing for the rest
+                          [timing-section "react, etc" -1]]])))]]
       [rc/v-box
        :class "timing-details"
        :children [[:h1 "No timing data available currently."]]])))


remove typo

remove typo

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

--- plugins/SlideExplorer2/src/slide_explorer/view.clj
+++ plugins/SlideExplorer2/src/slide_explorer/view.clj
@@ -9,7 +9,7 @@
   (:use [org.micromanager.mm :only (edt)]
         [slide-explorer.paint :only (enable-anti-aliasing)]
         [slide-explorer.image :only (crop merge-and-scale overlay overlay-memo lut-object)]))
-ftile
+
 ; Order of operations:
 ;  Stitch/crop
 ;  Flatten fields


don't throw exception if agr:top: return infinitive form instead

--- src/babel/espanol/morphology/verbs.clj
+++ src/babel/espanol/morphology/verbs.clj
@@ -106,6 +106,11 @@

      ;; </third person plural conditional>

+     ;; agreement is underspecified, but an infinitive form (the :espanol key) exists, so just return that infinitive form.
+     (and (= (get-in word [:agr]) :top)
+          (string? (get-in word [:espanol])))
+     (get-in word [:espanol])
+
      :else
      (throw (Exception. (str "get-string-1: conditional regular inflection: don't know what to do with input argument: " (strip-refs word)))))))

@@ -203,9 +208,10 @@

      ;; </third person plural future>

-     (= :top (get-in word [:agr]))
-     (do (log/debug (str "ignoring agr:top for stem: " stem " - maybe this is an incomplete phrase."))
-         "")
+     ;; agreement is underspecified, but an infinitive form (the :espanol key) exists, so just return that infinitive form.
+     (and (= (get-in word [:agr]) :top)
+          (string? (get-in word [:espanol])))
+     (get-in word [:espanol])

      :else
      (throw (Exception. (str "get-string-1: future regular inflection: don't know what to do with input argument: " (strip-refs word)))))))
@@ -298,6 +304,11 @@
      (str stem "ían")

      ;; </third person plural imperfecto>
+
+     ;; agreement is underspecified, but an infinitive form (the :espanol key) exists, so just return that infinitive form.
+     (and (= (get-in word [:agr]) :top)
+          (string? (get-in word [:espanol])))
+     (get-in word [:espanol])

      :else
      (throw (Exception. (str "get-string-1: imperfecto regular inflection: don't know what to do with input argument: " (strip-refs word)))))))
@@ -557,6 +568,11 @@
      (str stem "ieron")

      ;; </third person plural preterite>
+
+     ;; agreement is underspecified, but an infinitive form (the :espanol key) exists, so just return that infinitive form.
+     (and (= (get-in word [:agr]) :top)
+          (string? (get-in word [:espanol])))
+     (get-in word [:espanol])

      :else
      (throw (Exception. (str "get-string-1: conditional regular inflection: don't know what to do with input argument: " (strip-refs word)))))))


Fix checking permissions for starting a new thread in other group

Previously, a user could send a message to a group they aren't in.
That message couldn't tag or mention anyone, so it would always be
invisible, but anyway

--- src/braid/core/server/sync_helpers.clj
+++ src/braid/core/server/sync_helpers.clj
@@ -75,7 +75,8 @@
                  false))
          (or (boolean (if-let [cur-group (thread/thread-group-id (?data :thread-id))]
                         (= (?data :group-id) cur-group)
-                        true)))]
+                        true)))
+         (group/user-in-group? user-id (?data :group-id))]
         (map
           (fn [tag-id]
             (and


fix arguments to simple-matches?

fix arguments to simple-matches?

--- src/chat/client/views/new_message.cljs
+++ src/chat/client/views/new_message.cljs
@@ -19,7 +19,7 @@
     (not= -1 (.indexOf (normalize s) (normalize m)))))

 (defn simple-matches?
-  [s m]
+  [m s]
   (re-find (re-pattern m) s))


added code to send mail to the institution administrators if a member requested a membership

--- src/clj/org/openforis/ceo/db/users.clj
+++ src/clj/org/openforis/ceo/db/users.clj
@@ -222,7 +222,24 @@
   (let [user-id        (:userId params -1)
         institution-id (tc/val->int (:institutionId params))]
     (call-sql "add_institution_user" institution-id user-id 3)
-    (data-response "")))
+    (let [institution-id   (tc/val->int (:institutionId params))
+          institution-name (:name (first (call-sql "select_institution_by_id" institution-id -1)))
+          email            (:email (first (call-sql "get_user_by_id" user-id)))
+          emails           (mapv :email
+                                 (filter
+                                  (fn [{:keys [institution_role]}] (= institution_role "admin"))
+                                  (call-sql "get_all_users_by_institution_id" institution-id)))
+          email-msg (format (str "User %s has requested the acces to institution %s.")
+                            email institution-name)]
+      (if (not-empty emails)
+        (try
+          (send-mail emails nil nil "Membership Request" email-msg "text/plain")
+          (data-response "")
+          (catch Exception _ (data-response (str email
+                                                 " has requested the membership to "
+                                                 institution-name
+                                                 ", but the email notification has failed."))))
+        (data-response "There are no administrator users.")))))

 (defn- get-mailing-list-errors [subject body remaining-time]
   (cond (or (str/blank? subject) (str/blank? body))


Randomize doors to be closed/open/missing

--- src/cljc/robinson/dungeons/temple.cljc
+++ src/cljc/robinson/dungeons/temple.cljc
@@ -49,7 +49,7 @@
   "Takes a room and returns an [x y] of a door on the edge of the room."
   [[x-min y-min x-max y-max] start end]
   (let [side         (find-point-relation start end)]
-    (println "find-door" start end side)
+    ;(println "find-door" start end side)
     (rand-nth (case side
                 :left
                   (map (fn [i] [x-min i]) (range (inc y-min) y-max))
@@ -265,7 +265,7 @@
                                                        [room-center-2 room-center-1])))
                                               g)))]
                    [room-center-1 room-center-2]))]
-    (println "all extra edges" (reduce (fn [edges [[x1 y1] [x2 y2]]]
+    #_(println "all extra edges" (reduce (fn [edges [[x1 y1] [x2 y2]]]
                                          (conj edges [[x1 y1] [x2 y2] (rc/chebyshev-distance (rc/xy->pos x1 y1) (rc/xy->pos x2 y2))]))
                                        []
                                        edges))
@@ -281,7 +281,7 @@
                        edges)
        junctions (keys (into {} (filter (fn [[_ connections]] (> connections 2))
                                         counts)))]
-    (println "junctions" junctions)
+    #_(println "junctions" junctions)
     (set (take 2 junctions))))

 (defn vertical-or-horizontally-aligned?
@@ -293,7 +293,7 @@
         *
         ******x"
   [[x1 y1] [x2 y2]]
-  (println "horizontal-s-segment")
+  #_(println "horizontal-s-segment")
   (let [mid-x (int (/ (+ x1 x2) 2))]
     (concat (map #(vector % y1)    (range* x1 mid-x))
             (map #(vector mid-x %) (range* y1 y2))
@@ -308,7 +308,7 @@
           *
           x"
   [[x1 y1] [x2 y2]]
-  (println "vertical-s-segment")
+  #_(println "vertical-s-segment")
   (let [mid-y (int (/ (+ y1 y2) 2))]
     (concat (map #(vector x1 %)    (range* y1 mid-y))
             (map #(vector % mid-y) (range* x1 x2))
@@ -320,7 +320,7 @@
      *
      *****x"
   [[x1 y1] [x2 y2]]
-  (println "vertical-corner-segment")
+  #_(println "vertical-corner-segment")
   (concat (map #(vector x1 %) (range* y1 y2))
           (map #(vector % y2) (range* x1 x2))))

@@ -330,7 +330,7 @@
           *
           x"
   [[x1 y1] [x2 y2]]
-  (println "horizontal-corner-segment")
+  #_(println "horizontal-corner-segment")
   (concat (map #(vector x1 %) (range* y1 y2))
           (map #(vector % y2) (range* x1 x2))))

@@ -353,7 +353,7 @@
   [from from-type to to-type]
   {:pre [(contains? #{:vertical :horizontal} from-type)
          (contains? #{:vertical :horizontal} to-type)]}
-  (println "multi-part-segment" from-type to-type)
+  #_(println "multi-part-segment" from-type to-type)
   (cond
     (= from-type to-type :horizontal)
       (vertical-s-segment from to)
@@ -375,12 +375,12 @@
         door-xy-2         (if (contains? junction-room-centers end)
                             end
                             (find-door end-room-bounds end start))]
-    (println "start" start)
-    (println "start-room-bounds" start-room-bounds)
-    (println "end" end)
-    (println "end-room-bounds"end-room-bounds)
-    (println "door-1" door-xy-1)
-    (println "door-2" door-xy-2)
+    ;(println "start" start)
+    ;(println "start-room-bounds" start-room-bounds)
+    ;(println "end" end)
+    ;(println "end-room-bounds"end-room-bounds)
+    ;(println "door-1" door-xy-1)
+    ;(println "door-2" door-xy-2)
     (cond
       (vertical-or-horizontally-aligned? door-xy-1 door-xy-2)
         (rlos/line-segment door-xy-1 door-xy-2)
@@ -401,19 +401,23 @@
   "When merging cells, given their types, determine
    the type of the resulting cell."
   [cell1 cell2]
-  (println "merging cells" cell1 "," cell2)
+  ;(println "merging cells" cell1 "," cell2)
   (let [cell1-type (get cell1 :type)
         cell2-type (get cell2 :type)]
     (cond
       (or (and (contains? #{:corridor :moss-corridor :white-corridor} cell1-type)
-               (contains? #{:horizontal-wall :horizontal-wall-alt :vertical-wall :vertical-wall-alt :close-door
+               (contains? #{:horizontal-wall :horizontal-wall-alt :vertical-wall :vertical-wall-alt :close-door :open-door
                             :moss-horizontal-wall :moss-horizontal-wall-alt :moss-vertical-wall :moss-vertical-wall-alt
-                            :white-horizontal-wall :white-horizontal-wall-alt :white-vertical-wall :white-vertical-wall-alt} cell2-type))
+                            :white-horizontal-wall :white-horizontal-wall-alt :white-vertical-wall :white-vertical-wall-alt}
+                          cell2-type))
           (and (contains? #{:corridor :moss-corridor :white-corridor} cell2-type)
-               (contains? #{:horizontal-wall :horizontal-wall-alt :vertical-wall :vertical-wall-alt :close-door
+               (contains? #{:horizontal-wall :horizontal-wall-alt :vertical-wall :vertical-wall-alt :close-door :open-door
                             :moss-horizontal-wall :moss-horizontal-wall-alt :moss-vertical-wall :moss-vertical-wall-alt
-                            :white-horizontal-wall :white-horizontal-wall-alt :white-vertical-wall :white-vertical-wall-alt} cell2-type)))
-        :close-door
+                            :white-horizontal-wall :white-horizontal-wall-alt :white-vertical-wall :white-vertical-wall-altr}
+                          cell2-type)))
+        (rand-nth [:close-door :open-door :corridor :moss-corridor :white-corridor])
+      (every? #{:corridor :moss-corridor :white-corridor} [cell1-type cell2-type])
+        cell1-type
       (= cell1-type :nil)
         cell2-type
       (= cell2-type :nil)
@@ -513,8 +517,9 @@
     (println "more-edges" more-edges)
     ;(println (vec room-bounds))
     ;(println (vec rooms))
-    {:place cells #_(apply merge-with-canvas (canvas width height)
-                     (concat corridors rooms))
+    {:cells cells
+     :movement :fixed
+     :npcs []
      #_#_:up-stairs upstairs
      #_#_:down-stairs downstairs}))

@@ -541,6 +546,7 @@
                                               :upper-right-2 "\033[38;2;191;171;143m◙\033[0m"
                                               :bottom-left-2 "\033[38;2;191;171;143m◙\033[0m"
                                               :bottom-right-2 "\033[38;2;191;171;143m◙\033[0m"
+                                              :open-door \'
                                               :close-door \+
                                               :altar \┬
                                               :chest "\033[38;2;124;97;45m■\033[0m"
@@ -590,5 +596,5 @@
   "Generate a random grid and print it out."
   [& args]
   (println "generating...")
-  (print-cells (get (random-place 80 25) :place)))
-
+  (print-cells (get (random-place 80 25) :cells)))
+


refine account parent typeahead

refine account parent typeahead

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -73,7 +73,7 @@

 (defn- accounts-page []
   (accounts/get-all (:id @state/current-entity)
-                    #(reset! *accounts* %)
+                    #(reset! *accounts* (-> % nest unnest))
                     notify/danger)
   (commodities/get-all (:id @state/current-entity)
                        #(reset! *commodities* %)
@@ -107,12 +107,13 @@
    (typeahead-input
      :parent-id
      {:data-source accounts-source
+      :input-placeholder "Select an account"
       :in-fn (fn [id]
                ((juxt :path :id) (->> @*accounts*
                                       (filter #(= id (:id %)))
                                       first)))
-      :out-fn (fn [[_ id]] id)
-      :result-fn (fn [[path _]] path)})
+      :out-fn second
+      :result-fn first})
    (select-input :type account-types {:visible? #(nil? (:parent-id %))})
    (text-input :name :required)
    [:div.form-group


Explore view initial

Explore view initial

--- src/cljs/salava/gallery/ui/badges.cljs
+++ src/cljs/salava/gallery/ui/badges.cljs
@@ -235,10 +235,12 @@
   (let [show-advanced-search (cursor state [:advanced-search])]
     [:div {:id "grid-filter"
            :class "form-horizontal"}
+     (prn (session/get-in [:user :current-space] nil))
      (if (not (:user-id @state))
        [:div

-        [country-selector state]
+        (if (empty? (session/get-in [:user :current-space] nil))
+         [country-selector state])
         [:div
          [:a {:on-click #(reset! show-advanced-search (not @show-advanced-search))
               :href "#"}


:sparkles: Init i18N for viewer

:sparkles: Init i18N for viewer

--- frontend/src/uxbox/view.cljs
+++ frontend/src/uxbox/view.cljs
@@ -12,6 +12,7 @@

 (defn ^:export init
   []
+  (lc/init)
   (st/init)
   (ui/init-routes)
   (ui/init))


version bumps, dependency cleanup

version bumps, dependency cleanup

--- Clojure-Websockets/project.clj
+++ Clojure-Websockets/project.clj
@@ -4,12 +4,12 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.7.0-alpha2"]
-                 [twitter-api "0.7.6"]
+                 [twitter-api "0.7.6" :exclusions [org.clojure/clojure org.clojure/data.json]]
                  [org.clojure/core.async "0.1.346.0-17112a-alpha"]
-                 [clojurewerkz/elastisch "2.1.0-beta9"]
+                 [clojurewerkz/elastisch "2.1.0-beta9" :exclusions [com.fasterxml.jackson.core/jackson-core]]
                  [org.clojure/tools.logging "0.3.0"]
                  [ch.qos.logback/logback-classic "1.1.1"]
-                 [com.taoensso/sente "1.1.0" :exclusions [org.clojure/clojure]]
+                 [com.taoensso/sente "1.2.0" :exclusions [org.clojure/clojure]]
                  [org.clojure/core.match "0.2.1"]
                  [http-kit "2.1.19"]
                  [compojure "1.2.1"]
@@ -34,7 +34,7 @@

   :plugins [[lein-cljsbuild "1.0.3"]
             [com.cemerick/clojurescript.test "0.3.1"]
-            [quickie "0.3.5"]]
+            [quickie "0.3.5" :exclusions [org.clojure/clojure org.codehaus.plexus/plexus-utils]]]

   :cljsbuild {:builds [{:id "dev"
                         :source-paths ["src/cljs"]


get rid of a thread sleep

get rid of a thread sleep

--- test/clj/lambdacd/internal/pipeline_state_test.clj
+++ test/clj/lambdacd/internal/pipeline_state_test.clj
@@ -47,13 +47,14 @@
 (deftest initialize-pipeline-persistence-test
   (testing "that we tap into a pipelines step-results-channel and update the pipeline state with its information"
     (let [state (atom {})
-          step-results-channel (async/chan)
+          step-results-channel (async/chan 10)
           context (some-ctx-with :step-results-channel step-results-channel)]
-      (start-pipeline-state-updater state context)
       (async/>!! step-results-channel {:build-number 1 :step-id [1 2] :step-result {:status :running}})
       (async/>!! step-results-channel {:build-number 2 :step-id [1 2] :step-result {:status :success}})
       (async/>!! step-results-channel {:build-number 1 :step-id [1 2] :step-result {:status :running :foo :bar}})
-      (Thread/sleep 200)
+
+      (async/close! step-results-channel)
+      (async/<!! (start-pipeline-state-updater state context))
       (is (= {1 { [1 2] {:status :running :foo :bar}}
               2 { [1 2] {:status :success}}} (tu/without-ts @state))))))


add dynamic to log-factory declaration

add dynamic to log-factory declaration

--- src/main/clojure/clojure/tools/logging.clj
+++ src/main/clojure/clojure/tools/logging.clj
@@ -77,7 +77,7 @@
       (fn [_#] (impl-write! log level throwable message)))
     (impl-write! log level throwable message)))

-(declare *log-factory*) ; default LogFactory instance for calling impl-get-log
+(declare ^{:dynamic true} *log-factory*) ; default LogFactory instance for calling impl-get-log

 (defmacro log
   "Evaluates and logs a message only if the specified level is enabled. See log*


Remove unused import

Remove unused import

--- src/desdemona/launcher/aeron_media_driver.clj
+++ src/desdemona/launcher/aeron_media_driver.clj
@@ -4,7 +4,6 @@
    [clojure.core.async :refer [chan <!!]]
    [clojure.tools.cli :refer [parse-opts]])
   (:import
-   [uk.co.real_logic.aeron Aeron$Context]
    [uk.co.real_logic.aeron.driver MediaDriver MediaDriver$Context]))

 (def cli-options


Fix spyscope dependency. Add its injection.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,5 +1,5 @@
 {:user {:dependencies [[clj-stacktrace "0.2.5"]
-                       [spyscope "0.1.0"]
+                       [spyscope "0.1.2"]
                        [limit-break "0.1.0-SNAPSHOT"]]
         :plugins [[lein-difftest "1.3.7"]
                   [lein-drip "0.1.1-SNAPSHOT"]
@@ -11,7 +11,8 @@
                   [lein-deps-tree "0.1.2"]
                   [lein-marginalia "0.7.1"]]
         :repl-options {:timeout 120000}
-        :injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
+        :injections [(require 'spyscope.core)
+                     (let [orig (ns-resolve (doto 'clojure.stacktrace require)
                                             'print-cause-trace)
                            new (ns-resolve (doto 'clj-stacktrace.repl require)
                                            'pst)]


Fix typo

Fix typo

--- src/matchmaker_sparql/evaluation/setup.clj
+++ src/matchmaker_sparql/evaluation/setup.clj
@@ -152,8 +152,7 @@
   [contract-count]
   (let [short-head-count (/ contract-count 5)
         query-fn (fn [[limit offset]]
-                   (setup-template "templates/evaluation/setup/bidders_short_head"
-                                   {:limit limit :offset offset}))
+                   (setup-template "bidders_short_head" {:limit limit :offset offset}))
         reduce-fn (fn [{a :count} {bidder :bidder b :count}]
                     {:bidder bidder :count (+ a b)})
         in-head? (comp (partial >= short-head-count) :count)]


remove factored out function

remove factored out function

--- main/src/dda/pallet/dda_managed_ide/infra/clojure.clj
+++ main/src/dda/pallet/dda_managed_ide/infra/clojure.clj
@@ -59,20 +59,6 @@
     (util/create-file-content
       ["PATH=$PATH:/opt/leiningen"])))

-(defn install-mach
-  [facility]
-  (actions/as-action
-    (logging/info (str facility "install system: install-mach")))
-  (actions/packages
-    :aptitude ["npm"])
-  (actions/exec-checked-script
-    "install mach"
-    ("npm" "install" "-g" "@juxt/mach")
-    ("cd" "/usr/local/bin")
-    ("curl" "-fsSLo" "boot"
-            "https://github.com/boot-clj/boot-bin/releases/download/latest/boot.sh")
-    ("chmod" "755" "boot")))
-
 (s/defn lein-user-profile
   [lein-config :- Clojure]
   (selmer/render-file "lein_profiles.template" lein-config))


CMR-3044: Re-enabled reset functionality

--- message-queue-lib/src/cmr/message_queue/queue/sqs.clj
+++ message-queue-lib/src/cmr/message_queue/queue/sqs.clj
@@ -275,16 +275,16 @@

   (reset
      [this]
-     (let [sqs-client (:sqs-client this)]))
-      ;  (doseq [queue (:queues this)
-      ;          :let [queue-name (normalize-queue-name queue)
-      ;                dlq-name (dead-letter-queue queue-name)
-      ;                queue-url (.getQueueUrl (.getQueueUrl sqs-client queue-name))
-      ;                dlq-url (.getQueueUrl (.getQueueUrl sqs-client dlq-name))
-      ;                q-purge-req (PurgeQueueRequest. queue-url)
-      ;                dlq-purge-req (PurgeQueueRequest. dlq-url)]]
-      ;    (.purgeQueue sqs-client q-purge-req)
-      ;    (.purgeQueue sqs-client dlq-purge-req))))
+     (let [sqs-client (:sqs-client this)]
+       (doseq [queue (:queues this)
+               :let [queue-name (normalize-queue-name queue)
+                     dlq-name (dead-letter-queue queue-name)
+                     queue-url (.getQueueUrl (.getQueueUrl sqs-client queue-name))
+                     dlq-url (.getQueueUrl (.getQueueUrl sqs-client dlq-name))
+                     q-purge-req (PurgeQueueRequest. queue-url)
+                     dlq-purge-req (PurgeQueueRequest. dlq-url)]]
+         (.purgeQueue sqs-client q-purge-req)
+         (.purgeQueue sqs-client dlq-purge-req))))

   (health
      [this]


CLJ-2219 Fix ns :require spec regarding prefix lists

Signed-off-by: Alex Miller <99328387f8334f68433c424d2dfd83062f62754b@cognitect.com>

--- src/main/clojure/clojure/core/specs/alpha.clj
+++ src/main/clojure/clojure/core/specs/alpha.clj
@@ -116,12 +116,16 @@
 (s/def ::prefix-list
   (s/spec
     (s/cat :prefix simple-symbol?
-           :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::prefix-list))
-           :refer (s/keys* :opt-un [::as ::refer]))))
+           :libspecs (s/+ ::libspec))))
+
+(s/def ::libspec
+  (s/alt :lib simple-symbol?
+         :lib+opts (s/spec (s/cat :lib simple-symbol?
+                                  :options (s/keys* :opt-un [::as ::refer])))))

 (s/def ::ns-require
   (s/spec (s/cat :clause #{:require}
-                 :libs (s/* (s/alt :lib simple-symbol?
+                 :body (s/+ (s/alt :libspec ::libspec
                                    :prefix-list ::prefix-list
                                    :flag #{:reload :reload-all :verbose})))))

@@ -200,11 +204,14 @@
               :load ::ns-load
               :gen-class ::ns-gen-class)))

+(s/def ::ns-form
+  (s/cat :name simple-symbol?
+         :docstring (s/? string?)
+         :attr-map (s/? map?)
+         :clauses ::ns-clauses))
+
 (s/fdef clojure.core/ns
-  :args (s/cat :name simple-symbol?
-               :docstring (s/? string?)
-               :attr-map (s/? map?)
-               :clauses ::ns-clauses))
+  :args ::ns-form)

 (defmacro ^:private quotable
   "Returns a spec that accepts both the spec and a (quote ...) form of the spec"


:exclude redefined `merge from :refer-clojure in pu_map.cljc

--- src/main/clojure/clojure/data/xml/pu_map.cljc
+++ src/main/clojure/clojure/data/xml/pu_map.cljc
@@ -10,7 +10,7 @@
   (:require [clojure.data.xml.name :as name]
             [clojure.string :as str]
             [clojure.core :as core])
-  (:refer-clojure :exclude [assoc! dissoc! transient persistent! get assoc]))
+  (:refer-clojure :exclude [assoc! dissoc! transient persistent! get assoc merge]))

 (def prefix-map :p->u)
 (def uri-map    :u->ps)


Fix some problems with API docs.

Fix some problems with API docs.

As I noted on the mailing list, I found some inconsistencies which
seemed to be cut-and=paste errors, and as I started to describe them, I
realized it would be nicer to just submit a pull request. Since I was
doing that, I expanded my efforts to include making the spacing
consistent between them, and adding some additional disambiguation that
I thought would be helpful.

--- src/matcha.clj
+++ src/matcha.clj
@@ -77,7 +77,7 @@
         (str "not a " type-name ", " (describe-class-mismatch x))))))

 (defn =
-  "matches based on equality of the value given
+  "matches if the value given is equal to its argument

   (matcha/run-match (matcha/= 1) 1) ; => passes
   (matcha/run-match (matcha/= 1) 2) ; => fails"
@@ -96,10 +96,11 @@
                  "\n       -: " (pp things-in-x))))))))

 (defn <=
-  "matches based if the value given is greater-than or equal to
-
+  "matches if the value given is less than or equal to its argument
+
+  (matcha/run-match (matcha/<= 1) 0) ; => passes
   (matcha/run-match (matcha/<= 1) 1) ; => passes
-  (matcha/run-match (matcha/<= 1) 0) ; => fails"
+  (matcha/run-match (matcha/<= 1) 2) ; => fails"
   [a]
   (make-record-matcher
     (fn [b] (core/<= a b))
@@ -107,10 +108,11 @@
     standard-describe-mismatch))

 (defn <
-  "matches based if the value given is greater-than or equal to
-
-  (matcha/run-match (matcha/< 1) 2) ; => passes
-  (matcha/run-match (matcha/< 1) 0) ; => fails"
+  "matches if the value given is less than its argument
+
+  (matcha/run-match (matcha/< 1) 0) ; => passes
+  (matcha/run-match (matcha/< 1) 1) ; => fails
+  (matcha/run-match (matcha/< 1) 2) ; => fails"
   [a]
   (make-record-matcher
     (fn [b] (core/< a b))
@@ -118,9 +120,10 @@
     standard-describe-mismatch))

 (defn >
-  "matches based if the value given is greater-than
+  "matches if the value given is greater than its argument

   (matcha/run-match (matcha/> 1) 2) ; => passes
+  (matcha/run-match (matcha/> 1) 1) ; => fails
   (matcha/run-match (matcha/> 1) 0) ; => fails"
   [a]
   (make-record-matcher
@@ -129,10 +132,11 @@
     describe-class-mismatch))

 (defn >=
-  "matches based if the value given is less-than or equal to
-
+  "matches if the value given is less than or equal to its argument
+
+  (matcha/run-match (matcha/<= 1) 0) ; => passes
   (matcha/run-match (matcha/<= 1) 1) ; => passes
-  (matcha/run-match (matcha/<= 1) 0) ; => fails"
+  (matcha/run-match (matcha/<= 1) 2) ; => fails"
   [a]
   (make-record-matcher
     (fn [b] (core/>= a b))
@@ -142,7 +146,7 @@
 (defn has-numerator
   "passes if the ratio has the numerator given
   (matcha/run-match (matcha/has-numerator 1) 1/10) ; => passes
-  (matcha/run-match matcha/nil? 1) ; => fails"
+  (matcha/run-match (matcha/has-numerator 2) 1/10) ; => fails"
   [n]
   (type-matcher
     core/ratio?
@@ -151,8 +155,8 @@

 (defn has-denominator
   "passes if the ratio has the denominator given
-  (matcha/run-match (matcha/has-numerator 1) 1/10) ; => passes
-  (matcha/run-match matcha/nil? 1) ; => fails"
+  (matcha/run-match (matcha/has-denominator 10) 1/10) ; => passes
+  (matcha/run-match (matcha/has-denominator 11) 1/10) ; => fails"
   [n]
   (type-matcher
     core/ratio?
@@ -162,8 +166,8 @@
 (def empty?
   "matches if the collection passed is empty

-  (matcha/run-match matcha/empty? [1]) ; => passes
-  (matcha/run-match matcha/empty? [])  ; => fails"
+  (matcha/run-match matcha/empty? [])  ; => passes
+  (matcha/run-match matcha/empty? [1]) ; => fails"
   (make-record-matcher
     core/empty?
     "an empty collection"))
@@ -209,26 +213,28 @@
   (on count (= n) "count" "a collection"))

 (defn has-count-that
-  "passes if the sequence received has the given count
+  "passes if the sequence received has a count which matches
+   the nested matcher
   (matcha/run-match (matcha/has-count-that (matcha/= 1)) [1]) ; => passes
   (matcha/run-match (matcha/has-count-that (matcha/= 1)) [])  ; => fails"
   [m]
   (on count m "count" "a collection"))

 (defn has-nth
-  "passes if the sequence received has the value matching the matcher given at
-  (nth n)
-
-  (matcha/run-match (matcha/has-count 1) [1]) ; => passes
-  (matcha/run-match (matcha/has-count 2) [])  ; => fails"
+  "passes if the nested matcher passes when run against the value at
+  position n in the supplied sequence
+
+  (matcha/run-match (matcha/has-nth) (matcha/= 10) 1 [9 10 11]) ; => passes
+  (matcha/run-match (matcha/has-nth) (matcha/= 10) 0 [9 10 11]) ; => fails"
   [m n]
   (on #(nth % n) m "nth value" "a collection"))

 (defn has-entry
-  "passes if the map received has the given map-entry
+  "passes if the map received has a map-entry whose key and value
+  match the arguments supplied

   (matcha/run-match (matcha/has-entry :a 1) {:a 1}) ; => passes
-  (matcha/run-match (matcha/has-entry :a 1) {:a 2})  ; => fails"
+  (matcha/run-match (matcha/has-entry :a 1) {:a 2}) ; => fails"
   [k v]
   (make-record-matcher
     (fn [m] (core/= (get m k) v))
@@ -239,10 +245,11 @@
         (str "a map not containing the key " (pr-str k) " (was " (pr-str m) ")")))))

 (defn has-entry-that
-  "passes if the map received has a value at the key given that matches the matcher
+  "passes if the map received has a value at the key given that matches the
+  nested matcher

   (matcha/run-match (matcha/has-entry-that :a (matcha/= 1)) {:a 1}) ; => passes
-  (matcha/run-match (matcha/has-entry-that :a (matcha/= 2)) {:a 2})  ; => fails"
+  (matcha/run-match (matcha/has-entry-that :a (matcha/= 1)) {:a 2}) ; => fails"
   [k matcher]
   (make-record-matcher
     (fn [m] ((:match matcher) (get m k)))
@@ -257,10 +264,10 @@
         (str "a map not containing the key " (pr-str k) " (was " (pr-str m) ")")))))

 (defn has-val
-  "passes if the map received has the given val
+  "passes if the map received contains the given val

   (matcha/run-match (matcha/has-val 1) {:a 1}) ; => passes
-  (matcha/run-match (matcha/has-val 1) {:a 2})  ; => fails"
+  (matcha/run-match (matcha/has-val 1) {:a 2}) ; => fails"
   [v]
   (make-record-matcher
     (fn [m] (core/some #{v} (vals m)))
@@ -269,10 +276,10 @@
       (str "vals: " (string/join ", " (vals m)) " (was " (pr-str m) ")"))))

 (defn has-key
-  "passes if the map received has the given key
-
-  (matcha/run-match (matcha/has-key 1) {:a 1}) ; => passes
-  (matcha/run-match (matcha/has-key 1) {:a 2})  ; => fails"
+  "passes if the map received contains the given key
+
+  (matcha/run-match (matcha/has-key :a) {:a 1}) ; => passes
+  (matcha/run-match (matcha/has-key :z) {:a 1}) ; => fails"
   [v]
   (make-record-matcher
     (fn [m] (core/some #{v} (keys m)))
@@ -295,6 +302,7 @@
   "passes if every element of the sequence received matches the matcher

   (matcha/run-match (matcha/every? (matcha/= 1)) [1]) ; => passes
+  (matcha/run-match (matcha/every? (matcha/= 1)) [])  ; => passes
   (matcha/run-match (matcha/every? (matcha/= 1)) [2]) ; => fails"
   [m]
   (make-record-matcher
@@ -307,7 +315,7 @@
         (string/join "an item ")))))

 (defn some
-  "passes if some elements of the sequence received matches the matcher
+  "passes if any elements of the sequence received match the matcher

   (matcha/run-match (matcha/some? (matcha/= 1)) [1 2]) ; => passes
   (matcha/run-match (matcha/some? (matcha/= 1)) [2]) ; => fails"
@@ -345,10 +353,11 @@
       (str "a string matching " (pr-str re)))))

 (defn contains-string
-  "passes if the string includes the given string
-
-  (matcha/run-match (matcha/contains-string \"a\") \"a\") ; => passes
-  (matcha/run-match (matcha/contains-string \"a\") \"b\") ; => fails"
+  "passes if the string being tested includes the string supplied
+  as a matcher argument
+
+  (matcha/run-match (matcha/contains-string \"a\") \"cat\") ; => passes
+  (matcha/run-match (matcha/contains-string \"a\") \"bell\") ; => fails"
   [s]
   (type-matcher
     core/string?
@@ -358,7 +367,7 @@
       (str "a string including " (pr-str s)))))

 (defn starts-with
-  "passes if the string starts with the given string
+  "passes if the string being tested starts with the given string

   (matcha/run-match (matcha/starts-with \"a\") \"ab\") ; => passes
   (matcha/run-match (matcha/starts-with \"a\") \"ba\") ; => fails"
@@ -371,7 +380,7 @@
       (str "a string starting with " (pr-str s)))))

 (defn ends-with
-  "passes if the string ends with the given string
+  "passes if the string being tested ends with the given string

   (matcha/run-match (matcha/ends-with \"a\") \"ba\") ; => passes
   (matcha/run-match (matcha/ends-with \"a\") \"ab\") ; => fails"
@@ -384,7 +393,8 @@
       (str "a string ending with " (pr-str s)))))

 (defn equal-ignoring-case
-  "passes if the string is equal to the other string ignoring case
+  "passes if the string being tested is equal to the
+  matcher argument, ignoring case

   (matcha/run-match (matcha/equal-ignoring-case \"a\") \"A\") ; => passes
   (matcha/run-match (matcha/equal-ignoring-case \"a\") \"ab\") ; => fails"
@@ -395,7 +405,8 @@
     (on #(.toLowerCase ^String %) (= (.toLowerCase ^String s)) "lower case" "string")))

 (defn equal-ignoring-whitespace
-  "passes if the string is equal to the other string ignoring whitespace
+  "passes if the string being tested is equal to the
+  matcher argument, ignoring whitespace

   (matcha/run-match (matcha/equal-ignoring-whitespace \"a\") \"a \") ; => passes
   (matcha/run-match (matcha/equal-ignoring-whitespace \"a \") \"ab\") ; => fails"
@@ -419,7 +430,8 @@
     strings))

 (defn contains-in-order
-  "passes if the string contains the strings in order
+  "passes if the string being tested contains the strings
+  given as arguments to the matcher, in the same order

   (matcha/run-match (matcha/contains-in-order \"a\" \"b\") \"ab\") ; => passes
   (matcha/run-match (matcha/contains-in-order \"a\" \"b\") \"ac\") ; => fails"
@@ -434,8 +446,9 @@

 (defn not
   "passes if the given matcher fails
-  (matcha/run-match (matcha/not (matcha/= 1)) 1) ; => passes
-  (matcha/run-match (matcha/not (matcha/= 2)) 1) ; => fails"
+
+  (matcha/run-match (matcha/not (matcha/= 1)) 2) ; => passes
+  (matcha/run-match (matcha/not (matcha/= 2)) 2) ; => fails"
   [m]
   (make-record-matcher
     #(core/not ((:match m) %))
@@ -443,9 +456,10 @@
     standard-describe-mismatch))

 (defn instance?
-  "passes if the value matches the given class
+  "passes if the value matches the class given as a matcher argument
+
   (matcha/run-match (matcha/instance? clojure.lang.Keyword) :foo) ; => passes
-  (matcha/run-match (matcha/instance? clojure.lang.Keyword) 1) ; => fails"
+  (matcha/run-match (matcha/instance? clojure.lang.Keyword) 1)    ; => fails"
   [klazz]
   (make-record-matcher
     #(core/instance? klazz %)
@@ -455,7 +469,7 @@
   "passes if the value isa? the given object

   (matcha/run-match (matcha/isa? :parent) :child) ; => passes
-  (matcha/run-match (matcha/isa? :child) :child) ; => fails"
+  (matcha/run-match (matcha/isa? :child) :child)  ; => fails"
   [parent]
   (make-record-matcher
     #(core/isa? % parent)
@@ -464,8 +478,9 @@
 (def
   ^{:doc
     "passes if the value is a string
+
     (matcha/run-match matcha/string? \"foo\") ; => passes
-    (matcha/run-match matcha/string? 1) ; => fails"}
+    (matcha/run-match matcha/string? 1)       ; => fails"}
   string?
   (make-record-matcher
     core/string?
@@ -474,8 +489,9 @@
 (def
   ^{:doc
     "passes if the value is a map
+
     (matcha/run-match matcha/map? {}) ; => passes
-    (matcha/run-match matcha/map? 1) ; => fails"}
+    (matcha/run-match matcha/map? 1)  ; => fails"}
   map?
   (make-record-matcher
     core/map?
@@ -484,8 +500,9 @@
 (def
   ^{:doc
     "passes if the value is a seq
+
     (matcha/run-match matcha/seq? {}) ; => passes
-    (matcha/run-match matcha/seq? 1) ; => fails"}
+    (matcha/run-match matcha/seq? 1)  ; => fails"}
   seq?
   (make-record-matcher
     core/seq?
@@ -494,8 +511,9 @@
 (def
   ^{:doc
     "passes if the value is a char
-    (matcha/run-match matcha/char? {}) ; => passes
-    (matcha/run-match matcha/char? 1) ; => fails"}
+
+    (matcha/run-match matcha/char? \a) ; => passes
+    (matcha/run-match matcha/char? 1)  ; => fails"}
   char?
   (make-record-matcher
     core/char?
@@ -504,8 +522,9 @@
 (def
   ^{:doc
     "passes if the value is a vector
-    (matcha/run-match matcha/vector? {}) ; => passes
-    (matcha/run-match matcha/vector? 1) ; => fails"}
+
+    (matcha/run-match matcha/vector? []) ; => passes
+    (matcha/run-match matcha/vector? 1)  ; => fails"}
   vector?
   (make-record-matcher
     core/vector?
@@ -514,8 +533,9 @@
 (def
   ^{:doc
     "passes if the value is a keyword
+
     (matcha/run-match matcha/keyword? :foo) ; => passes
-    (matcha/run-match matcha/keyword? 1) ; => fails"}
+    (matcha/run-match matcha/keyword? 1)    ; => fails"}
   keyword?
   (make-record-matcher
     core/keyword?
@@ -524,8 +544,9 @@
 (def
   ^{:doc
     "passes if the value is a symbol
+
     (matcha/run-match matcha/symbol? 'foo) ; => passes
-    (matcha/run-match matcha/symbol? 1) ; => fails"}
+    (matcha/run-match matcha/symbol? 1)    ; => fails"}
   symbol?
   (make-record-matcher
     core/symbol?
@@ -534,8 +555,9 @@
 (def
   ^{:doc
     "passes if the value is nil
+
     (matcha/run-match matcha/nil? nil) ; => passes
-    (matcha/run-match matcha/nil? 1) ; => fails"}
+    (matcha/run-match matcha/nil? 1)   ; => fails"}
   nil?
   (make-record-matcher
     core/nil?
@@ -546,7 +568,7 @@
     "passes if the value is a ratio

     (matcha/run-match matcha/ratio? 1/5) ; => passes
-    (matcha/run-match matcha/ratio? 5) ; => fails"}
+    (matcha/run-match matcha/ratio? 5)   ; => fails"}
   ratio?
   (make-record-matcher
     core/ratio?
@@ -554,10 +576,10 @@

 (def
   ^{:doc
-    "passes if the value is a decimal
-
-    (matcha/run-match matcha/decimal? bigdec 1)) ; => passes
-    (matcha/run-match matcha/decimal? 5) ; => fails"}
+    "passes if the value is a BigDecimal
+
+    (matcha/run-match matcha/decimal? (bigdec 1)) ; => passes
+    (matcha/run-match matcha/decimal? 5)          ; => fails"}
   decimal?
   (make-record-matcher
     core/decimal?
@@ -567,7 +589,7 @@
   ^{:doc
     "passes if the value is a rational

-    (matcha/run-match matcha/rational? 1) ; => passes
+    (matcha/run-match matcha/rational? 1)     ; => passes
     (matcha/run-match matcha/rational? \"a\") ; => fails"}
   rational?
   (make-record-matcher
@@ -579,7 +601,7 @@
     "passes if the value is a float

     (matcha/run-match matcha/float? (float 1.0)) ; => passes
-    (matcha/run-match matcha/float? 5) ; => fails"}
+    (matcha/run-match matcha/float? 5)           ; => fails"}
   float?
   (make-record-matcher
     core/float?
@@ -590,7 +612,7 @@
     "passes if the value is a collection

     (matcha/run-match matcha/coll? []) ; => passes
-    (matcha/run-match matcha/coll? 5) ; => fails"}
+    (matcha/run-match matcha/coll? 5)  ; => fails"}
   coll?
   (make-record-matcher
     core/coll?
@@ -601,7 +623,7 @@
     "passes if the value is a list

     (matcha/run-match matcha/list? '()) ; => passes
-    (matcha/run-match matcha/list? 5) ; => fails"}
+    (matcha/run-match matcha/list? 5)   ; => fails"}
   list?
   (make-record-matcher
     core/list?
@@ -612,7 +634,7 @@
     "passes if the value is a set

     (matcha/run-match matcha/set? #{}) ; => passes
-    (matcha/run-match matcha/set? 5) ; => fails"}
+    (matcha/run-match matcha/set? 5)   ; => fails"}
   set?
   (make-record-matcher
     core/set?
@@ -633,8 +655,8 @@
   ^{:doc
     "passes if the value is falsey

-    (matcha/run-match matcha/falsey? #{}) ; => passes
-    (matcha/run-match matcha/falsey? nil) ; => fails"}
+    (matcha/run-match matcha/falsey? nil) ; => passes
+    (matcha/run-match matcha/falsey? #{}) ; => fails"}
   falsey?
   (make-record-matcher
     not
@@ -645,7 +667,7 @@
     "passes if the value is a function

     (matcha/run-match matcha/fn? #()) ; => passes
-    (matcha/run-match matcha/fn? 5) ; => fails"}
+    (matcha/run-match matcha/fn? 5)   ; => fails"}
   fn?
   (make-record-matcher
     core/fn?


Fix scheduler lag metric.

Fix scheduler lag metric.

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

           reporter (-> (JmxReporter/forRegistry reg)
                        (.inDomain "org.onyxplatform")


[#2895] Remove table-name not used arg

[#2895] Remove table-name not used arg

--- backend/src/akvo/lumen/lib/visualisation/maps.clj
+++ backend/src/akvo/lumen/lib/visualisation/maps.clj
@@ -123,7 +123,7 @@
   (try
     (conform-create-args layers)
     (let [metadata-array (metadata-layers tenant-conn layers opts)
-          map-config (map-config/build tenant-conn "todo: remove this" layers metadata-array)
+          map-config (map-config/build tenant-conn layers metadata-array)
           headers* (headers tenant-conn)
           layer-group-id (-> (http.client/post* (format "%s/layergroup" windshaft-url)
                                                 (merge http-client-req-defaults


Disablingthe bootstrap db sync job for now. We want to enable it when we're sure it won't cause problems and after Doug has run db sync in UAT.

--- bootstrap-app/src/cmr/bootstrap/services/jobs.clj
+++ bootstrap-app/src/cmr/bootstrap/services/jobs.clj
@@ -7,7 +7,8 @@

 (def-stateful-job DbSynchronizeJob
   [ctx system]
-  (bootstrap-service/db-synchronize
+  (warn "Boostrap db synchronize job is disabled for now via code until we're ready to enable it.")
+  #_(bootstrap-service/db-synchronize
     {:system system}
     true ;; synchronous
     {:sync-types [:missing :deletes]}))


Stablize reaction order.

Stablize reaction order.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -99,6 +99,18 @@
               (unreact-link org-uuid board-uuid entry-uuid reaction)
               (react-link org-uuid board-uuid entry-uuid reaction))]})

+(defn- reaction-sort
+  "
+  Keep the reaction order stable by sorting on the order they are provided, and if they are legacy
+  reactions, by the order of how many reactions they have (which while not definitively stable, will
+  effectively be fairly stable for legacy reactions).
+  "
+  [reaction]
+  (let [index-of (.indexOf config/default-reactions (first reaction))] ; order in the defaults
+    (if (= index-of -1) ; is it in the defaults, or legacy?
+      (* (last reaction) -1) ; it's legacy, so by reaction count (more reactions, lower # so higher sort)
+      index-of))) ; by order in the defaults
+
 (defn- reactions-and-links
   "
   Given a sequence of reactions and the parts of a reaction URL, return a representation of the reactions
@@ -109,11 +121,12 @@
                                  (group-by :reaction reactions)) ; reactions grouped by unicode character
         counted-reactions-map (map-kv count grouped-reactions) ; how many for each character?
         counted-reactions (map #(vec [% (get counted-reactions-map %)]) (keys counted-reactions-map)) ; map -> sequence
-        top-three-reactions (take 3 (reverse (sort-by last counted-reactions)))] ; top 3 unicode characters by how many
+        top-three-reactions (take 3 (reverse (sort-by last counted-reactions))) ; top 3 unicode characters by how many
+        sorted-reactions (sort-by reaction-sort top-three-reactions)]
     (map #(reaction-and-link org-uuid board-uuid entry-uuid (first %) (last %)
             (some (fn [reaction] (= user-id (-> reaction :author :user-id))) ; did the user leave one of this reaction?
               (get grouped-reactions (first %))))
-      top-three-reactions)))
+      sorted-reactions)))

 (defn- entry-and-links
   "


Add storyboard-slug prop to story responses.

--- src/oc/storage/representations/story.clj
+++ src/oc/storage/representations/story.clj
@@ -16,7 +16,7 @@

 (def representation-props [:uuid :title :banner-url :banner-width :banner-height :body
                            :org-name :org-logo-url :org-logo-width :org-logo-height
-                           :storyboard-name :status
+                           :storyboard-name :storyboard-slug :status
                            :author :created-at :updated-at])

 (defun url
@@ -113,6 +113,7 @@
       (select-keys  representation-props)
       (include-secure-uuid (:secure-uuid story) access-level)
       (assoc :storyboard-name (:name board))
+      (assoc :storyboard-slug (:slug board))
       (assoc :reactions reaction-rep)
       (assoc :links full-links))))


Fix typo that caused runtime creation to fail.

--- src/clj/rb.clj
+++ src/clj/rb.clj
@@ -121,7 +121,7 @@
   * :env - a map of values to set in the ruby ENV [nil]
   * :gem-paths - a sequence of paths to search for gems [nil]"
   ([] (runtime nil))
-  ([{:keys [preserve-locals? gem-path load-paths env]}]
+  ([{:keys [preserve-locals? gem-paths load-paths env]}]
      (let [rt (ScriptingContainer. (if preserve-locals?
                                      LocalVariableBehavior/PERSISTENT
                                      LocalVariableBehavior/TRANSIENT))]


(PDB-4637) Rework services shutdown to prepare for TK 3.1+

In master we're going to want to request a custom process exit status
and friendlier error messages using TK 3.1's enhanced
request-shutdown.  Rework cli.services along those lines, even though
we can't do that yet, in order to minimize the differences between 5.1
and master.

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -514,7 +514,7 @@
     (async/>!! cmd-event-ch (queue/make-cmd-event cmdref kind))))

 (defn check-schema-version
-  [desired-schema-version context db service shutdown-on-error]
+  [desired-schema-version context db service request-shutdown]
   {:pre [(integer? desired-schema-version)]}
   (when-not (= #{:stopping} @(:stop-status context))
     (let [schema-version (-> (jdbc/with-transacted-connection db
@@ -536,14 +536,15 @@

                        :else
                        (throw (Exception. "Unknown state when checking schema versions")))]
-          (shutdown-on-error (service-id service)
-                             #(throw (ex-info ex-msg {:kind ::schema-mismatch}))))))))
+          (request-shutdown {::tk/exit
+                             {:status 1  ;; Unsuppported by older TK (will be 1)
+                              :messages [[ex-msg *err*]]}}))))))

 (defn start-puppetdb
   "Throws {:kind ::unsupported-database :current version :oldest version} if
   the current database is not supported. If a database setting is configured
   incorrectly, throws {:kind ::invalid-database-configuration :failed-validation failed-map}"
-  [context config service get-registered-endpoints shutdown-on-error]
+  [context config service get-registered-endpoints request-shutdown]
   (let [{:keys [developer jetty
                 database read-database
                 puppetdb command-processing
@@ -606,7 +607,7 @@
                                                 context
                                                 read-db
                                                 service
-                                                shutdown-on-error)
+                                                request-shutdown)
                          job-pool))
           (when (pos? gc-interval-millis)
             (let [request (db-config->clean-request database)]
@@ -651,23 +652,19 @@
                        invalid-settings))))

 (defn start-puppetdb-or-shutdown
-  [context config service get-registered-endpoints shutdown-on-error]
+  [context config service get-registered-endpoints request-shutdown]
   {:pre [(map? context)
          (map? config)]
    :post [(map? %)]}
   (try
-    (start-puppetdb context config service get-registered-endpoints shutdown-on-error)
+    (start-puppetdb context config service get-registered-endpoints request-shutdown)
     (catch ExceptionInfo ex
       (let [{:keys [kind] :as data} (ex-data ex)
             stop (fn [msg]
-                   (let [msg (utils/attention-msg msg)]
-                     (utils/println-err msg)
-                     (log/error msg)
-                     ;; This will become a custom exit request once
-                     ;; trapperkeeper supports it.
-                     (shutdown-on-error
-                      (service-id service)
-                      #(throw ex))))]
+                   (request-shutdown {::tk/exit
+                                      {:status 1  ;; Unsuppported by older TK (will be 1)
+                                       :messages [[msg *err*]]}})
+                   context)]
         (case kind
           ::unsupported-database
           (stop (db-unsupported-msg (:current data) (:oldest data)))
@@ -680,6 +677,29 @@

           ;; Unrecognized -- pass it on.
           (throw ex))))))
+
+(defn shutdown-requestor
+  "Returns a shim for TK's request-shutdown that also records the
+  shutdown request in the service context as :shutdown-request.  The
+  shim accepts the TK 3.1+ method's arguments and (somewhat) emulates
+  that newer behavior (until we move to TK 3.1+)."
+  [request-shutdown shutdown-on-error service]
+  ;; Changes to the argument order above will require changes to the
+  ;; unsupported-database-triggers-shutdown test.
+  (fn shutdown [opts]
+    (let [{{:keys [status messages] :as exit-opts} ::tk/exit} opts]
+      (assert (integer? status))
+      (assert (every? string? (map first messages)))
+      (some-> (:shutdown-request (service-context service))
+              (deliver {:opts opts}))
+      (doseq [[msg out] messages
+              :let [msg (utils/attention-msg msg)]]
+        (utils/println-err msg)
+        (log/error msg))
+      (if (zero? status)
+        (request-shutdown)
+        (shutdown-on-error (service-id service)
+                           #(throw (Exception. (apply str (map first messages)))))))))

 (defprotocol PuppetDBServer
   (shared-globals [this])
@@ -715,7 +735,7 @@
   PuppetDBServer
   [[:DefaultedConfig get-config]
    [:WebroutingService add-ring-handler get-registered-endpoints]
-   [:ShutdownService shutdown-on-error]]
+   [:ShutdownService request-shutdown shutdown-on-error]]
   (init [this context]

         (doseq [{:keys [reporter]} (vals metrics/metrics-registries)]
@@ -729,12 +749,15 @@
                  ;; This coordination is needed until we no longer
                  ;; support jdk < 10.
                  ;; https://bugs.openjdk.java.net/browse/JDK-8176254
-                 :stop-status (atom #{}))))
+                 :stop-status (atom #{})
+                 :shutdown-request (promise))))
   (start
    [this context]
    (start-puppetdb-or-shutdown context (get-config) this
                                get-registered-endpoints
-                               shutdown-on-error))
+                               (shutdown-requestor request-shutdown
+                                                   shutdown-on-error
+                                                   this)))

   (stop [this context]
         (doseq [{:keys [reporter]} (vals metrics/metrics-registries)]


(SERVER-2681) Remove test that checks instance ids

This commit removes a test that checks the instance ids of the borrowed JRuby
instances. In multithreaded mode, the `:borrowed-instances` metric uses the
thread id rather than the instance id, so these values don't match. Since the
actual values here are pretty arbitrary, the test doesn't seem especially
valuable, so let's just remove it.

--- test/integration/puppetlabs/services/jruby/jruby_metrics_service_test.clj
+++ test/integration/puppetlabs/services/jruby/jruby_metrics_service_test.clj
@@ -320,7 +320,7 @@
           (is (= expected-metrics (-> (current-jruby-status-metrics)
                                       (jruby-status-metric-counters)))))))))

-(deftest ^:metrics ^:single-threaded-only borrowed-instances-test
+(deftest ^:metrics borrowed-instances-test
   (with-metrics-test-env test-env default-test-config
     (let [{:keys [coordinator update-expected-values expected-metrics-values
                   current-metrics-values jruby-service]} test-env
@@ -344,8 +344,6 @@
                                       (jruby-status-metric-counters))))

           ;; let's take a peek at the info about the borrowed instances.
-          ;; the keys for `borrowed-instances` are the jruby instance ids.
-          (is (= #{1 2} (set (keys @borrowed-instances))))
           (let [expected-uris #{"/foo/bar/async1" "/foo/baz/async2"}
                 actual-uris #(set (map (fn [instance]
                                          (get-in instance


refactored add & rel

refactored add & rel

--- src/latte_compiler/static_analysis.clj
+++ src/latte_compiler/static_analysis.clj
@@ -1,7 +1,8 @@
 (ns latte-compiler.static-analysis
   (:require [clojure.core.match :as match]
             [clojure.algo.monads :as m]
-            [latte-compiler.util :as util]))
+            [latte-compiler.util :as util]
+            ))

 (defrecord ClassDef [extends fields funs])
 (defrecord FunDef [name outType inTypes])
@@ -274,6 +275,60 @@
   [obj vars]
   (with-meta obj (assoc (meta obj) "_vars" vars))
   )
+
+(defn- is-str
+  [x]
+  (= (get-type x) [:string]))
+
+(defn- is-bool
+  [x]
+  (= (get-type x) [:bool]))
+
+(defn- is-int
+  [x]
+  (= (get-type x) [:int]))
+
+(defn annotate-erel
+  [vars lexpr rexpr relop location]
+  (match/match [lexpr rexpr relop]
+    [(lexpr :guard #(is-str %)) (rexpr :guard #(is-str %)) [:eq]]
+    (util/succ [vars (with-type [:eapp [:ident "_eqStrings"] [lexpr rexpr]] [:bool])])
+
+    [(lexpr :guard #(is-str %)) (rexpr :guard #(is-str %)) [:ieq]]
+      (util/succ [vars (with-type [:not [:eapp [:ident "_eqStrings"] [lexpr rexpr]]] [:bool])])
+
+    [(lexpr :guard #(is-bool %)) (rexpr :guard #(is-bool %)) (:or [:eq] [:ieq])]
+    (util/succ [vars (with-type [:erel lexpr relop rexpr] [:bool])])
+
+    [(lexpr :guard #(is-int %)) (rexpr :guard #(is-int %)) relop]
+    (util/succ [vars (with-type [:erel lexpr relop rexpr] [:bool])])
+
+    [ _ _  (:or [:eq] [:ieq])]
+    (util/err (str "expr invalid; expected int,int or bool,bool or string,string, "
+                "found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))
+
+    :else
+    (util/err (str "expr invalid; expected int,int, "
+                "found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))
+    ))
+
+(defn annotate-eadd
+  [vars lexpr rexpr relop location]
+  (match/match [lexpr rexpr relop]
+    [(lexpr :guard #(is-str %)) (rexpr :guard #(is-str %)) [:plus]]
+    (util/succ [vars (with-type [:eapp [:ident "_concatStrings"] [lexpr rexpr]] [:string])])
+
+    [(lexpr :guard #(is-int %)) (rexpr :guard #(is-int %)) relop]
+    (util/succ [vars (with-type [:eadd lexpr relop rexpr] [:int])])
+
+    [ _ _  [:plus]]
+    (util/err (str "expr invalid; expected int,int or string,string, "
+                "found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))
+
+    :else
+    (util/err (str "expr invalid; expected int,int, "
+                "found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location)
+    )))

 (defn annotate-expr
   [glob-state vars expr]
@@ -332,41 +387,7 @@
               [[vars1 lexpr] (annotate-expr glob-state vars (second expr))
                [vars2 rexpr] (annotate-expr glob-state vars1 (fourth expr))
                op (m-result (third expr))
-               res (if (and
-                         (= (get-type lexpr) [:int])
-                         (= (get-type rexpr) [:int]))
-                     (util/succ [vars2 (with-type [:erel lexpr op rexpr] [:bool])])
-                     (if (or
-                           (= (third expr) [:eq])
-                           (= (third expr) [:ieq]))
-
-                       (if (and
-                             (= (get-type lexpr) [:bool])
-                             (= (get-type rexpr) [:bool])
-                             (or
-                               (= (third expr) [:eq])
-                               (= (third expr) [:ieq])
-                               )
-                             )
-                         (util/succ [vars2 (with-type [:erel lexpr op rexpr] [:bool])])
-                         (if (and
-                               (= (get-type lexpr) [:string])
-                               (= (get-type rexpr) [:string])
-                               (or
-                                 (= (third expr) [:eq])
-                                 (= (third expr) [:ieq])
-                                 ))
-                           (let
-                             [cmp [:eapp [:ident "_eqStrings"] [lexpr rexpr]]
-                              expr (if (= (third expr) [:eq])
-                                     cmp
-                                     [:not cmp])]
-                             (util/succ [vars2 (with-type expr [:bool])]))
-                           (util/err (str "expr invalid; expected int,int or bool,bool or string,string, "
-                                       "found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))))
-                       (util/err (str "expr invalid; expected int,int, "
-                                   "found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location)))
-                     )
+               res (annotate-erel vars2 lexpr rexpr op location)
                ]
               res)
       :emul (m/domonad util/phase-m
@@ -381,38 +402,13 @@
                      )
                ]
               res)
-      :eadd (match/match (third expr)
-              [:minus]
-              (m/domonad util/phase-m
-                [[vars1 lexpr] (annotate-expr glob-state vars (second expr))
-                 [vars2 rexpr] (annotate-expr glob-state vars1 (fourth expr))
-                 res (if (and
-                           (= (get-type lexpr) [:int])
-                           (= (get-type rexpr) [:int]))
-                       (util/succ [vars2 (with-type [:eadd lexpr [:minus] rexpr] [:int])])
-                       (util/err (str "expr invalid; expected int,int, found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))
-                       )
-                 ]
-                res)
-              [:plus]
-              (m/domonad util/phase-m
-                [[vars1 lexpr] (annotate-expr glob-state vars (second expr))
-                 [vars2 rexpr] (annotate-expr glob-state vars1 (fourth expr))
-                 res (if
-                       (and
-                         (= (get-type lexpr) [:int])
-                         (= (get-type rexpr) [:int]))
-                       (util/succ [vars2 (with-type [:eadd lexpr [:plus] rexpr] [:int])])
-                       (if
-                         (and
-                           (= (get-type lexpr) [:string])
-                           (= (get-type rexpr) [:string]))
-                         (util/succ [vars2 (with-type [:eapp [:ident "_concatStrings"] [lexpr rexpr]] [:string])])
-                         (util/err (str "expr invalid; expected int,int or string,string, found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location)))
-                       )
-                 ]
-                res)
-              )
+      :eadd  (m/domonad util/phase-m
+               [[vars1 lexpr] (annotate-expr glob-state vars (second expr))
+                [vars2 rexpr] (annotate-expr glob-state vars1 (fourth expr))
+                op (m-result (third expr))
+                res (annotate-eadd vars2 lexpr rexpr op location)
+                ]
+               res)
       :eapp (m/domonad util/phase-m
               [ident (m-result (second expr))
                [nvar args] (reduce (fn [buff tmp] (m/domonad util/phase-m [[tmvar tmargs] buff [ntmvar nexpr] (annotate-expr glob-state tmvar tmp)] [ntmvar (conj tmargs nexpr)])) (m-result [vars []]) (rest (rest expr)))


added normalize true as the default for reconciler

--- src/untangled/client/impl/application.cljs
+++ src/untangled/client/impl/application.cljs
@@ -81,6 +81,7 @@
                 :send       (fn [tx cb]
                               (server-send (assoc app :reconciler @rec-atom) tx cb))
                 :migrate    tempid-migrate
+                :normalize  true
                 :merge-tree (comp impl/sweep-missing util/deep-merge)
                 :parser     parser}
         rec (om/reconciler config)]


Story ID: develop Summary: - mutation now catches all errors and reports them to the user

--- src/untangled/client/impl/om_plumbing.cljs
+++ src/untangled/client/impl/om_plumbing.cljs
@@ -33,7 +33,7 @@
 (defn write-entry-point [env k params]
   (try
     (m/mutate env k params)
-    (catch js/Error e (log/error (str "Mutation " k " failed with exception") e))))
+    (catch :default e (log/error (str "Mutation " k " failed with exception") e))))

 (defn resolve-tempids [state tid->rid]
   "Replaces all om-tempids in app-state with the ids returned by the server."


adding support for foreign libs reloading

--- sidecar/src/figwheel_sidecar/core.clj
+++ sidecar/src/figwheel_sidecar/core.clj
@@ -277,27 +277,43 @@
     (concat (get-dependency-files state))
     (send-changed-files state)))

-(defn closure-file->namespace [js-file-path]
-  (-> js-file-path
-    io/file
-    build-api/parse-js-ns
-    :provides
-    first))
-
-(defn copy-changed-closure-js [output-dir changed-js]
+(defn get-foreign-lib [{:keys [foreign-libs]} file-path]
+  (when foreign-libs
+    (let [file (io/file file-path)]
+      (first (filter (fn [fl]
+                       (= (.getCanonicalPath (io/file (:file fl)))
+                          (.getCanonicalPath file)))
+                     foreign-libs)))))
+
+(defn js-file->namespaces [{:keys [foreign-libs] :as state} js-file-path]
+  (if-let [foreign (get-foreign-lib state js-file-path)]
+    (:provides foreign)
+    (:provides (build-api/parse-js-ns js-file-path))))
+
+(defn cljs-target-file-from-foreign [output-dir file-path]
+  (io/file (str output-dir java.io.File/separator (.getName (io/file file-path)))) )
+
+(defn get-js-copies [{:keys [output-dir] :as state} changed-js]
+  (keep
+   (fn [f]
+     (if-let [foreign (get-foreign-lib state f)]
+       {:output-file (cljs-target-file-from-foreign output-dir f)
+        :file f}
+       (when-let [namesp (first (js-file->namespaces state f))]
+         {:output-file (cbapi/cljs-target-file-from-ns output-dir namesp)
+          :file f})))
+   changed-js))
+
+(defn make-copies [copies]
+  (doseq [{:keys [file output-file]} copies]
+    (spit output-file (slurp file))))
+
+(defn copy-changed-js [state changed-js]
   ;; there is an easy way to do this built into clojurescript
   ;; the idea here is we are only copying files that make sense to
   ;; copy i.e. they have a provide
   (when-not (empty? changed-js)
-    (let [copies (keep
-                  (fn [f]
-                    (when-let [nspace (closure-file->namespace f)]
-                      {:namespace nspace
-                       :output-file (cbapi/cljs-target-file-from-ns output-dir nspace)
-                       :file f}))
-                  changed-js)]
-      (doseq [{:keys [file output-file]} copies]
-        (spit output-file (slurp file))))))
+    (make-copies (get-js-copies state changed-js))))

 ;; this functionality should be moved to autobuilder or a new ns
 ;; this ns should just be for notifications?
@@ -315,11 +331,11 @@
   ;; are made explicitely
   ([state old-mtimes new-mtimes additional-ns]
    (let [change-source-file-paths (get-changed-source-file-paths old-mtimes new-mtimes)]
-
-     (copy-changed-closure-js (:output-dir state) (:js change-source-file-paths))
+     (copy-changed-js state (:js change-source-file-paths))
      (notify-cljs-ns-changes state
                              (set (concat additional-ns
-                                          (keep closure-file->namespace (:js change-source-file-paths))
+                                          (mapcat (partial js-file->namespaces state)
+                                                  (:js change-source-file-paths))
                                           (keep get-ns-from-source-file-path
                                                 (concat
                                                    (:cljs change-source-file-paths)


Fix typo in exception-report view.

Fix typo in exception-report view.

Fixes #29.

--- src/main/clojure/cascade/exception.clj
+++ src/main/clojure/cascade/exception.clj
@@ -111,7 +111,7 @@
           (conj stack (assoc exception-map :stack-trace (transform-stack-trace (.getStackTrace current))))
           (recur next-exception (conj stack exception-map))))))

-(def exception-banner "An unexpected exception has occured.")
+(def exception-banner "An unexpected exception has occurred.")

 (defn render-exception-map
   "Renders an individual exception map. "


Better communicate intent

Better communicate intent

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -106,8 +106,8 @@
       (apply make-measurement target-temperature to location)
       (make-measurement target-temperature to))))

-(defn typical-vertical-depth
-  ([] (typical-vertical-depth (rand-length-unit)))
+(defn typical-vertical-depth-subsea
+  ([] (typical-vertical-depth-subsea (rand-length-unit)))
   ([length-unit]
    (let [typical-vertical-depth-in-feet
          (fn [] (make-measurement (tuc/draw-normal 8000 1216) :ft))]
@@ -560,7 +560,7 @@
   ([] (typical-subsurface-location (rand-length-unit)))
   ([length-unit]
    (let [typical-location-in-ft (vec (map #(make-measurement % :ft)
-                                          [(rand-easting) (rand-northing) (typical-vertical-depth)]))]
+                                          [(rand-easting) (rand-northing) (typical-vertical-depth-subsea)]))]
      (if (= length-unit :ft)
        typical-location-in-ft
        (vec (map #(length-as % :m) typical-location-in-ft))))))


Remove convert-units-f for volume

Remove convert-units-f for volume

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -52,14 +52,10 @@
 (def rand-volume-unit (fn [] (rand-unit :volume)))

 (defn convert-units-f [from to]
-  (let [factors   {[:ft-lb :J]                1.35582
-                   ;; slurry rate conversion not needed (use [:bbl :m3])
-                   [:m3 :bbl]                 6.28981077}
+  (let [factors   {[:ft-lb :J]                1.35582}
         converter {[:kg-per-m3 :lb-per-cu-ft] #(/ % (factors [:lb-per-cu-ft :kg-per-m3]))
                    [:ft-lb :J]                #(* % (factors [:ft-lb :J]))
-                   [:J :ft-lb]                #(/ % (factors [:ft-lb :J]))
-                   [:bbl :m3]                 #(/ % (factors [:m3 :bbl]))
-                   [:m3 :bbl]                 #(* % (factors [:m3 :bbl]))}]
+                   [:J :ft-lb]                #(/ % (factors [:ft-lb :J]))}]
     (converter [from to])))

 ;; I model a measurement as a 2- or 3-item vector. These functions make the intent of some code clearer when
@@ -91,6 +87,7 @@
 (def pressure-as (as-f :psi :kPa 6.894757293168361))
 (def proppant-concentration-as (as-f :lb-per-gal :kg-per-m3 119.826))
 (def slurry-rate-as (as-f :m3-per-min :bpm 6.28981077))
+(def volume-as (as-f :m3 :bbl 6.28981077))

 ;; Because conversion between temperature units is not simply multiplicative, I define this function with a
 ;; unique body.
@@ -654,8 +651,8 @@
         measurement (generate-measurement-f unit)]
     [measurement (measurement-as-f measurement (first (remove (partial = unit) units)))]))

-(generate-measurement-pair (set (quantity-unit-map :mass))
-                           rand-mass-unit typical-proppant-mass mass-as)
+(generate-measurement-pair (set (quantity-unit-map :volume))
+                           rand-volume-unit typical-pumped-volume volume-as)

 (defn rand-measurement
   ([]


CMR-3161 More cleanup

CMR-3161 More cleanup

--- umm-spec-lib/src/cmr/umm_spec/test/iso19115_expected_conversion.clj
+++ umm-spec-lib/src/cmr/umm_spec/test/iso19115_expected_conversion.clj
@@ -378,7 +378,6 @@

 (defn umm-expected-conversion-iso19115
   [umm-coll]
-  (def umm-coll umm-coll)
   (-> umm-coll
       (assoc :DirectoryNames nil)
       update-bounding-rectangles


Add pithyless regression test

Add pithyless regression test

--- test/cljc/spec_tools/data_spec_test.cljc
+++ test/cljc/spec_tools/data_spec_test.cljc
@@ -18,8 +18,8 @@
            (s/explain-data spec ["1"])
            (s/explain-data impl ["1"])))
     (comment "CLJ-CLJ-2168"
-      (is (= (ignoring-spec (s/explain-data spec [1]))
-             (ignoring-spec (s/explain-data impl [1])))))
+             (is (= (ignoring-spec (s/explain-data spec [1]))
+                    (ignoring-spec (s/explain-data impl [1])))))
     (is (= ["1"]
            (s/conform spec ["1"])
            (s/conform impl ["1"])))))
@@ -222,3 +222,6 @@
              (ds/spec ::kikka {keyword? keyword?})
              {"thanks" "alex"}
              st/string-conforming)))))
+
+(deftest pithyless-test
+  (is (st/explain-data (ds/spec ::foo {:foo string?}) {:foo 42})))


test simplified

test simplified

--- test/clj/swarmpit/api_integration_test.clj
+++ test/clj/swarmpit/api_integration_test.clj
@@ -115,10 +115,7 @@

     (testing "tasks"
       (let [tasks (tasks)]
-        (is (some? tasks))
-        (is (= (service-tasks service-id)
-               (->> tasks
-                    (filter #(.startsWith (:taskName %) "test")))))))
+        (is (some? tasks))))

     (testing "find public repository"
       (let [results (public-repositories "nginx" 1)]


* src/clj/cljs/compiler.clj: :defs is now hashmap of symbol -> hashmap. :name and :line available. this is to support metadata that was lost since we don't have Vars or Namespaces in ClojureScript.