support for more date ranges options.

support for more date ranges options.

--- src/metabase/query_processor/parameters.clj
+++ src/metabase/query_processor/parameters.clj
@@ -4,14 +4,63 @@
             [clj-time.core :as t]
             [clj-time.format :as tf]
             [medley.core :as m]
-            [metabase.driver :as driver]))
+            [metabase.driver :as driver])
+  (:import (org.joda.time DateTimeConstants)))

 (def ^:private ^:const relative-dates
   #{"today"
     "yesterday"
     "past7days"
-    "past30days"})
+    "past30days"
+    "thisweek"
+    "thismonth"
+    "thisyear"
+    "lastweek"
+    "lastmonth"
+    "lastyear"})
+
+(defn- start-of-quarter [quarter year]
+  (condp = quarter
+    "Q1" (t/first-day-of-the-month (.withMonthOfYear (t/date-time year) DateTimeConstants/JANUARY))
+    "Q2" (t/first-day-of-the-month (.withMonthOfYear (t/date-time year) DateTimeConstants/APRIL))
+    "Q3" (t/first-day-of-the-month (.withMonthOfYear (t/date-time year) DateTimeConstants/JULY))
+    "Q4" (t/first-day-of-the-month (.withMonthOfYear (t/date-time year) DateTimeConstants/OCTOBER))))
+
+(defn- week-range [dt]
+  ;; weeks always start on SUNDAY and end on SATURDAY
+  {:end   (.withDayOfWeek dt DateTimeConstants/SATURDAY)
+   :start (.withDayOfWeek dt DateTimeConstants/SUNDAY)})
+
+(defn- month-range [dt]
+  {:end   (t/last-day-of-the-month dt)
+   :start (t/first-day-of-the-month dt)})
+
+;; NOTE: this is perhaps a little hacky, but we are assuming that `dt` will be in the first month of the quarter
+(defn- quarter-range [dt]
+  {:end   (t/last-day-of-the-month (t/plus dt (t/months 2)))
+   :start (t/first-day-of-the-month dt)})
+
+(defn- year-range [dt]
+  {:end   (t/last-day-of-the-month (.withMonthOfYear dt DateTimeConstants/DECEMBER))
+   :start (t/first-day-of-the-month (.withMonthOfYear dt DateTimeConstants/JANUARY))})
+
+(defn- absolute-date->range
+  "Take a given string description of an absolute date range and return a MAP with a given `:start` and `:end`.
+   Supported formats:
+      \"2014-05-10~2014-05-16\"
+      \"Q1-2016\"
+      \"2016-04\""
+  [value]
+  (if (s/includes? value "~")
+    ;; these values are already expected to be iso8601 strings, so we are done
+    (zipmap [:start :end] (s/split value #"~" 2))
+    ;; these cases represent fixed date ranges, but we need to calculate start/end still
+    (->> (if (s/starts-with? value "Q")
+           (let [[quarter year] (s/split value #"-" 2)]
+             (quarter-range (start-of-quarter quarter (Integer/parseInt year))))
+           (month-range (tf/parse (tf/formatters :year-month) value)))
+         (m/map-vals (partial tf/unparse (tf/formatters :year-month-day))))))

 ;;; +-------------------------------------------------------------------------------------------------------+
@@ -25,13 +74,19 @@
     ["=" field param-value]
     ;; otherwise we need to handle date filtering
     (if-not (contains? relative-dates param-value)
-      ;; absolute date range such as: "2014-05-10,2014-05-16"
-      (let [[start end] (s/split param-value #"~" 2)]
+      ;; absolute date range
+      (let [{:keys [start end]} (absolute-date->range param-value)]
         ["BETWEEN" field start end])
-      ;; relative date range, so build appropriate MBQL clause
+      ;; relative date range
       (condp = param-value
         "past7days"  ["TIME_INTERVAL" field -7 "day"]
         "past30days" ["TIME_INTERVAL" field -30 "day"]
+        "thisweek"   ["TIME_INTERVAL" field "current" "week"]
+        "thismonth"  ["TIME_INTERVAL" field "current" "month"]
+        "thisyear"   ["TIME_INTERVAL" field "current" "year"]
+        "lastweek"   ["TIME_INTERVAL" field "last" "week"]
+        "lastmonth"  ["TIME_INTERVAL" field "last" "month"]
+        "lastyear"   ["TIME_INTERVAL" field "last" "year"]
         "yesterday"  ["=" field ["relative_datetime" -1 "day"]]
         "today"      ["=" field ["relative_datetime" "current"]]))))

@@ -58,26 +113,37 @@
 ;;; +-------------------------------------------------------------------------------------------------------+

+(defn- relative-date->range
+  "Take a given string description of a relative date range such as 'lastmonth' and return a MAP with a given
+   `:start` and `:end` as iso8601 string formatted dates.  Values should be appropriate for the given REPORT-TIMEZONE."
+  [value report-timezone]
+  (let [tz        (t/time-zone-for-id report-timezone)
+        formatter (tf/formatter "YYYY-MM-dd" tz)
+        today     (t/today-at-midnight tz)]
+    (->> (condp = value
+           "past7days"  {:end   (t/minus today (t/days 1))
+                         :start (t/minus today (t/days 7))}
+           "past30days" {:end   (t/minus today (t/days 1))
+                         :start (t/minus today (t/days 30))}
+           "thisweek"   (week-range today)
+           "thismonth"  (month-range today)
+           "thisyear"   (year-range today)
+           "lastweek"   (week-range (t/minus today (t/weeks 1)))
+           "lastmonth"  (month-range (t/minus today (t/months 1)))
+           "lastyear"   (year-range (t/minus today (t/years 1)))
+           "yesterday"  {:end   (t/minus today (t/days 1))
+                         :start (t/minus today (t/days 1))}
+           "today"      {:end   today
+                         :start today})
+         ;; the above values are JodaTime objects, so unparse them to iso8601 strings
+         (m/map-vals (partial tf/unparse formatter)))))
+
 (defn- extract-dates [value report-timezone]
   (if-not (contains? relative-dates value)
-    ;; absolute date range such as: "2014-05-10,2014-05-16"
-    ;; TODO: other absolute options?  year-quarter?  year-month?
-    (zipmap [:start :end] (s/split value #"~" 2))
+    ;; absolute date range
+    (absolute-date->range value)
     ;; relative date range
-    (let [tz        (t/time-zone-for-id report-timezone)
-          formatter (tf/formatter "YYYY-MM-dd" tz)
-          today     (t/today-at-midnight tz)]
-      (->> (condp = value
-             "past7days"  {:end   (t/minus today (t/days 1))
-                           :start (t/minus today (t/days 7))}
-             "past30days" {:end   (t/minus today (t/days 1))
-                           :start (t/minus today (t/days 30))}
-             "yesterday"  {:end   (t/minus today (t/days 1))
-                           :start (t/minus today (t/days 1))}
-             "today"      {:end   today
-                           :start today})
-           ;; the above values are JodaTime objects, so unparse them to iso8601 strings
-           (m/map-vals (partial tf/unparse formatter))))))
+    (relative-date->range value report-timezone)))

 (defn- expand-date-range-param [report-timezone {[target param-name] :target, param-type :type, param-value :value, :as param}]
   (if-not (= param-type "date")


Expose debug middleware through API

Expose debug middleware through API

--- src/re_frame/core.cljs
+++ src/re_frame/core.cljs
@@ -2,7 +2,7 @@
   (:require
     [re-frame.handlers   :as handlers]
     [re-frame.subs       :as subs]
-    [re-frame.middleware :as  middleware]))
+    [re-frame.middleware :as middleware]))

 ;; --  API  -------
@@ -17,15 +17,16 @@

 (def pure        middleware/pure)
+(def debug       middleware/debug)
 (def undoable    middleware/undoable)
 (def path        middleware/path)
 (def validate    middleware/validate)
-(def log-events  middleware/log-events)
 (def trim-v      middleware/trim-v)
+; (def log-events  middleware/log-events)

-;; --  Convienience API  -------
+;; --  Convienience  -------

 ;; virtually ever handler will be pure, make it easy
 (defn register-pure-handler


Make sure on-set is valid before allowing change of Reaction

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -285,10 +285,10 @@

   IReset
   (-reset! [a newval]
+    (assert (ifn? on-set) "Reaction is read only.")
     (let [oldval state]
       (set! state newval)
-      (when (some? on-set)
-        (on-set oldval newval))
+      (on-set oldval newval)
       (-notify-watches a oldval newval)
       newval))


common/pre-dump-event: serialize non-float metrics correctly.

--- src/reimann/common.clj
+++ src/reimann/common.clj
@@ -38,7 +38,8 @@

 ; Protobuf transformation
 (defn pre-dump-event [e]
-  (assoc e :metric_f (:metric e)))
+  (let [e (if (:metric e) (assoc e :metric_f (float (:metric e))) e)]
+    e))

 (defn post-load-event [e]
   "Loads a protobuf event to an internal event."


Load hipchat into riemann namespace

Load hipchat into riemann namespace

Fixes:
```
INFO [2013-12-10 17:36:26,647] main - riemann.bin - PID 81295

ERROR [2013-12-10 17:36:26,674] main - riemann.bin - Couldn't start java.lang.RuntimeException: Unable to resolve symbol: hipchat in this context, compiling:(etc/riemann.config:6:9)
```

--- src/riemann/config.clj
+++ src/riemann/config.clj
@@ -29,6 +29,7 @@
         [riemann.campfire :only [campfire]]
         [riemann.librato :only [librato-metrics]]
         [riemann.nagios :only [nagios]]
+        [riemann.hipchat :only [hipchat]]
         riemann.streams))

 (def core "The currently running core."


Fixed error messages.

Fixed error messages.

--- src/seria/analyze.cljc
+++ src/seria/analyze.cljc
@@ -34,6 +34,7 @@
     composite
     (vec (concat [a {} b] rest))))

+
 (declare validate)

 (defn validate-dispatch [_ [composite-type]]
@@ -45,50 +46,46 @@
 (defmulti validate-composite validate-dispatch)

 (defmethod validate-composite :coll [schemas [composite-type options schema]]
-  (assert schema "todo")
   (if-let [size-option (:size options)]
-    (assert (size-type? size-option) "todo"))
+    (assert (size-type? size-option) (str composite-type " | Invalid size option: " size-option)))
   [composite-type options (validate schemas schema)])

-(defmethod validate-composite :map [schemas [composite-type options schema-1 schema-2]]
-  (assert schema-1 "todo")
-  (assert schema-2 "todo")
+(defmethod validate-composite :map [schemas [composite-type options key-schema value-schema]]
   (if-let [size-option (:size options)]
-    (assert (size-type? size-option) "todo"))
-  [composite-type options (validate schemas schema-1) (validate schemas schema-2)])
+    (assert (size-type? size-option) (str composite-type " | Invalid size option: " size-option)))
+  [composite-type options (validate schemas key-schema) (validate schemas value-schema)])

 (defmethod validate-composite :optional [schemas [_ options schema]]
-  (assert schema "todo")
   [:optional options (validate schemas schema)])

-(defmethod validate-composite :enum [_ [_ options args]]
-  (assert (sequential? args) "todo")
-  (assert (seq args) "todo")
-  (assert (every? keyword? args) "todo")
-  [:enum options args])
+(defmethod validate-composite :enum [_ [_ options values]]
+  (assert (sequential? values) (str ":enum | Invalid values (must be sequential): " values))
+  (assert (seq values) (str ":enum | Invalid values (must be non-empty): " values))
+  (assert (every? keyword? values) (str ":enum | Invalid values (must contain keywords only): " values))
+  [:enum options values])

 (defmethod validate-composite :tuple [schemas [_ options sub-schemas]]
-  (assert (sequential? sub-schemas) "todo")
-  (assert (seq sub-schemas) "todo")
+  (assert (sequential? sub-schemas) (str ":tuple | Invalid schemas (must be sequential): " sub-schemas))
+  (assert (seq sub-schemas) (str ":tuple | Invalid schemas (must be non-empty): " sub-schemas))
   [:tuple options (mapv (partial validate schemas) sub-schemas)])

 (defmethod validate-composite :record [schemas [_ options arg-map]]
-  (assert (map? arg-map) "todo")
+  (assert (map? arg-map) (str ":record | Invalid record map (must be a map): " arg-map))
   (let [fields      (keys arg-map)
         sub-schemas (vals arg-map)]
-    (assert (every? keyword? fields) "todo")
+    (assert (every? keyword? fields) (str ":record | Invalid record fields (must be keywords): " fields))
     [:record options (zipmap fields (mapv (partial validate schemas) sub-schemas))]))

 (defmethod validate-composite :multi [schemas [_ options selector arg-map]]
-  (assert (ifn? selector) "todo")
-  (assert (map? arg-map) "todo")
+  (assert (ifn? selector) (str ":multi | Invalid selector (must implement IFn): " selector))
+  (assert (map? arg-map) (str ":multi | Invalid multi map (must be a map): " arg-map))
   (let [multi-cases (keys arg-map)
         sub-schemas (vals arg-map)]
     [:multi options selector (zipmap multi-cases (mapv (partial validate schemas) sub-schemas))]))

 (defn validate
   ([schemas]
-   (assert (not-any? built-in? (keys schemas)) "todo")
+   (assert (not-any? built-in? (keys schemas)) "Built-in schema used as a top-level schema.")
    (into {} (for [[top-schema schema] schemas]
               [top-schema (validate schemas schema)])))
   ([schemas schema]
@@ -97,7 +94,7 @@
          (advanced? schema)
          (contains? schemas schema)) schema
      (composite? schema) (validate-composite schemas (with-options schema))
-     :else (throw (Exception. (str "Unknown schema type " schema))))))
+     :else (throw (Exception. (str "Unknown schema type: " schema))))))

 (defn find-multi-cases [schemas]


Function to segment measures

Function to segment measures

--- src/tenor/entities.clj
+++ src/tenor/entities.clj
@@ -36,6 +36,19 @@
       (fn [x] (or (= 1 x) (rand-nth [true false])))
       notes)))

