Macros

Macros

--- src/voxxed/macros.clj
+++ src/voxxed/macros.clj
@@ -1 +1,17 @@
 (ns voxxed.macros)
+
+(defmacro foreach [[sym coll] & body]
+  `(loop [coll# ~coll]
+     (when-let [[~sym & xs#] (seq coll#)]
+       ~@body
+       (recur xs#))))
+
+(macroexpand
+  '(foreach [ch ["Here is a simple macro"]]
+           (println ch)))
+
+(macroexpand
+  '(->> "Here is another one but much more useful"
+       (filter #(not (#{\a \e \i \o \u} %)))
+       (map #(Character/toUpperCase %))
+       (apply str)))


[#115] Fixed broken test

[#115] Fixed broken test

--- backend/test/org/akvo/dash/fixtures.clj
+++ backend/test/org/akvo/dash/fixtures.clj
@@ -24,5 +24,5 @@
                                  :title "Tenant 2"})
       (migrate/migrate conn)
       (f)
-      (migrate/rollback conn)
+      (migrate/rollback conn [])
       (finally (stop)))))


Logic tweaks for admin setup :information_desk_person:

--- src/metabase/api/setup.clj
+++ src/metabase/api/setup.clj
@@ -92,7 +92,7 @@
 ;;; Admin Checklist

 (defn- admin-checklist-values []
-  (let [has-dbs?           (db/exists? Database)
+  (let [has-dbs?           (db/exists? Database, :is_sample false)
         has-dashboards?    (db/exists? 'Dashboard)
         has-pulses?        (db/exists? 'Pulse)
         has-labels?        (db/exists? 'Label)
@@ -124,7 +124,7 @@
       :group       "Get connected"
       :description "Share answers and data with the rest of your team."
       :link        "/admin/people/"
-      :completed   (>= num-users 1)
+      :completed   (> num-users 1)
       :triggered   (or has-dashboards?
                        has-pulses?
                        (>= num-cards 5))}


First working implementation of bob in clojure.


Added *icon-size*

Added *icon-size*

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

--- conexp/gui/base.clj
+++ conexp/gui/base.clj
@@ -2,7 +2,8 @@
   (:import [javax.swing JFrame JMenuBar JMenu JMenuItem Box JToolBar JPanel
 	                JButton ImageIcon JSeparator JTabbedPane JSplitPane
 	                JLabel]
-	   [java.awt GridLayout BorderLayout Dimension]
+	   [javax.imageio ImageIO]
+	   [java.awt GridLayout BorderLayout Dimension Image]
 	   [java.awt.event KeyEvent ActionListener]
 	   [java.io File])
   (:use clojure.contrib.repl-utils
@@ -57,17 +58,21 @@
     (add-to-menubar frame menu-bar menu-entries-from-filler)
     (.validate frame)))

+; shortcuts for menu creating
+(def --- {})
+(def === (Box/createHorizontalGlue))
+
 (def *main-menu* {:name "Main" :content [{:name "Add Menu" ; just for fun
 					  :handler (fn [frame _]
 						     (add-menus frame
 								[{:name "?" :content []}]))}
-					 {}
+					 ---
 					 {:name "Quit"
 					  :handler (fn [frame _] (.dispose frame))}]})

 (def *help-menu* {:name "Help" :content []})

-(def *standard-menus* [*main-menu* (Box/createHorizontalGlue) *help-menu*])
+(def *standard-menus* [*main-menu* === *help-menu*])

 ;;; Tool Bar
@@ -75,7 +80,8 @@
 (defn get-toolbar [frame]
   (get-component frame #(= (class %) JToolBar)))

-(def *default-icon* "images/default.jpg")
+(def *default-icon* (File. "images/default.jpg"))
+(def *icon-size* 17)

 (defn make-icon [frame icon-hash]
   (let [button (JButton.)]
@@ -83,10 +89,14 @@
       (.setName (:name icon-hash))
       (add-handler frame (:handler icon-hash))
       (.setToolTipText (:name icon-hash)))
-    (let [icon (:icon icon-hash)]
-      (if (and icon (.exists (File. icon)))
-	(.setIcon button (ImageIcon. icon))
-	(.setIcon button (ImageIcon. *default-icon*))))
+    (let [icon (:icon icon-hash)
+	  image (-> (ImageIO/read (if (and icon (.exists (File. icon)))
+				    (File. icon)
+				    *default-icon*))
+		    (.getScaledInstance *icon-size*
+					*icon-size*
+					Image/SCALE_SMOOTH))]
+	(.setIcon button (ImageIcon. image)))
     button))

 (defn add-to-toolbar [frame toolbar icons]
@@ -104,7 +114,10 @@

 (def *quit-icon* {:name "Quit" :icon "???" :handler (fn [frame _] (.dispose frame))})

-(def *standard-icons* [*quit-icon* {}])
+; shortcuts for toolbar creation
+(def | {})
+
+(def *standard-icons* [*quit-icon* |])

 ;;; Tabs


Made merge-attrs! use merge-with merge.

Made merge-attrs! use merge-with merge.

--- src/freactive/dom.cljs
+++ src/freactive/dom.cljs
@@ -573,6 +573,9 @@
 (defn- get-velem-state [elem]
   (or (get-element-state elem) elem))

+(defn- find-by-id [id]
+  (.getElementById js/document id))
+
 (defn- get-managed-dom-element [elem]
   (let [velem (ui/velem-simple-element (get-element-state elem))]
     (assert (instance? DOMElement velem) "Not a managed DOM element.")
@@ -589,16 +592,13 @@
   "Merges the attrs map with a managed element's existing attribute map. A nil
 value will unset any attribute."
   (let [velem (get-managed-dom-element elem)]
-    (.updateAttrs velem (merge (.-attrs velem) attrs))))
+    (.updateAttrs velem (merge-with merge (.-attrs velem) attrs))))

 (defn update-attrs! [elem f & args]
   "Updates a managed element's attributes by applying f and optionally args to
 the existing attribute map."
   (let [velem (get-managed-dom-element elem)]
     (.updateAttrs velem (apply f (.-attrs velem) args))))
-
-(defn- find-by-id [id]
-  (.getElementById js/document id))

 (defn- create-or-find-root-node [id]
   (if-let [root-node (find-by-id id)]


Added common namespaces.

Added common namespaces.

--- dev-resources/src/cmr/client/dev.clj
+++ dev-resources/src/cmr/client/dev.clj
@@ -8,6 +8,8 @@
    [clojure.string :as string]
    [clojure.tools.namespace.repl :as repl]
    [cmr.client.ac.core :as ac]
+   [cmr.client.common.const :as const]
+   [cmr.client.common.util :as util]
    [cmr.client.http.core :as http]
    [cmr.client.ingest.core :as ingest]
    [cmr.client.search.core :as search]))


fix sorted content

fix sorted content

--- server/src/gratefulplace/db/maprules.clj
+++ server/src/gratefulplace/db/maprules.clj
@@ -70,7 +70,7 @@
             :retriever #(gratefulplace.db.query/all :topic/title [:content/author (:db/id %)]))
   (has-many :posts
             :rules gratefulplace.db.maprules/ent->post
-            :retriever (sorted-content :post/content :post/created-at)))
+            :retriever (gratefulplace.db.maprules/sorted-content :post/content :post/created-at)))

 (defmaprules ent->userauth
   (attr :id :db/id)


incrase waiting timeout for messages in failure use case to avoid travis failing

--- kafka-clj/test/kafka_clj/failure_tests.clj
+++ kafka-clj/test/kafka_clj/failure_tests.clj
@@ -104,7 +104,7 @@
                             (fail-broker res)

                             (prn "waiting for message consumption")
-                            (let [msg-read-count (count (read-messages node 60000))]
+                            (let [msg-read-count (count (read-messages node (* 60000 5)))]
                               (prn "!!!!!!!!!!############+++++++++=======>>>>>> messages " msg-read-count)
                               (consumer-node/shutdown-node! node)
                               (facts "Check that all messages were read"


Unbreak merging on sequences.

Unbreak merging on sequences.

Also, better error reporting in a few cases.

--- src/active/clojure/config.cljc
+++ src/active/clojure/config.cljc
@@ -569,42 +569,55 @@

   This helper assumes there are no profiles."
   [schema path c1 c2]
-  (when-not (map? c1)
-    (c/error `merge-config-objects-sans-profiles
-             "configuration is not a map" path c1))
-  (when-not (map? c2)
-    (c/error `merge-config-objects-sans-profiles
-             "configuration is not a map" path c2))
   (cond
     (map-schema? schema)
-    (let [sections-map (map-schema-sections-map schema)
-          settings-map (map-schema-settings-map schema)]
-      (loop [c {}
-             all-keys (seq (set/union (set (keys c1))
-                                      (set (keys c2))))]
-        (if all-keys
-          (let [key (first all-keys)
-                val1 (get c1 key)
-                val2 (get c2 key)]
-            (if (contains? settings-map key)
-              (recur (assoc c
-                            ;; that `nil` is a valid value
-                            key
-                            (if (contains? c2 key)
-                              val2
-                              val1))
-                     (next all-keys))
-              (if-let [section (get sections-map key)]
-                (recur (assoc c key
-                              (merge-config-objects-sans-profiles (section-schema section) (conj (vec path) key) (or val1 {}) (or val2 {})))
+    (do
+      (when-not (map? c1)
+        (c/error `merge-config-objects-sans-profiles
+                 (str "configuration at " path " is not a map: " c1)
+                 path c1))
+      (when-not (map? c2)
+        (c/error `merge-config-objects-sans-profiles
+                 (str "configuration at " path " is not a map: " c2)
+                 path c2))
+      (let [sections-map (map-schema-sections-map schema)
+            settings-map (map-schema-settings-map schema)]
+        (loop [c {}
+               all-keys (seq (set/union (set (keys c1))
+                                        (set (keys c2))))]
+          (if all-keys
+            (let [key (first all-keys)
+                  val1 (get c1 key)
+                  val2 (get c2 key)]
+              (if (contains? settings-map key)
+                (recur (assoc c
+                              ;; that `nil` is a valid value
+                              key
+                              (if (contains? c2 key)
+                                val2
+                                val1))
                        (next all-keys))
-                (c/error `merge-config-objects-sans-profiles
-                         (str "unknown path " (vec (conj path key)) " in config")
-                         (conj path key) (if (contains? c1 key) val1 val2) nil (if (contains? c1 key) c1 c2)))))
-          c)))
+                (if-let [section (get sections-map key)]
+                  (recur (assoc c key
+                                (merge-config-objects-sans-profiles (section-schema section) (conj (vec path) key) (or val1 {}) (or val2 {})))
+                         (next all-keys))
+                  (c/error `merge-config-objects-sans-profiles
+                           (str "unknown path " (vec (conj path key)) " in config")
+                           (conj path key) (if (contains? c1 key) val1 val2) nil (if (contains? c1 key) c1 c2)))))
+            c))))

     (sequence-schema? schema)
-    (concat c1 c2)))
+    (do
+      (when-not (sequable? c1)
+        (c/error `merge-config-objects-sans-profiles
+                 (str "configuration at " path " is not a sequence: " (pr-str c1))
+                 path c1))
+      (when-not (sequable? c2)
+        (c/error `merge-config-objects-sans-profiles
+                 (str "configuration at " path " is not a sequence: " (pr-str c2))
+                 path c2))
+
+      (concat c1 c2))))

 (defn merge-config-objects
   "Merge several config maps into one, with the latter taking precedence."
@@ -664,8 +677,9 @@
   (letfn []
     (cond
       (map-schema? schema)
-      (if (not (map? config))
-        (make-range-error nil path config)
+      (if (and (not (map? config))
+               (not (nil? config)))
+        (make-range-error :not-a-map path config)
         (let [sections-map (map-schema-sections-map schema)
               res
               ;; go through the settings first, as we need to collect
@@ -689,7 +703,7 @@
                                  (dissoc settings-map key))))
                       (if (contains? sections-map key) ; do sections later
                         (recur (next entries) c inherited-map settings-map)
-                        (make-range-error nil (concat path [key]) val))))
+                        (make-range-error :unknown-section (concat path [key]) val))))
                   [(merge c (complete-settings inherited-map settings-map))
                    inherited-map settings-map]))]
           (if (range-error? res)
@@ -762,11 +776,13 @@
                     (vec (range-error-path res))
                     " in configuration map: "
                     "value "
-                    (range-error-value res)
+                    (pr-str (range-error-value res))
                     " should be in range "
-                    (if-let [r (range-error-range res)]
-                      (range-description r)
-                      "<no range>")
+                    (let [r (range-error-range res)]
+                      (if (range? r)
+                        (range-description r)
+                        ;; FIXME: should look at this
+                        (pr-str r)))
                     " but isn't")
                res)
       (really-make-configuration res schema))))


Add namespace API doc comment.

Add namespace API doc comment.

--- src/afterglow/effects/cues.clj
+++ src/afterglow/effects/cues.clj
@@ -1,4 +1,13 @@
 (ns afterglow.effects.cues
+  "Cues provide a user interface for controlling effects, by
+  associating them with cells in a cue grid so they can be easily
+  triggered and monitored, either through a physical grid controller,
+  or the web show control interface. They also provide a way of
+  binding cue variables to effect parameters, which can enable
+  controller interfaces to adjust them, and of tying those variables
+  to velocity and pressure sensitivity on physical grid controllers
+  which have such capabilities."
+  {:author "James Elliott"}
   (:require [afterglow.controllers :as controllers]
             [afterglow.effects.channel :as chan]
             [afterglow.effects.params :as params]


[#1077] Sort point color mapping

[#1077] Sort point color mapping

--- backend/src/akvo/lumen/lib/visualisation/map_metadata.clj
+++ backend/src/akvo/lumen/lib/visualisation/map_metadata.clj
@@ -28,6 +28,21 @@
 (defn next-color [used-colors]
   (some (fn [color] (if (contains? used-colors color) false color)) palette))

+(defn move-last
+  "Move the first element in coll last. Returns a vector"
+  [coll]
+  (if (empty? coll)
+    coll
+    (let [[first & rest] coll]
+      (conj (vec rest) first))))
+
+(defn sort-point-color-mapping
+  [point-color-mapping]
+  (let [sorted (sort-by #(get % "value") point-color-mapping)]
+    (if (nil? (-> sorted first (get "value")))
+      (move-last sorted)
+      sorted)))
+
 (defn point-color-mapping
   [tenant-conn table-name {:strs [pointColorMapping pointColorColumn]}]
   (when pointColorColumn
@@ -38,21 +53,22 @@
           color-map (reduce (fn [m {:strs [value color]}]
                               (assoc m value color))
                             {}
-                            pointColorMapping)]
-      (loop [result []
-             values distinct-values
-             used-colors used-colors]
-        (if (empty? values)
-          result
-          (let [value (first values)]
-            (if-some [color (get color-map value)]
-              (recur (conj result {"op" "equals" "value" value "color" color})
-                     (rest values)
-                     used-colors)
-              (let [color (next-color used-colors)]
-                (recur (conj result {"op" "equals" "value" value "color" color})
-                       (rest values)
-                       (conj used-colors color))))))))))
+                            pointColorMapping)
+          color-mapping (loop [result []
+                               values distinct-values
+                               used-colors used-colors]
+                          (if (empty? values)
+                            result
+                            (let [value (first values)]
+                              (if-some [color (get color-map value)]
+                                (recur (conj result {"op" "equals" "value" value "color" color})
+                                       (rest values)
+                                       used-colors)
+                                (let [color (next-color used-colors)]
+                                  (recur (conj result {"op" "equals" "value" value "color" color})
+                                         (rest values)
+                                         (conj used-colors color)))))))]
+      (sort-point-color-mapping color-mapping))))

 ;; "BOX(-0.127758 51.507351,24.938379 63.095089)"
 (defn parse-box [s]


consolidate rules because we'll use run-time default-setting instead

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -246,101 +246,18 @@
                                        :subcat {:1 {:agr agr
                                                     :reflexive reflexive}}}}}))
                    (unify-check c10
+                                unmodified
                                 root-is-head
-                                unmodified
-                                {:head {:phrasal false ;; non-auxiliary past: e.g. "he slept"
-                                        :synsem {:aux false}}
-                                 :rule "s-past-nonphrasal-head"
-                                 :synsem {:infl :past
-                                          :cat :verb
-                                          :sem {:aspect :perfect
-                                                :tense :past}}})
+                                {:head {:phrasal false} ;; non-auxiliary past: e.g. "he slept"
+                                 :rule "sentence-nonphrasal-head"
+                                 :synsem {:cat :verb}})
+
                    (unify-check c10
                                 unmodified
-                                root-is-head
-                                {:head {:phrasal true ;; reflexive past: e.g. "he washed himself"
-                                        :synsem {:aux false}}
-                                 :rule "s-past-phrasal-head"
-                                 :synsem {:infl :past
-                                          :cat :verb
-                                          :sem {:aspect :perfect
-                                                :tense :past}}})
-                   (unify-check c10
                                 root-is-head-root
-                                unmodified
-                                {:rule "s-conditional-phrasal-head"
-                                 :head {:phrasal true}
-                                 :synsem {:aux false
-                                          :infl :conditional
-                                          :cat :verb
-                                          :sem {:tense :conditional}}})
-                   (unify-check c10
-                                root-is-head
-                                unmodified
-                                {:rule "s-conditional-nonphrasal-head"
-                                 :head {:phrasal false}
-                                 :synsem {:aux false
-                                          :infl :conditional
-                                          :cat :verb
-                                          :sem {:tense :conditional}}})
-                   (unify-check c10
-                                root-is-head-root
-                                unmodified
-                                {:rule "s-future-phrasal-head"
-                                 :head {:phrasal true}
-                                 :synsem {:aux false
-                                          :infl :future
-                                          :cat :verb
-                                          :sem {:tense :future}}})
-                   (unify-check c10
-                           root-is-head
-                           unmodified
-                           {:rule "s-future-nonphrasal-head"
-                            :head {:phrasal false}
-                            :synsem {:aux false
-                                     :infl :future
-                                     :cat :verb
-                                     :sem {:tense :future}}})
-                   (unify-check c10
-                                root-is-head-root
-                                unmodified
-                                {:rule "s-imperfect-phrasal-head"
-                                 :head {:phrasal true}
-                                 :synsem {:aux false
-                                          :infl :imperfect
-                                          :cat :verb
-                                          :sem {:aspect :progressive
-                                                :tense :past}}})
-                   (unify-check c10
-                                root-is-head
-                                unmodified
-                                {:rule "s-imperfect-nonphrasal-head"
-                                 :head {:phrasal false}
-                                 :synsem {:aux false
-                                          :infl :imperfect
-                                          :cat :verb
-                                          :sem {:aspect :progressive
-                                                :tense :past}}})
-
-                   (unify-check c10
-                                root-is-head-root
-                                unmodified
-                                {:rule "s-present-phrasal-head"
-                                 :head {:phrasal true}
-                                 :synsem {:aux false
-                                          :infl :present
-                                          :cat :verb
-                                          :sem {:aspect :progressive
-                                                :tense :present}}})
-                   (unify-check c10
-                           root-is-head
-                           {:rule "s-present-nonphrasal-head"
-                            :head {:phrasal false}
-                            :synsem {:aux false
-                                     :infl :present
-                                     :cat :verb
-                                     :sem {:aspect :progressive
-                                           :tense :present}}})
+                                {:head {:phrasal true} ;; reflexive past: e.g. "he washed himself"
+                                 :rule "sentence-phrasal-head"
+                                 :synsem {:cat :verb}})

                    (unify-check h21
                                 root-is-head
@@ -348,6 +265,7 @@
                                  :head {:phrasal false}
                                  :synsem {:aux false
                                           :cat :verb}})
+
                    (unify-check h21
                                 root-is-head-root
                                 {:rule "transitive-vp"


improve debugging message

improve debugging message

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -747,7 +747,7 @@
                 with-structure
                 (if structure (unify base-unify structure)
                     base-unify)]
-            (log/debug (str "creating lexemes for surface: '" surface "' and with-structure: " with-structure))
+            (log/debug (str "creating lexemes for surface: '" surface "' and with-structure: "(u/strip-refs with-structure)))
             (if (= :fail with-structure)
               (let [message (str "fail to unify vocab-entry information: base-unify:" (u/strip-refs base-unify)
                                         "; vocab structure:" structure)]


add sell[:obj :buyable=true], not human=false

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1536,7 +1536,7 @@
    "sell" {:synsem {:cat :verb
                     :sem {:pred :vendere
                           :subj {:human true}
-                          :obj {:human false}}}
+                          :obj {:buyable true}}}
            :english {:past "sold"}}

    "send" {:synsem {:cat :verb


encyclopedic stuff moved out of here

encyclopedic stuff moved out of here

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -122,10 +122,7 @@
                      :sem {:pred :avoid}}}

    "bag" {:synsem {:cat :noun
-                   :sem {:pred :bag
-                         :animate false
-                         :edible false
-                         :place false}}}
+                   :sem {:pred :bag}}}

    "base" {:synsem {:cat :verb
                     :sem {:pred :support}}}


fix debug annotations so that more than one rule can apply

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2318,12 +2318,12 @@
                     (unifyc
                      (dissoc-paths lexeme [[:synsem :sem :obj]
                                            [:synsem :subcat :2]])
-                     {:applied {:rule 1}
+                     {:applied {:1 true}
                       :synsem {:subcat {:2 '()}}})))

                  (default ;; intransitive verbs' :obj is :unspec.
                   {:modal-with false
-                   :applied {:rule 2}
+                   :applied {:2 true}
                    :synsem {:cat :verb
                             :subcat {:1 {:top :top}
                                      :2 '()}


whitespace

whitespace

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1011,6 +1011,7 @@
               :sem {:human true
                     :pred :Juan-and-i}
               :subcat '()}}]
+
    "Juan and me"
    [{:synsem {:cat :noun
               :pronoun true


fix mix shift

fix mix shift

--- examples/om.cljs
+++ examples/om.cljs
@@ -28,12 +28,12 @@
     om/IWillReceiveProps
     (will-receive-props [_ {:keys [x y]}]
       (let [{:keys [intrpl start]} (om/get-state owner)
-            t (/ (- (now) start) speed)
+            dt (/ (- (now) start) speed)
             [px py] ((juxt :x :y) (om/get-props owner))
-            intrpl (if (< t 1)
+            intrpl (if (< dt 1)
                      (-> intrpl
-                         (shift 0 1 t 1)
-                         (mix (interpolate (intrpl t) {:x x :y y})))
+                         (shift 0 (- 1 dt) dt 1)
+                         (mix (interpolate (intrpl dt) {:x x :y y})))
                      (interpolate {:x px :y py}
                                   {:x x :y y}))]
         (om/set-state! owner :intrpl intrpl)


remove newlines from title

remove newlines from title

--- src-cljs/frontend/components/issues.cljs
+++ src-cljs/frontend/components/issues.cljs
@@ -53,7 +53,7 @@
                                                                        (throw "Couldn't create doc."))))]
                                                     (d/transact! issue-db [{:db/id -1
                                                                             :issue/created-at (datetime/server-date)
-                                                                            :issue/title (str/trim issue-title)
+                                                                            :issue/title (gstring/normalizeWhitespace (str/trim issue-title))
                                                                             :issue/author (:cust/email cust)
                                                                             :issue/document doc-id
                                                                             :frontend/issue-id fe-id}])


Add more examples.

Add more examples.

--- src-cljs/kixi/hecuba/tabs/hierarchy.cljs
+++ src-cljs/kixi/hecuba/tabs/hierarchy.cljs
@@ -217,8 +217,10 @@
   (data/search-properties cursor 0 results-size term (get-sort-str th-click sort-asc)))

 (def filters
-  [{:display "Properties with photovoltaics "             :value "photovoltaics" :filter "photovoltaics:true"}
-   {:display "Field built_form either a House or a Flat " :value "house_or_flat" :filter "built_form:(House OR Flat)"}])
+  [{:display "Properties with photovoltaics " :filter "photovoltaics:true"}
+   {:display "Field built_form either a House or a Flat " :filter "built_form:(House OR Flat)"}
+   {:display "Project name like \"Eco-retrofit Ealing\"" :filter "project_name:\"Eco-retrofit Ealing\""}
+   {:display "Project name like \"Eco-retrofit Ealing\" and properties with photovoltaics" :filter "project_name:\"Eco-retrofit Ealing\" AND photovoltaics:true"}])

 (defn set-filter [cursor filter]
   (om/update! cursor :term (:filter filter)))


prune before scan

prune before scan

--- src/clj/cljspazzer/scanner.clj
+++ src/clj/cljspazzer/scanner.clj
@@ -71,8 +71,8 @@

 (defn process-mounts! []
   (let [m (db/mount-points db/the-db)]
-    (dorun (map process-dir! m))
-    (dorun (db/prune-tracks! db/the-db))))
+    (dorun (db/prune-tracks! db/the-db))
+    (dorun (map process-dir! m))))


updating

updating

--- src/clj/hsd_scoring/routes.clj
+++ src/clj/hsd_scoring/routes.clj
@@ -28,13 +28,12 @@
   (let [team-name (:team_name params)]
     (if (exists? team_scores :team_name team-name)
       (response {:status 403
-                 :body {:error (str "The team named '" team-name "' already exists")}})
-    (do
-      (insert team_scores
-              (values {:team_name team-name}))
-      (response {:status 200
-                 :headers {}
-                 :body "Successfully created team"})))))
+                  :body {:error (str "The team named '" team-name "' already exists")}})
+      (do
+        (response {:status 200
+                   :body "Success"})
+        (insert team_scores
+          (values params))))))

 (defn get-score-type [name]
   (cond


Parse badges, make a HEAD requests to related assertion urls

--- src/clj/salava/badge/parse.clj
+++ src/clj/salava/badge/parse.clj
@@ -565,6 +565,17 @@

 ;;;

+(defn- ping-related
+  "Make a HEAD requests to related assertion urls."
+  [asr]
+  (doseq [rel (:related asr)]
+    (when (and (= (:type rel) "Assertion") (re-find #"^http" (get rel :id "")))
+      (try
+        (http/http-req {:method :head :url (:id rel)})
+        (catch Exception e
+          (log/error "HEAD request failed: " (:id rel))
+          (log/error (.getMessage e)))))))
+
 (defmulti verify-assertion assertion-version)

 (defmethod verify-assertion :v0.5.0 [url asr]
@@ -573,6 +584,7 @@
       (throw (IllegalArgumentException. "invalid assertion, origin url mismatch")))))

 (defmethod verify-assertion :v2.0 [url asr]
+  (ping-related asr)
   (let [kind (get-in asr [:verify :type] (get-in asr [:verification :type]))]
     (when (and (not (nil? url)) (or (= kind "hosted") (= kind "HostedBadge")))
       (if (and (not (string/starts-with? url (:id asr))) (not= (domain url) (domain (:id asr))))
@@ -589,6 +601,7 @@
       (throw (IllegalArgumentException. "invalid assertion, verify url mismatch"))))
   (if (not= (domain (get-in asr [:verify :url])) (domain (:badge asr)))
     (throw (IllegalArgumentException. "invalid assertion, verify url mismatch"))))
+

 (defn assertion->badge
   ([user assertion] (assertion->badge user assertion {}))


Enable console print for cljs

Enable console print for cljs

--- src/cljs/clojuredocs/main.cljs
+++ src/cljs/clojuredocs/main.cljs
@@ -6,6 +6,8 @@
             [clojuredocs.sticky :as sticky]
             [highlight])
   (:use-macros [dommy.macros :only [node sel sel1]]))
+
+(enable-console-print!)

 (defn log [& args]
   (.log js/console args))


Add New Game button to reset.

Add New Game button to reset.

--- src/connect_four/frontend.cljs
+++ src/connect_four/frontend.cljs
@@ -6,7 +6,7 @@
             [clojure.string :as string])
   (:import [goog.math Long]))

-(def state (atom (cf/new-state)))
+(def game-state (atom (cf/new-state)))

 (def ai-chan (chan))

@@ -15,23 +15,23 @@
              :black [:span {:style {:color "black"}} "BLACK"]})

 (defn drop-piece [column]
-  (swap! state cf/play column))
+  (swap! game-state cf/play column))

 (defn player-click [column]
-  (let [{:keys [player boards]} @state]
+  (let [{:keys [player boards]} @game-state]
     (when (and (= player :red)
-               (nil? (:winner @state))
+               (nil? (:winner @game-state))
                (cf/is-valid? (:game-board boards) column))
       (drop-piece column))))

-(add-watch state :ai
+(add-watch game-state :ai
   (fn [key atom old-state new-state]
     (when (= (:player new-state) :black)
       (put! ai-chan "run"))))

 (go (while true (when (and (= "run" (<! ai-chan))
-                           (nil? (:winner @state)))
-                         (let [best-move (cf/find-best-move @state :black)]
+                           (nil? (:winner @game-state)))
+                         (let [best-move (cf/find-best-move @game-state :black)]
                            (drop-piece (:column best-move))
                            (.log js/console "Win Percentage: " (:percentage best-move))))))

@@ -43,23 +43,29 @@
    piece])

 (defn winner-display []
-  (let [winner (:winner @state)]
+  (let [winner (:winner @game-state)]
     [:div {:style {:height "32px"}}
      [:h1
       (when (some? winner)
         (str (string/capitalize (name winner)) " wins!"))]]))

 (defn game-board []
-  (let [{:keys [boards winner]} @state
+  (let [{:keys [boards winner]} @game-state
         {:keys [rows columns state]} (:game-board boards)]
-    [:div
+    [:div {:style {:width "500px"
+                   :text-align "center"}}
      [winner-display]
-     [:table {:style {:border-collapse "collapse"}}
+     [:table {:style {:margin "auto"
+                      :border-collapse "collapse"}}
       (doall (for [row (range (dec rows) -1 -1)]
                [:tr {:key row}
                 (doall (for [column (range columns)]
                          ^{:key (str column row)}
-                         [cell (pieces (get (state column) row :empty)) column]))]))]]))
+                         [cell (pieces (get (state column) row :empty)) column]))]))]
+     [:button {:on-click #(reset! game-state (cf/new-state))
+               :style {:margin-top "20px"
+                       :font-size "20px"}}
+      "New Game!"]]))

 (reagent/render-component [game-board]
                           (.-body js/document))


Only listen on localhost

Only listen on localhost

--- desktop/src/nightweb_desktop/server.clj
+++ desktop/src/nightweb_desktop/server.clj
@@ -31,4 +31,5 @@

 (defn start-server
   []
-  (future (jetty/run-jetty (multi/wrap-multipart-params handler) {:port port})))
+  (future (jetty/run-jetty (multi/wrap-multipart-params handler)
+                           {:port port :host "127.0.0.1"})))


Endpoint for /job-info handler

Endpoint for /job-info handler

--- src/emender_service/server.clj
+++ src/emender_service/server.clj
@@ -54,6 +54,7 @@
         [:get  "/info"]         (rest-api/info-handler request (get-hostname))
         [:get  "/job-list"]     (rest-api/get-job-list-handler request)
         [:get  "/jobs"]         (rest-api/get-job-list-handler request)
+        [:get  "/job-info"]     (rest-api/get-job-info-handler request)
         [:post "/job-started"]  (rest-api/job-started-handler  request)
         [:post "/job-finished"] (rest-api/job-finished-handler request)
         [:post "/job-results"]  (rest-api/job-results-handler  request)


cassandra: avoid calling uuid/get-timestamp on nils - it's not nil safe

--- src/er_cassandra/util/time.clj
+++ src/er_cassandra/util/time.clj
@@ -44,8 +44,8 @@
    timestamps and if they are equal comparing their
    binary encodings - this does the same"
   [timeuuid-a timeuuid-b]
-  (let [ts-a (-> timeuuid-a uuid/get-timestamp)
-        ts-b (-> timeuuid-b uuid/get-timestamp)
+  (let [ts-a (some-> timeuuid-a uuid/get-timestamp)
+        ts-b (some-> timeuuid-b uuid/get-timestamp)
         tsc (compare ts-a ts-b)]
     (if (not= tsc 0)
       tsc
@@ -55,8 +55,8 @@
   "it seems cassandra always compares timeuuids as lower than
    non-timeuuids, so that's a thing"
   [a b]
-  (let [ts-a (uuid/get-timestamp a)
-        ts-b (uuid/get-timestamp b)]
+  (let [ts-a (some-> a uuid/get-timestamp)
+        ts-b (some-> b uuid/get-timestamp)]
     (cond
       (and ts-a ts-b)
       (timeuuid-comparator a b)


Move debug open? config to opts

Move debug open? config to opts

--- src/cljs/dato/debug/components/core.cljs
+++ src/cljs/dato/debug/components/core.cljs
@@ -152,9 +152,9 @@
     om/IWillMount
     (will-mount [_]
       (om/set-state! owner [:current-save-slot] 0)
-      (om/set-state! owner [:tool] :components)
+      (om/set-state! owner [:tool] :query)
       (om/set-state! owner [:current-query] "default")
-      (om/set-state! owner [:open?] (or (:open? data) false))
+      (om/set-state! owner [:open?] (or (:open? opts) false))
       (om/set-state! owner [:query] (or (:expressions opts) [])))
     om/IDidUpdate
     (did-update [_ _ prev]


form init

form init

--- src/cljs/re_form/inputs/webcam_impl.cljs
+++ src/cljs/re_form/inputs/webcam_impl.cljs
@@ -25,7 +25,7 @@
     :component-will-unmount #(reset! widget-state {})
     :reagent-render
     (fn [{:keys [upload-fn uploading]}]
-      [:div.re-webcam
+      [:div.re-webcam {:style {:padding "10px"}}
        [:video {:ref #(swap! widget-state assoc :video %)
                 :width width
                 :height height
@@ -45,7 +45,8 @@
      (set! (.. canvas -style -display) "block")
      (swap! widget-state assoc-in [:images image-name :data-uri] (.toDataURL canvas "image/png"))
      (.toBlob canvas #(do (swap! widget-state assoc-in [:images image-name :blob] %)
-                          (rf/dispatch (into (:on-image opts) [image-name])))))))
+                          (when-let [on-image-ev (:on-image opts)]
+                            (rf/dispatch (into on-image-ev [image-name]))))))))

 (rf/reg-event-fx
  :webcam/shot


Fix direct reduction of tuple sources.

Fix direct reduction of tuple sources.

--- src/clojure/parkour/mapreduce/source.clj
+++ src/clojure/parkour/mapreduce/source.clj
@@ -47,7 +47,7 @@
 provided, applies `nextf` to `context` to retrieve the next tuple source for
 each iteration and `dataf` to retrieve the tuple values passed to `f`."
   ([context f init]
-     (reduce next-keyval keyval f init))
+     (reduce next-keyval keyval context f init))
   ([nextf dataf context f init]
      (loop [context context, state init]
        (if-let [context (nextf context)]


[hotfix][tests] Add missing space to help text

--- flink-jepsen/src/jepsen/flink/flink.clj
+++ flink-jepsen/src/jepsen/flink/flink.clj
@@ -120,13 +120,13 @@
                      :parse-fn read-test-spec
                      :validate [#(->> % :dbs (map dbs) (every? (complement nil?)))
                                 (str "Invalid :dbs specification. " (keys->allowed-values-help-text dbs))]]
-                    [nil "--nemesis-gen GEN" (str "Which nemesis should be used?"
+                    [nil "--nemesis-gen GEN" (str "Which nemesis should be used? "
                                                   (keys->allowed-values-help-text fn/nemesis-generator-factories))
                      :parse-fn keyword
                      :default :kill-task-managers
                      :validate [#(fn/nemesis-generator-factories %)
                                 (keys->allowed-values-help-text fn/nemesis-generator-factories)]]
-                    [nil "--client-gen GEN" (str "Which client should be used?"
+                    [nil "--client-gen GEN" (str "Which client should be used? "
                                                  (keys->allowed-values-help-text client-gens))
                      :parse-fn keyword
                      :default :poll-job-running


Revert back to stock lein-bin

Revert back to stock lein-bin

--- kwho-clj/project.clj
+++ kwho-clj/project.clj
@@ -4,7 +4,7 @@
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
   :dependencies [[org.clojure/clojure "1.6.0"]]
-  :plugins [[lein-bin "0.3.6-SNAPSHOT"]] #_ "https://github.com/jacobmorzinski/lein-bin"
+  :plugins [[lein-bin "0.3.5"]] #_ "https://github.com/jacobmorzinski/lein-bin"
   :bin {:name "kwho.bat"} #_ "I wish I could use a conditional..."
   :main ^:skip-aot kwho.core
   :target-path "target/%s"


Updated instrumented-ring-jetty-adapter that allows SSL service to work. Updated rest-driver as latest version is needed to work with jetty 9.

--- src/leiningen/new/mr_clojure/project.clj
+++ src/leiningen/new/mr_clojure/project.clj
@@ -8,7 +8,7 @@
                  [compojure "1.2.0"]
                  [environ "1.0.0"]
                  [mixradio/graphite-filter "1.0.0"]
-                 [mixradio/instrumented-ring-jetty-adapter "1.0.2"]
+                 [mixradio/instrumented-ring-jetty-adapter "1.0.4"]
                  [mixradio/radix "1.0.5"]
                  [net.logstash.logback/logstash-logback-encoder "3.2"]
                  [org.clojure/clojure "1.6.0"]
@@ -19,7 +19,7 @@
                log4j
                org.clojure/clojure]

-  :profiles {:dev {:dependencies [[com.github.rest-driver/rest-client-driver "1.1.36"
+  :profiles {:dev {:dependencies [[com.github.rest-driver/rest-client-driver "1.1.41"
                                    :exclusions [org.slf4j/slf4j-nop
                                                 javax.servlet/servlet-api
                                                 org.eclipse.jetty.orbit/javax.servlet]]


Remove unnecessary to-transient call on the memory when running queries on a LocalSession

--- src/main/clojure/clara/rules/engine.cljc
+++ src/main/clojure/clara/rules/engine.cljc
@@ -1893,13 +1893,12 @@
                      get-alphas-fn
                      [])))

-  ;; TODO: queries shouldn't require the use of transient memory.
   (query [session query params]
     (let [query-node (get-in rulebase [:query-nodes query])]
       (when (= nil query-node)
         (platform/throw-error (str "The query " query " is invalid or not included in the rule base.")))

-      (->> (mem/get-tokens (mem/to-transient memory) query-node params)
+      (->> (mem/get-tokens memory query-node params)

            ;; Get the bindings for each token and filter generate symbols.
            (map (fn [{bindings :bindings}]


(re-4902) Update startup timeout default to 180 seconds

Currently the startup timeout default is set to 60 seconds. There
have been some reports of services timing out on restart,
particularly on lower-powered VMs. console-services already overrides
the default to 180 seconds.

This updates the default to 180 seconds.

--- src/puppetlabs/ezbake/core.clj
+++ src/puppetlabs/ezbake/core.clj
@@ -404,7 +404,7 @@
          :terminus-map              termini
          :replaces-pkgs             (get-local-ezbake-var lein-project :replaces-pkgs [])
          :start-after               (quoted-list (get-local-ezbake-var lein-project :start-after []))
-         :start-timeout             (get-local-ezbake-var lein-project :start-timeout "60")
+         :start-timeout             (get-local-ezbake-var lein-project :start-timeout "180")
          :main-namespace            (get-local-ezbake-var lein-project
                                                           :main-namespace
                                                           "puppetlabs.trapperkeeper.main")


Whitespace cleanup

Whitespace cleanup

--- src/puppetlabs/ezbake/core.clj
+++ src/puppetlabs/ezbake/core.clj
@@ -320,7 +320,6 @@
             (str/replace lein-version "-" ".")
             (get-timestamp-string))
     lein-version))
-

 ;; TODO: this is a horrible, horrible hack; I can't yet see a good way to
 ;; let the packaging library know what the version number is without faking


(PDB-4655) Always clean up puppetdb service resources

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -48,7 +48,7 @@
             [metrics.gauges :refer [gauge-fn]]
             [metrics.timers :refer [time! timer]]
             [metrics.reporters.jmx :as jmx-reporter]
-            [murphy :refer [with-final]]
+            [murphy :refer [try! with-final]]
             [overtone.at-at :refer [mk-pool every interspaced stop-and-reset-pool!]]
             [puppetlabs.i18n.core :refer [trs tru]]
             [puppetlabs.kitchensink.core :as kitchensink]
@@ -95,6 +95,33 @@
    (java.io Closeable)
    [java.util.concurrent.locks ReentrantLock]
    [org.joda.time Period]))
+
+(defn stop-reporters [registries]
+  (letfn [(stop [[registry & registries]]
+            (when registry
+              (try!
+               (stop registries)
+               (finally
+                 ;; Not certain whether :reporter can be nil
+                 (some-> (:reporter registry) jmx-reporter/stop)))))]
+    (stop (vals registries))))
+
+(defn init-puppetdb
+  [context]
+  (with-final [_ metrics/metrics-registries :error stop-reporters
+               cmd-event-ch (async/chan 1000) :error async/close!
+               cmd-event-mult (async/mult cmd-event-ch) :error async/untap-all]
+    (doseq [{:keys [reporter]} (vals metrics/metrics-registries)]
+      (jmx-reporter/start reporter))
+    (assoc context
+           :cmd-event-ch cmd-event-ch
+           :cmd-event-mult cmd-event-mult
+           :url-prefix (atom nil)
+           ;; This coordination is needed until we no longer
+           ;; support jdk < 10.
+           ;; https://bugs.openjdk.java.net/browse/JDK-8176254
+           :stop-status (atom {})
+           :shutdown-request (atom nil))))

 (def database-metrics-registry (get-in metrics/metrics-registries [:database :registry]))

@@ -396,21 +423,23 @@
   not a normal shutdown, emergency? must be set, which currently just
   produces a fatal level level log message, instead of info."
   [{:keys [stop-status] :as context}]
-  (log/info (trs "Shutdown request received; puppetdb exiting."))
-  (when-let [pool (:job-pool context)]
-    (stop-and-reset-pool! pool))
-  ;; Wait up to ~5s for https://bugs.openjdk.java.net/browse/JDK-8176254
-  (swap! stop-status assoc :stopping true)
-  (if (utils/await-ref-state stop-status ready-to-stop? (stop-gc-wait-ms) false)
-    (log/info (trs "Periodic activities halted"))
-    (log/info (trs "Forcibly terminating periodic activities")))
-  (close-write-dbs (get-in context [:shared-globals :scf-write-dbs]))
-  (when-let [ds (get-in context [:shared-globals :scf-read-db :datasource])]
-    (.close ^Closeable ds))
-
-  (when-let [command-loader (:command-loader context)]
-    (future-cancel command-loader))
-  context)
+  (try!
+   (log/info (trs "Shutdown request received; puppetdb exiting."))
+   context
+   (finally (some-> (:job-pool context) stop-and-reset-pool!))
+   (finally
+     ;; Wait up to ~5s for https://bugs.openjdk.java.net/browse/JDK-8176254
+     (swap! stop-status assoc :stopping true)
+     (if (utils/await-ref-state stop-status ready-to-stop? (stop-gc-wait-ms) false)
+       (log/info (trs "Periodic activities halted"))
+       (log/info (trs "Forcibly terminating periodic activities"))))
+   (finally (close-write-dbs (get-in context [:shared-globals :scf-write-dbs])))
+   (finally (some-> (get-in context [:shared-globals :scf-read-db :datasource])
+                    .close))
+   (finally (some-> (:command-loader context) future-cancel))
+   (finally (some-> (:cmd-event-ch context) async/close!))
+   (finally (some-> (:cmd-event-mult context) async/untap-all))
+   (finally (stop-reporters metrics/metrics-registries))))

 ;; A map of required postgres settings and their expected value.
 ;; PuppetDB will refuse to start unless ALL of these values
@@ -942,21 +971,9 @@
   [[:DefaultedConfig get-config]
    [:WebroutingService add-ring-handler get-registered-endpoints]
    [:ShutdownService request-shutdown]]
-  (init [this context]
-
-        (doseq [{:keys [reporter]} (vals metrics/metrics-registries)]
-          (jmx-reporter/start reporter))
-        (let [cmd-event-ch (async/chan 1000)
-              cmd-event-mult (async/mult cmd-event-ch)]
-          (assoc context
-                 :cmd-event-ch cmd-event-ch
-                 :cmd-event-mult cmd-event-mult
-                 :url-prefix (atom nil)
-                 ;; This coordination is needed until we no longer
-                 ;; support jdk < 10.
-                 ;; https://bugs.openjdk.java.net/browse/JDK-8176254
-                 :stop-status (atom {})
-                 :shutdown-request (atom nil))))
+
+  (init [this context] (init-puppetdb context))
+
   (start
    [this context]
    ;; Some tests rely on keeping all the logic out of this function,
@@ -965,15 +982,7 @@
                                get-registered-endpoints
                                (shutdown-requestor request-shutdown this)))

-  (stop [this context]
-        (doseq [{:keys [reporter]} (vals metrics/metrics-registries)]
-          (jmx-reporter/stop reporter))
-        (let [{:keys [cmd-event-mult cmd-event-ch]} context]
-          (when cmd-event-mult
-            (async/untap-all cmd-event-mult))
-          (when cmd-event-ch
-            (async/close! cmd-event-ch)))
-        (stop-puppetdb context))
+  (stop [this context] (stop-puppetdb context))

   (set-url-prefix [this url-prefix]
                   (let [old-url-prefix (:url-prefix (service-context this))]


Fix broken realm sorting

Fix broken realm sorting

This fixes bugs #2520 and #2484
The cause of the bugs is the fact that calling `.sorted` method
on the realm resultset produces another resultset which is sorted
when iterated through `Iterator<T>` interface, but does absolutely
nothing to way how resultset object is serialised (printed out
as JSON).
So when we sorted, printed to json, parsed back through transit
and expected the order to be retained, it was not, and it was
failing quite randomly.
To be precise, it failed in a case where we sorted the resultset
according to some property and picked the top element from the result.
As the top element picking was done AFTER the sorted realm resultset
was converted into cljs datastructure, it was sometimes failing.

This fix just ensures that we select the single element from js
resultset (where sorting info is still retained) and only convert
that single element to cljs (it's also much more efficient).

--- src/status_im/data_store/realm/core.cljs
+++ src/status_im/data_store/realm/core.cljs
@@ -73,7 +73,7 @@
         (reset! account-realm (open-migrated-realm address account/schemas))
         (handler nil)))))

-; realm functions
+;; realm functions

 (defn and-query [queries]
   (str/join " and " queries))
@@ -128,17 +128,19 @@

 (def reader (transit/reader :json))

+(defn- internal-convert [js-object]
+  (->> js-object
+       (.stringify js/JSON)
+       (transit/read reader)
+       walk/keywordize-keys))
+
 (defn js-object->clj
   "Converts any js type/object into a map recursively
   Performs 5 times better than iterating over the object keys
   and that would require special care for collections"
   [js-object]
-  (let [o (->> js-object
-               (.stringify js/JSON)
-               (transit/read reader))]
-    (walk/keywordize-keys (if (map? o)
-                            (map->vec o)
-                            o))))
+  (let [o (internal-convert js-object)]
+    (if (map? o) (map->vec o) o)))

 (defn fix-map->vec
   "Takes a map m and a keyword k
@@ -161,8 +163,8 @@
 (defn single [result]
   (aget result 0))

-(def single-clj
-  (comp first js-object->clj))
+(defn single-clj [results]
+  (some-> results single internal-convert))

 (defn- get-schema-by-name [opts]
   (->> opts


update lein config

update lein config

--- misc/lein/profiles.clj
+++ misc/lein/profiles.clj
@@ -1,4 +1,4 @@
-{:user {:plugins [[cider/cider-nrepl "0.9.1"]
+{:user {:plugins [[cider/cider-nrepl "0.14.0"]
                   [refactor-nrepl "1.1.0"]
                   [jonase/eastwood "0.2.3"]]}}


Minor correction to better fit margin

Minor correction to better fit margin

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -38,7 +38,8 @@
 (defn rand-minimal-xy-monitor-treatment-distance []
   (let [minimum-euclidean-distance 946.9745
         x-component (* minimum-euclidean-distance (rand))
-        y-component (Math/sqrt (- (* minimum-euclidean-distance minimum-euclidean-distance) (* x-component x-component)))]
+        y-component (Math/sqrt (- (* minimum-euclidean-distance minimum-euclidean-distance)
+                                  (* x-component x-component)))]
     [x-component y-component]))

 (defn rand-well-number []


fix bug in data filtering

fix bug in data filtering

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

--- plugins/DataBrowser/src/org/micromanager/browser/core.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/core.clj
@@ -102,14 +102,20 @@

 (defn set-filter [table text]
   (let [chunks (.split text "\\s")
-        sorter (.getRowSorter table)
-        column-indices
-          (int-array (map #(.getModelIndex %) (get-table-columns table)))
-        filters
-          (map #(RowFilter/regexFilter (str "(?i)\\Q" % "\\E") column-indices)
-               chunks)]
-    (do (.setRowFilter sorter
-          (RowFilter/andFilter filters)))))
+        ;_ (dorun (map println chunks))
+        filter
+        (when-not (empty? (remove empty? chunks))
+          (let [column-indices (int-array
+                                 (map #(.getModelIndex %)
+                                      (get-table-columns table)))
+                filters (map #(RowFilter/regexFilter
+                                (str "(?i)\\Q" % "\\E")
+                                column-indices) chunks)]
+            ;(println (seq column-indices) (map #(str "(?i)\\Q" % "\\E") chunks))
+            ;(println (count filters))
+            (RowFilter/andFilter filters)))]
+    ;(println filter)
+    (.setRowFilter (.getRowSorter table) filter)))

 (def filter-agent (agent nil))

@@ -502,16 +508,15 @@
   (update-collection-menu collection-name)
   (set-last-collection-name collection-name)
   (let [table (@browser :table)
-        model (.getModel table)
         {:keys [browser-model-data
                 browser-model-headings
                 window-size display-columns
-                locations sorted-column]} settings]
+                locations sorted-column]} settings
+        model (create-browser-table-model browser-model-headings)]
+    (.setModel table model)
     (dosync
       (ref-set current-data (vec (map (fn [r] (vec (map #(get r (keyword %)) tags))) browser-model-data)))
       (ref-set current-locations (apply sorted-set locations)))
-    (when (pos? (count @current-data))
-      (set-default-comparator table))
     (.fireTableDataChanged model)
     (-> @settings-window :locations :table .getModel .fireTableDataChanged)
     (remove-all-columns table)
@@ -520,15 +525,17 @@
         (doto (add-browser-column (:title col))
           (.setPreferredWidth (* total-width (:width col))))))
     ;(println "sorted-column" sorted-column :model-column)
+    (when (pos? (count @current-data))
+      (set-default-comparator table))
     (when sorted-column
-    (try
-      (.. table getRowSorter
-          (setSortKeys (list (RowSorter$SortKey.
-                               (.indexOf tags (sorted-column :model-column))
-                               (nth (SortOrder/values) (sorted-column :order))))))
-      (catch Exception e nil)))
+      (try
+        (.. table getRowSorter
+            (setSortKeys (list (RowSorter$SortKey.
+                                 (.indexOf tags (sorted-column :model-column))
+                                 (nth (SortOrder/values) (sorted-column :order))))))
+        (catch Exception e nil)))
     (-> @settings-window :columns :table
-                         .getModel .fireTableDataChanged))
+        .getModel .fireTableDataChanged))
   (update-browser-status))

 ;; creating a new collection


Remove lock.

Remove lock.

--- src/via/netty/http2/client.clj
+++ src/via/netty/http2/client.clj
@@ -8,8 +8,6 @@
   (delay
     (Executors/newFixedThreadPool
      (* 2 (.availableProcessors (Runtime/getRuntime))))))
-
-(def http-client-lock (Object.))

 (defn new-http-client
   []
@@ -23,14 +21,11 @@

 (defn http-client
   [client]
-  (or client
-      (locking http-client-lock
-        @@default-http-client)))
+  (or client @@default-http-client))

 (defn reset-default-client!
   []
-  (locking http-client-lock
-    (reset! default-http-client (delay (new-http-client)))))
+  (reset! default-http-client (delay (new-http-client))))

 (defn request
   [{:keys [url headers method client connection-reset-retries]


Kind of a catch all, not really.

Kind of a catch all, not really.

--- src/wishlistd/views/routes.clj
+++ src/wishlistd/views/routes.clj
@@ -10,3 +10,6 @@

 (defpage [:post "/wishlist/"] []
   (wishlist/create-wishlist-json))
+
+(defpage "/:dontcare" [] ; catchall! kinda...
+  (wishlist/main-page))


polygon angles needs more thought to prevent returning outside angle in concave poly

--- test/infinitelives/utils/geom2_test.cljs
+++ test/infinitelives/utils/geom2_test.cljs
@@ -31,15 +31,15 @@
     (is (= (geom2/polygon-triplets poly)
            [[d a b] [a b c] [b c d] [c d a]]))))

-
-(deftest polygon-angles
-  (let [a (vec2/vec2 0 0)
-        b (vec2/vec2 0 4)
-        c (vec2/vec2 3 3)
-        d (vec2/vec2 4 1)
-        e (vec2/vec2 3 0)
-        poly [a b c d e]]
-    (println
-     (sort (map vector
-                              (map #(apply geom2/angle %) (geom2/polygon-triplets poly))
-                              (range))))))
+(comment
+  (deftest polygon-angles
+    (let [a (vec2/vec2 0 0)
+          b (vec2/vec2 0 4)
+          c (vec2/vec2 3 3)
+          d (vec2/vec2 4 1)
+          e (vec2/vec2 3 0)
+          poly [a b c d e]]
+      (println
+       (sort (map vector
+                  (map #(apply geom2/angle %) (geom2/polygon-triplets poly))
+                  (range)))))))


CMR-149: Updated integration tests to use persistent http connections to improve test performance.

--- int_test/cmr/metadata_db/int_test/utility.clj
+++ int_test/cmr/metadata_db/int_test/utility.clj
@@ -9,7 +9,17 @@
             [clj-time.local :as l]
             [clj-time.coerce :as cr]
             [inflections.core :as inf]
-            [cmr.transmit.config :as transmit-config]))
+            [cmr.transmit.config :as transmit-config]
+            [clj-http.conn-mgr :as conn-mgr]))
+
+(def conn-mgr-atom (atom nil))
+
+(defn conn-mgr
+  "Returns the HTTP connection manager to use. This allows integration tests to use persistent
+  HTTP connections"
+  []
+  (when-not @conn-mgr-atom
+    (reset! conn-mgr-atom  (conn-mgr/make-reusable-conn-manager {}))))

 (def concepts-url (str "http://localhost:" (transmit-config/metadata-db-port) "/concepts/"))

@@ -86,7 +96,8 @@
   [concept-type provider-id native-id]
   (let [response (client/get (str concept-id-url concept-type "/" provider-id "/" native-id)
                              {:accept :json
-                              :throw-exceptions false})
+                              :throw-exceptions false
+                              :connection-manager (conn-mgr)})
         status (:status response)
         body (cheshire/parse-string (:body response))
         {:strs [concept-id errors]} body]
@@ -97,7 +108,8 @@
   [concept-id revision-id]
   (let [response (client/get (str concepts-url concept-id "/" revision-id)
                              {:accept :json
-                              :throw-exceptions false})
+                              :throw-exceptions false
+                              :connection-manager (conn-mgr)})
         status (:status response)]
     (if (= status 200)
       {:status status :concept (parse-concept response)}
@@ -108,7 +120,8 @@
   [concept-id]
   (let [response (client/get (str concepts-url concept-id)
                              {:accept :json
-                              :throw-exceptions false})
+                              :throw-exceptions false
+                              :connection-manager (conn-mgr)})
         status (:status response)]
     (if (= status 200)
       {:status status :concept (parse-concept response)}
@@ -121,7 +134,8 @@
                               {:body (cheshire/generate-string tuples)
                                :content-type :json
                                :accept :json
-                               :throw-exceptions false})
+                               :throw-exceptions false
+                               :connection-manager (conn-mgr)})
         status (:status response)]
     (if (= status 200)
       {:status status
@@ -134,7 +148,8 @@
   (let [response (client/get (str concepts-url "search/" (inf/plural (name concept-type)))
                              {:query-params params
                               :accept :json
-                              :throw-exceptions false})
+                              :throw-exceptions false
+                              :connection-manager (conn-mgr)})
         status (:status response)]
     (if (= status 200)
       {:status status
@@ -149,7 +164,8 @@
                               {:body (cheshire/generate-string concept)
                                :content-type :json
                                :accept :json
-                               :throw-exceptions false})
+                               :throw-exceptions false
+                               :connection-manager (conn-mgr)})
         status (:status response)
         body (cheshire/parse-string (:body response))
         {:strs [revision-id concept-id errors]} body]
@@ -164,7 +180,8 @@
               (format "%s%s/%s" concepts-url concept-id revision-id)
               (format "%s%s" concepts-url concept-id))
         response (client/delete url
-                                {:throw-exceptions false})
+                                {:throw-exceptions false
+                                 :connection-manager (conn-mgr)})
         status (:status response)
         body (cheshire/parse-string (:body response))
         {:strs [revision-id errors]} body]
@@ -175,7 +192,8 @@
   [concept-id revision-id]
   (let [url (format "%sforce-delete/%s/%s" concepts-url concept-id revision-id)
         response (client/delete url
-                                {:throw-exceptions false})
+                                {:throw-exceptions false
+                                 :connection-manager (conn-mgr)})
         status (:status response)
         body (cheshire/parse-string (:body response))
         {:strs [revision-id errors]} body]
@@ -219,7 +237,8 @@
                               {:body (cheshire/generate-string {:provider-id provider-id})
                                :content-type :json
                                :accept :json
-                               :throw-exceptions false})
+                               :throw-exceptions false
+                               :connection-manager (conn-mgr)})
         status (:status response)
         body (cheshire/parse-string (:body response))
         errors (get body "errors")
@@ -231,7 +250,8 @@
   []
   (let [response (client/get providers-url
                              {:accept :json
-                              :throw-exceptions false})
+                              :throw-exceptions false
+                              :connection-manager (conn-mgr)})
         status (:status response)
         body (cheshire/parse-string (:body response))
         errors (get body "errors")
@@ -243,7 +263,8 @@
   [provider-id]
   (let [response (client/delete (format "%s/%s" providers-url provider-id)
                                 {:accept :json
-                                 :throw-exceptions false})
+                                 :throw-exceptions false
+                                 :connection-manager (conn-mgr)})
         status (:status response)
         body (cheshire/parse-string (:body response))
         errors (get body "errors")]
@@ -261,7 +282,8 @@
 (defn reset-database
   "Make a request to reset the database by clearing out all stored concepts."
   []
-  (let [response (client/post reset-url {:throw-exceptions false})
+  (let [response (client/post reset-url {:throw-exceptions false
+                                         :connection-manager (conn-mgr)})
         status (:status response)]
     status))


Added formvalidation example.

Added formvalidation example.

--- clojure/sodium/src/sodium/s_widgets.clj
+++ clojure/sodium/src/sodium/s_widgets.clj
@@ -2,7 +2,7 @@
   (:require [sodium.core :refer :all])
   (:require [clojure.string :as s])
   (:import [nz.sodium Cell  CellLoop Listener Stream StreamLoop StreamSink Operational Transaction Unit])
-  (:import [javax.swing JButton JFrame JLabel JPanel JTextField SwingUtilities])
+  (:import [javax.swing JButton JComponent JFrame JLabel JPanel JTextField SwingUtilities])
   (:import [java.awt FlowLayout GridBagLayout GridBagConstraints])
   (:import [java.awt.event ActionListener])
   (:import [javax.swing.event DocumentEvent DocumentListener]))
@@ -64,9 +64,15 @@

 (defn s-text-field
   ([init-text] (s-text-field (Stream.) init-text 15))
-  ;([^String init-text ^Long width] (s-text-field (Stream.) init-text width))
-  ([^Stream s-text ^String init-text] (s-text-field s-text init-text 15))
-  ([^Stream s-text ^String init-text ^long width] (s-text-field s-text init-text width (Cell. true)))
+  ([string-or-stream string-or-width]
+     (if (string? string-or-stream)
+       (s-text-field (Stream.) string-or-stream string-or-width (Cell. true))
+       (s-text-field string-or-stream string-or-width 15 (Cell. true))))
+  ([string-or-stream string-or-width cell-or-width]
+     (if (string? string-or-stream)
+       (s-text-field (Stream.) string-or-stream string-or-width cell-or-width)
+       (s-text-field string-or-stream string-or-width cell-or-width (Cell. true))))
+  ;(s-text-field s-text init-text width (Cell. true)))
   ([^Stream s-text ^String init-text ^long width ^Cell enabled]
    (let [s-decrement (StreamSink.)
          allow (.map
@@ -103,7 +109,7 @@
                                                     (println "dispatch else")
                                                     (SwingUtilities/invokeLater (fn []
                                                                                (.setEnabled s-text-field ena)))))))))
-     {:jtext s-text-field :cell text :stream s-user-changes :dl dl})))
+     {:jcomp s-text-field :jtext s-text-field :cell text :stream s-user-changes :dl dl})))

 (defn label
   []
@@ -291,7 +297,7 @@
     (.loop s-set-value (.snapshot s-delta value (apply2 [delta value]
                                                         (println (str delta ":" value))
                                                         (+ delta value))))
-    {:jpanel spinner :cell value}))
+    {:jcomp spinner :jpanel spinner :cell value}))

 (defn spinme
   []
@@ -305,9 +311,121 @@
       (.setSize 400 160)
       (.setVisible true))))

-
+(defn form-validation
+  []
+  (let [view (JFrame. "formvalidation")]
+    (Transaction/runVoid
+     (fn []
+       (let [max-emails 4
+             gridbag (GridBagLayout.)
+             all-valid (Cell. true)
+             valids (atom {})
+             x (atom {:row0 { :label (JLabel. "Name")
+                             :component (s-text-field "" 30)}
+                      :row1 { :label (JLabel. "No of email addresses")
+                             :component (s-spinner 1)}})]
+         (reset! valids (conj @valids {:valid0
+                                     (.map (:cell (:component (:row0 @x))) (apply1 [t]
+                                                                                (cond
+                                                        (= "" (s/trim t))
+                                                        "<-- enter something"
+                                                        (< 0 (.indexOf (s/trim t)))
+                                                        "<-- must contain space"
+                                                        :else "")))
+                                     :valid1   (.map (:cell (:component (:row1 @x))) (apply1 [n]
+                                                                                (if (or (< n max-emails)
+                                                               (> n max-emails))
+                                                         (str "<-- must be 1 to " max-emails)
+                                                         "")))
+                                     }))
+
+         (dotimes [row max-emails]
+           (let [email (+ row 1)
+                 enabled (.map (:cell (:component (:row1 @x)))
+                               (apply1 [n] (< row n)))
+                 k-row (keyword (str "row" (+ row 2)))
+                 k-valid (keyword (str "valid" (+ row 2)))]
+             (reset! x (conj @x {k-row
+                                 {:label (JLabel. (str "Email #" email))
+                                  :component (s-text-field "" 30 enabled) }}))
+             (reset! valids (conj @valids {k-valid
+                                           (Cell/lift (apply2 [e n]
+                                                             (cond
+                                                              (>= row n)
+                                                              ""
+                                                              (= "" (s/trim e))
+                                                              "<-- enter something"
+                                                              (< 0 (.indexOf e "@"))
+                                                              "<-- must contain @"
+                                                              :else ""))
+                                                     (:cell (:component (k-row @x)))
+                                                     (:cell (:component (:row2 @x))))
+                                           } ))))
+         (doto view
+           (.setLayout gridbag)
+           (grid-bag-layout
+            :gridwidth 1 :gridheight 1
+            :fill :BOTH
+            ))
+         (dotimes [row (+ max-emails 2)]
+           (let [k-row (keyword (str "row" row))
+                 k-valid (keyword (str "valid" row))]
+             (doto view
+               (grid-bag-layout
+                :weightx 0
+                :gridx 0 :gridy row
+                (:label (k-row @x))
+                :weightx 1.0
+                :gridx 1
+                (:jcomp (:component (k-row @x)))
+                :weightx 0
+                :gridx 2
+                (s-label (k-valid @valids))))
+             (Cell/lift (apply2 [a b]
+                                (and a b))
+                        all-valid
+                        (.map (k-valid @valids) (apply1 [t] (= "" t))))))
+         (doto view
+           (grid-bag-layout
+            :weightx 1.0
+            :gridx 0 :gridy 6
+            :gridwidth 3
+            :fill :NONE
+            (:jbutton (s-button "OK" all-valid))))
+         (pr @valids))))
+    (doto view
+      (.setSize 600 200)
+      (.setVisible true))))
+
+ (form-validation)
+
+
+
+(let [x (atom { :row0 { :foo :bar}})]
+
+  (dotimes [row 4]
+    (let [email (+ row 1)
+          enabled true
+          k-row (keyword (str "row" email))]
+      (reset! x (conj @x {k-row {:label (JLabel. (str "Email #" email))
+                                 :component '() } }))
+      (println (str "::: " (update-in @x [k-row :component] :bar )))))
+    (println @x))
+
+(def n 5)
+
+
+(if (or (< n 1) (> n 4))
+  (println "not ok")
+  (println "ok"))
+
+
+
+
+
 (defn -main
   [& args]
+  ;(form-validation)
   (spinme)
   (add)
   (spinner)


Update core; add helper for minimize function

--- clojure/src/evolution_programs/core.clj
+++ clojure/src/evolution_programs/core.clj
@@ -38,3 +38,4 @@
        logger))))

 (defn maximize [f & options] (apply run (cons (objective/maximize f) options)))
+(defn minimize [f & options] (apply run (cons (objective/minimize f) options)))


more logging about model-creation

more logging about model-creation

--- src/babel/espanol.cljc
+++ src/babel/espanol.cljc
@@ -17,10 +17,14 @@
                            copy]]))

 (def small-model (promise))
-(defn small [] (if (and (not (nil? small-model))
-                        (realized? small-model))
-                 @small-model
-                 @(deliver small-model (grammar/small))))
+(defn small []
+  (log/debug (str "resolving model: small."))
+  (if (and (not (nil? small-model))
+           (realized? small-model))
+    @small-model
+    (do
+      (log/debug (str "model:small does not exist yet."))
+      @(deliver small-model (grammar/small)))))

 (def medium-model (promise))
 (defn medium [] (if (and (realized? medium-model)


Improve manual test for fun-mode in cljs by logging last 10 events.

--- test/cljs/snippets/manual.cljs
+++ test/cljs/snippets/manual.cljs
@@ -20,21 +20,31 @@
           (q/text (str (q/hour) ":" (q/minute) ":" (q/seconds)) 20 50))
   :key-pressed #(q/redraw))

+(defn add-event [state data]
+  (update-in state [:last-events]
+             #(take 10 (cons data %))))
+
+(defn print-state [state]
+  (q/text (str ":round " (:round state)) 50 50)
+  (doseq [[ind event] (map vector
+                           (range)
+                           (:last-events state))]
+    (q/text (pr-str event) 50 (+ 70 (* ind 15)))))

 (defn single-fn [n]
   (fn [state]
     (q/background 255)
-    (q/text (str n) 50 20)
-    (q/text (str state) 50 50)
-    state))
+    (q/text (pr-str n) 50 20)
+    (print-state state)
+    (add-event state n)))

 (defn double-fn [n]
   (fn [state event]
     (q/background 255)
-    (q/text (str n) 50 20)
-    (q/text (str event) 50 35)
-    (q/text (str state) 50 50)
-    state))
+    (q/text (pr-str n) 50 20)
+    (q/text (pr-str event) 50 35)
+    (print-state state)
+    (add-event state [n event])))

 (q/defsketch fun-mode
   :size [500 500]


fail the build

fail the build

--- test/clojento/magento/t_db.clj
+++ test/clojento/magento/t_db.clj
@@ -186,7 +186,7 @@
       (fact "meta contains time and total time"
             (meta (get-product-data (:db @system) -1 :debug true)) => (contains {:time pos? :total-time pos?}))
       (fact "meta contains all queries"
-            (count (:queries (meta (get-product-data (:db @system) -1 :debug true)))) => 2))
+            (count (:queries (meta (get-product-data (:db @system) -1 :debug true)))) => 3))

     (log/info "completed tests with read-only DB")))


Pre-emptive init using prog.

Pre-emptive init using prog.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -176,12 +176,12 @@
         (println :render-ch event-str)
         (recur)))
     (go-loop []
-      (<! go-ch)
       (let [prog (get-el-value "prog")
             prog-js (str "with (cbfg.world.t1) {" prog "}")]
         (let [res (try (js/eval prog-js)
                        (catch js/Object ex ex))]
           (println :prog-res res)))
+      (<! go-ch)
       (recur))))

 ; --------------------------------------------


Indicate when a card is trashed in order to use an ability. First attempt at Armand "Geist" Walker.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -3,12 +3,12 @@
 (def trash-program {:prompt "Choose a program to trash" :label "Trash a program"
                     :msg (msg "trash " (:title target))
                     :choices {:req #(= (:type %) "Program")}
-                    :effect (effect (trash target))})
+                    :effect (effect (trash target {:cause :subroutine}))})

 (def trash-hardware {:prompt "Choose a piece of hardware to trash" :label "Trash a piece of hardware"
                      :msg (msg "trash " (:title target))
                      :choices {:req #(= (:type %) "Hardware")}
-                     :effect (effect (trash target))})
+                     :effect (effect (trash target {:cause :subroutine}))})

 (def cards
   {"Accelerated Beta Test"
@@ -83,7 +83,7 @@
                  :effect (effect (gain :credit (* 2 (:counter card))) (trash card))}]}

    "All-nighter"
-   {:abilities [{:cost [:click 1] :effect (effect (trash card) (gain :click 2))
+   {:abilities [{:cost [:click 1] :effect (effect (trash card {:cause :ability-cost}) (gain :click 2))
                  :msg "gain [Click][Click]"}]}

    "Amped Up"
@@ -122,6 +122,11 @@
     :effect (effect (move target :hand)
                     (system-msg (str "adds " (if (:seen target) (:title target) "a card") " to HQ")))}

+   "Armand \"Geist\" Walker"
+   {:effect (effect (gain :link 1))
+    :events {:trash {:optional {:req (req (and (= side :runner) (= (second targets) :ability-cost)))
+                                :prompt "Draw a card?" :msg (msg "draw a card" targets) :effect (effect (draw 1))}}}}
+
    "Armitage Codebusting"
    {:data {:counter 12}
     :abilities [{:cost [:click 1] :counter-cost 2 :msg "gain 2 [Credits]"
@@ -376,7 +381,7 @@
    {:abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
                  :priority true
                  :choices (req (filter #(and (has? % :type "Program")) (:discard runner)))
-                 :effect (effect (trash card) (runner-install target))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (runner-install target))}]}

    "Clone Retirement"
    {:msg "remove 1 bad publicity" :effect (effect (lose :bad-publicity 1))
@@ -484,16 +489,28 @@
     :effect (req (if (> (:credit corp) 6)
                    (gain state :corp :credit 7) (lose state :corp :credit :all)))}

+   "Cortez Chip"
+   {:abilities [{:label "increase cost to rez a piece of ice by 2 [Credits]"
+                 :prompt "Choose a piece of ice" :choices {:req #(and (not (:rezzed %)) (= (:type %) "ICE"))}
+                 :effect (effect (update! (assoc card :cortez-target target))
+                                 (trash (get-card state card) {:cause :ability-cost}))}]
+    :trash-effect {:effect (effect (register-events {:pre-rez {:req (req (= (:cid target) (:cid (:cortez-target card))))
+                                                               :effect (effect (rez-cost-bonus 2))}
+                                                     :runner-turn-ends {:effect (effect (unregister-events card))}
+                                                     :corp-turn-ends {:effect (effect (unregister-events card))}}
+                                                    (get-card state card)))}
+    :events {:pre-rez nil :runner-turn-ends nil :corp-turn-ends nil}}
+
    "Crash Space"
    {:prevent {:damage [:meat]}
     :recurring 2
     :abilities [{:label "Trash to prevent up to 3 meat damage"
                  :msg "prevent up to 3 meat damage"
-                 :effect (effect (trash card) (damage-prevent :meat 3))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (damage-prevent :meat 3))}]}

    "Crescentus"
    {:abilities [{:req (req current-ice) :msg (msg "derez " (:title current-ice))
-                 :effect (effect (trash card) (derez current-ice))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (derez current-ice))}]}

    "Cybsoft MacroDrive"
    {:recurring 1}
@@ -572,7 +589,7 @@
    {:additional-cost [:click 3] :effect (effect (gain :credit 10))}

    "Decoy"
-   {:abilities [{:msg "avoid 1 tag" :effect (effect (trash card))}]}
+   {:abilities [{:msg "avoid 1 tag" :effect (effect (trash card {:cause :ability-cost}))}]}

    "Dedicated Response Team"
    {:events {:successful-run-ends {:req (req tagged) :msg "do 2 meat damage"
@@ -792,8 +809,8 @@
    "Fall Guy"
    {:prevent {:trash [:resource]}
     :abilities [{:label "Prevent a resource from being trashed"
-                 :effect (effect (trash-prevent :resource 1 ) (trash card {:unpreventable true}))}
-                {:effect (effect (trash card) (gain :credit 2)) :msg "gain 2 [Credits]"}]}
+                 :effect (effect (trash-prevent :resource 1) (trash card {:unpreventable true :cause :ability-cost}))}
+                {:effect (effect (trash card {:cause :ability-cost}) (gain :credit 2)) :msg "gain 2 [Credits]"}]}

    "False Lead"
    {:abilities [{:req (req (>= (:click runner) 2)) :msg "force the Runner to lose [Click][Click]"
@@ -807,7 +824,8 @@
    "Feedback Filter"
    {:prevent {:damage [:net :brain]}
     :abilities [{:cost [:credit 3] :msg "prevent 1 net damage" :effect (effect (damage-prevent :net 1))}
-                {:msg "prevent 2 brain damage" :effect (effect (trash card) (damage-prevent :brain 2)) }]}
+                {:msg "prevent 2 brain damage" :effect (effect (trash card {:cause :ability-cost})
+                                                               (damage-prevent :brain 2)) }]}

    "Feint"
    {:effect (effect (run :hq) (max-access 0))}
@@ -892,7 +910,8 @@
    {:abilities [{:cost [:click 2] :effect (effect (gain :credit 3)) :msg "gain 3 [Credits]"}]}

    "Gorman Drip v1"
-   {:abilities [{:cost [:click 1] :effect (effect (gain :credit (get-virus-counters state side card)) (trash card))
+   {:abilities [{:cost [:click 1] :effect (effect (gain :credit (get-virus-counters state side card))
+                                                  (trash card {:cause :ability-cost}))
                  :msg (msg "gain " (get-virus-counters state side card) " [Credits]")}]
     :events {:corp-click-credit {:effect (effect (add-prop :runner card :counter 1))}
              :corp-click-draw {:effect (effect (add-prop :runner card :counter 1))}}}
@@ -904,7 +923,7 @@
    {:abilities [{:cost [:click 1] :effect (effect (gain :credit 3)) :msg "gain 3 [Credits]"}]}

    "Grappling Hook"
-   {:abilities [{:msg "break all but 1 subroutine" :effect (effect (trash card))}]}
+   {:abilities [{:msg "break all but 1 subroutine" :effect (effect (trash card {:cause :ability-cost}))}]}

    "Gravedigger"
    {:events {:trash {:req (req (and (= (first (:zone target)) :servers) (= (:side target) "Corp")))
@@ -966,7 +985,7 @@

    "Hades Shard"
    {:abilities [{:msg "access all cards in Archives"
-                 :effect (effect (trash card) (handle-access (access state side [:archives])))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (handle-access (access state side [:archives])))}]}

    "Hard at Work"
    {:events {:runner-turn-begins {:msg "gain 2 [Credits] and lose [Click]"
@@ -1086,7 +1105,7 @@
     :abilities [{:cost [:click 1]
                  :msg (msg "move " (:counter card) " virus counter to " (:title target))
                  :choices {:req #(and (= (first (:zone %)) :rig) (has? % :subtype "Virus"))}
-                 :effect (effect (trash card) (add-prop target :counter (:counter card)))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (add-prop target :counter (:counter card)))}]}

    "Indexing"
    {:effect (effect (run :rd {:replace-access
@@ -1187,7 +1206,7 @@
    "Investigative Journalism"
    {:req (req (> (:bad-publicity corp) 0))
     :abilities [{:cost [:click 4] :msg "give the Corp 1 bad publicity"
-                 :effect (effect (gain :corp :bad-publicity 1) (trash card))}]}
+                 :effect (effect (gain :corp :bad-publicity 1) (trash card {:cause :ability-cost}))}]}

    "Kate \"Mac\" McCaffrey: Digital Tinker"
    {:effect (effect (gain :link 1))
@@ -1301,7 +1320,7 @@
    "LLDS Energy Regulator"
    {:prevent {:trash [:hardware]}
     :abilities [{:cost [:credit 3] :msg "prevent a hardware from being trashed"}
-                {:effect (effect (trash card)) :msg "prevent a hardware from being trashed"}]}
+                {:effect (effect (trash card {:cause :ability-cost})) :msg "prevent a hardware from being trashed"}]}

    "Lockpick"
    {:recurring 1}
@@ -1954,7 +1973,7 @@
                                                 (filter #(not (has? % :subtype "Virtual"))
                                                         (get-in runner [:rig :resource]))
                                                 (:hand runner))]
-                                (trash state side c))
+                                (trash state side c {:cause :ability-cost}))
                               (lose state side :credit :all :tag :all)
                               (damage-prevent state side :net Integer/MAX_VALUE)
                               (damage-prevent state side :meat Integer/MAX_VALUE)
@@ -1962,7 +1981,8 @@

    "Sacrificial Construct"
    {:prevent {:trash [:program :hardware]}
-    :abilities [{:effect (effect (trash-prevent :program 1) (trash-prevent :hardware 1) (trash card))}]}
+    :abilities [{:effect (effect (trash-prevent :program 1) (trash-prevent :hardware 1)
+                                 (trash card {:cause :ability-cost}))}]}

    "Sahasrara"
    {:recurring 2}
@@ -1972,7 +1992,7 @@
                  :prompt "Choose an event to play" :msg (msg "play " (:title target))
                  :choices (req (filter #(and (has? % :type "Event")
                                              (<= (:cost %) (:credit runner))) (:discard runner)))
-                 :effect (effect (trash card) (play-instant target))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (play-instant target))}]}

    "SanSan City Grid"
    {:effect (req (when-let [agenda (some #(when (= (:type %) "Agenda") %) (:content (card->server state card)))]
@@ -2090,7 +2110,7 @@
                  :priority true
                  :choices (req (filter #(has? % :type "Program") (:deck runner)))
                  :cost [:credit 2]
-                 :effect (effect (trash card) (runner-install target) (shuffle! :deck))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (runner-install target) (shuffle! :deck))}]}

    "Sentinel Defense Program"
    {:events {:damage {:req (req (= target :brain)) :msg "to do 1 net damage"
@@ -2240,7 +2260,7 @@
     :choices (req (filter #(has? % :subtype "Icebreaker") (:deck runner)))}

    "Spike"
-   {:abilities [{:msg "break up to 3 barrier subroutines" :effect (effect (trash card))}]}
+   {:abilities [{:msg "break up to 3 barrier subroutines" :effect (effect (trash card {:cause :ability-cost}))}]}

    "Spinal Modem"
    {:effect (effect (gain :memory 1)) :leave-play (effect (lose :memory 1)) :recurring 2
@@ -2381,7 +2401,7 @@

    "The Helpful AI"
    {:effect (effect (gain :link 1)) :leave-play (effect (lose :link 1))
-    :abilities [{:msg "give an icebreaker +2 strength" :effect (effect (trash card))}]}
+    :abilities [{:msg "give an icebreaker +2 strength" :effect (effect (trash card {:cause :ability-cost}))}]}

    "The Makers Eye"
    {:effect (effect (run :rd) (access-bonus 2))}
@@ -2528,7 +2548,8 @@
       :msg (msg "trash " (:title target)) :effect (effect (trash target))}]}

    "Utopia Shard"
-   {:abilities [{:effect (effect (trash-cards :corp (take 2 (shuffle (:hand corp)))) (trash card))
+   {:abilities [{:effect (effect (trash-cards :corp (take 2 (shuffle (:hand corp))))
+                                 (trash card {:cause :ability-cost}))
                  :msg "force the Corp to discard 2 cards from HQ at random"}]}

    "Valencia Estevez: The Angel of Cayambe"
@@ -2693,9 +2714,9 @@

    "Deus X"
    {:prevent {:damage [:net]}
-    :abilities [{:msg "break any number of AP subroutines" :effect (effect (trash card))}
+    :abilities [{:msg "break any number of AP subroutines" :effect (effect (trash card {:cause :ability-cost}))}
                 {:msg "prevent any amount of net damage"
-                 :effect (effect (trash card) (damage-prevent :net Integer/MAX_VALUE))}]}
+                 :effect (effect (trash card {:cause :ability-cost}) (damage-prevent :net Integer/MAX_VALUE))}]}

    "Eater"
    {:abilities [{:cost [:credit 1] :msg "break ICE subroutine and access 0 cards this run"
@@ -2721,7 +2742,7 @@
    "Gordian Blade"
    {:abilities [{:cost [:credit 1] :msg "break 1 code gate subroutine"}
                 {:cost [:credit 1] :msg "add 1 strength for the remainder of this run"
-                 :effect (effect (pump card 1 true))}]}
+                 :effect (effect (pump card 1 {:pump-duration :per-run}))}]}

    "Gingerbread"
    {:abilities [{:cost [:credit 1] :msg "break 1 tracer subroutine"}
@@ -2797,7 +2818,7 @@
                  :effect (effect (pump card 1 true))}]}

    "Sharpshooter"
-   {:abilities [{:msg "break any number of destroyer subroutines" :effect (effect (trash card))}
+   {:abilities [{:msg "break any number of destroyer subroutines" :effect (effect (trash card {:cause :ability-cost}))}
                 {:cost [:credit 1] :msg "add 2 strength" :effect (effect (pump card 2))}]}

    "Study Guide"
@@ -3476,7 +3497,7 @@
                                                  (:title (first (:deck corp)))) ["OK"] {}))}}}

    "Eden Shard"
-   {:abilities [{:effect (effect (trash card) (draw :corp 2))
+   {:abilities [{:effect (effect (trash card {:cause :ability-cost}) (draw :corp 2))
                  :msg "force the Corp to draw 2 cards"}]}

    "Ghost Runner"
@@ -3497,7 +3518,8 @@
    {:req (req (:made-run runner-reg))}

    "Tallie Perrault"
-   {:abilities [{:label "Draw 1 card for each Corp bad publicity" :effect (effect (trash card) (draw (:bad-publicity corp)))
+   {:abilities [{:label "Draw 1 card for each Corp bad publicity"
+                 :effect (effect (trash card {:cause :ability-cost}) (draw (:bad-publicity corp)))
                  :msg (msg "draw " (:bad-publicity corp) " cards")}]
     :events {:play-operation {:msg "give the Corp 1 bad publicity and take 1 tag"
                               :effect (effect (gain :bad-publicity 1) (gain :runner :tag 1))


First cut of body support

First cut of body support

--- src/clj_http/core2.clj
+++ src/clj_http/core2.clj
@@ -6,6 +6,8 @@
             [clj-http.util :refer [opt]]
             [clojure.pprint])
   (:import (java.io FilterInputStream InputStream)
+           (java.net URI)
+           (java.util Locale)
            (org.apache.http HttpHost)
            (org.apache.http.client.methods HttpGet)
            (org.apache.http.client.protocol HttpClientContext)
@@ -46,6 +48,41 @@
 (defn http-get []
   (HttpGet. "https://www.google.com"))

+(defn make-proxy-method-with-body
+  [method]
+  (fn [url]
+    (doto (proxy [HttpEntityEnclosingRequestBase] []
+            (getMethod [] (.toUpperCase (name method) Locale/ROOT)))
+      (.setURI (URI. url)))))
+
+(def proxy-delete-with-body (make-proxy-method-with-body :delete))
+(def proxy-get-with-body (make-proxy-method-with-body :get))
+(def proxy-copy-with-body (make-proxy-method-with-body :copy))
+(def proxy-move-with-body (make-proxy-method-with-body :move))
+(def proxy-patch-with-body (make-proxy-method-with-body :patch))
+
+(defn http-request-for
+  "Provides the HttpRequest object for a particular request-method and url"
+  [request-method ^String http-url body]
+  (case request-method
+    :get     (if body
+               (proxy-get-with-body http-url)
+               (HttpGet. http-url))
+    :head    (HttpHead. http-url)
+    :put     (HttpPut. http-url)
+    :post    (HttpPost. http-url)
+    :options (HttpOptions. http-url)
+    :delete  (if body
+               (proxy-delete-with-body http-url)
+               (HttpDelete. http-url))
+    :copy    (proxy-copy-with-body http-url)
+    :move    (proxy-move-with-body http-url)
+    :patch   (if body
+               (proxy-patch-with-body http-url)
+               (HttpPatch. http-url))
+    (throw (IllegalArgumentException.
+            (str "Invalid request method " request-method)))))
+
 (defn http-context []
   (HttpClientContext/create))

@@ -68,19 +105,45 @@
             (.close response)
             (.shutdown conn-mgr)))))))

-(defn request [{:keys [cookie-store] :as req}]
-  (let [conn-mgr (pooling-conn-mgr)
+(defn request
+  [{:keys [body
+           cookie-store
+           multipart
+           request-method
+           scheme
+           server-name
+           server-port
+           request-method
+           query-string
+           uri]
+    :as req}]
+  (let [scheme (name scheme)
+        http-url (str scheme "://" server-name
+                      (when server-port (str ":" server-port))
+                      uri
+                      (when query-string (str "?" query-string)))
+        conn-mgr (pooling-conn-mgr)
         client (http-client conn-mgr)
         context (http-context)
-        get-req (http-get)
-        response (.execute client get-req context)
-        entity (.getEntity response)
-        status (.getStatusLine response)]
+        http-req (http-request-for request-method http-url body)]
     (when cookie-store
       (.setCookieStore context cookie-store))
-    {:body (coerce-body-entity entity conn-mgr response)
-     :length (.getContentLength entity)
-     :chunked? (.isChunked entity)
-     :repeatable? (.isRepeatable entity)
-     :streaming? (.isStreaming entity)
-     :status (.getStatusCode status)}))
+    (if multipart
+      (.setEntity ^HttpEntityEnclosingRequest http-req
+                  (mp/create-multipart-entity multipart))
+      (when (and body (instance? HttpEntityEnclosingRequest http-req))
+        (if (instance? HttpEntity body)
+          (.setEntity ^HttpEntityEnclosingRequest http-req body)
+          (.setEntity ^HttpEntityEnclosingRequest http-req
+                      (if (string? body)
+                        (StringEntity. ^String body "UTF-8")
+                        (ByteArrayEntity. body))))))
+    (let [response (.execute client http-req context)
+          entity (.getEntity response)
+          status (.getStatusLine response)]
+      {:body (coerce-body-entity entity conn-mgr response)
+       :length (.getContentLength entity)
+       :chunked? (.isChunked entity)
+       :repeatable? (.isRepeatable entity)
+       :streaming? (.isStreaming entity)
+       :status (.getStatusCode status)})))


Gangway : Testing : Disabling purposefully broken test.check defspec.

This should allow for Travis CI builds to run clean.

--Tom

--- test/gangway/message_tests.clj
+++ test/gangway/message_tests.clj
@@ -13,7 +13,9 @@
               (first (sort v)))))

 ;; VLACS data exchange messages are defined as a vector of maps.
-(defspec abstract-message
+;; Disabling this example as Travic CI is now config'ed to run
+;; Immutant, etc.
+#_(defspec abstract-message
   ;; testing that reading EDN data structure into JSON and converting
   ;; back yields the same data structure.
   ;; Note: This test fails. Committing failing test to show how


Tearing down logss so that output is not repeated

--- test/time_tracker/fixtures.clj
+++ test/time_tracker/fixtures.clj
@@ -10,7 +10,8 @@

 (defn init! [f]
   (core/init!)
-  (f))
+  (f)
+  (core/teardown!))

 (defn destroy-db []
   (jdbc/with-db-transaction [conn (db/connection)]


Typo fix

Typo fix

--- src/compojure/core.clj
+++ src/compojure/core.clj
@@ -103,7 +103,7 @@
   #(apply routing % handlers))

 (defmacro defroutes
-  "Define a Ring handler function from a sequence of routes. The name may be
+  "Define a Ring handler function from a sequence of routes. The name may
   optionally be followed by a doc-string and metadata map."
   [name & routes]
   (let [[name routes] (name-with-attributes name routes)]


Contrary to popular belief I think it should be blank, not off

--- src/exploud/asgard.clj
+++ src/exploud/asgard.clj
@@ -187,7 +187,7 @@
    :keyName default-key-name
    :name (str application-name "-" environment)
    :ticket ticket-id
-   :trafficAllowed "off"})
+   :trafficAllowed ""})

 ;; # Concerning Asgard URL generation


fixed network date field

fixed network date field

--- src/cljs/swarmpit/component/network/info.cljs
+++ src/cljs/swarmpit/component/network/info.cljs
@@ -38,7 +38,7 @@
      (comp/form-section "General settings")
      (comp/form-item "ID" (:id item))
      (comp/form-item "NAME" (:networkName item))
-     (comp/form-item "CREATED" (:created item))
+     (comp/form-item-date "CREATED" (:created item))
      (comp/form-item "DRIVER" (:driver item))
      (comp/form-item "INTERNAL" (if (:internal item)
                                   "yes"


enables SSL tests after JDK11 migration (#1148)

--- waiter/integration/waiter/proto_test.clj
+++ waiter/integration/waiter/proto_test.clj
@@ -120,12 +120,9 @@
     (is "test completed marker")))

 (deftest ^:parallel ^:integration-slow ^:resource-heavy test-https-backend-proto-service
-  ;; Disabled on Travis: https://github.com/twosigma/waiter/issues/1137
-  (if-not (= "true" (System/getenv "TRAVIS"))
-    (testing-using-waiter-url
-      (run-backend-proto-service-test waiter-url "https" "https" "HTTP/1.1")
-      (is "test completed marker")))
-  (log/info "Skipping test in the Travis environment"))
+  (testing-using-waiter-url
+    (run-backend-proto-service-test waiter-url "https" "https" "HTTP/1.1")
+    (is "test completed marker")))

 (deftest ^:parallel ^:integration-slow ^:resource-heavy ^:explicit test-h2c-backend-proto-service
   (testing-using-waiter-url
@@ -133,12 +130,9 @@
     (is "test completed marker")))

 (deftest ^:parallel ^:integration-slow ^:resource-heavy test-h2-backend-proto-service
-  ;; Disabled on Travis: https://github.com/twosigma/waiter/issues/1137
-  (if-not (= "true" (System/getenv "TRAVIS"))
-    (testing-using-waiter-url
-      (run-backend-proto-service-test waiter-url "h2" "https" "HTTP/2.0")
-      (is "test completed marker")))
-  (log/info "Skipping test in the Travis environment"))
+  (testing-using-waiter-url
+    (run-backend-proto-service-test waiter-url "h2" "https" "HTTP/2.0")
+    (is "test completed marker")))

 (deftest ^:parallel ^:integration-fast test-internal-protocol
   (testing-using-waiter-url


fixed connection bug

fixed connection bug

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -178,7 +178,6 @@
                     :onplay #(.setPosition js/soundManager current-sound-id
                                                            position)})))))

-(.on socket "connect" #(.emit socket "connect" room-id))
 (.on socket "sign-in-success"
   (fn []
     (println "Successfully signed in!")


stopped songs from overwriting current song

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -101,7 +101,8 @@
           (request-new-file)
           (println (str "Number of music files downloaded "
                         (count (:music-files @app-state))))
-          (set! (.-onloadend reader) #(play-sound (.-result reader))))))))
+          (if (nil? (:current-sound @app-state))
+            (set! (.-onloadend reader) #(play-sound (.-result reader)))))))))

 (.change (js/$ "#file_upload_input")
   (fn [e]