+(defn segment-measure [measure
+                       & {:keys [running-count result note-value]
+                          :or {running-count 0 result '() note-value 16}}]
+  (if (empty? measure)
+    result
+    (let [result (concat result (map #(+ running-count %)
+                                     (segment-beat (first measure) note-value)))
+          running-count (+ running-count (first measure))]
+      (segment-measure (rest measure)
+                       :running-count running-count
+                       :result result
+                       :note-value note-value))))
+
 (defrecord Beat [note-count note-value]
   Entity
   (generated [this] (segment-beat note-count note-value)))


Add :allow-all-sg to security-group

Add :allow-all-sg to security-group

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -88,9 +88,23 @@
       (let [defaults {:protocol "tcp"
                       :type "ingress"
                       :security_group_id (id-of "aws_security_group" name)}
-            port (:port rule)
-            port-to-port-range (fn [rule] (if port (-> (assoc rule :from_port port :to_port port) (dissoc :port)) rule))
-            rule (merge defaults (port-to-port-range rule))
+
+            port-to-port-range (fn [rule] (if-let [port (:port rule)]
+                                            (-> rule
+                                                (assoc :from_port port :to_port port)
+                                                (dissoc :port))
+                                            rule))
+
+            allow-all-sg (fn [rule] (if-let [allow-all-sg-id (:allow-all-sg rule)]
+                                      (-> rule
+                                          (assoc :from_port 0 :to_port 0)
+                                          (assoc :protocol -1)
+                                          (assoc :source_security_group_id allow-all-sg-id)
+                                          (dissoc :allow-all-sg))
+                                      rule))
+            rule (-> (merge defaults rule)
+                     port-to-port-range
+                     allow-all-sg)
             suffix (str (hash rule))]
         ["aws_security_group_rule"
          (stringify name "-" suffix)


handle aggregation: rows

handle aggregation: rows

--- src/metabase/query_processor/structured.clj
+++ src/metabase/query_processor/structured.clj
@@ -7,8 +7,8 @@
                              [table :refer [Table]])
             [metabase.util :refer [assoc*]]))

-(defn annotate-column [table column-id]
-  (let [{:keys [name base_type] :as column} (sel :one Field :id column-id)
+(defn annotate-column [table column]
+  (let [{:keys [name base_type]} column
         qualified-name (format "\"%s\".\"%s\"" (:name table) name)
         alias (match base_type
                 "DateTimeField" (format "%s_date" name)
@@ -24,6 +24,9 @@
            :alias alias
            :select select)))

+(defn annotate-column-with-id [table column-id]
+  (annotate-column table (sel :one Field :id column-id)))
+
 (defn annotate-special-column [column]
   (println "COLUMN -> " column)
   (match column
@@ -38,23 +41,24 @@
              :id nil
              :description nil}))

-(defn get-columns [{:keys [table breakout aggregation] :as query}]
-  (->> (concat breakout aggregation)
-       (filter identity)
-       (map (fn [column]
-              (case (integer? column)
-                true (annotate-column table column)
-                false (annotate-special-column column))))))
-
-(declare build-query
-         generate-sql)
+(defn get-columns
+  "Return an array of column info dictionaries for query."
+  [{:keys [source_table table breakout aggregation] :as query}]
+  (if (= aggregation ["rows"]) (->> (sel :many Field :table_id source_table) ; aggregation: ["rows"] just means return all rows
+                                    (map (partial annotate-column table)))
+      (->> (concat breakout aggregation)
+           (filter identity)
+           (map (fn [column]
+                  (case (integer? column)
+                    true (annotate-column-with-id table column)
+                    false (annotate-special-column column)))))))

 (defn process [{:keys [source_table] :as query}]
   (assoc* query
           :table (sel :one Table :id source_table)
           :database (:db (-> (:source_table <>)
                              (hydrate :db)))
-          :columns ( get-columns <>)
+          :columns (get-columns <>)
           :columns-by-name (->> (:columns <>)
                                 (map (fn [{:keys [keyword] :as col}]
                                        {keyword col}))
@@ -82,7 +86,7 @@
 (defn apply-clause [query [clause-name clause-value]]
   (case clause-name
     :filter nil
-    :breakout ( apply-breakout query clause-value)
+    :breakout (apply-breakout query clause-value)
     :limit (when clause-value
              {:limit clause-value})
     :aggregation nil))


Clean up strip-eq formatting.

Clean up strip-eq formatting.

--- src/playasophy/wonderdome/mode/strip_eq.clj
+++ src/playasophy/wonderdome/mode/strip_eq.clj
@@ -3,6 +3,7 @@
     [playasophy.wonderdome.geometry.sphere :as sphere]
     [playasophy.wonderdome.mode.core :as mode]
     [playasophy.wonderdome.util.color :as color]))
+

 ;; StripEQ will process audio signals and turn each strip into an indicator for
 ;; the strength of a range of frequencies over time.
@@ -29,37 +30,28 @@
       (assoc this
              :freq/at (System/currentTimeMillis)
              ;; Break frequencies into groups per strip and take mean for each.
-             :freq/group_mean
+             :freq/group-mean
              (->> (:spectrum event)
                   (partition (-> event :spectrum count (/ num-strips) int))
-                  (map #(/ (reduce + %) (count %))))
-      )
+                  (map #(/ (reduce + %) (count %)))))

       ;; Default case.
-      this
-    )
-  )
+      this))

   (render
     [this pixel]
-    (let [
-      ;; Frequency for this strip from most recent signal.
-      ;; Assumes frequencies range from 0 to 1.
-      freq (nth (:freq/group_mean this) (:strip pixel))
-      ;; How far down the strip is this pixel?
-      ;; Ranges from 0 (start of strip) to 1 (end of strip).
-      pix-to-len-pct (double (/ (inc (:pixel pixel)) (inc pix-per-strip)))
-      ]
+    (let [; Frequency for this strip from most recent signal.
+          ; Assumes frequencies range from 0 to 1.
+          freq (nth (:freq/group-mean this) (:strip pixel))
+          ; How far down the strip is this pixel?
+          ; Ranges from 0 (start of strip) to 1 (end of strip).
+          pix-to-len-pct (double (/ (inc (:pixel pixel)) (inc pix-per-strip)))]
+      ; Each strip has the same color, but strips form an even spread over the
+      ; color spectrum.
       (if (< pix-to-len-pct (or freq 0.0))
-        ;; Each strip has the same color,
-        ;; but strips form an even spread over the color spectrum.
         (color/rainbow (* (:strip pixel) (:colorindex this)))
-        color/none
-      )
-    )
-  )
-)
+        color/none))))

 (defn init


getting sesssion id but driver re-uses previously opened file

--- src/athena_cmd/core.clj
+++ src/athena_cmd/core.clj
@@ -48,19 +48,30 @@
                 {}
                 (range 1 (+ 1 cnt)))))

+(defn get_session_id
+  [fn]
+  (let [ls (clojure.string/split-lines (slurp fn))
+        m (map
+            #(re-matches #".*Execution ID: (.*)" %)
+            ls)
+        f (filter #(< 0 (count %)) m)]
+    (second (first f))))
+
 (defn exec
   [query]
   (let [[stmt info] (get_stmt)
-        rs (.executeQuery stmt query)]
+        rs (.executeQuery stmt query)
+        f (get info "log_path")]

     (loop [res []
            more (.next rs)]

       (if-not more

-        [res
-         (get info "log_path")
-         (.close stmt)]
+        (do
+          [res
+           (get_session_id f)
+           f])

         (do
           (recur


revert (def ^:const truncate) in last change: back to false

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -29,7 +29,7 @@

 ;; whether to remove [:head] and [:comp] paths from generated trees after generation:
 ;; for performance.
-(def ^:const truncate true)
+(def ^:const truncate false)

 (declare candidate-parents)
 (declare comp-path-to-complements)


less shuffling and increase max-depth from 5 to 6

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -11,7 +11,7 @@
                                         ref? remove-false remove-top-values-log
                                         strip-refs show-spec unify unifyc)]))
 ;; during generation, will not search deeper than this:
-(def ^:const max-total-depth 5)
+(def ^:const max-total-depth 6)
 (def ^:const mapfn pmap)

 (declare add-complement)
@@ -116,7 +116,7 @@
            bolts))

         expressions
-        (-> (lightning-bolt (lazy-shuffle grammar)
+        (-> (lightning-bolt grammar
                             lexicon
                             spec 0 index morph total-depth)
             ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
@@ -149,7 +149,7 @@
               (mapcat (fn [parent]
                         (if (= false (get-in parent [:head :phrasal] false))
                           (let [candidate-lexemes (get-lex parent :head index spec)
-                                results (over/overh parent (mapfn copy (lazy-shuffle candidate-lexemes)))]
+                                results (over/overh parent (mapfn copy candidate-lexemes))]
                             (log/debug (str "lightning-bolt: " (get-in parent [:rule]) ": candidate head lexemes:'"
                                             (string/join "','" (map morph candidate-lexemes)) "'"))
                             results)))


result file name does not need path

result file name does not need path

--- src/badger/badgerer.clj
+++ src/badger/badgerer.clj
@@ -7,7 +7,7 @@
 (defn add-badge
   "receives profile pic filename and badge number, and saves the badged pic and return the filename"
   [profile-filename badge-num]
-  (let [result-filename (prefix-path (clojure.string/replace profile-filename #"\." (str "_" badge-num ".")))
+  (let [result-filename (clojure.string/replace profile-filename #"\." (str "_" badge-num "."))
         profile-size 600 badge-size 200]
     (q/defsketch badged-profile
       :size [profile-size profile-size]
@@ -17,7 +17,7 @@
                      badge-pos (- profile-size badge-size)]
                  (q/image profile-pic 0 0 profile-size profile-size)
                  (q/image badge-pic badge-pos badge-pos badge-size badge-size)
-                 (q/save result-filename)))
+                 (q/save (prefix-path result-filename))))
       :title "saving to file"
       :draw (fn [] nil))
     (.exit badged-profile)


add time utility functions

add time utility functions

--- src/bract/core/util.clj
+++ src/bract/core/util.clj
@@ -83,3 +83,20 @@
   (let [^StringWriter sw (StringWriter.)]
     (.printStackTrace e (PrintWriter. sw))
     (.toString sw)))
+
+
+(defn now-millis
+  "Return current epochal time in milliseconds."
+  (^long []
+    (System/currentTimeMillis))
+  (^long [^long start-millis]
+    (unchecked-subtract (System/currentTimeMillis) start-millis)))
+
+
+(defn sleep-millis
+  "Sleep for specified number of milliseconds."
+  [^long millis]
+  (try
+    (Thread/sleep millis)
+    (catch InterruptedException e
+      (.interrupt (Thread/currentThread)))))


add atom to stock items

add atom to stock items

--- src/ca_recipe/store.clj
+++ src/ca_recipe/store.clj
@@ -1,7 +1,40 @@
 (ns ca-recipe.store)

 (defn go-shopping-naive
-  "Returns a list of items purchased" [shopping-list]
+  "Returns a list of items purchased"
+  [shopping-list]
   (loop [[item & items] shopping-list
-         cart []] (if item
-                    (recur items (conj cart item)) cart)))
+         cart []]
+    (if item
+      (recur items (conj cart item))
+      cart)))
+
+(def inventory (arom {}))
+
+(defn no-negative-values?
+  "check values of a map for a negative value"
+  [m]
+  (not-any? neg? (vals m)))
+
+(defn in-stock?
+  "check if an item is in stock"
+  [item]
+  (let [cnt (item @inventory)]
+    (and (pos? cnt))))
+
+(defn init
+  "set up store with inventory"
+  [items]
+  (set-validator! inventory no-negative-values?)
+  (swap! inventory items))
+
+(defn grab
+  "grab an item from the shelves"
+  [item]
+  (if (in-stock? item)
+    (swap! inventory unpdate-in [item] dec)))
+
+(defn stock
+  "stock an item on the shelves"
+  [item]
+  (swap! inventory update-in [item] inc))


support test filters in autotest

support test filters in autotest

--- src/cake/tasks/test.clj
+++ src/cake/tasks/test.clj
@@ -2,20 +2,23 @@
   (:use cake cake.core)
   (:import [java.io File]))

-(defn test-opts [args]
-  (if (empty? args)
-    {:all true}
-    (group-by #(cond (keyword?  %) :tags
-                     (namespace %) :functions
-                     :else         :namespaces)
-              (map read-string args))))
+(defn test-opts []
+  (let [args (into (:test *opts*) (:autotest *opts*))]
+    (if (empty? args)
+      {:all true}
+      (group-by #(cond (keyword?  %) :tags
+                       (namespace %) :functions
+                       :else         :namespaces)
+                (map read-string args)))))

 (deftask test #{compile}
   "Run project tests."
-  (bake (:use bake.test) [opts (test-opts (:test *opts*))]
+  "Specify which tests to run as arguments like: namespace, namespace/function, or :tag"
+  (bake (:use bake.test) [opts (test-opts)]
     (run-project-tests opts)))

 (deftask autotest #{compile}
   "Automatically run tests whenever your project code changes."
-  (bake (:use bake.test) [opts (test-opts (:autotest *opts*))]
+  "Specify tests to run just like the test task. Specify the interval with --interval."
+  (bake (:use bake.test) [opts (test-opts)]
     (run-project-tests (assoc opts :quiet true))))


refactor project insights metadata into its own card

--- src-cljs/frontend/components/insights/project.cljs
+++ src-cljs/frontend/components/insights/project.cljs
@@ -262,13 +262,65 @@
           (empty? timing-data) [:div.no-builds.no-insights "No builds in the last 90 days."]
           :else (om/build build-time-line-chart timing-data))]])

-(defn project-insights [state owner]
+(defn insights-metadata [state owner]
   (reify
     om/IRender
     (render [_]
       (component
         (let [branch (-> state :navigation-data :branch)
               {:keys [parallel] :as project} (get-in state state/project-path)
+              project-branch-builds (branch-builds project branch)
+              chartable-builds (some->> project-branch-builds
+                                  (filter insights/build-chartable?))
+              bar-chart-builds (->> chartable-builds
+                                    (take (:max-bars build-time-bar-chart-plot-info))
+                                    (map insights/add-queued-time))]
+          (html
+            [:div.insights-metadata-header
+             [:div.card.insights-metadata
+              [:dl
+               [:dt "last build"]
+               [:dd (om/build common/updating-duration
+                              {:start (->> chartable-builds
+                                           (filter :start_time)
+                                           first
+                                           :start_time)}
+                              {:opts {:formatter datetime/as-time-since
+                                      :formatter-use-start? true}})]]]
+             [:div.card.insights-metadata
+              [:dl
+               [:dt "median build time"]
+               [:dd (-> (map :build_time_millis bar-chart-builds)
+                        (insights/median)
+                        (datetime/as-duration))" min"]]]
+             [:div.card.insights-metadata
+              [:dl
+               [:dt "median queue time"]
+               [:dd (-> (map :queued_time_millis bar-chart-builds)
+                        (insights/median)
+                        (datetime/as-duration))" min"]]]
+             [:div.card.insights-metadata
+              [:dl
+               [:dt "success rate"]
+               [:dd (insights/pass-percent chartable-builds)]]]
+             [:div.card.insights-metadata
+              [:dl
+               [:dt "current parallelism"]
+               [:dd parallel
+                (when (project-model/can-write-settings? project)
+                  [:a.btn.btn-xs.btn-default {:href (routes/v1-project-settings-path {:org (:username project)
+                                                                                :repo (:reponame project)
+                                                                                :_fragment "parallel-builds"})
+                                              :on-click #((om/get-shared owner :track-event) {:event-type :parallelism-clicked})}
+                   [:i.material-icons "tune"]])]]]]))))))
+
+(defn project-insights [state owner]
+  (reify
+    om/IRender
+    (render [_]
+      (component
+        (let [branch (-> state :navigation-data :branch)
+              project (get-in state state/project-path)
               timing-data (get-in project [:build-timing branch])
               project-branch-builds (branch-builds project branch)
               chartable-builds (some->> project-branch-builds
@@ -280,43 +332,7 @@
               junit-enabled? (get-in state state/failed-builds-junit-enabled?-path)]
          (html
           [:div.insights-project
-           [:div.insights-metadata-header
-            [:div.card.insights-metadata
-             [:dl
-              [:dt "last build"]
-              [:dd (om/build common/updating-duration
-                             {:start (->> chartable-builds
-                                          (filter :start_time)
-                                          first
-                                          :start_time)}
-                             {:opts {:formatter datetime/as-time-since
-                                     :formatter-use-start? true}})]]]
-            [:div.card.insights-metadata
-             [:dl
-              [:dt "median build time"]
-              [:dd (-> (map :build_time_millis bar-chart-builds)
-                       (insights/median)
-                       (datetime/as-duration))" min"]]]
-            [:div.card.insights-metadata
-             [:dl
-              [:dt "median queue time"]
-              [:dd (-> (map :queued_time_millis bar-chart-builds)
-                       (insights/median)
-                       (datetime/as-duration))" min"]]]
-            [:div.card.insights-metadata
-             [:dl
-              [:dt "success rate"]
-              [:dd (insights/pass-percent chartable-builds)]]]
-            [:div.card.insights-metadata
-             [:dl
-              [:dt "current parallelism"]
-              [:dd parallel
-               (when (project-model/can-write-settings? project)
-                [:a.btn.btn-xs.btn-default {:href (routes/v1-project-settings-path {:org (:username project)
-                                                                                :repo (:reponame project)
-                                                                                :_fragment "parallel-builds"})
-                                            :on-click #((om/get-shared owner :track-event) {:event-type :parallelism-clicked})}
-                 [:i.material-icons "tune"]])]]]]
+           (om/build insights-metadata state)
            (failed-tests-card failed-tests junit-enabled?)
            (slowest-tests-card failed-tests junit-enabled?)
            (build-status-card chartable-builds bar-chart-builds)


Add tooltip to override toggle

Add tooltip to override toggle

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -721,7 +721,8 @@
       {:show-slack-channel-override (-> project-data :project :slack_channel_override seq nil? not)})
     om/IDidMount
     (did-mount [_]
-      (utils/equalize-size (om/get-node owner) "chat-room-item"))
+      (utils/equalize-size (om/get-node owner) "chat-room-item")
+      (utils/tooltip "#slack-channel-override"))
     om/IDidUpdate
     (did-update [_ _ _]
       (utils/equalize-size (om/get-node owner) "chat-room-item"))
@@ -747,14 +748,15 @@
                                           " page, choose a default channel, and click the green \"Add CircleCI Integration\" button at the bottom of the page."]
                                          [:div
                                           [:label
-                                           {:for "slack-channel-override"}
-                                           [:input#slack-channel-override
+                                           [:input
                                             {:type "checkbox"
                                              :checked (:show-slack-channel-override state)
                                              :on-change #(do (om/update-state! owner :show-slack-channel-override not)
                                                              (utils/edit-input owner (conj state/project-path :slack_channel_override) %
                                                                                :value ""))}
-                                            [:span "Override room"]]]])
+                                            [:span "Override room"]
+                                            [:i.fa.fa-question-circle {:id "slack-channel-override"
+                                                                       :title "If you want to send notifications to a different channel than the webhook URL was created for, enter the channel ID or channel name below."}]]]])
                               :inputs [{:field :slack_webhook_url :placeholder "Webhook URL"}
                                        (when (:show-slack-channel-override state)
                                          {:field :slack_channel_override :placeholder "Room"})]


merging

merging

--- src/celestial/model.clj
+++ src/celestial/model.clj
@@ -26,8 +26,9 @@

 (defn get-env! [] {:pre [env]} env)

+
 (def hypervizors
-  #{:proxmox :aws :vcenter :vagrant :physical :docker :openstack :freenas :digital-ocean :gce})
+  #{:proxmox :aws :vcenter :vagrant :physical :docker :openstack :freenas :digital-ocean :gce })

 (def operations
  #{:reload :destroy :provision :stage :run-action :create :start :stop :clear :clone})


convert some uses of 'transform' to be 'translation,' as that's what's used in the data-spec

move generation of translation function to a more appropriate place (when we build local context)

--- src/vip/data_processor/validation/csv.clj
+++ src/vip/data_processor/validation/csv.clj
@@ -82,7 +82,7 @@
 (defn process-row-chunks
   "Processes all the map rows in a chunk via `process-row` with the
   supplied format-rules (see `data-spec/create-format-rules` in
-  `do-bulk-import-and-validate-csv`) and transforms (see
+  `do-bulk-import-and-validate-csv`) and translations (see
   `data-spec/translation-fns` in
   `do-bulk-import-and-validate-csv`). Inserts the row into the
   database, retries any UNIQUE id constraint-failing SQLExceptions
@@ -90,29 +90,25 @@
   `ctx`. If the supplied chunk is empty, simply returns the context
   as-is."
   [{:keys [columns filename] :as data-spec}
-   {:keys [transforms column-names headers sql-table line-number] :as file-ctx}
+   {:keys [row-translation-fn column-names headers sql-table line-number] :as file-ctx}
    ctx chunk]
   (if (seq chunk)
-    (let [ctx (reduce (partial process-row data-spec file-ctx) ctx chunk)
-          transform-row-fn (comp
-                            transforms
-                            #(select-keys % column-names)
-                            (partial zipmap headers))
+    (let [ctx' (reduce (partial process-row data-spec file-ctx) ctx chunk)
           chunk-values (->> chunk
-                            (map transform-row-fn)
-                            (maybe-coerce-to-db-type ctx sql-table columns))]
+                            (map row-translation-fn)
+                            (maybe-coerce-to-db-type ctx' sql-table columns))]
       (try
         (korma/insert sql-table (korma/values chunk-values))
-        ctx
+        ctx'
         (catch java.sql.SQLException e
           (let [message (.getMessage e)]
             (if (re-find #"UNIQUE constraint failed: (\w+).id" message)
-              (db.util/retry-chunk-without-dupe-ids ctx sql-table chunk-values)
-              (let [identifier (if (= "3.0" @(:spec-version ctx))
+              (db.util/retry-chunk-without-dupe-ids ctx' sql-table chunk-values)
+              (let [identifier (if (= "3.0" @(:spec-version ctx'))
                                  @line-number
                                  (csv-error-path filename @line-number))]
                 (errors/add-errors
-                 ctx :fatal (:name sql-table) identifier
+                 ctx' :fatal (:name sql-table) identifier
                  :unknown-sql-error message)))))))
     ctx))

@@ -171,8 +167,18 @@
             (map clojure.string/lower-case))
       (eduction columns)))

+(defn make-row-translation-fn
+  "Takes columns, column names, and headers, and composes a function
+  that takes a chunk of rows and applies each data-spec translation
+  function for a given row as provided by `data-spec/translation-fns`."
+  [columns column-names headers]
+  (comp
+   (apply comp (data-spec/translation-fns columns))
+   #(select-keys % column-names)
+   (partial zipmap headers)))
+
 (defn do-bulk-import-and-validate-csv
-  "Prepares all the necessary formatting and transformation functions
+  "Prepares all the necessary formatting and translation functions
   along with other useful meta-data and initiates the insertion and
   preliminary validation of CSV data using the chunking mechanism in
   vip.data-processor.db.util/chunk-rows. Returns the context `ctx`
@@ -197,9 +203,11 @@
             :column-names column-names
             :required-header-names (required-header-names columns)
             :line-number (atom 1)
-            :format-rules (data-spec/create-format-rules data-specs filename columns)
-            :transforms (apply comp (data-spec/translation-fns columns))}
-           (chunk-rows-and-process ctx data-spec)))))
+            :format-rules
+            (data-spec/create-format-rules data-specs filename columns)
+            :row-translation-fn
+            (make-row-translation-fn columns column-names headers)}
+            (chunk-rows-and-process ctx data-spec)))))

 (defn-traced bulk-import-and-validate-csv
   "Bulk importing and CSV validation is done in one go, so that it can


Basic public schema queries now work

Basic public schema queries now work

I am slowly working in the new structure for the schema based apps. this
means that each AppShare application will have one database schema

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -1452,11 +1452,14 @@
       ;(println (str "    " ))
       ;(println (str "    update-query-in-cache" ))
       ;(println (str "    " query))
+      ;(println (str "     existing-query: "  existing-query))

       (if (not existing-query)
         (swap! server-side-cached-queries assoc  query (atom {:clients  (atom #{})})))

+
+      ;(println (str "    server: " @(get @server-side-cached-queries   query)))

       (let [the-query        (get @server-side-cached-queries   query)
             clients-atom     (:clients @the-query)
@@ -1467,7 +1470,7 @@
         (swap! the-query assoc  :count         record-count)
         (swap! the-query assoc  :timestamp     query-time)

-        ;(println (str "    clients: " @clients-atom))
+        (println (str "    clients: " @clients-atom))
         (doall (for [client @clients-atom]
                  (do
                    ;(println (str "    Client: " client))
@@ -1475,9 +1478,11 @@
                          response-atom    (:update-request @the-client)
                          ]
                      (if (not response-atom) (swap! the-query assoc  :update-request (atom {})))
-                     (swap! (:update-request @the-client) assoc-in [:queries query] {:timestamp query-time})
-                     ;(println (str "    responses: " (if response-atom @response-atom)))
-
+                     (let [client-query    (assoc query :db-table (get-table-name  (:db-table query)))]
+                       (println (str "    query: " client-query))
+                       (swap! (:update-request @the-client) assoc-in [:queries client-query] {:timestamp query-time})
+                       ;(println (str "    responses: " (if response-atom @response-atom)))
+                       )
                      ;                   (swap! (:update-request @the-query) assoc  1 2)
                      ))))))))

@@ -1631,7 +1636,7 @@
     (let [queries (keys @server-side-cached-queries)]
       (doall (for [query queries]
                (do
-                 (if (= (get query :db-table)   db-table)
+                 (if (= (get-table-name (get query :db-table))   db-table)
                    (do
                      ;(println (str "    "))
                      ;(println (str "    " "Query"))


CMR-2201: Re-added side api calls to time-keeper

--- metadata-db-app/int_test/cmr/metadata_db/int_test/concepts/cleanup_test.clj
+++ metadata-db-app/int_test/cmr/metadata_db/int_test/concepts/cleanup_test.clj
@@ -15,8 +15,7 @@
 (use-fixtures :each (join-fixtures
                       [(util/reset-database-fixture {:provider-id "REG_PROV" :small false}
                                                     {:provider-id "SMAL_PROV1" :small true}
-                                                    {:provider-id "SMAL_PROV2" :small true})
-                       tk/freeze-resume-time-fixture]))
+                                                    {:provider-id "SMAL_PROV2" :small true})]))

 (defn concept-revision-exists?
   "Returns true if the revision of the concept exists"
@@ -48,6 +47,7 @@
   (= 200 (:status (util/get-concept-by-id (:concept-id concept)))))

 (deftest old-collection-revisions-are-cleaned-up
+  (side/eval-form `(tk/set-time-override! (tk/now)))
   (let [coll1 (util/create-and-save-collection "REG_PROV" 1 13)
         coll2 (util/create-and-save-collection "REG_PROV" 2 3)
         coll3 (util/create-and-save-collection "SMAL_PROV1" 1 12 {:native-id "foo"})
@@ -90,9 +90,11 @@
     ;; tag association associated to the whole collection is not deleted
     (util/is-tag-association-deleted? ta1 false)
     ;; tag association not associated to deleted collection revisions is not deleted
-    (util/is-tag-association-deleted? ta3 false)))
+    (util/is-tag-association-deleted? ta3 false))
+ (side/eval-form `(tk/clear-current-time!)))

 (deftest old-granule-revisions-are-cleaned-up
+  (side/eval-form `(tk/set-time-override! (tk/now)))
   (let [coll1 (util/create-and-save-collection "REG_PROV" 1 1)
         gran1 (util/create-and-save-granule "REG_PROV" coll1 1 3)
         gran2 (util/create-and-save-granule "REG_PROV" coll1 2 3)
@@ -113,9 +115,11 @@

     (is (every? #(revisions-removed? % (range 1 3)) granules))
     (is (every? #(concept-revision-exists? % 3) [gran1 gran2 gran3 gran4]))
-    (is (concept-revision-exists? gran5 12))))
+    (is (concept-revision-exists? gran5 12)))
+ (side/eval-form `(tk/clear-current-time!)))

 (deftest old-service-revisions-are-cleaned-up
+  (side/eval-form `(tk/set-time-override! (tk/now)))
   (let [serv1 (util/create-and-save-service "REG_PROV" 1 13)
         serv2 (util/create-and-save-service "REG_PROV" 2 3)
         serv3 (util/create-and-save-service "SMAL_PROV1" 1 12 {:native-id "foo"})
@@ -141,7 +145,8 @@
     (is (revisions-exist? serv3 (range 3 13)))

     (is (revisions-exist? serv4 (range 1 5)))
-    (is (revisions-exist? serv5 (range 1 4)))))
+    (is (revisions-exist? serv5 (range 1 4))))
+ (side/eval-form `(tk/clear-current-time!)))

 (deftest old-tombstones-are-cleaned-up
   (side/eval-form `(tk/set-time-override! (tk/now)))
@@ -246,6 +251,7 @@
   (side/eval-form `(tk/clear-current-time!)))

 (deftest old-tag-revisions-are-cleaned-up
+  (side/eval-form `(tk/set-time-override! (tk/now)))
   (let [tag1 (util/create-and-save-tag 1 13)
         tag2 (util/create-and-save-tag 2 3)
         tags [tag1 tag2]]
@@ -259,9 +265,11 @@
     (is (revisions-removed? tag1 (range 1 4)))
     (is (revisions-exist? tag1 (range 4 13)))

-    (is (all-revisions-exist? tag2))))
+    (is (all-revisions-exist? tag2)))
+ (side/eval-form `(tk/clear-current-time!)))

 (deftest old-tag-association-revisions-are-cleaned-up
+  (side/eval-form `(tk/set-time-override! (tk/now)))
   (let [coll1 (util/create-and-save-collection "REG_PROV" 1 1)
         tag1 (util/create-and-save-tag 1 1)
         tag2 (util/create-and-save-tag 2 1)
@@ -278,4 +286,5 @@
     (is (revisions-removed? ta1 (range 1 4)))
     (is (revisions-exist? ta1 (range 4 13)))

-    (is (all-revisions-exist? ta2))))
+    (is (all-revisions-exist? ta2)))
+ (side/eval-form `(tk/clear-current-time!)))


Prevent the parsing of empty streams

Prevent the parsing of empty streams

This bug was raised against ztellman/aleph here:
https://github.com/ztellman/aleph/pull/331

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -102,9 +102,10 @@
   "Resolve and apply Transit's JSON/MessagePack decoding."
   [in type & [opts]]
   {:pre [transit-enabled?]}
-  (let [reader (ns-resolve 'cognitect.transit 'reader)
-        read (ns-resolve 'cognitect.transit 'read)]
-    (read (reader in type (transit-read-opts opts)))))
+  (when (pos? (.available in))
+    (let [reader (ns-resolve 'cognitect.transit 'reader)
+          read (ns-resolve 'cognitect.transit 'read)]
+      (read (reader in type (transit-read-opts opts))))))

 (defn ^:dynamic transit-encode
   "Resolve and apply Transit's JSON/MessagePack encoding."


create a more random scenery

create a more random scenery

--- src/clj_turtle/core.clj
+++ src/clj_turtle/core.clj
@@ -67,24 +67,58 @@
             [:right (/ base-angle 2)]
             extra-arrows)))

+(defn- rand-range
+  [min max]
+  (+ min (rand-int (- max min))))

 (defn goto-random
   [min-distance max-distance]
-  (let [distance (+ min-distance (rand-int (- max-distance min-distance)))
+  (let [distance (rand-range min-distance max-distance)
         angle (rand-int 360)]
     [:pen :up
      :right angle
      :fwd distance
      :pen :down]))

+(defn rand-flake
+  [flake]
+  (let [len (rand-range 300 600)
+        star-len (+ (/ len 2) (rand-range 30 (/ len 3)))]
+   (flake len star-len (rand-range 20 45))))
+
+(defn combo1
+  []
+  (concat
+   [:right (rand-int 360)]
+   (rand-flake flake)
+   (goto-random 1000 2500)
+   (simple-flake (rand-range 100 200))
+   (goto-random 1200 2000)
+   (rand-flake complex-flake)
+   (goto-random 2200 3500)))
+
+(defn simple-flakes
+  []
+  (concat
+   (simple-flake (rand-range 50 150))
+   (goto-random 800 3000)))
+
+(defn combo2
+  []
+  (concat
+   (repeatedly 4 simple-flakes)
+   (combo1)
+   (simple-flakes)
+   (goto-random 2500 4000)))
+
 (defn scenery
   []
   (concat
-   [:color :blue :right (rand-int 360)]
-   (flake 500 280 30)
-   (goto-random 600 1500)
-   (simple-flake 150)))
+   [:color :blue]
+   (->> combo2
+        (repeatedly 13)
+        (apply concat))))

 (defn draw-svg [filename commands]
-  (spit filename (draw! ->svg commands [200 200])))
+  (spit filename (draw! ->svg commands [1200 800])))


ArrayChunk now uses array-reduce

ArrayChunk now uses array-reduce

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1834,9 +1834,9 @@

   IReduce
   (-reduce [coll f]
-    (ci-reduce coll f (aget arr off) (inc off)))
+    (array-reduce arr f (aget arr off) (inc off)))
   (-reduce [coll f start]
-    (ci-reduce coll f start off)))
+    (array-reduce arr f start off)))

 (defn array-chunk
   ([arr]


Story ID: RPC-321 added a spec for query parameter modification

--- spec/untangled/client/data_fetch_spec.cljs
+++ spec/untangled/client/data_fetch_spec.cljs
@@ -197,7 +197,7 @@
       (mark-loading-mutate) => :check-that-invoked

       (let [_ (df/load-field :mock-2 :comments :post-mutation 'mark-loading-test/callback) ; place ready markers in state
-            _ (df/load-field :mock-3 :comments)
+            _ (df/load-field :mock-3 :comments :params {:comments {:max-length 20}} )
             _ (df/load-field :mock-4 :comments)             ; TODO: we should be able to select :on-missing behavior
             {:keys [query on-load on-error]} (df/mark-loading reconciler) ; transition to loading
             loading-state @state
@@ -206,7 +206,7 @@
             good-response {[:items/id 3] {:comments comments-3}
                            [:items/id 2] {:comments comments-2}}
             item-4-expr {[:items/id 4] [{:comments comment-query}]}
-            item-3-expr {[:items/id 3] [{:comments comment-query}]}
+            item-3-expr `{[:items/id 3] [({:comments ~comment-query} {:max-length 20})]}
             item-2-expr {[:items/id 2] [{:comments comment-query}]}
             normalized-response {[:items/id 3]   {:comments [[:comments/id 8] [:comments/id 9]]},
                                  [:items/id 2]   {:comments [[:comments/id 5] [:comments/id 6]]},
@@ -227,7 +227,7 @@
             (is (:app/loading-data @state))))

         (component "generated query"
-          (behavior "composes together all of the item queries"
+          (behavior "composes together all of the item queries, with desired parameters"
             (is (= [item-4-expr item-3-expr item-2-expr] query)))

           (behavior "has metadata for proper normalization of a response"


don't return array over string

don't return array over string

--- src-cljs/frontend/components/hud.cljs
+++ src-cljs/frontend/components/hud.cljs
@@ -33,8 +33,8 @@
             :role "button"
             :class (when (overlay-visible? app)
                      (if (< 1 (overlay-count app))
-                       ["back"]
-                       ["close"]))
+                       "back"
+                       "close"))
             :data-right (when-not main-menu-learned?
                           (if (overlay-visible? app) "Close Menu" "Open Menu"))
             :title (when main-menu-learned?


style fix

style fix

--- src-cljs/frontend/components/hud.cljs
+++ src-cljs/frontend/components/hud.cljs
@@ -136,7 +136,8 @@
               viewers-count (count (remove (comp :hide-in-list? last) (:subscribers app)))
               can-edit? (not (empty? (:cust app)))
               viewers-truncated? (< 4 viewers-count)
-              show-viewers? (when-not (overlay-visible? app) (or (:show-viewers? app (< 1 viewers-count 5))))]
+              show-viewers? (and (not (overlay-visible? app))
+                                 (get app :show-viewers? (< 1 viewers-count 5)))]
           (html
             [:div.viewers.hud-item
              {:class (when viewers-truncated? ["truncated"])}


Add indicator when there are older effects.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -428,8 +428,8 @@
   [controller]
   (with-show (:show controller)
     (case (:type (show/sync-status))
-      :manual "Manual"
-      :midi "MIDI"
+      :manual " Manual"
+      :midi "  MIDI"
       :dj-link "DJ Link"
       "Unknown")))

@@ -549,7 +549,7 @@

                    ;; Add the labels for reset and sync, and light the pads
                    (write-display-cell controller 3 0
-                                       (str "Reset    " (metronome-sync-label controller)))
+                                       (str " Reset   " (metronome-sync-label controller)))
                    (aset (:next-top-pads controller) 0 (top-pad-state :dim :red))
                    (aset (:next-top-pads controller) 1 (top-pad-state :dim :green)))
                  (handle-control-change [this controller message]
@@ -752,26 +752,29 @@
   effects (or three, if the metronome is taking up a slot)."
   [controller]
   (let [room (room-for-effects controller)
+        first-cell (- 4 room)
         fx-info @(:active-effects (:show controller))
         fx (:effects fx-info)
-        fx-meta (:meta fx-info)]
+        fx-meta (:meta fx-info)
+        num-skipped (- (count fx-meta) room)]
     (if (seq fx)
-      (loop [fx (drop (- (count fx) room) fx)
-             fx-meta (drop (- (count fx-meta) room) fx-meta)
-             x (- 4 room)]
-        (let [effect (:effect (first fx))
-              info (first fx-meta)
-              cue (:cue info)]
-          (write-display-cell controller 0 x (cue-variable-names cue))
-          (write-display-cell controller 1 x (cue-variable-values controller cue))
-          (write-display-cell controller 2 x (or (:name cue) (:name (first fx))))
-          (write-display-cell controller 3 x "End")
-          (aset (:next-top-pads controller) (* 2 x) (top-pad-state :dim :red))
-          (when (seq (rest fx))
-            (recur (rest fx) (rest fx-meta) (inc x)))))
-      (do
-        (write-display-cell controller 2 1 "       No effects")
-        (write-display-cell controller 2 2 "are active.")))))
+      (do (loop [fx (drop num-skipped fx)
+                 fx-meta (drop num-skipped fx-meta)
+                 x first-cell]
+            (let [effect (:effect (first fx))
+                  info (first fx-meta)
+                  cue (:cue info)]
+              (write-display-cell controller 0 x (cue-variable-names cue))
+              (write-display-cell controller 1 x (cue-variable-values controller cue))
+              (write-display-cell controller 2 x (or (:name cue) (:name (first fx))))
+              (write-display-cell controller 3 x "  End")
+              (aset (:next-top-pads controller) (* 2 x) (top-pad-state :dim :red))
+              (when (seq (rest fx))
+                (recur (rest fx) (rest fx-meta) (inc x)))))
+          (when (pos? num-skipped)
+            (aset (get (:next-display controller) 3) (* first-cell 17) (util/ubyte (:left-arrow special-symbols)))))
+      (do (write-display-cell controller 2 1 "       No effects")
+          (write-display-cell controller 2 2 "are active.")))))

 (declare enter-stop-mode)


vector access and method parameters

vector access and method parameters

--- src/be/ac/ua/aspchecker/transformation.clj
+++ src/be/ac/ua/aspchecker/transformation.clj
@@ -56,12 +56,6 @@
     (= op "!")))

-(defn parentheses-char? [op]
-  (or
-    (= op ")")
-    (= op "(")))
-
-
 (defn terminal? [exp]
   (= (.getChildCount exp) 0))

@@ -69,8 +63,8 @@
 (defn parentheses-expression? [exp]
   (and
     (= (.getChildCount exp) 3)
-    (parentheses-char? (.getText (.getChild exp 0)))
-    (parentheses-char? (.getText (.getChild exp 2)))))
+    (= "(" (.getText (.getChild exp 0)))
+    (= ")" (.getText (.getChild exp 2)))))

 (defn logical-expression? [exp]
@@ -101,10 +95,15 @@

 (defn method-call? [exp]
+  (or
   (and
     (= (.getChildCount exp) 3)
     (= "(" (.getText (.getChild exp 1)))
-    (= ")" (.getText (.getChild exp 2)))))
+    (= ")" (.getText (.getChild exp 2))))
+  (and
+    (= (.getChildCount exp) 4)
+    (= "(" (.getText (.getChild exp 1)))
+    (= ")" (.getText (.getChild exp 3))))))

 (defn member-access? [exp]
@@ -112,6 +111,13 @@
     (= (.getChildCount exp) 3)
     (not (number? (read-string (.getText (.getChild exp 0)))))
     (= "." (.getText (.getChild exp 1)))))
+
+
+(defn vector-access? [exp]
+  (and
+    (= (.getChildCount exp) 4)
+    (= "[" (.getText (.getChild exp 1)))
+    (= "]" (.getText (.getChild exp 3)))

 ;Contract parsing
@@ -185,16 +191,26 @@

 (defn visit-method-call [rule]
   (str
-    "method_call_"
-    (visit-rule (.getChild rule 0))))
+  "__method_call__"
+  (visit-rule (.getChild rule 0))
+  (when
+    (= (.getChildCount rule) 4)
+    (hash (.getText (.getChild rule 2))))))

 (defn visit-member-access [rule]
   (str
     (visit-rule (.getChild rule 0))
-    "_messages_"
+    "__messages__"
     (visit-rule (.getChild rule 2))))

+
+(defn visit-vector-access [rule]
+  (str
+    "__vector_access__"
+    (visit-rule (.getChild rule 0))
+    (hash (.getText (.getChild rule 2)))))
+

 (defn visit-children [rule]
   (loop [result "" i 0 max (.getChildCount rule)]
@@ -219,6 +235,7 @@
     (ternary? rule) (visit-ternary rule)
     (method-call? rule) (visit-method-call rule)
     (member-access? rule) (visit-member-access rule)
+    (vector-access? rule) (visit-vector-access rule)
     (terminal? rule) (.getText rule)
     ;Recursively visit children
     :else (visit-children rule)))


Make close & unread buttons have button role

Makes them accessibly, presumably for screenreaders, but also so I can
use link-hinting to click on them

--- src/braid/core/client/ui/views/thread.cljs
+++ src/braid/core/client/ui/views/thread.cljs
@@ -215,6 +215,8 @@
           (if @(subscribe [:thread-open? (thread :id)])
             [:div.control.close
              {:title "Close"
+              :tabindex 0
+              :role "button"
               :on-click (fn [e]
                           ; Need to preventDefault & propagation when using
                           ; divs as controls, otherwise divs higher up also
@@ -224,6 +226,8 @@
              \uf00d]
             [:div.control.unread
              {:title "Mark Unread"
+              :tabindex 0
+              :role "button"
               :on-click (fn [e]
                           ; Need to preventDefault & propagation when using
                           ; divs as controls, otherwise divs higher up also


whitespace

whitespace

--- src/cljs/infinitelives/pixi/resources.cljs
+++ src/cljs/infinitelives/pixi/resources.cljs
@@ -159,7 +159,6 @@
 (defmethod resources/register! "gif" [url texture-hash] (register! url texture-hash))
 (defmethod resources/register! "jpg" [url texture-hash] (register! url texture-hash))

-
 (defn load [url]
   (let [c (chan)
         img (js/Image.)]


Compose multiple checks in a single `testing` form

--- test/io/perun_test.clj
+++ test/io/perun_test.clj
@@ -472,18 +472,19 @@
                       :comparator #(compare %1 %2)
                       :meta {:assorted "yep"})
         (testing "assortment"
-          (content-check :path "foo/true-tag1.html"
-                         :content "assortment 1")
-          (content-check :path "foo/true-tag2.html"
-                         :content "assortment 1")
-          (content-check :path "foo/false-tag1.html"
-                         :content "assortment 2")
-          (value-check :path "foo/true-tag1.html"
-                       :value-fn #(meta= %1 %2 :assorted "yep"))
-          (value-check :path "foo/true-tag2.html"
-                       :value-fn #(meta= %1 %2 :assorted "yep"))
-          (value-check :path "foo/false-tag1.html"
-                       :value-fn #(meta= %1 %2 :assorted "yep")))
+          (comp
+           (content-check :path "foo/true-tag1.html"
+                          :content "assortment 1")
+           (content-check :path "foo/true-tag2.html"
+                          :content "assortment 1")
+           (content-check :path "foo/false-tag1.html"
+                          :content "assortment 2")
+           (value-check :path "foo/true-tag1.html"
+                        :value-fn #(meta= %1 %2 :assorted "yep"))
+           (value-check :path "foo/true-tag2.html"
+                        :value-fn #(meta= %1 %2 :assorted "yep"))
+           (value-check :path "foo/false-tag1.html"
+                        :value-fn #(meta= %1 %2 :assorted "yep"))))

         (p/collection :renderer 'io.perun-test/render-collection
                       :out-dir "bar"
@@ -494,10 +495,11 @@
                       :page "its-a-collection.html"
                       :meta {:collected "uh huh"})
         (testing "collection"
-          (content-check :path "bar/its-a-collection.html"
-                         :content "collection 2")
-          (value-check :path "bar/its-a-collection.html"
-                       :value-fn #(meta= %1 %2 :collected "uh huh")))
+          (comp
+           (content-check :path "bar/its-a-collection.html"
+                          :content "collection 2")
+           (value-check :path "bar/its-a-collection.html"
+                        :value-fn #(meta= %1 %2 :collected "uh huh"))))

         (p/paginate :renderer 'io.perun-test/render-paginate
                     :out-dir "baz"
@@ -509,24 +511,25 @@
                     :comparator #(compare %1 %2)
                     :meta {:paginated "mmhmm"})
         (testing "paginate"
-          (content-check :path "baz/decomplect-1.html"
-                         :content "paginate 2"
-                         :msg "`paginate` should write new files")
-          (content-check :path "baz/decomplect-2.html"
-                         :content "paginate 2"
-                         :msg "`paginate` should write new files")
-          (content-check :path "baz/decomplect-3.html"
-                         :content "paginate 1"
-                         :msg "`paginate` should write new files")
-          (value-check :path "baz/decomplect-1.html"
-                       :value-fn #(meta= %1 %2 :paginated "mmhmm")
-                       :msg "`paginate` should set metadata")
-          (value-check :path "baz/decomplect-2.html"
-                       :value-fn #(meta= %1 %2 :paginated "mmhmm")
-                       :msg "`paginate` should set metadata")
-          (value-check :path "baz/decomplect-3.html"
-                       :value-fn #(meta= %1 %2 :paginated "mmhmm")
-                       :msg "`paginate` should set metadata"))
+          (comp
+           (content-check :path "baz/decomplect-1.html"
+                          :content "paginate 2"
+                          :msg "`paginate` should write new files")
+           (content-check :path "baz/decomplect-2.html"
+                          :content "paginate 2"
+                          :msg "`paginate` should write new files")
+           (content-check :path "baz/decomplect-3.html"
+                          :content "paginate 1"
+                          :msg "`paginate` should write new files")
+           (value-check :path "baz/decomplect-1.html"
+                        :value-fn #(meta= %1 %2 :paginated "mmhmm")
+                        :msg "`paginate` should set metadata")
+           (value-check :path "baz/decomplect-2.html"
+                        :value-fn #(meta= %1 %2 :paginated "mmhmm")
+                        :msg "`paginate` should set metadata")
+           (value-check :path "baz/decomplect-3.html"
+                        :value-fn #(meta= %1 %2 :paginated "mmhmm")
+                        :msg "`paginate` should set metadata")))

         (p/render :renderer 'io.perun-test/render
                   :filterer :markdown-set


internet gateway has no required properties

--- src/crucible/aws/ec2.clj
+++ src/crucible/aws/ec2.clj
@@ -47,7 +47,7 @@

 (s/def ::internet-gateway (s/keys :opt [::r/tags]))

-(s/def ::internet-gateway map?)
+(s/def ::internet-gateway (s/nilable map?))

 (def internet-gateway (r/resource-factory (ec2 "InternetGateway") ::internet-gateway))


Fix no-op test

Fix no-op test

Nesting prop/for-all doesn't work...yet!

--- test/str/core_test.clj
+++ test/str/core_test.clj
@@ -14,8 +14,13 @@
          (count s)))))

 (defspec chomping-string-not-ending-in-seperator-does-not-alter-length 100
-  (prop/for-all [sep gen/string]
-    (prop/for-all [s (gen/such-that #(not (.endsWith % sep)) gen/string)]
+  (prop/for-all [vals (gen/bind (gen/not-empty gen/string)
+                                (fn [sep]
+                                  (gen/tuple (gen/return sep)
+                                             (gen/such-that #(not (.endsWith % sep))
+                                                            gen/string))))]
+    (let [sep (first vals)
+          s (second vals)]
       (= (count (str/chomp s sep)) (count s)))))

 (defspec chomp-removes-newline 100


Make the tests pass

Make the tests pass

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -34,6 +34,11 @@
        (eval (generate-logic-query n-answers logic-query events))
        (finally
          (in-ns (ns-name old-ns)))))))
+
+(defn free-sym
+  "Returns symbol, but marked as a free variable."
+  [sym]
+  (vary-meta sym assoc ::free true))

 (def ^:private free-sym?
   "Check if an object has the free variable metadata annotation."


Remove more unused utils

Remove more unused utils

--- src/desdemona/utils.clj
+++ src/desdemona/utils.clj
@@ -3,12 +3,6 @@
             [clojure.java.io :refer [resource]]))

 ;;;; Test utils ;;;;
-
-(def zk-address "127.0.0.1")
-
-(def zk-port 2188)
-
-(def zk-str (str zk-address ":" zk-port))

 (defn find-task
   "Finds the catalog entry where the :onyx/name key equals task-name"
@@ -18,43 +12,3 @@
       (throw (ex-info (format "Couldn't find task %s in catalog" task-name)
                       {:catalog catalog :task-name task-name})))
     (first matches)))
-
-(defn n-peers
-  "Takes a workflow and catalog, returns the minimum number of peers
-   needed to execute this job."
-  [catalog workflow]
-  (let [task-set (set (apply concat workflow))]
-    (reduce
-     (fn [sum t]
-       (+ sum (or (:onyx/min-peers (find-task catalog t)) 1)))
-     0 task-set)))
-
-;;;; Lifecycles utils ;;;;
-
-(def input-channel-capacity 10000)
-
-(def output-channel-capacity (inc input-channel-capacity))
-
-(def get-input-channel
-  (memoize
-   (fn [id] (chan input-channel-capacity))))
-
-(def get-output-channel
-  (memoize
-   (fn [id] (chan (sliding-buffer output-channel-capacity)))))
-
-(defn inject-in-ch [event lifecycle]
-  {:core.async/chan (get-input-channel (:core.async/id lifecycle))})
-
-(defn inject-out-ch [event lifecycle]
-  {:core.async/chan (get-output-channel (:core.async/id lifecycle))})
-
-(def in-calls
-  {:lifecycle/before-task-start inject-in-ch})
-
-(def out-calls
-  {:lifecycle/before-task-start inject-out-ch})
-
-;;; Stubs lifecycles to use core.async IO, instead of, say, Kafka or Datomic.
-
-


Function to get MIME type and export product data

--- src/hurvinek/server.clj
+++ src/hurvinek/server.clj
@@ -253,12 +253,36 @@
     [products]
     (json/write-str products))

+(defn data->edn
+    [products]
+    (with-out-str
+        (clojure.pprint/pprint products)))
+
+(defn data->csv
+    [products]
+    (with-out-str
+        (csv/write-csv *out* products)))
+
+(defn product-output-data
+    [output-format product-list]
+    (condp = output-format
+        "json" (data->json product-list)
+               (data->json product-list))) ; default value
+
+(defn mime-type
+    [output-format]
+    (condp = output-format
+        "json" "application/json"
+               "application/json")) ; default value
+
 (defn process-list-of-products
     [request]
     (let [product-list (db-interface/read-products)
-          json-output  (data->json product-list)]
-        (-> (http-response/response json-output)
-            (http-response/content-type "application/json"))))
+          output-format (get request "format")
+          output-data   (product-output-data output-format product-list)
+          mime-type     (mime-type output-format)]
+        (-> (http-response/response output-data)
+            (http-response/content-type mime-type))))

 (defn process-list-of-chapters
     [request]


PLD: fix line width

PLD: fix line width

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -191,7 +191,9 @@
                              :else [:a {:href image :target "_blank"}
                                     (if (image? field)
                                       [:img {:width "80px" :src thumb}]
-                                      [:span [:i.fa.fa-file-video-o] "  " fname])]))
+                                      [:span
+                                       [:i.fa.fa-file-video-o]
+                                       " " fname])]))
      (osm? field) (when answer
                     (let [kw->name name ; aliasing before overriding name
                           {:keys [name type osm-id]} answer


Change boot.core/boot to be a function instead of a macro (fixes #199)

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -690,19 +690,19 @@
     (let [fs (commit! (reset-fileset))]
       ((task-stack #(do (sync-target fs %) (sync-user-dirs!) %)) fs))))

-(defmacro boot
+(defn boot
   "The REPL equivalent to the command line 'boot'. If all arguments are
   strings then they are treated as if they were given on the command line.
   Otherwise they are assumed to evaluate to task middleware."
   [& argv]
-  (let [->app (fn [xs] `(apply comp (filter fn? [~@xs])))]
-    `(try @(future
-             (util/with-let [_# nil]
-               (#'run-tasks
-                 ~(if (every? string? argv)
-                    `(apply #'construct-tasks [~@argv])
-                    (->app argv)))))
-          (finally (#'do-cleanup!)))))
+  (try @(future ;; see issue #6
+          (util/with-let [_ nil]
+            (run-tasks
+              (cond (every? fn? argv)     (apply comp argv)
+                    (every? string? argv) (apply construct-tasks argv)
+                    :else (throw (IllegalArgumentException.
+                                   "Arguments must be either all strings or all fns"))))))
+       (finally (do-cleanup!))))

 ;; Low-Level Tasks, Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


DRY up items-by-account queries, other misc refinements

--- test/clj_money/models/transactions_test.clj
+++ test/clj_money/models/transactions_test.clj
@@ -20,6 +20,14 @@

 (use-fixtures :each (partial reset-db storage-spec))

+(defn items-by-account
+  [account-id]
+  (transactions/items-by-account
+    storage-spec
+    account-id
+    [(t/local-date 2015 1 1)
+     (t/local-date 2017 12 31)]))
+
 (def create-context
   {:users [(factory :user, {:email "john@doe.com"})]
    :entities [{:name "Personal"}]
@@ -84,20 +92,25 @@
                           (catch RuntimeException e
                             nil))]
         (testing "records are not created"
-          (is (= 0 (count (transactions/search storage-spec {:entity-id (-> context :entities first :id)})))
+          (is (= 0 (count (transactions/search
+                            storage-spec
+                            {:entity-id (-> context :entities first :id)
+                             :transaction-date [:between
+                                                (t/local-date 2016 1 1)
+                                                (t/local-date 2016 12 31)]})))
               "The transaction should not be saved")
-          (is (= 0 (count (transactions/items-by-account storage-spec (:id checking))))
+          (is (= 0 (count (items-by-account (:id checking))))
               "The transaction item for checking should not be created")
-          (is (= 0 (count (transactions/items-by-account storage-spec (:id salary))))
+          (is (= 0 (count (items-by-account (:id salary))))
               "The transaction item for salary should not be created"))
         (testing "account balances are not updated"
           (is (= 0M (->> checking
-                                 (accounts/reload storage-spec)
-                                 :balance))
+                         (accounts/reload storage-spec)
+                         :balance))
               "The checking balance should not be updated")
           (is (= 0M (->> salary
-                                 (accounts/reload storage-spec)
-                                 :balance))
+                         (accounts/reload storage-spec)
+                         :balance))
               "The salary balance should not be updated"))))))

 (deftest create-a-transaction-us-string-date
@@ -235,11 +248,7 @@
   (let [context (serialization/realize storage-spec balance-context)
         [checking-items
          salary-items
-         groceries-items] (map #(transactions/items-by-account
-                                  storage-spec
-                                  (:id %)
-                                  [(t/local-date 2016 1 1)
-                                   (t/local-date 2016 12 31)])
+         groceries-items] (map #(items-by-account (:id %))
                                (:accounts context))]
            ; Transactions are returned with most recent first
     (is (= [900M 1000M]
@@ -254,10 +263,7 @@
   (let [context (serialization/realize storage-spec balance-context)
         [checking-items
          salary-items
-         groceries-items] (map #(transactions/items-by-account
-                                  storage-spec
-                                  (:id %)
-                                  [(t/local-date 2016 1 1) (t/local-date 2016 12 31)])
+         groceries-items] (map #(items-by-account (:id %))
                                (:accounts context))]
     (is (= [1 0] (map :index checking-items)) "The checking transaction items have correct indexes")
     (is (= [0] (map :index salary-items)) "The salary transaction items have the correct indexes")
@@ -327,9 +333,7 @@
   (let [context (serialization/realize storage-spec insert-context)
         [checking-items
          salary-items
-         groceries-items] (map #(transactions/items-by-account storage-spec
-                                                               (:id %)
-                                                               [(t/local-date 2016 1 1) (t/local-date 2016 12 31)])
+         groceries-items] (map #(items-by-account (:id %))
                                (:accounts context))]
     (is (= [{:index 2
              :amount 100M
@@ -398,10 +402,7 @@
   (let [context (serialization/realize storage-spec multi-context)
         [checking-items
          salary-items
-         groceries-items] (map #(transactions/items-by-account
-                                  storage-spec
-                                  (:id %)
-                                  [(t/local-date 2016 1 1) (t/local-date 2016 12 31)])
+         groceries-items] (map #(items-by-account (:id %))
                                (:accounts context))
         expected-checking-items [{:index 2 :amount  100M :balance 1000M}
                                  {:index 1 :amount  100M :balance 1100M}
@@ -464,17 +465,12 @@
         [checking
          salary
          groceries] (:accounts context)
-        items-fn (fn []
-                   (transactions/items-by-account
-                                storage-spec
-                                (:id checking)
-                                [(t/local-date 2016 1 1) (t/local-date 2016 12 31)]))
-        checking-items-before (items-fn)
+        checking-items-before (items-by-account (:id checking))
         trans (-> context
                   :transactions
                   second)
         _ (transactions/delete storage-spec (:id trans) (:transaction-date trans))
-        checking-items-after (items-fn)]
+        checking-items-after (items-by-account (:id checking))]
     (testing "transaction item balances are adjusted"
       (let [expected-before [{:index 2 :amount 102M :balance 797M}
                              {:index 1 :amount 101M :balance 899M}
@@ -564,13 +560,11 @@
         expected-checking [{:index 2 :amount 102M   :balance 798.01M}
                            {:index 1 :amount 99.99M :balance 900.01M}
                            {:index 0 :amount 1000M  :balance 1000M}]
-        actual-checking (->> (:id checking)
-                             (transactions/items-by-account storage-spec)
+        actual-checking (->> (items-by-account (:id checking))
                              (map #(select-keys % [:index :amount :balance])))
         expected-groceries [{:index 1 :amount 102M   :balance 201.99M}
                             {:index 0 :amount 99.99M :balance 99.99M}]
-        actual-groceries (->> (:id groceries)
-                              (transactions/items-by-account storage-spec)
+        actual-groceries (->> (items-by-account (:id groceries))
                               (map #(select-keys % [:index :amount :balance])))]
     (testing "transaction item balances are correct"
       (is (= expected-checking actual-checking)
@@ -634,12 +628,12 @@
                            {:index 1 :amount 102M :balance 898M}
                            {:index 0 :amount 1000M :balance 1000M}]
         actual-checking (->> (:id checking)
-                             (transactions/items-by-account storage-spec)
+                             items-by-account
                              (map #(select-keys % [:index :amount :balance])))
         expected-groceries [{:index 1 :amount 101M :balance 203M}
                             {:index 0 :amount 102M :balance 102M}]
         actual-groceries (->> (:id groceries)
-                              (transactions/items-by-account storage-spec)
+                              items-by-account
                               (map #(select-keys % [:index :amount :balance])))]
     (testing "transaction item balances are correct"
       (is (= expected-checking actual-checking)
@@ -753,7 +747,9 @@
         [t1 t2 t3 t4] (:transactions context)
         updated (assoc t3 :transaction-date (t/local-date 2016 3 8))
         update-calls (atom {})]
-    (with-redefs [transactions/update-item-index-and-balance (partial fake-update-item-index-and-balance context update-calls)]
+    (with-redefs [transactions/update-item-index-and-balance (partial fake-update-item-index-and-balance
+                                                                      context
+                                                                      update-calls)]
       (transactions/update storage-spec updated)
       (let [expected #{{:index 2
                        :amount 101M
@@ -764,6 +760,10 @@
                                                ; the 4th item should never be updated because the 4rd one did not change a value
             actual (get @update-calls (:id checking))]
         (testing "the expected transactions are updated"
+          (when-not (= expected actual)
+            (pprint {:expected expected
+                     :actual actual
+                     :diff (diff expected actual)}))
           (is (= expected actual)
               "Only items with changes are updated")
           (is (not-any? #(= (:index %) 4) actual) "The last item is never updated"))
@@ -833,8 +833,8 @@
          groceries] (:accounts context)
         [t1 t2 t3 t4] (:transactions context)
         _ (transactions/update storage-spec (assoc-in t3 [:items 0 :account-id] (:id rent)))
-        groceries-items (transactions/items-by-account storage-spec (:id groceries))
-        rent-items (transactions/items-by-account storage-spec (:id rent))
+        groceries-items (items-by-account (:id groceries))
+        rent-items (items-by-account (:id rent))
         expected-groceries [{:index 1
                              :amount 103M
                              :balance 204M}
@@ -930,7 +930,7 @@
                          :amount 103M
                          :balance 103M}]
         actual-items (map #(select-keys % [:index :amount :balance])
-                          (transactions/items-by-account storage-spec (:id groceries)))]
+                          (items-by-account (:id groceries)))]
     (testing "items are updated correctly"
       (is (= expected-items actual-items)
           "Groceries should have the correct items after update"))
@@ -1025,7 +1025,7 @@
                          :amount 103M
                          :balance 103M}]
         actual-items (map #(select-keys % [:index :amount :balance])
-                          (transactions/items-by-account storage-spec (:id groceries)))]
+                          (items-by-account (:id groceries)))]
     (testing "item values are correct"
       (is (= expected-items actual-items)
           "The Pets account should have the correct items"))
@@ -1062,8 +1062,12 @@
                          :amount 13M
                          :balance 13M}]
         actual-items (map #(select-keys % [:index :amount :balance])
-                          (transactions/items-by-account storage-spec (:id pets)))]
+                          (items-by-account (:id pets)))]
     (testing "item values are correct"
+      (when-not (= expected-items actual-items)
+        (pprint {:expected expected-items
+                 :actual actual-items
+                 :diff (diff expected-items actual-items)}))
       (is (= expected-items actual-items)
           "The Pets account should have the correct items"))
     (testing "account balances are correct"


Replace use of deprecated lambdacd.step.support namespace with the current alternative

--- test/lambdacd_artifacts/sample_pipeline.clj
+++ test/lambdacd_artifacts/sample_pipeline.clj
@@ -8,7 +8,7 @@
             [lambdacd-artifacts.test-utils :as test-utils]
             [lambdacd.ui.ui-server :as ui]
             [lambdacd.steps.git :as git]
-            [lambdacd.steps.support :as step-support :refer [injected-ctx injected-args]]
+            [lambdacd.stepsupport.chaining :as step-support :refer [injected-ctx injected-args]]
             [lambdacd.runners :as runners]
             [lambdacd-artifacts.core :as artifacts]
             [ring.util.response :as resp]))


Tests for ../ in artifact, version, and file

--- test/clojars/test/integration/uploads.clj
+++ test/clojars/test/integration/uploads.clj
@@ -153,4 +153,33 @@
                                                  "UTF-8"))
                                      "UTF-8"))}
              :body "Bad jar")
+      (has (status? 400))
+      (visit "/repo/group/..%2F..%2Fasdf/1.0.0/test.jar" :request-method :put
+             :headers {"authorization"
+                       (str "Basic "
+                            (String. (base64/encode
+                                      (.getBytes "dantheman:password"
+                                                 "UTF-8"))
+                                     "UTF-8"))}
+             :body "Bad jar")
+      (has (status? 400))
+      (visit "/repo/group/artifact/..%2F..%2F..%2F1.0.0/test.jar"
+             :request-method :put
+             :headers {"authorization"
+                       (str "Basic "
+                            (String. (base64/encode
+                                      (.getBytes "dantheman:password"
+                                                 "UTF-8"))
+                                     "UTF-8"))}
+             :body "Bad jar")
+      (has (status? 400))
+      (visit "/repo/group/artifact/1.0.0/..%2F..%2F..%2F..%2F/test.jar"
+             :request-method :put
+             :headers {"authorization"
+                       (str "Basic "
+                            (String. (base64/encode
+                                      (.getBytes "dantheman:password"
+                                                 "UTF-8"))
+                                     "UTF-8"))}
+             :body "Bad jar")
       (has (status? 400))))


+ limit

+ limit

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -23,7 +23,7 @@
 (defn sqlquery [name]

 ;(first (jdbc/query mysql-db [(str "select * from konten where Name='" name "'")])))
-(jdbc/execute! mysql-db ["UPDATE konten SET Kontostand = Kontostand - 1 WHERE Name = ?" name]))
+(jdbc/execute! mysql-db ["UPDATE konten SET Kontostand = Kontostand - 1 WHERE Kontostand > 95 AND Name = ?" name]))
 ;(jdbc/update! mysql-db :konten {:Kontostand 99} ["Name = ?" name]))
 ; maybe this sets the guthaben to 99


[#2925] Integrate generated sql view in data-group aggregation bar

--- backend/src/akvo/lumen/lib/aggregation/bar.clj
+++ backend/src/akvo/lumen/lib/aggregation/bar.clj
@@ -3,6 +3,7 @@
             [akvo.lumen.lib.aggregation.commons :refer (run-query sql-option-bucket-column) :as commons]
             [akvo.lumen.lib.dataset.utils :refer (find-column)]
             [akvo.lumen.postgres.filter :refer (sql-str)]
+            [akvo.lumen.util :as util]
             [clojure.java.jdbc :as jdbc]
             [clojure.string :as str]
             [clojure.pprint :refer (pprint)]
@@ -179,53 +180,16 @@
            (if subbucket-column
              (subbucket-column-response sql-response bucket-column)
              (bucket-column-response sql-response bucket-column metric-y-column))))))
-    (lib/ok (bucket-column-response nil nil nil)))
-  )
+    (lib/ok (bucket-column-response nil nil nil))))

 (defn query-with-data-groups
-  [tenant-conn data-groups query]
-  (let [columns (reduce #(into % (:columns %2)) [] data-groups)]
-    (if-let [bucket-column (find-column columns (:bucketColumn query))]
-      (let [subbucket-column (find-column columns (:subBucketColumn query))
-            metric-y-column  (or (find-column columns (:metricColumnY query)) subbucket-column)
-            metric-aggregation (:metricAggregation query)
-            aggregation      (aggregation* metric-aggregation metric-y-column bucket-column)
-            metric-columns-y (when (not (empty? (:metricColumnsY query)))
-                               (let [metric-columns-y (map #(find-column columns %) (:metricColumnsY query) )]
-                                 (conj metric-columns-y metric-y-column)))
-            ;; temp-view
-            sql*  (if subbucket-column
-                    (subbucket-sql (map :table-name data-groups) bucket-column subbucket-column aggregation
-                                   (sql-str columns (:filters query))
-                                   (sort* (:sort query) "sort_value") (or (:truncateSize query) "ALL"))
-                    (bucket-sql (map :table-name data-groups)
-                                bucket-column
-                                (if metric-columns-y
-                                  (->> metric-columns-y
-                                       (map #(aggregation* metric-aggregation %  bucket-column))
-                                       (map-indexed
-                                        (fn [index x]
-                                          (if (= index 0) (str x " as y") x)) )
-                                       (str/join ", " ))
-                                  (str aggregation " as y"))
-                                (sql-str columns (:filters query))
-                                (sort* (:sort query) "z.y")
-                                (or (:truncateSize query) "ALL")))
-            _ (log/debug :sql* sql*)
-            sql-response     (run-query tenant-conn sql*)
-            _ (log/debug :sql-response* sql-response)
-            max-elements     200]
-        (if (> (count sql-response) max-elements)
-          (lib/bad-request {"error"  true
-                            "reason" "too-many"
-                            "max"    max-elements
-                            "count"  (count sql-response)})
-          (lib/ok
-           (if metric-columns-y
-             (metrics-column-response sql-response bucket-column metric-columns-y)
-             (if subbucket-column
-               (subbucket-column-response sql-response bucket-column)
-               (bucket-column-response sql-response bucket-column metric-y-column))))))
-      (lib/ok (bucket-column-response nil nil nil))))
-
-  )
+  [tenant-conn data-groups q]
+  (let [columns (reduce #(into % (:columns %2)) [] data-groups)
+        table-name (str "view_" (str/replace (util/squuid) "-" "_"))]
+    (->> data-groups
+         commons/data-groups-sql-template
+         commons/data-groups-sql
+         (commons/data-groups-temp-view table-name)
+         vector
+         (jdbc/execute! tenant-conn))
+    (query tenant-conn {:table-name table-name :columns columns} q)))


added basic grid structure and cleaned up syntax

--- src/cljs/cljspazzer/client/pages.cljs
+++ src/cljs/cljspazzer/client/pages.cljs
@@ -2,24 +2,28 @@
   (:require [om.core :as om :include-macros true]
             [sablono.core :as html :refer-macros [html]]
             [cljspazzer.client.utils :as utils]))
+
 (def nav-seq (concat (map str "#abcdefghijklmnopqrstuvwxyz") ["all"]))

 (defn nav-item [x]
-  (html [:li
-         [:a {:href (utils/format "#/nav/%s" x)} x]]))
+  [:li [:a {:href (utils/format "#/nav/%s" x)} x]])

 (defn artist-item [x]
-  (html [:li [:a {:href (utils/format "#/artists/%s" x)} x]]))
+  [:li [:a {:href (utils/format "#/artists/%s" x)} x]])

 (defn album-item [x]
-  (html [:li (utils/format "%s - (%s)" (x "album_canonical") (x "year"))]))
+  [:li (utils/format "%s - (%s)" (x "album_canonical") (x "year"))])

 (defn browse-page [data]
   (html [:div.browse
-         [:div.collection-nav [:ul (map nav-item nav-seq)]]
-         [:div.artist-list [:ul (map artist-item (:artists data))]]
-         [:div.artist-detail [:ul (map album-item (:albums data))]]]
-        ))
+         [:div.pure-g
+          [:div.collection-nav.pure-u-5-5 [:ul (map nav-item nav-seq)]]]
+         [:div.content.pure-g
+          [:div.artist-list.pure-u-1-5
+           [:ul (map artist-item (:artists data))]]
+          [:div.artist-detail.pure-u-3-5
+           [:h1 (:active-artist data)]
+           [:ul (map album-item (:albums data))]]]]))

 (defn view-browse [data]
   (om/component (browse-page data)))


Remove more magic numbers

Remove more magic numbers

--- src/cljs/goya/components/drawing.cljs
+++ src/cljs/goya/components/drawing.cljs
@@ -82,12 +82,12 @@
         y (quot mouse-y pixel-size)]
     [(* x pixel-size) (* y pixel-size)]))

-(defn visit-pixels-for-rect-tool [doc-x doc-y]
+(defn visit-pixels-for-rect-tool [doc-x doc-y doc-width]
   (let [[orig-x orig-y] (get-in @guistate/transient-state [:mouse-down-pos])
         [x y nx ny] (geometry/normalize-rect orig-x orig-y doc-x doc-y)]
     (doseq [dx (range x nx)]
       (doseq [dy (range y ny)]
-        (visit-pixel (geometry/flatten-to-index dx dy 64))))))
+        (visit-pixel (geometry/flatten-to-index dx dy doc-width))))))

 (defn unpack-event [event]
   [(.-offsetX event) (.-offsetY event)])
@@ -135,7 +135,7 @@

 (defn visit-pixels-for-fill-tool [doc-x doc-y image-data doc-width doc-height]
   (let [[orig-x orig-y] (get-in @guistate/transient-state [:mouse-down-pos])
-        idx (geometry/flatten-to-index orig-x orig-y 64)
+        idx (geometry/flatten-to-index orig-x orig-y doc-width)
         color (nth image-data idx)
         fill-target (flood idx image-data doc-width doc-height color)]
     (doseq [i fill-target]
@@ -211,14 +211,13 @@
         (.fillRect context x-with-offset y-with-offset pixel-size pixel-size)))))

-(defn clip-sub-image [image rect]
+(defn clip-sub-image [image rect doc-width]
   (let [[x1 y1 x2 y2] rect
         width (geometry/rect-width rect)
         height (geometry/rect-height rect)
-        main-image-width 64
         sub-image-indices(for [y (range y1 y2)
                                x (range x1 x2)
-                               :let [i (geometry/flatten-to-index x y main-image-width)]]
+                               :let [i (geometry/flatten-to-index x y doc-width)]]
                                i)
         sub-image-data (vec (map #(nth image %) sub-image-indices))]
       {:width width
@@ -235,12 +234,12 @@
   (om/set-state! owner :user-is-moving-selection false))

-(defn make-selection [app owner doc-x doc-y]
+(defn make-selection [app owner doc-x doc-y doc-width]
   (let [[orig-x orig-y] (get-in @guistate/transient-state [:mouse-down-pos])
         selection-rect (geometry/normalize-rect orig-x orig-y doc-x doc-y)
         main-image (get-in @app [:main-app :image-data])]
     (om/set-state! owner :selection selection-rect)
-    (om/set-state! owner :selection-image (clip-sub-image main-image selection-rect))))
+    (om/set-state! owner :selection-image (clip-sub-image main-image selection-rect doc-width))))

 (defn draw-selection [app owner]
@@ -417,7 +416,7 @@
                       (reset! guistate/transient-state
                               (assoc @guistate/transient-state :last-mouse-pos [])))
                     (when (= paint-tool :box)
-                      (visit-pixels-for-rect-tool doc-x doc-y))
+                      (visit-pixels-for-rect-tool doc-x doc-y doc-width))
                     (when (= paint-tool :line)
                       (let [last-x ((get-in @guistate/transient-state [:mouse-down-pos]) 0)
                             last-y ((get-in @guistate/transient-state [:mouse-down-pos]) 1)]
@@ -427,7 +426,7 @@
                     (when (= paint-tool :picker)
                       (pick-color app doc-x doc-y doc-width))
                     (when (and (= paint-tool :selection) (not (om/get-state owner :user-is-moving-selection)))
-                      (make-selection app owner doc-x doc-y))
+                      (make-selection app owner doc-x doc-y doc-width))
                     (when (and (= paint-tool :selection) (om/get-state owner :user-is-moving-selection))
                       (let [[xOff yOff] (om/get-state owner :mouse-offset-in-selection)
                             [x1 y1 x2 y2] (om/get-state owner :selection)


fix sign-up

fix sign-up

--- src/cljs/lesezeichen/client/core.cljs
+++ src/cljs/lesezeichen/client/core.cljs
@@ -64,7 +64,7 @@
 (defn send-registry
   "Send mail for sign up"
   [app owner]
-  (let [email (om/get-state owner :signup-text)
+  (let [email (om/get-state owner :sign-up-email)
         ws (-> app deref :ws)]
     (if (clojure.string/blank? email)
       (println "INFO: no mail")
@@ -79,14 +79,6 @@
   [app owner state]
   {[:#brand] (content "Lesezeichen")
    [:#nav-current-user] (content (or (-> app :user :email) "Not registered yet!"))
-   [:#sign-up-input] (do-> (set-attr :value (:signup-text state))
-                           (listen :on-change #(handle-text-change % owner :signup-text)
-                                   :on-key-down #(if (= (.-keyCode %) 10)
-                                                   (send-registry app owner)
-                                                   (when (= (.-which %) 13)
-                                                     (when (.-ctrlKey %)
-                                                       (send-registry app owner))))))
-   [:#modal-signup-btn] (listen :on-click (fn [e] (send-registry app owner)))
    [:#general-info] (content (om/get-state owner :info-text))
    [:#clear-db-btn] (listen :on-click (fn [e] (do (.clear (.-localStorage js/window))
                                                  (om/transact! app :user (fn [old] (assoc old :email "")))
@@ -106,8 +98,8 @@
   [app owner state]
   {[:#sign-up-username] (do-> (set-attr :value (:sign-up-username state))
                               (listen :on-change #(handle-text-change % owner :sign-up-username)))
-   [:#-sign-up-btn] (listen :on-click (fn [e] (send-registry app owner)))
-   [:#sign-up-mail] (do-> (set-attr :value (:sign-up-email state))
+   [:#sign-up-btn] (listen :on-click (fn [e] (send-registry app owner)))
+   [:#sign-up-email] (do-> (set-attr :value (:sign-up-email state))
                           (listen :on-change #(handle-text-change % owner :sign-up-email)
                                   :on-key-down #(if (= (.-keyCode %) 10)
                                                   (send-registry app owner)
@@ -209,7 +201,7 @@
     om/IInitState
     (init-state [_] {:url-input-text ""
                      :search-text ""
-                     :sign-up-mail ""
+                     :sign-up-email ""
                      :sign-up-username ""})
     om/IRenderState
     (render-state [this state] (bookmarks app owner state))))


add info popover to follow badge button

add info popover to follow badge button

--- src/cljs/salava/social/ui/follow.cljs
+++ src/cljs/salava/social/ui/follow.cljs
@@ -5,14 +5,15 @@
             [salava.core.ui.helper :refer [path-for current-path not-activated?]]
             [salava.social.ui.helper :refer [social-plugin?]]
             [salava.core.i18n :refer [t]]
-            [salava.core.helper :refer [dump]]))
+            [salava.core.helper :refer [dump]]
+            [salava.core.ui.popover :refer [info]]))

 (def followed?
   (atom nil))

 (defn follow-button-badge [badge-id followed?]
-  [:button {:class    "btn btn-primary follow "
+  [:div [:button {:class    "btn btn-primary follow "
             :disabled (if (not-activated?) "disabled" "")
             :on-click #(ajax/POST
                         (path-for (str "/obpv1/social/create_connection_badge/" badge-id))
@@ -24,7 +25,7 @@
                          :error-handler   (fn [{:keys [status status-text]}]
                                             (.log js/console (str status " " status-text))
                                             )})}
-   (str " " (t :social/Follow)) ])
+   (str " " (t :social/Follow)) ] [info {:content (t :social/Badgenotificationsinfo) :placement "left" :style {:vertical-align "super"}}]])

 (defn unfollow-ajax-post [badge-id]
   (ajax/POST


Add only ChemCam abbrev seen so far

Add only ChemCam abbrev seen so far

--- src/mars_ogler/cams.clj
+++ src/mars_ogler/cams.clj
@@ -7,6 +7,7 @@
                      "NRA" :navcam
                      "NRB" :navcam
                      "CR" :chemcam
+                     "CR0" :chemcam
                      "MH" :mahli
                      "MD" :mardi
                      "FLA" :hazcam
@@ -17,6 +18,8 @@
                      "RLB" :hazcam
                      "RRA" :hazcam
                      "RRB" :hazcam})
+
+(def cams (-> (vals cams-by-abbrev) distinct set))

 (def cam-names-by-abbrev {"ML" "MastCam Left"
                           "MR" "MastCam Right"